PersonnelHistory.hs

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

-- | The data type @PersonnelHistory'@: the history of the applicant and nominated personnel (CASA Form 101-02, questions 19 to 23).
module ReOC.Data.PersonnelHistory (
  PersonnelHistory' (..),
  PersonnelHistory'Like (..),
  lawNamesPersonnelHistory',
  PersonnelHistory,
  UnfilledPersonnelHistory,
  mkUnfilledPersonnelHistory,
  InheritPersonnelHistory',
  inheritPersonnelHistory',
) where

import Control.Lens (Optic, cloneLens, view)
import Data.Functor.Const (Const)
import ReOC.Data.HistoryAnswer (HistoryAnswer, UnfilledHistoryAnswer)
import ReOC.Name.ActionTaken (ActionTakenLike (..))
import ReOC.Name.CriminalConviction (CriminalConvictionLike (..))
import ReOC.Name.SuspensionPending (SuspensionPendingLike (..))
import ReOC.Name.TransportLicenceRefused (TransportLicenceRefusedLike (..))

-- | The history of the applicant and nominated personnel (CASA Form 101-02, questions 19 to 23). Its valid form is @PersonnelHistory@, and its unfilled form @UnfilledPersonnelHistory@.
data PersonnelHistory' a1 a2 a3 a4 = PersonnelHistory' a1 a2 a3 a4
  deriving (Eq, Ord, Show)

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

-- | Identity
instance (x' ~ PersonnelHistory' a1' a2' a3' a4') => PersonnelHistory'Like p f (PersonnelHistory' a1 a2 a3 a4) x' a1 a1' a2 a2' a3 a3' a4 a4' where
  personnelHistory' = id

-- | Lens
instance (p ~ (->), Functor f, x' ~ PersonnelHistory' a1' a2 a3 a4) => ActionTakenLike p f (PersonnelHistory' a1 a2 a3 a4) x' a1 a1' where
  actionTaken f (PersonnelHistory' x1 x2 x3 x4) = fmap (\x1' -> PersonnelHistory' x1' x2 x3 x4) (f x1)

-- | Lens
instance (p ~ (->), Functor f, x' ~ PersonnelHistory' a1 a2' a3 a4) => TransportLicenceRefusedLike p f (PersonnelHistory' a1 a2 a3 a4) x' a2 a2' where
  transportLicenceRefused f (PersonnelHistory' x1 x2 x3 x4) = fmap (\x2' -> PersonnelHistory' x1 x2' x3 x4) (f x2)

-- | Lens
instance (p ~ (->), Functor f, x' ~ PersonnelHistory' a1 a2 a3' a4) => CriminalConvictionLike p f (PersonnelHistory' a1 a2 a3 a4) x' a3 a3' where
  criminalConviction f (PersonnelHistory' x1 x2 x3 x4) = fmap (\x3' -> PersonnelHistory' x1 x2 x3' x4) (f x3)

-- | Lens
instance (p ~ (->), Functor f, x' ~ PersonnelHistory' a1 a2 a3 a4') => SuspensionPendingLike p f (PersonnelHistory' a1 a2 a3 a4) x' a4 a4' where
  suspensionPending f (PersonnelHistory' x1 x2 x3 x4) = fmap (PersonnelHistory' x1 x2 x3) (f x4)

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

Laws:

> lawNamesPersonnelHistory' == id
-}
lawNamesPersonnelHistory' :: PersonnelHistory' a1 a2 a3 a4 -> PersonnelHistory' a1 a2 a3 a4
lawNamesPersonnelHistory' s =
  PersonnelHistory'
    (view (cloneLens actionTaken) s)
    (view (cloneLens transportLicenceRefused) s)
    (view (cloneLens criminalConviction) s)
    (view (cloneLens suspensionPending) s)

-- | A valid @PersonnelHistory'@.
type PersonnelHistory = PersonnelHistory' HistoryAnswer HistoryAnswer HistoryAnswer HistoryAnswer

-- | An unfilled @PersonnelHistory'@: each field holds what has been entered, if anything, to be checked by @fillPersonnelHistory@.
type UnfilledPersonnelHistory = PersonnelHistory' (Maybe UnfilledHistoryAnswer) (Maybe UnfilledHistoryAnswer) (Maybe UnfilledHistoryAnswer) (Maybe UnfilledHistoryAnswer)

-- | An unfilled @PersonnelHistory'@ with nothing entered.
mkUnfilledPersonnelHistory :: UnfilledPersonnelHistory
mkUnfilledPersonnelHistory =
  PersonnelHistory'
    Nothing
    Nothing
    Nothing
    Nothing

-- | The classes that a data type holding @PersonnelHistory'@ in one field, or in one or more constructors, inherits.
type InheritPersonnelHistory' s a1 a2 a3 a4 =
  ( PersonnelHistory'Like (->) (Const ()) s s a1 a1 a2 a2 a3 a3 a4 a4
  , ActionTakenLike (->) (Const ()) s s a1 a1
  , TransportLicenceRefusedLike (->) (Const ()) s s a2 a2
  , CriminalConvictionLike (->) (Const ()) s s a3 a3
  , SuspensionPendingLike (->) (Const ()) s s a4 a4
  )

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