MCNominee.hs

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

-- | The data type @MCNominee'@: who is nominated as maintenance controller (CASA Form 101-02, question 12): the CEO, the chief remote pilot, or another person.
module ReOC.Data.MCNominee (
  MCNominee' (..),
  MCNominee'Like (..),
  lawNamesMCNominee',
  MCNominee,
  UnfilledMCNominee,
  InheritMCNominee',
  inheritMCNominee',
) where

import Control.Lens (Choice, Optic, prism, prism', review)
import Data.Functor.Const (Const)
import ReOC.Data.Nominee (Nominee, UnfilledNominee)
import ReOC.Name.McIsCEO (McIsCEOLike (..))
import ReOC.Name.McIsCRP (McIsCRPLike (..))
import ReOC.Name.McNominated (McNominatedLike (..))

-- | Who is nominated as maintenance controller (CASA Form 101-02, question 12): the CEO, the chief remote pilot, or another person. Its valid form is @MCNominee@, and its unfilled form @UnfilledMCNominee@.
data MCNominee' a1
  = MCIsCEO
  | MCIsCRP
  | MCNominated a1
  deriving (Eq, Ord, Show)

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

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

-- | Prism
instance (Choice p, Applicative f, x' ~ MCNominee' a1) => McIsCEOLike p f (MCNominee' a1) x' where
  mcIsCEO = prism' (\() -> MCIsCEO) (\case MCIsCEO -> Just (); MCIsCRP -> Nothing; MCNominated _ -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ MCNominee' a1) => McIsCRPLike p f (MCNominee' a1) x' where
  mcIsCRP = prism' (\() -> MCIsCRP) (\case MCIsCEO -> Nothing; MCIsCRP -> Just (); MCNominated _ -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ MCNominee' a1') => McNominatedLike p f (MCNominee' a1) x' a1 a1' where
  mcNominated = prism MCNominated (\case MCIsCEO -> Left MCIsCEO; MCIsCRP -> Left MCIsCRP; MCNominated x -> Right x)

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

Laws:

> lawNamesMCNominee' == id
-}
lawNamesMCNominee' :: MCNominee' a1 -> MCNominee' a1
lawNamesMCNominee' = \case
  MCIsCEO -> review mcIsCEO ()
  MCIsCRP -> review mcIsCRP ()
  MCNominated x -> review mcNominated x

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

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

-- | The classes that a data type holding @MCNominee'@ in one field, or in one or more constructors, inherits.
type InheritMCNominee' s a1 =
  ( MCNominee'Like (->) (Const ()) s s a1 a1
  , McIsCEOLike (->) (Const ()) s s
  , McIsCRPLike (->) (Const ()) s s
  , McNominatedLike (->) (Const ()) s s a1 a1
  )

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