TrainingCourse.hs

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

-- | The data type @TrainingCourse'@: a RePL training course (a row of CASA Form 101-02, question 29). Its category and weight class are those of its training RPA, which is listed with the operator’s RPA in both documents.
module ReOC.Data.TrainingCourse (
  TrainingCourse' (..),
  TrainingCourse'Like (..),
  lawNamesTrainingCourse',
  TrainingCourse,
  UnfilledTrainingCourse,
  mkUnfilledTrainingCourse,
  InheritTrainingCourse',
  inheritTrainingCourse',
) where

import Control.Lens (Optic, cloneLens, view)
import Data.Functor.Const (Const)
import Data.List.NonEmpty (NonEmpty)
import ReOC.Data.Complexity (Complexity)
import ReOC.Data.CourseType (CourseType)
import ReOC.Data.OperatedType (OperatedType, UnfilledOperatedType, mkUnfilledOperatedType)
import ReOC.Name.Complexities (ComplexitiesLike (..))
import ReOC.Name.CourseKind (CourseKindLike (..))
import ReOC.Name.TrainingRPA (TrainingRPALike (..))

-- | A RePL training course (a row of CASA Form 101-02, question 29). Its category and weight class are those of its training RPA, which is listed with the operator’s RPA in both documents. Its valid form is @TrainingCourse@, and its unfilled form @UnfilledTrainingCourse@.
data TrainingCourse' a1 a2 a3 = TrainingCourse' a1 a2 a3
  deriving (Eq, Ord, Show)

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

-- | Identity
instance (x' ~ TrainingCourse' a1' a2' a3') => TrainingCourse'Like p f (TrainingCourse' a1 a2 a3) x' a1 a1' a2 a2' a3 a3' where
  trainingCourse' = id

-- | Lens
instance (p ~ (->), Functor f, x' ~ TrainingCourse' a1' a2 a3) => CourseKindLike p f (TrainingCourse' a1 a2 a3) x' a1 a1' where
  courseKind f (TrainingCourse' x1 x2 x3) = fmap (\x1' -> TrainingCourse' x1' x2 x3) (f x1)

-- | Lens
instance (p ~ (->), Functor f, x' ~ TrainingCourse' a1 a2' a3) => TrainingRPALike p f (TrainingCourse' a1 a2 a3) x' a2 a2' where
  trainingRPA f (TrainingCourse' x1 x2 x3) = fmap (\x2' -> TrainingCourse' x1 x2' x3) (f x2)

-- | Lens
instance (p ~ (->), Functor f, x' ~ TrainingCourse' a1 a2 a3') => ComplexitiesLike p f (TrainingCourse' a1 a2 a3) x' a3 a3' where
  complexities f (TrainingCourse' x1 x2 x3) = fmap (TrainingCourse' x1 x2) (f x3)

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

Laws:

> lawNamesTrainingCourse' == id
-}
lawNamesTrainingCourse' :: TrainingCourse' a1 a2 a3 -> TrainingCourse' a1 a2 a3
lawNamesTrainingCourse' s =
  TrainingCourse'
    (view (cloneLens courseKind) s)
    (view (cloneLens trainingRPA) s)
    (view (cloneLens complexities) s)

-- | A valid @TrainingCourse'@.
type TrainingCourse = TrainingCourse' CourseType OperatedType (NonEmpty Complexity)

-- | An unfilled @TrainingCourse'@: each field holds what has been entered, if anything, to be checked by @fillTrainingCourse@.
type UnfilledTrainingCourse = TrainingCourse' (Maybe CourseType) UnfilledOperatedType [Complexity]

-- | An unfilled @TrainingCourse'@ with nothing entered.
mkUnfilledTrainingCourse :: UnfilledTrainingCourse
mkUnfilledTrainingCourse =
  TrainingCourse'
    Nothing
    mkUnfilledOperatedType
    []

-- | The classes that a data type holding @TrainingCourse'@ in one field, or in one or more constructors, inherits.
type InheritTrainingCourse' s a1 a2 a3 =
  ( TrainingCourse'Like (->) (Const ()) s s a1 a1 a2 a2 a3 a3
  , CourseKindLike (->) (Const ()) s s a1 a1
  , TrainingRPALike (->) (Const ()) s s a2 a2
  , ComplexitiesLike (->) (Const ()) s s a3 a3
  )

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