{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}

module Cardano.Chain.Delegation.Map (
  Map (..),

  -- * Query
  memberR,
  notMemberR,
  pairMember,
  lookupR,

  -- * Update
  insert,

  -- * Conversion/traversal
  fromList,
  keysSet,
) where

import Cardano.Chain.Common.KeyHash (KeyHash)
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  fromByronCBOR,
  toByronCBOR,
 )
import Cardano.Prelude hiding (Map)
import Data.Bimap (Bimap)
import qualified Data.Bimap as Bimap
import qualified Data.Set as Set
import NoThunks.Class (NoThunks (..), noThunksInKeysAndValues)

newtype Map = Map
  { Map -> Bimap KeyHash KeyHash
unMap :: Bimap KeyHash KeyHash
  }
  deriving (Map -> Map -> Bool
(Map -> Map -> Bool) -> (Map -> Map -> Bool) -> Eq Map
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Map -> Map -> Bool
== :: Map -> Map -> Bool
$c/= :: Map -> Map -> Bool
/= :: Map -> Map -> Bool
Eq, Int -> Map -> ShowS
[Map] -> ShowS
Map -> String
(Int -> Map -> ShowS)
-> (Map -> String) -> ([Map] -> ShowS) -> Show Map
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Map -> ShowS
showsPrec :: Int -> Map -> ShowS
$cshow :: Map -> String
show :: Map -> String
$cshowList :: [Map] -> ShowS
showList :: [Map] -> ShowS
Show, (forall x. Map -> Rep Map x)
-> (forall x. Rep Map x -> Map) -> Generic Map
forall x. Rep Map x -> Map
forall x. Map -> Rep Map x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Map -> Rep Map x
from :: forall x. Map -> Rep Map x
$cto :: forall x. Rep Map x -> Map
to :: forall x. Rep Map x -> Map
Generic)
  deriving anyclass (Map -> ()
(Map -> ()) -> NFData Map
forall a. (a -> ()) -> NFData a
$crnf :: Map -> ()
rnf :: Map -> ()
NFData)

instance ToCBOR Map where
  toCBOR :: Map -> Encoding
toCBOR = Map -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR Map where
  fromCBOR :: forall s. Decoder s Map
fromCBOR = Decoder s Map
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance DecCBOR Map where
  decCBOR :: forall s. Decoder s Map
decCBOR = Bimap KeyHash KeyHash -> Map
Map (Bimap KeyHash KeyHash -> Map)
-> ([(KeyHash, KeyHash)] -> Bimap KeyHash KeyHash)
-> [(KeyHash, KeyHash)]
-> Map
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(KeyHash, KeyHash)] -> Bimap KeyHash KeyHash
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
Bimap.fromList ([(KeyHash, KeyHash)] -> Map)
-> Decoder s [(KeyHash, KeyHash)] -> Decoder s Map
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s [(KeyHash, KeyHash)]
forall s. Decoder s [(KeyHash, KeyHash)]
forall a s. DecCBOR a => Decoder s a
decCBOR

instance EncCBOR Map where
  encCBOR :: Map -> Encoding
