{-# LANGUAGE DeriveFunctor #-}
{-# 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
  ) where

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

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