{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}

-- | Utilities for arguments record with defaults
--
-- Useful for when you want to define a default value of an arguments record
-- consisting of a mix of arguments with/without defaults.
--
-- The following code example explains it best:
--
-- > data Args f = Args {
-- >       hasNoDefault :: HKD f Int
-- >     , hasDefault   :: Bool
-- >     }
-- >
-- > defaultArgs :: Incomplete Args
-- > defaultArgs = Args {
-- >       hasNoDefault = noDefault
-- >     , hasDefault   = False
-- >     }
-- >
-- > theArgs :: Complete Args
-- > theArgs = defaultArgs {
-- >       hasNoDefault = 0
-- >     }
-- >
-- > useArgs :: Complete Args -> (Int, Bool)
-- > useArgs (Args a b) = (a, b)
--
-- Leaving out the 'hasNoDefault' field from 'theArgs' will result in a type
-- error.
module Ouroboros.Consensus.Util.Args
  ( Defaults (..)
  , HKD
  , MapHKD (..)

    -- * Types
  , Complete
  , Incomplete
  , noDefault
  , OverrideOrDefault (..)
  , provideDefault
  ) where

import Data.Functor.Identity (Identity (..))
import Data.Kind

data OverrideOrDefault a = Override !a | UseDefault
  deriving stock (Int -> OverrideOrDefault a -> ShowS
[OverrideOrDefault a] -> ShowS
OverrideOrDefault a -> String
(Int -> OverrideOrDefault a -> ShowS)
-> (OverrideOrDefault a -> String)
-> ([OverrideOrDefault a] -> ShowS)
-> Show (OverrideOrDefault a)
forall a. Show a => Int -> OverrideOrDefault a -> ShowS
forall a. Show a => [OverrideOrDefault a] -> ShowS
forall a. Show a => OverrideOrDefault a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> OverrideOrDefault a -> ShowS
showsPrec :: Int -> OverrideOrDefault a -> ShowS
$cshow :: forall a. Show a => OverrideOrDefault a -> String
show :: OverrideOrDefault a -> String
$cshowList :: forall a. Show a => [OverrideOrDefault a] -> ShowS
showList :: [OverrideOrDefault a] -> ShowS
Show, OverrideOrDefault a -> OverrideOrDefault a -> Bool
(OverrideOrDefault a -> OverrideOrDefault a -> Bool)
-> (OverrideOrDefault a -> OverrideOrDefault a -> Bool)
-> Eq (OverrideOrDefault a)
forall a.
Eq a =>
OverrideOrDefault a -> OverrideOrDefault a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
OverrideOrDefault a -> OverrideOrDefault a -> Bool
== :: OverrideOrDefault a -> OverrideOrDefault a -> Bool
$c/= :: forall a.
Eq a =>
OverrideOrDefault a -> OverrideOrDefault a -> Bool
/= :: OverrideOrDefault a -> OverrideOrDefault a -> Bool
Eq, (forall a b.
 (a -> b) -> OverrideOrDefault a -> OverrideOrDefault b)
-> (forall a b. a -> OverrideOrDefault b -> OverrideOrDefault a)
-> Functor OverrideOrDefault
forall a b. a -> OverrideOrDefault b -> OverrideOrDefault a
forall a b. (a -> b) -> OverrideOrDefault a -> OverrideOrDefault b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> OverrideOrDefault a -> OverrideOrDefault b
fmap :: forall a b. (a -> b) -> OverrideOrDefault a -> OverrideOrDefault b
$c<$ :: forall a b. a -> OverrideOrDefault b -> OverrideOrDefault a
<$ :: forall a b. a -> OverrideOrDefault b -> OverrideOrDefault a
Functor)

provideDefault :: a -> OverrideOrDefault a -> a
provideDefault :: forall a. a -> OverrideOrDefault a -> a
provideDefault a
d = \case
  OverrideOrDefault a
UseDefault -> a
d
  Override a
t -> a
t

data Defaults t = NoDefault
  deriving (forall a b. (a -> b) -> Defaults a -> Defaults b)
-> (forall a b. a -> Defaults b -> Defaults a) -> Functor Defaults
forall a b. a -> Defaults b -> Defaults a
forall a b. (a -> b) -> Defaults a -> Defaults b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Defaults a -> Defaults b
fmap :: forall a b. (a -> b) -> Defaults a -> Defaults b
$c<$ :: forall a b. a -> Defaults b -> Defaults a
<$ :: forall a b. a -> Defaults b -> Defaults a
Functor

noDefault :: Defaults t
noDefault :: forall {k} (t :: k). Defaults t
noDefault = Defaults t
forall {k} (t :: k). Defaults t
NoDefault

type family HKD f a where
  HKD Identity a = a
  HKD f a = f a

type Incomplete (args :: (Type -> Type) -> k) = args Defaults
type Complete (args :: (Type -> Type) -> k) = args Identity

class MapHKD f where
  mapHKD :: proxy (f b) -> (a -> b) -> HKD f a -> HKD f b

instance MapHKD Identity where
  mapHKD :: forall (proxy :: * -> *) b a.
proxy (Identity b) -> (a -> b) -> HKD Identity a -> HKD Identity b
mapHKD proxy (Identity b)
_ = (a -> b) -> a -> b
(a -> b) -> HKD Identity a -> HKD Identity b
forall a. a -> a
id

instance MapHKD Defaults where
  mapHKD :: forall (proxy :: * -> *) b a.
proxy (Defaults b) -> (a -> b) -> HKD Defaults a -> HKD Defaults b
mapHKD proxy (Defaults b)
_ a -> b
_ = Defaults b -> Defaults a -> Defaults b
forall a b. a -> b -> a
const Defaults b
forall {k} (t :: k). Defaults t
NoDefault