CRPNominee.hs

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wall #-}
-- The checks of inheritance (inheritCRPNominee') have a constraint that their body does not use, by design.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | The data type @CRPNominee'@: who is nominated as chief remote pilot: the CEO, or another person.
module ReOC.Data.CRPNominee (
  CRPNominee' (..),
  CRPNominee'Like (..),
  lawNamesCRPNominee',
  CRPNominee,
  UnfilledCRPNominee,
  InheritCRPNominee',
  inheritCRPNominee',
) where

import Control.Lens (Choice, Optic, prism, prism', review)
import Data.Functor.Const (Const)
import ReOC.Data.Nominee (Nominee, UnfilledNominee)
import ReOC.Name.CrpIsCEO (CrpIsCEOLike (..))
import ReOC.Name.CrpNominated (CrpNominatedLike (..))

-- | Who is nominated as chief remote pilot: the CEO, or another person. Its valid form is @CRPNominee@, and its unfilled form @UnfilledCRPNominee@.
data CRPNominee' a1
  = CRPIsCEO
  | CRPNominated a1
  deriving (Eq, Ord, Show)

-- | The name of the data type @CRPNominee'@.
class CRPNominee'Like p f x x' a1 a1' | x -> a1 where
  crpNominee' ::
    Optic p f x x' (CRPNominee' a1) (CRPNominee' a1')

-- | Identity
instance (x' ~ CRPNominee' a1') => CRPNominee'Like p f (CRPNominee' a1) x' a1 a1' where
  crpNominee' = id

-- | Prism
instance (Choice p, Applicative f, x' ~ CRPNominee' a1) => CrpIsCEOLike p f (CRPNominee' a1) x' where
  crpIsCEO = prism' (\() -> CRPIsCEO) (\case CRPIsCEO -> Just (); CRPNominated _ -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ CRPNominee' a1') => CrpNominatedLike p f (CRPNominee' a1) x' a1 a1' where
  crpNominated = prism CRPNominated (\case CRPIsCEO -> Left CRPIsCEO; CRPNominated x -> Right x)

{- | Rebuilds a value from the name of each field or constructor.

Laws:

> lawNamesCRPNominee' == id
-}
lawNamesCRPNominee' :: CRPNominee' a1 -> CRPNominee' a1
lawNamesCRPNominee' = \case
  CRPIsCEO -> review crpIsCEO ()
  CRPNominated x -> review crpNominated x

-- | A valid @CRPNominee'@.
type CRPNominee = CRPNominee' Nominee

-- | An unfilled @CRPNominee'@: each field holds what has been entered, if anything, to be checked by @fillCRPNominee@.
type UnfilledCRPNominee = CRPNominee' UnfilledNominee

-- | The classes that a data type holding @CRPNominee'@ in one field, or in one or more constructors, inherits.
type InheritCRPNominee' s a1 =
  ( CRPNominee'Like (->) (Const ()) s s a1 a1
  , CrpIsCEOLike (->) (Const ()) s s
  , CrpNominatedLike (->) (Const ()) s s a1 a1
  )

-- | Checks that a data type inherits every class of @InheritCRPNominee'@.
inheritCRPNominee' :: (InheritCRPNominee' s a1) => proxy s -> ()
inheritCRPNominee' _ = ()