FlightTestExaminer.hs

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

-- | The data type @FlightTestExaminer@: who conducts flight tests.
module ReOC.Data.FlightTestExaminer (
  FlightTestExaminer (..),
  FlightTestExaminerLike (..),
  lawNamesFlightTestExaminer,
  InheritFlightTestExaminer,
  inheritFlightTestExaminer,
) where

import Control.Lens (Choice, Optic, prism', review)
import Data.Functor.Const (Const)
import ReOC.Name.CriConductsFlightTests (CriConductsFlightTestsLike (..))
import ReOC.Name.IndependentExaminerWhereAvailable (IndependentExaminerWhereAvailableLike (..))

-- | Who conducts flight tests.
data FlightTestExaminer
  = CRIConductsFlightTests
  | IndependentExaminerWhereAvailable
  deriving (Eq, Ord, Show)

-- | The name of the data type @FlightTestExaminer@.
class FlightTestExaminerLike p f x x' where
  flightTestExaminer ::
    Optic p f x x' FlightTestExaminer FlightTestExaminer

-- | Identity
instance (x' ~ FlightTestExaminer) => FlightTestExaminerLike p f FlightTestExaminer x' where
  flightTestExaminer = id

-- | Prism
instance (Choice p, Applicative f, x' ~ FlightTestExaminer) => CriConductsFlightTestsLike p f FlightTestExaminer x' where
  criConductsFlightTests = prism' (\() -> CRIConductsFlightTests) (\case CRIConductsFlightTests -> Just (); IndependentExaminerWhereAvailable -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ FlightTestExaminer) => IndependentExaminerWhereAvailableLike p f FlightTestExaminer x' where
  independentExaminerWhereAvailable = prism' (\() -> IndependentExaminerWhereAvailable) (\case CRIConductsFlightTests -> Nothing; IndependentExaminerWhereAvailable -> Just ())

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

Laws:

> lawNamesFlightTestExaminer == id
-}
lawNamesFlightTestExaminer :: FlightTestExaminer -> FlightTestExaminer
lawNamesFlightTestExaminer = \case
  CRIConductsFlightTests -> review criConductsFlightTests ()
  IndependentExaminerWhereAvailable -> review independentExaminerWhereAvailable ()

-- | The classes that a data type holding @FlightTestExaminer@ in one field, or in one or more constructors, inherits.
type InheritFlightTestExaminer s =
  ( FlightTestExaminerLike (->) (Const ()) s s
  , CriConductsFlightTestsLike (->) (Const ()) s s
  , IndependentExaminerWhereAvailableLike (->) (Const ()) s s
  )

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