Nominee.hs

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

-- | The data type @Nominee'@: a person nominated for a key position, with their qualifications and experience (operations manual Section 1.2.1).
module ReOC.Data.Nominee (
  Nominee' (..),
  Nominee'Like (..),
  lawNamesNominee',
  Nominee,
  UnfilledNominee,
  mkNominee,
  mkUnfilledNominee,
  InheritNominee',
  inheritNominee',
) where

import Control.Lens (Optic, cloneLens, view)
import Data.Functor.Const (Const)
import Data.Text (Text)
import ReOC.Data.Person (Person, UnfilledPerson, mkUnfilledPerson)
import ReOC.Name.AviationExperience (AviationExperienceLike (..))
import ReOC.Name.OtherQualifications (OtherQualificationsLike (..))
import ReOC.Name.Person (PersonLike (..))
import ReOC.Primitive.Text1 (Text1)

-- | A person nominated for a key position, with their qualifications and experience (operations manual Section 1.2.1). Its valid form is @Nominee@, and its unfilled form @UnfilledNominee@.
data Nominee' a1 a2 a3 = Nominee' a1 a2 a3
  deriving (Eq, Ord, Show)

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

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

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

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

-- | Lens
instance (p ~ (->), Functor f, x' ~ Nominee' a1 a2 a3') => AviationExperienceLike p f (Nominee' a1 a2 a3) x' a3 a3' where
  aviationExperience f (Nominee' x1 x2 x3) = fmap (Nominee' x1 x2) (f x3)

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

Laws:

> lawNamesNominee' == id
-}
lawNamesNominee' :: Nominee' a1 a2 a3 -> Nominee' a1 a2 a3
lawNamesNominee' s =
  Nominee'
    (view (cloneLens person) s)
    (view (cloneLens otherQualifications) s)
    (view (cloneLens aviationExperience) s)

-- | A valid @Nominee'@.
type Nominee = Nominee' Person [Text1] Text1

-- | An unfilled @Nominee'@: each field holds what has been entered, if anything, to be checked by @fillNominee@.
type UnfilledNominee = Nominee' UnfilledPerson [Text] (Maybe Text)

-- | Builds a valid @Nominee'@ with every @Maybe@ field @Nothing@ and every list (or @AtMost@) field empty.
mkNominee :: Person -> Text1 -> Nominee
mkNominee x1 = Nominee' x1 []

-- | An unfilled @Nominee'@ with nothing entered.
mkUnfilledNominee :: UnfilledNominee
mkUnfilledNominee =
  Nominee'
    mkUnfilledPerson
    []
    Nothing

-- | The classes that a data type holding @Nominee'@ in one field, or in one or more constructors, inherits.
type InheritNominee' s a1 a2 a3 =
  ( Nominee'Like (->) (Const ()) s s a1 a1 a2 a2 a3 a3
  , PersonLike (->) (Const ()) s s a1 a1
  , OtherQualificationsLike (->) (Const ()) s s a2 a2
  , AviationExperienceLike (->) (Const ()) s s a3 a3
  )

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