Operator.hs

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

-- | The data type @Operator'@: the operator: the company, its key personnel and the types of RPA it operates, which are held by both documents. The fleet has at most 8 types, so that with up to 9 types of training RPA it fits question 27.
module ReOC.Data.Operator (
  Operator' (..),
  Operator'Like (..),
  lawNamesOperator',
  Operator,
  UnfilledOperator,
  mkUnfilledOperator,
  InheritOperator',
  inheritOperator',
) where

import Control.Lens (Optic, cloneLens, view)
import Data.Functor.Const (Const)
import ReOC.Data.Company (Company, UnfilledCompany, mkUnfilledCompany)
import ReOC.Data.KeyPersonnel (KeyPersonnel, UnfilledKeyPersonnel, mkUnfilledKeyPersonnel)
import ReOC.Data.OperatedType (OperatedType, UnfilledOperatedType)
import ReOC.Name.Company (CompanyLike (..))
import ReOC.Name.Fleet (FleetLike (..))
import ReOC.Name.KeyPersonnel (KeyPersonnelLike (..))
import ReOC.Primitive.Some (Some)

-- | The operator: the company, its key personnel and the types of RPA it operates, which are held by both documents. The fleet has at most 8 types, so that with up to 9 types of training RPA it fits question 27. Its valid form is @Operator@, and its unfilled form @UnfilledOperator@.
data Operator' a1 a2 a3 = Operator' a1 a2 a3
  deriving (Eq, Ord, Show)

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

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

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

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

-- | Lens
instance (p ~ (->), Functor f, x' ~ Operator' a1 a2 a3') => FleetLike p f (Operator' a1 a2 a3) x' a3 a3' where
  fleet f (Operator' x1 x2 x3) = fmap (Operator' x1 x2) (f x3)

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

Laws:

> lawNamesOperator' == id
-}
lawNamesOperator' :: Operator' a1 a2 a3 -> Operator' a1 a2 a3
lawNamesOperator' s =
  Operator'
    (view (cloneLens company) s)
    (view (cloneLens keyPersonnel) s)
    (view (cloneLens fleet) s)

-- | A valid @Operator'@.
type Operator = Operator' Company KeyPersonnel (Some 8 OperatedType)

-- | An unfilled @Operator'@: each field holds what has been entered, if anything, to be checked by @fillOperator@.
type UnfilledOperator = Operator' UnfilledCompany UnfilledKeyPersonnel [UnfilledOperatedType]

-- | An unfilled @Operator'@ with nothing entered.
mkUnfilledOperator :: UnfilledOperator
mkUnfilledOperator =
  Operator'
    mkUnfilledCompany
    mkUnfilledKeyPersonnel
    []

-- | The classes that a data type holding @Operator'@ in one field, or in one or more constructors, inherits.
type InheritOperator' s a1 a2 a3 =
  ( Operator'Like (->) (Const ()) s s a1 a1 a2 a2 a3 a3
  , CompanyLike (->) (Const ()) s s a1 a1
  , KeyPersonnelLike (->) (Const ()) s s a2 a2
  , FleetLike (->) (Const ()) s s a3 a3
  )

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