EmergencyAction.hs

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

-- | The data type @EmergencyAction'@: an emergency action of the type-specific procedures (operations manual Appendix C): the situation, what the RPA does, and the steps the remote pilot takes.
module ReOC.Data.EmergencyAction (
  EmergencyAction' (..),
  EmergencyAction'Like (..),
  lawNamesEmergencyAction',
  EmergencyAction,
  UnfilledEmergencyAction,
  mkEmergencyAction,
  mkUnfilledEmergencyAction,
  InheritEmergencyAction',
  inheritEmergencyAction',
) where

import Control.Lens (Optic, cloneLens, view)
import Data.Functor.Const (Const)
import Data.Text (Text)
import ReOC.Name.ActionSteps (ActionStepsLike (..))
import ReOC.Name.Response (ResponseLike (..))
import ReOC.Name.Situation (SituationLike (..))
import ReOC.Primitive.Text1 (Text1)

-- | An emergency action of the type-specific procedures (operations manual Appendix C): the situation, what the RPA does, and the steps the remote pilot takes. Its valid form is @EmergencyAction@, and its unfilled form @UnfilledEmergencyAction@.
data EmergencyAction' a1 a2 a3 = EmergencyAction' a1 a2 a3
  deriving (Eq, Ord, Show)

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

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

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

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

-- | Lens
instance (p ~ (->), Functor f, x' ~ EmergencyAction' a1 a2 a3') => ActionStepsLike p f (EmergencyAction' a1 a2 a3) x' a3 a3' where
  actionSteps f (EmergencyAction' x1 x2 x3) = fmap (EmergencyAction' x1 x2) (f x3)

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

Laws:

> lawNamesEmergencyAction' == id
-}
lawNamesEmergencyAction' :: EmergencyAction' a1 a2 a3 -> EmergencyAction' a1 a2 a3
lawNamesEmergencyAction' s =
  EmergencyAction'
    (view (cloneLens situation) s)
    (view (cloneLens response) s)
    (view (cloneLens actionSteps) s)

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

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

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

-- | An unfilled @EmergencyAction'@ with nothing entered.
mkUnfilledEmergencyAction :: UnfilledEmergencyAction
mkUnfilledEmergencyAction =
  EmergencyAction'
    Nothing
    Nothing
    []

-- | The classes that a data type holding @EmergencyAction'@ in one field, or in one or more constructors, inherits.
type InheritEmergencyAction' s a1 a2 a3 =
  ( EmergencyAction'Like (->) (Const ()) s s a1 a1 a2 a2 a3 a3
  , SituationLike (->) (Const ()) s s a1 a1
  , ResponseLike (->) (Const ()) s s a2 a2
  , ActionStepsLike (->) (Const ()) s s a3 a3
  )

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