TeachingQualification.hs

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

-- | The data type @TeachingQualification'@: the teaching qualification of the chief RePL instructor (CASA Form 101-02, questions 15 and 17).
module ReOC.Data.TeachingQualification (
  TeachingQualification' (..),
  TeachingQualification'Like (..),
  lawNamesTeachingQualification',
  TeachingQualification,
  UnfilledTeachingQualification,
  InheritTeachingQualification',
  inheritTeachingQualification',
) where

import Control.Lens (Choice, Optic, prism, review)
import Data.Functor.Const (Const)
import Data.Text (Text)
import ReOC.Name.TeachingQualificationHeld (TeachingQualificationHeldLike (..))
import ReOC.Name.TeachingQualificationIntent (TeachingQualificationIntentLike (..))
import ReOC.Primitive.FormText (FormFont (..), FormLines, FormText)

-- | The teaching qualification of the chief RePL instructor (CASA Form 101-02, questions 15 and 17). Its valid form is @TeachingQualification@, and its unfilled form @UnfilledTeachingQualification@.
data TeachingQualification' a1 a2
  = TeachingQualificationHeld a1
  | TeachingQualificationIntent a2
  deriving (Eq, Ord, Show)

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

-- | Identity
instance (x' ~ TeachingQualification' a1' a2') => TeachingQualification'Like p f (TeachingQualification' a1 a2) x' a1 a1' a2 a2' where
  teachingQualification' = id

-- | Prism
instance (Choice p, Applicative f, x' ~ TeachingQualification' a1' a2) => TeachingQualificationHeldLike p f (TeachingQualification' a1 a2) x' a1 a1' where
  teachingQualificationHeld = prism TeachingQualificationHeld (\case TeachingQualificationHeld x -> Right x; TeachingQualificationIntent x -> Left (TeachingQualificationIntent x))

-- | Prism
instance (Choice p, Applicative f, x' ~ TeachingQualification' a1 a2') => TeachingQualificationIntentLike p f (TeachingQualification' a1 a2) x' a2 a2' where
  teachingQualificationIntent = prism TeachingQualificationIntent (\case TeachingQualificationHeld x -> Left (TeachingQualificationHeld x); TeachingQualificationIntent x -> Right x)

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

Laws:

> lawNamesTeachingQualification' == id
-}
lawNamesTeachingQualification' :: TeachingQualification' a1 a2 -> TeachingQualification' a1 a2
lawNamesTeachingQualification' = \case
  TeachingQualificationHeld x -> review teachingQualificationHeld x
  TeachingQualificationIntent x -> review teachingQualificationIntent x

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

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

-- | The classes that a data type holding @TeachingQualification'@ in one field, or in one or more constructors, inherits.
type InheritTeachingQualification' s a1 a2 =
  ( TeachingQualification'Like (->) (Const ()) s s a1 a1 a2 a2
  , TeachingQualificationHeldLike (->) (Const ()) s s a1 a1
  , TeachingQualificationIntentLike (->) (Const ()) s s a2 a2
  )

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