Complexity.hs

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

-- | The data type @Complexity@: the complexity of a RePL training course (CASA Form 101-02, question 29). Liquid fuel is for RPA over 25 kg, which the operations manual does not cover.
module ReOC.Data.Complexity (
  Complexity (..),
  ComplexityLike (..),
  lawNamesComplexity,
  InheritComplexity,
  inheritComplexity,
) where

import Control.Lens (Choice, Optic, prism', review)
import Data.Functor.Const (Const)
import ReOC.Name.AutomatedAndManual (AutomatedAndManualLike (..))
import ReOC.Name.AutomatedOnly (AutomatedOnlyLike (..))

-- | The complexity of a RePL training course (CASA Form 101-02, question 29). Liquid fuel is for RPA over 25 kg, which the operations manual does not cover.
data Complexity
  = AutomatedAndManual
  | AutomatedOnly
  deriving (Eq, Ord, Show)

-- | The name of the data type @Complexity@.
class ComplexityLike p f x x' where
  complexity ::
    Optic p f x x' Complexity Complexity

-- | Identity
instance (x' ~ Complexity) => ComplexityLike p f Complexity x' where
  complexity = id

-- | Prism
instance (Choice p, Applicative f, x' ~ Complexity) => AutomatedAndManualLike p f Complexity x' where
  automatedAndManual = prism' (\() -> AutomatedAndManual) (\case AutomatedAndManual -> Just (); AutomatedOnly -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ Complexity) => AutomatedOnlyLike p f Complexity x' where
  automatedOnly = prism' (\() -> AutomatedOnly) (\case AutomatedAndManual -> Nothing; AutomatedOnly -> Just ())

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

Laws:

> lawNamesComplexity == id
-}
lawNamesComplexity :: Complexity -> Complexity
lawNamesComplexity = \case
  AutomatedAndManual -> review automatedAndManual ()
  AutomatedOnly -> review automatedOnly ()

-- | The classes that a data type holding @Complexity@ in one field, or in one or more constructors, inherits.
type InheritComplexity s =
  ( ComplexityLike (->) (Const ()) s s
  , AutomatedAndManualLike (->) (Const ()) s s
  , AutomatedOnlyLike (->) (Const ()) s s
  )

-- | Checks that a data type inherits every class of @InheritComplexity@.
inheritComplexity :: (InheritComplexity s) => proxy s -> ()
inheritComplexity _ = ()