OperationalHeadquarters.hs

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

-- | The data type @OperationalHeadquarters'@: where the operational headquarters of the operator is.
module ReOC.Data.OperationalHeadquarters (
  OperationalHeadquarters' (..),
  OperationalHeadquarters'Like (..),
  lawNamesOperationalHeadquarters',
  OperationalHeadquarters,
  UnfilledOperationalHeadquarters,
  InheritOperationalHeadquarters',
  inheritOperationalHeadquarters',
) where

import Control.Lens (Choice, Optic, prism, prism', review)
import Data.Functor.Const (Const)
import ReOC.Data.Address (Address, UnfilledAddress)
import ReOC.Name.AtRegisteredOffice (AtRegisteredOfficeLike (..))
import ReOC.Name.OperationalHeadquartersAddress (OperationalHeadquartersAddressLike (..))

-- | Where the operational headquarters of the operator is. Its valid form is @OperationalHeadquarters@, and its unfilled form @UnfilledOperationalHeadquarters@.
data OperationalHeadquarters' a1
  = AtRegisteredOffice
  | OperationalHeadquartersAddress a1
  deriving (Eq, Ord, Show)

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

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

-- | Prism
instance (Choice p, Applicative f, x' ~ OperationalHeadquarters' a1) => AtRegisteredOfficeLike p f (OperationalHeadquarters' a1) x' where
  atRegisteredOffice = prism' (\() -> AtRegisteredOffice) (\case AtRegisteredOffice -> Just (); OperationalHeadquartersAddress _ -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ OperationalHeadquarters' a1') => OperationalHeadquartersAddressLike p f (OperationalHeadquarters' a1) x' a1 a1' where
  operationalHeadquartersAddress = prism OperationalHeadquartersAddress (\case AtRegisteredOffice -> Left AtRegisteredOffice; OperationalHeadquartersAddress x -> Right x)

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

Laws:

> lawNamesOperationalHeadquarters' == id
-}
lawNamesOperationalHeadquarters' :: OperationalHeadquarters' a1 -> OperationalHeadquarters' a1
lawNamesOperationalHeadquarters' = \case
  AtRegisteredOffice -> review atRegisteredOffice ()
  OperationalHeadquartersAddress x -> review operationalHeadquartersAddress x

-- | A valid @OperationalHeadquarters'@.
type OperationalHeadquarters = OperationalHeadquarters' Address

-- | An unfilled @OperationalHeadquarters'@: each field holds what has been entered, if anything, to be checked by @fillOperationalHeadquarters@.
type UnfilledOperationalHeadquarters = OperationalHeadquarters' UnfilledAddress

-- | The classes that a data type holding @OperationalHeadquarters'@ in one field, or in one or more constructors, inherits.
type InheritOperationalHeadquarters' s a1 =
  ( OperationalHeadquarters'Like (->) (Const ()) s s a1 a1
  , AtRegisteredOfficeLike (->) (Const ()) s s
  , OperationalHeadquartersAddressLike (->) (Const ()) s s a1 a1
  )

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