RegulatoryHistory.hs

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

-- | The data type @RegulatoryHistory'@: whether regulatory action has been taken in the last 10 years (CASA Form 101-02, question 24).
module ReOC.Data.RegulatoryHistory (
  RegulatoryHistory' (..),
  RegulatoryHistory'Like (..),
  lawNamesRegulatoryHistory',
  RegulatoryHistory,
  UnfilledRegulatoryHistory,
  InheritRegulatoryHistory',
  inheritRegulatoryHistory',
) where

import Control.Lens (Choice, Optic, prism, prism', review)
import Data.Functor.Const (Const)
import ReOC.Data.RegulatoryAction (RegulatoryAction, UnfilledRegulatoryAction)
import ReOC.Name.NoRegulatoryAction (NoRegulatoryActionLike (..))
import ReOC.Name.RegulatoryActionTaken (RegulatoryActionTakenLike (..))

-- | Whether regulatory action has been taken in the last 10 years (CASA Form 101-02, question 24). Its valid form is @RegulatoryHistory@, and its unfilled form @UnfilledRegulatoryHistory@.
data RegulatoryHistory' a1
  = NoRegulatoryAction
  | RegulatoryActionTaken a1
  deriving (Eq, Ord, Show)

-- | The name of the data type @RegulatoryHistory'@.
class RegulatoryHistory'Like p f x x' a1 a1' | x -> a1 where
  regulatoryHistory' ::
    Optic p f x x' (RegulatoryHistory' a1) (RegulatoryHistory' a1')

-- | Identity
instance (x' ~ RegulatoryHistory' a1') => RegulatoryHistory'Like p f (RegulatoryHistory' a1) x' a1 a1' where
  regulatoryHistory' = id

-- | Prism
instance (Choice p, Applicative f, x' ~ RegulatoryHistory' a1) => NoRegulatoryActionLike p f (RegulatoryHistory' a1) x' where
  noRegulatoryAction = prism' (\() -> NoRegulatoryAction) (\case NoRegulatoryAction -> Just (); RegulatoryActionTaken _ -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ RegulatoryHistory' a1') => RegulatoryActionTakenLike p f (RegulatoryHistory' a1) x' a1 a1' where
  regulatoryActionTaken = prism RegulatoryActionTaken (\case NoRegulatoryAction -> Left NoRegulatoryAction; RegulatoryActionTaken x -> Right x)

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

Laws:

> lawNamesRegulatoryHistory' == id
-}
lawNamesRegulatoryHistory' :: RegulatoryHistory' a1 -> RegulatoryHistory' a1
lawNamesRegulatoryHistory' = \case
  NoRegulatoryAction -> review noRegulatoryAction ()
  RegulatoryActionTaken x -> review regulatoryActionTaken x

-- | A valid @RegulatoryHistory'@.
type RegulatoryHistory = RegulatoryHistory' RegulatoryAction

-- | An unfilled @RegulatoryHistory'@: each field holds what has been entered, if anything, to be checked by @fillRegulatoryHistory@.
type UnfilledRegulatoryHistory = RegulatoryHistory' UnfilledRegulatoryAction

-- | The classes that a data type holding @RegulatoryHistory'@ in one field, or in one or more constructors, inherits.
type InheritRegulatoryHistory' s a1 =
  ( RegulatoryHistory'Like (->) (Const ()) s s a1 a1
  , NoRegulatoryActionLike (->) (Const ()) s s
  , RegulatoryActionTakenLike (->) (Const ()) s s a1 a1
  )

-- | Checks that a data type inherits every class of @InheritRegulatoryHistory'@.
inheritRegulatoryHistory' :: (InheritRegulatoryHistory' s a1) => proxy s -> ()
inheritRegulatoryHistory' _ = ()