{-# 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.Binary (FromCBOR (..), ToCBOR (..))
import Cardano.Chain.Common.KeyHash (KeyHash)
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
/= :: Map -> Map -> Bool
$c/= :: Map -> Map -> Bool
== :: Map -> Map -> Bool
$c== :: 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
showList :: [Map] -> ShowS
$cshowList :: [Map] -> ShowS
show :: Map -> String
$cshow :: Map -> String
showsPrec :: Int -> Map -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Map x -> Map
$cfrom :: forall x. Map -> Rep Map x
Generic)
  deriving anyclass (Map -> ()
(Map -> ()) -> NFData Map
forall a. (a -> ()) -> NFData a
rnf :: Map -> ()
$crnf :: Map -> ()
NFData)

instance FromCBOR Map where
  fromCBOR :: Decoder s Map
fromCBOR = Bimap KeyHash KeyHash -> Map
Map (Bimap KeyHash KeyHash -> Map)
-> ([(KeyHash, KeyHash)] -> Bimap KeyHash KeyHash)
-> [(KeyHash, KeyHash)]
-> Map
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 a s. FromCBOR a => Decoder s a
fromCBOR

instance ToCBOR Map where
  toCBOR :: Map -> Encoding
toCBOR = [(KeyHash, KeyHash)] -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ([(KeyHash, KeyHash)] -> Encoding)
-> (Map -> [(KeyHash, KeyHash)]) -> Map -> Encoding
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 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 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 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 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 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 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 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 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 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 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 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 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