encCBOR = [(KeyHash, KeyHash)] -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ([(KeyHash, KeyHash)] -> Encoding)
-> (Map -> [(KeyHash, KeyHash)]) -> Map -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Bimap KeyHash KeyHash -> [(KeyHash, KeyHash)]
forall a b. Bimap a b -> [(a, b)]
Bimap.toList (Bimap KeyHash KeyHash -> [(KeyHash, KeyHash)])
-> (Map -> Bimap KeyHash KeyHash) -> Map -> [(KeyHash, KeyHash)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map -> Bimap KeyHash KeyHash
unMap

-- | A 'Bimap' contains two regular 'Map's, which are spine strict; we therefore
-- have to worry about the elements only
instance NoThunks Map where
  wNoThunks :: Context -> Map -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt =
    Context -> [(KeyHash, KeyHash)] -> IO (Maybe ThunkInfo)
forall k v.
(NoThunks k, NoThunks v) =>
Context -> [(k, v)] -> IO (Maybe ThunkInfo)
noThunksInKeysAndValues Context
ctxt
      ([(KeyHash, KeyHash)] -> IO (Maybe ThunkInfo))
-> (Map -> [(KeyHash, KeyHash)]) -> Map -> IO (Maybe ThunkInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Bimap KeyHash KeyHash -> [(KeyHash, KeyHash)]
forall a b. Bimap a b -> [(a, b)]
Bimap.toList
      (Bimap KeyHash KeyHash -> [(KeyHash, KeyHash)])
-> (Map -> Bimap KeyHash KeyHash) -> Map -> [(KeyHash, KeyHash)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map -> Bimap KeyHash KeyHash
unMap

--------------------------------------------------------------------------------
-- Query
--------------------------------------------------------------------------------

memberR :: KeyHash -> Map -> Bool
memberR :: KeyHash -> Map -> Bool
memberR KeyHash
b = KeyHash -> Bimap KeyHash KeyHash -> Bool
forall a b. (Ord a, Ord b) => b -> Bimap a b -> Bool
Bimap.memberR KeyHash
b (Bimap KeyHash KeyHash -> Bool)
-> (Map -> Bimap KeyHash KeyHash) -> Map -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map -> Bimap KeyHash KeyHash
unMap

-- TODO: maybe we should call these @delegate@ and @notADelegate@ (and add also a @delegator@) function.

notMemberR :: KeyHash -> Map -> Bool
notMemberR :: KeyHash -> Map -> Bool
notMemberR KeyHash
b = KeyHash -> Bimap KeyHash KeyHash -> Bool
forall a b. (Ord a, Ord b) => b -> Bimap a b -> Bool
Bimap.notMemberR KeyHash
b (Bimap KeyHash KeyHash -> Bool)
-> (Map -> Bimap KeyHash KeyHash) -> Map -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map -> Bimap KeyHash KeyHash
unMap

pairMember :: (KeyHash, KeyHash) -> Map -> Bool
pairMember :: (KeyHash, KeyHash) -> Map -> Bool
pairMember (KeyHash, KeyHash)
p = (KeyHash, KeyHash) -> Bimap KeyHash KeyHash -> Bool
forall a b. (Ord a, Ord b) => (a, b) -> Bimap a b -> Bool
Bimap.pairMember (KeyHash, KeyHash)
p (Bimap KeyHash KeyHash -> Bool)
-> (Map -> Bimap KeyHash KeyHash) -> Map -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map -> Bimap KeyHash KeyHash
unMap

lookupR :: KeyHash -> Map -> Maybe KeyHash
lookupR :: KeyHash -> Map -> Maybe KeyHash
lookupR KeyHash
b = KeyHash -> Bimap KeyHash KeyHash -> Maybe KeyHash
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
b -> Bimap a b -> m a
Bimap.lookupR KeyHash
b (Bimap KeyHash KeyHash -> Maybe KeyHash)
-> (Map -> Bimap KeyHash KeyHash) -> Map -> Maybe KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map -> Bimap KeyHash KeyHash
unMap

--------------------------------------------------------------------------------
-- Update
--------------------------------------------------------------------------------

insert :: KeyHash -> KeyHash -> Map -> Map
insert :: KeyHash -> KeyHash -> Map -> Map
insert KeyHash
a KeyHash
b = Bimap KeyHash KeyHash -> Map
Map (Bimap KeyHash KeyHash -> Map)
-> (Map -> Bimap KeyHash KeyHash) -> Map -> Map
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. KeyHash
-> KeyHash -> Bimap KeyHash KeyHash -> Bimap KeyHash KeyHash
forall a b. (Ord a, Ord b) => a -> b -> Bimap a b -> Bimap a b
Bimap.insert KeyHash
a KeyHash
b (Bimap KeyHash KeyHash -> Bimap KeyHash KeyHash)
-> (Map -> Bimap KeyHash KeyHash) -> Map -> Bimap KeyHash KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map -> Bimap KeyHash KeyHash
unMap

--------------------------------------------------------------------------------
-- Conversion/traversal
--------------------------------------------------------------------------------

fromList :: [(KeyHash, KeyHash)] -> Map
fromList :: [(KeyHash, KeyHash)] -> Map
fromList = Bimap KeyHash KeyHash -> Map
Map (Bimap KeyHash KeyHash -> Map)
-> ([(KeyHash, KeyHash)] -> Bimap KeyHash KeyHash)
-> [(KeyHash, KeyHash)]
-> Map
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(KeyHash, KeyHash)] -> Bimap KeyHash KeyHash
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
Bimap.fromList

keysSet :: Map -> Set KeyHash
keysSet :: Map -> Set KeyHash
keysSet = [KeyHash] -> Set KeyHash
forall a. Ord a => [a] -> Set a
Set.fromList ([KeyHash] -> Set KeyHash)
-> (Map -> [KeyHash]) -> Map -> Set KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Bimap KeyHash KeyHash -> [KeyHash]
forall a b. Bimap a b -> [a]
Bimap.keys (Bimap KeyHash KeyHash -> [KeyHash])
-> (Map -> Bimap KeyHash KeyHash) -> Map -> [KeyHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map -> Bimap KeyHash KeyHash
unMap