{-# LANGUAGE DeriveFunctor #-}
{-# 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 :: Args Defaults
-- > defaultArgs = Args {
-- >       hasNoDefault = NoDefault
-- >     , hasDefault   = False
-- >     }
-- >
-- > theArgs :: Args Identity
-- > theArgs = defaultArgs {
-- >       hasNoDefault = 0
-- >     }
-- >
-- > useArgs :: Args Identity -> (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 (..)
    -- * Re-exported for convenience
  , Identity (..)
  ) where

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

data Defaults t = NoDefault
  deriving ((a -> b) -> Defaults a -> Defaults b
(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
<$ :: a -> Defaults b -> Defaults a
$c<$ :: forall a b. a -> Defaults b -> Defaults a
fmap :: (a -> b) -> Defaults a -> Defaults b
$cfmap :: forall a b. (a -> b) -> Defaults a -> Defaults b
Functor)

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

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

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

instance MapHKD Defaults where
  mapHKD :: 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 t. Defaults t
NoDefault