KeyPersonnel.hs

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

-- | The data type @KeyPersonnel'@: the key personnel of the operator: CEO, chief remote pilot and maintenance controller. A position held by the holder of another position refers to it, so that one person is given once.
module ReOC.Data.KeyPersonnel (
  KeyPersonnel' (..),
  KeyPersonnel'Like (..),
  lawNamesKeyPersonnel',
  KeyPersonnel,
  UnfilledKeyPersonnel,
  mkUnfilledKeyPersonnel,
  InheritKeyPersonnel',
  inheritKeyPersonnel',
) where

import Control.Lens (Optic, cloneLens, view)
import Data.Functor.Const (Const)
import ReOC.Data.ChiefExecutive (ChiefExecutive, UnfilledChiefExecutive, mkUnfilledChiefExecutive)
import ReOC.Data.ChiefPilot (ChiefPilot, UnfilledChiefPilot, mkUnfilledChiefPilot)
import ReOC.Data.MCNominee (MCNominee, UnfilledMCNominee)
import ReOC.Name.ChiefExecutive (ChiefExecutiveLike (..))
import ReOC.Name.ChiefPilot (ChiefPilotLike (..))
import ReOC.Name.McNominee (McNomineeLike (..))

-- | The key personnel of the operator: CEO, chief remote pilot and maintenance controller. A position held by the holder of another position refers to it, so that one person is given once. Its valid form is @KeyPersonnel@, and its unfilled form @UnfilledKeyPersonnel@.
data KeyPersonnel' a1 a2 a3 = KeyPersonnel' a1 a2 a3
  deriving (Eq, Ord, Show)

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

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

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

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

-- | Lens
instance (p ~ (->), Functor f, x' ~ KeyPersonnel' a1 a2 a3') => McNomineeLike p f (KeyPersonnel' a1 a2 a3) x' a3 a3' where
  mcNominee f (KeyPersonnel' x1 x2 x3) = fmap (KeyPersonnel' x1 x2) (f x3)

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

Laws:

> lawNamesKeyPersonnel' == id
-}
lawNamesKeyPersonnel' :: KeyPersonnel' a1 a2 a3 -> KeyPersonnel' a1 a2 a3
lawNamesKeyPersonnel' s =
  KeyPersonnel'
    (view (cloneLens chiefExecutive) s)
    (view (cloneLens chiefPilot) s)
    (view (cloneLens mcNominee) s)

-- | A valid @KeyPersonnel'@.
type KeyPersonnel = KeyPersonnel' ChiefExecutive ChiefPilot MCNominee

-- | An unfilled @KeyPersonnel'@: each field holds what has been entered, if anything, to be checked by @fillKeyPersonnel@.
type UnfilledKeyPersonnel = KeyPersonnel' UnfilledChiefExecutive UnfilledChiefPilot (Maybe UnfilledMCNominee)

-- | An unfilled @KeyPersonnel'@ with nothing entered.
mkUnfilledKeyPersonnel :: UnfilledKeyPersonnel
mkUnfilledKeyPersonnel =
  KeyPersonnel'
    mkUnfilledChiefExecutive
    mkUnfilledChiefPilot
    Nothing

-- | The classes that a data type holding @KeyPersonnel'@ in one field, or in one or more constructors, inherits.
type InheritKeyPersonnel' s a1 a2 a3 =
  ( KeyPersonnel'Like (->) (Const ()) s s a1 a1 a2 a2 a3 a3
  , ChiefExecutiveLike (->) (Const ()) s s a1 a1
  , ChiefPilotLike (->) (Const ()) s s a2 a2
  , McNomineeLike (->) (Const ()) s s a3 a3
  )

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