ChiefExecutive.hs

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

-- | The data type @ChiefExecutive'@: the nominated CEO (CASA Form 101-02, question 7).
module ReOC.Data.ChiefExecutive (
  ChiefExecutive' (..),
  ChiefExecutive'Like (..),
  lawNamesChiefExecutive',
  ChiefExecutive,
  UnfilledChiefExecutive,
  mkChiefExecutive,
  mkUnfilledChiefExecutive,
  InheritChiefExecutive',
  inheritChiefExecutive',
) where

import Control.Lens (Optic, cloneLens, view)
import Data.Functor.Const (Const)
import Data.Text (Text)
import ReOC.Data.Directorship (Directorship)
import ReOC.Data.Nominee (Nominee, UnfilledNominee, mkUnfilledNominee)
import ReOC.Name.DirectorStatus (DirectorStatusLike (..))
import ReOC.Name.ManagementExperience (ManagementExperienceLike (..))
import ReOC.Name.Nominee (NomineeLike (..))
import ReOC.Primitive.FormText (FormLines)

-- | The nominated CEO (CASA Form 101-02, question 7). Its valid form is @ChiefExecutive@, and its unfilled form @UnfilledChiefExecutive@.
data ChiefExecutive' a1 a2 a3 = ChiefExecutive' a1 a2 a3
  deriving (Eq, Ord, Show)

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

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

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

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

-- | Lens
instance (p ~ (->), Functor f, x' ~ ChiefExecutive' a1 a2 a3') => ManagementExperienceLike p f (ChiefExecutive' a1 a2 a3) x' a3 a3' where
  managementExperience f (ChiefExecutive' x1 x2 x3) = fmap (ChiefExecutive' x1 x2) (f x3)

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

Laws:

> lawNamesChiefExecutive' == id
-}
lawNamesChiefExecutive' :: ChiefExecutive' a1 a2 a3 -> ChiefExecutive' a1 a2 a3
lawNamesChiefExecutive' s =
  ChiefExecutive'
    (view (cloneLens nominee) s)
    (view (cloneLens directorStatus) s)
    (view (cloneLens managementExperience) s)

-- | A valid @ChiefExecutive'@.
type ChiefExecutive = ChiefExecutive' Nominee Directorship (Maybe (FormLines 6))

-- | An unfilled @ChiefExecutive'@: each field holds what has been entered, if anything, to be checked by @fillChiefExecutive@.
type UnfilledChiefExecutive = ChiefExecutive' UnfilledNominee (Maybe Directorship) (Maybe Text)

-- | Builds a valid @ChiefExecutive'@ with every @Maybe@ field @Nothing@ and every list (or @AtMost@) field empty.
mkChiefExecutive :: Nominee -> Directorship -> ChiefExecutive
mkChiefExecutive x1 x2 = ChiefExecutive' x1 x2 Nothing

-- | An unfilled @ChiefExecutive'@ with nothing entered.
mkUnfilledChiefExecutive :: UnfilledChiefExecutive
mkUnfilledChiefExecutive =
  ChiefExecutive'
    mkUnfilledNominee
    Nothing
    Nothing

-- | The classes that a data type holding @ChiefExecutive'@ in one field, or in one or more constructors, inherits.
type InheritChiefExecutive' s a1 a2 a3 =
  ( ChiefExecutive'Like (->) (Const ()) s s a1 a1 a2 a2 a3 a3
  , NomineeLike (->) (Const ()) s s a1 a1
  , DirectorStatusLike (->) (Const ()) s s a2 a2
  , ManagementExperienceLike (->) (Const ()) s s a3 a3
  )

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