{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | This module contains just the type of protocol parameters.
module Cardano.Ledger.HKD (
  HKD,
  HKDNoUpdate,
  HKDFunctor (..),
  NoUpdate (..),
  HKDApplicative (..),
) where

import Control.DeepSeq (NFData)
import Data.Functor.Identity (Identity)
import Data.Maybe.Strict (StrictMaybe (..))
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)

-- ====================================================================

-- | Higher Kinded Data
type family HKD f a where
  HKD Identity a = a
  HKD f a = f a

data NoUpdate a = NoUpdate
  deriving (NoUpdate a -> NoUpdate a -> Bool
(NoUpdate a -> NoUpdate a -> Bool)
-> (NoUpdate a -> NoUpdate a -> Bool) -> Eq (NoUpdate a)
forall a. NoUpdate a -> NoUpdate a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. NoUpdate a -> NoUpdate a -> Bool
== :: NoUpdate a -> NoUpdate a -> Bool
$c/= :: forall a. NoUpdate a -> NoUpdate a -> Bool
/= :: NoUpdate a -> NoUpdate a -> Bool
Eq, Eq (NoUpdate a)
Eq (NoUpdate a) =>
(NoUpdate a -> NoUpdate a -> Ordering)
-> (NoUpdate a -> NoUpdate a -> Bool)
-> (NoUpdate a -> NoUpdate a -> Bool)
-> (NoUpdate a -> NoUpdate a -> Bool)
-> (NoUpdate a -> NoUpdate a -> Bool)
-> (NoUpdate a -> NoUpdate a -> NoUpdate a)
-> (NoUpdate a -> NoUpdate a -> NoUpdate a)
-> Ord (NoUpdate a)
NoUpdate a -> NoUpdate a -> Bool
NoUpdate a -> NoUpdate a -> Ordering
NoUpdate a -> NoUpdate a -> NoUpdate a
forall a. Eq (NoUpdate a)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. NoUpdate a -> NoUpdate a -> Bool
forall a. NoUpdate a -> NoUpdate a -> Ordering
forall a. NoUpdate a -> NoUpdate a -> NoUpdate a
$ccompare :: forall a. NoUpdate a -> NoUpdate a -> Ordering
compare :: NoUpdate a -> NoUpdate a -> Ordering
$c< :: forall a. NoUpdate a -> NoUpdate a -> Bool
< :: NoUpdate a -> NoUpdate a -> Bool
$c<= :: forall a. NoUpdate a -> NoUpdate a -> Bool
<= :: NoUpdate a -> NoUpdate a -> Bool
$c> :: forall a. NoUpdate a -> NoUpdate a -> Bool
> :: NoUpdate a -> NoUpdate a -> Bool
$c>= :: forall a. NoUpdate a -> NoUpdate a -> Bool
>= :: NoUpdate a -> NoUpdate a -> Bool
$cmax :: forall a. NoUpdate a -> NoUpdate a -> NoUpdate a
max :: NoUpdate a -> NoUpdate a -> NoUpdate a
$cmin :: forall a. NoUpdate a -> NoUpdate a -> NoUpdate a
min :: NoUpdate a -> NoUpdate a -> NoUpdate a
Ord, Int -> NoUpdate a -> ShowS
[NoUpdate a] -> ShowS
NoUpdate a -> String
(Int -> NoUpdate a -> ShowS)
-> (NoUpdate a -> String)
-> ([NoUpdate a] -> ShowS)
-> Show (NoUpdate a)
forall a. Int -> NoUpdate a -> ShowS
forall a. [NoUpdate a] -> ShowS
forall a. NoUpdate a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> NoUpdate a -> ShowS
showsPrec :: Int -> NoUpdate a -> ShowS
$cshow :: forall a. NoUpdate a -> String
show :: NoUpdate a -> String
$cshowList :: forall a. [NoUpdate a] -> ShowS
showList :: [NoUpdate a] -> ShowS
Show, (forall x. NoUpdate a -> Rep (NoUpdate a) x)
-> (forall x. Rep (NoUpdate a) x -> NoUpdate a)
-> Generic (NoUpdate a)
forall x. Rep (NoUpdate a) x -> NoUpdate a
forall x. NoUpdate a -> Rep (NoUpdate a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (NoUpdate a) x -> NoUpdate a
forall a x. NoUpdate a -> Rep (NoUpdate a) x
$cfrom :: forall a x. NoUpdate a -> Rep (NoUpdate a) x
from :: forall x. NoUpdate a -> Rep (NoUpdate a) x
$cto :: forall a x. Rep (NoUpdate a) x -> NoUpdate a
to :: forall x. Rep (NoUpdate a) x -> NoUpdate a
Generic)

instance NoThunks (NoUpdate a)

instance NFData (NoUpdate a)

type family HKDNoUpdate f a where
  HKDNoUpdate Identity a = a
  HKDNoUpdate StrictMaybe a = NoUpdate a
  HKDNoUpdate Maybe a = NoUpdate a
  HKDNoUpdate f a = f a

class HKDFunctor f where
  hkdMap :: proxy f -> (a -> b) -> HKD f a -> HKD f b
  toNoUpdate :: HKD f a -> HKDNoUpdate f a
  fromNoUpdate :: HKDNoUpdate f a -> HKD f a

instance HKDFunctor Identity where
  hkdMap :: forall (proxy :: (* -> *) -> *) a b.
proxy Identity -> (a -> b) -> HKD Identity a -> HKD Identity b
hkdMap proxy Identity
_ a -> b
f = a -> b
HKD Identity a -> HKD Identity b
f
  toNoUpdate :: forall a. HKD Identity a -> HKDNoUpdate Identity a
toNoUpdate = a -> a
HKD Identity a -> HKDNoUpdate Identity a
forall a. a -> a
id
  fromNoUpdate :: forall a. HKDNoUpdate Identity a -> HKD Identity a
fromNoUpdate = a -> a
HKDNoUpdate Identity a -> HKD Identity a
forall a. a -> a
id

instance HKDFunctor Maybe where
  hkdMap :: forall (proxy :: (* -> *) -> *) a b.
proxy Maybe -> (a -> b) -> HKD Maybe a -> HKD Maybe b
hkdMap proxy Maybe
_ = (a -> b) -> Maybe a -> Maybe b
(a -> b) -> HKD Maybe a -> HKD Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  toNoUpdate :: forall a. HKD Maybe a -> HKDNoUpdate Maybe a
toNoUpdate HKD Maybe a
_ = HKDNoUpdate Maybe a
NoUpdate a
forall a. NoUpdate a
NoUpdate
  fromNoUpdate :: forall a. HKDNoUpdate Maybe a -> HKD Maybe a
fromNoUpdate HKDNoUpdate Maybe a
_ = Maybe a
HKD Maybe a
forall a. Maybe a
Nothing

instance HKDFunctor StrictMaybe where
  hkdMap :: forall (proxy :: (* -> *) -> *) a b.
proxy StrictMaybe
-> (a -> b) -> HKD StrictMaybe a -> HKD StrictMaybe b
hkdMap proxy StrictMaybe
_ = (a -> b) -> StrictMaybe a -> StrictMaybe b
(a -> b) -> HKD StrictMaybe a -> HKD StrictMaybe b
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  toNoUpdate :: forall a. HKD StrictMaybe a -> HKDNoUpdate StrictMaybe a
toNoUpdate HKD StrictMaybe a
_ = HKDNoUpdate StrictMaybe a
NoUpdate a
forall a. NoUpdate a
NoUpdate
  fromNoUpdate :: forall a. HKDNoUpdate StrictMaybe a -> HKD StrictMaybe a
fromNoUpdate HKDNoUpdate StrictMaybe a
_ = StrictMaybe a
HKD StrictMaybe a
forall a. StrictMaybe a
SNothing

class HKDFunctor f => HKDApplicative f where
  hkdPure :: a -> HKD f a
  hkdLiftA2 :: forall a b c. (a -> b -> c) -> HKD f a -> HKD f b -> HKD f c

instance HKDApplicative Identity where
  hkdPure :: forall a. a -> HKD Identity a
hkdPure = a -> a
a -> HKD Identity a
forall a. a -> a
id
  hkdLiftA2 :: forall a b c.
(a -> b -> c) -> HKD Identity a -> HKD Identity b -> HKD Identity c
hkdLiftA2 a -> b -> c
g = a -> b -> c
HKD Identity a -> HKD Identity b -> HKD Identity c
g

instance HKDApplicative Maybe where
  hkdPure :: forall a. a -> HKD Maybe a
hkdPure = a -> Maybe a
a -> HKD Maybe a
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  hkdLiftA2 :: forall a b c.
(a -> b -> c) -> HKD Maybe a -> HKD Maybe b -> HKD Maybe c
hkdLiftA2 = (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
(a -> b -> c) -> HKD Maybe a -> HKD Maybe b -> HKD Maybe c
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2

instance HKDApplicative StrictMaybe where
  hkdPure :: forall a. a -> HKD StrictMaybe a
hkdPure = a -> StrictMaybe a
a -> HKD StrictMaybe a
forall a. a -> StrictMaybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  hkdLiftA2 :: forall a b c.
(a -> b -> c)
-> HKD StrictMaybe a -> HKD StrictMaybe b -> HKD StrictMaybe c
hkdLiftA2 = (a -> b -> c) -> StrictMaybe a -> StrictMaybe b -> StrictMaybe c
(a -> b -> c)
-> HKD StrictMaybe a -> HKD StrictMaybe b -> HKD StrictMaybe c
forall a b c.
(a -> b -> c) -> StrictMaybe a -> StrictMaybe b -> StrictMaybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2