Equipment.hs

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

-- | The data type @Equipment'@: an item of equipment associated with an RPA, such as a gimbal camera or remote controller.
module ReOC.Data.Equipment (
  Equipment' (..),
  Equipment'Like (..),
  lawNamesEquipment',
  Equipment,
  UnfilledEquipment,
  mkUnfilledEquipment,
  InheritEquipment',
  inheritEquipment',
) where

import Control.Lens (Optic, cloneLens, view)
import Data.Functor.Const (Const)
import Data.Text (Text)
import ReOC.Name.EquipmentDescription (EquipmentDescriptionLike (..))
import ReOC.Name.SerialNumber (SerialNumberLike (..))
import ReOC.Primitive.Text1 (Text1)

-- | An item of equipment associated with an RPA, such as a gimbal camera or remote controller. Its valid form is @Equipment@, and its unfilled form @UnfilledEquipment@.
data Equipment' a1 a2 = Equipment' a1 a2
  deriving (Eq, Ord, Show)

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

-- | Identity
instance (x' ~ Equipment' a1' a2') => Equipment'Like p f (Equipment' a1 a2) x' a1 a1' a2 a2' where
  equipment' = id

-- | Lens
instance (p ~ (->), Functor f, x' ~ Equipment' a1' a2) => EquipmentDescriptionLike p f (Equipment' a1 a2) x' a1 a1' where
  equipmentDescription f (Equipment' x1 x2) = fmap (\x1' -> Equipment' x1' x2) (f x1)

-- | Lens
instance (p ~ (->), Functor f, x' ~ Equipment' a1 a2') => SerialNumberLike p f (Equipment' a1 a2) x' a2 a2' where
  serialNumber f (Equipment' x1 x2) = fmap (Equipment' x1) (f x2)

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

Laws:

> lawNamesEquipment' == id
-}
lawNamesEquipment' :: Equipment' a1 a2 -> Equipment' a1 a2
lawNamesEquipment' s =
  Equipment'
    (view (cloneLens equipmentDescription) s)
    (view (cloneLens serialNumber) s)

-- | A valid @Equipment'@.
type Equipment = Equipment' Text1 Text1

-- | An unfilled @Equipment'@: each field holds what has been entered, if anything, to be checked by @fillEquipment@.
type UnfilledEquipment = Equipment' (Maybe Text) (Maybe Text)

-- | An unfilled @Equipment'@ with nothing entered.
mkUnfilledEquipment :: UnfilledEquipment
mkUnfilledEquipment =
  Equipment'
    Nothing
    Nothing

-- | The classes that a data type holding @Equipment'@ in one field, or in one or more constructors, inherits.
type InheritEquipment' s a1 a2 =
  ( Equipment'Like (->) (Const ()) s s a1 a1 a2 a2
  , EquipmentDescriptionLike (->) (Const ()) s s a1 a1
  , SerialNumberLike (->) (Const ()) s s a2 a2
  )

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