{-# 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
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
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Map -> ()
$crnf :: Map -> ()
NFData)

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

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

instance EncCBOR Map where
  encCBOR :: Map -> Encoding
encCBOR = forall a. EncCBOR a => a -> Encoding
encCBOR forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. Bimap a b -> [(a, b)]
Bimap.toList 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 =
    forall k v.
(NoThunks k, NoThunks v) =>
Context -> [(k, v)] -> IO (Maybe ThunkInfo)
noThunksInKeysAndValues Context
ctxt
      forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. Bimap a b -> [(a, b)]
Bimap.toList
      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 = forall a b. (Ord a, Ord b) => b -> Bimap a b -> Bool
Bimap.memberR KeyHash
b 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 = forall a b. (Ord a, Ord b) => b -> Bimap a b -> Bool
Bimap.notMemberR KeyHash
b 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 = forall a b. (Ord a, Ord b) => (a, b) -> Bimap a b -> Bool
Bimap.pairMember (KeyHash, KeyHash)
p 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 = forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
b -> Bimap a b -> m a
Bimap.lookupR KeyHash
b 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Ord a, Ord b) => a -> b -> Bimap a b -> Bimap a b
Bimap.insert KeyHash
a KeyHash
b 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
Bimap.fromList

keysSet :: Map -> Set KeyHash
keysSet :: Map -> Set KeyHash
keysSet = forall a. Ord a => [a] -> Set a
Set.fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. Bimap a b -> [a]
Bimap.keys 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