RePLHolding.hs

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

-- | The data type @RePLHolding'@: whether the chief RePL instructor holds a RePL for each type of RPA used in training (CASA Form 101-02, questions 14 and 17).
module ReOC.Data.RePLHolding (
  RePLHolding' (..),
  RePLHolding'Like (..),
  lawNamesRePLHolding',
  RePLHolding,
  UnfilledRePLHolding,
  InheritRePLHolding',
  inheritRePLHolding',
) where

import Control.Lens (Choice, Optic, prism, prism', review)
import Data.Functor.Const (Const)
import Data.Text (Text)
import ReOC.Name.HoldsRePLForEachType (HoldsRePLForEachTypeLike (..))
import ReOC.Name.RePLHoldingIntent (RePLHoldingIntentLike (..))
import ReOC.Primitive.FormText (FormFont (..), FormText)

-- | Whether the chief RePL instructor holds a RePL for each type of RPA used in training (CASA Form 101-02, questions 14 and 17). Its valid form is @RePLHolding@, and its unfilled form @UnfilledRePLHolding@.
data RePLHolding' a1
  = HoldsRePLForEachType
  | RePLHoldingIntent a1
  deriving (Eq, Ord, Show)

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

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

-- | Prism
instance (Choice p, Applicative f, x' ~ RePLHolding' a1) => HoldsRePLForEachTypeLike p f (RePLHolding' a1) x' where
  holdsRePLForEachType = prism' (\() -> HoldsRePLForEachType) (\case HoldsRePLForEachType -> Just (); RePLHoldingIntent _ -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ RePLHolding' a1') => RePLHoldingIntentLike p f (RePLHolding' a1) x' a1 a1' where
  rePLHoldingIntent = prism RePLHoldingIntent (\case HoldsRePLForEachType -> Left HoldsRePLForEachType; RePLHoldingIntent x -> Right x)

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

Laws:

> lawNamesRePLHolding' == id
-}
lawNamesRePLHolding' :: RePLHolding' a1 -> RePLHolding' a1
lawNamesRePLHolding' = \case
  HoldsRePLForEachType -> review holdsRePLForEachType ()
  RePLHoldingIntent x -> review rePLHoldingIntent x

-- | A valid @RePLHolding'@.
type RePLHolding = RePLHolding' (FormText 'Wide 185 5)

-- | An unfilled @RePLHolding'@: each field holds what has been entered, if anything, to be checked by @fillRePLHolding@.
type UnfilledRePLHolding = RePLHolding' (Maybe Text)

-- | The classes that a data type holding @RePLHolding'@ in one field, or in one or more constructors, inherits.
type InheritRePLHolding' s a1 =
  ( RePLHolding'Like (->) (Const ()) s s a1 a1
  , HoldsRePLForEachTypeLike (->) (Const ()) s s
  , RePLHoldingIntentLike (->) (Const ()) s s a1 a1
  )

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