ContactPerson.hs

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

-- | The data type @ContactPerson'@: the main contact person for an application (CASA Form 101-02, question 3).
module ReOC.Data.ContactPerson (
  ContactPerson' (..),
  ContactPerson'Like (..),
  lawNamesContactPerson',
  ContactPerson,
  UnfilledContactPerson,
  mkUnfilledContactPerson,
  InheritContactPerson',
  inheritContactPerson',
) where

import Control.Lens (Optic, cloneLens, view)
import Data.Functor.Const (Const)
import Data.Text (Text)
import ReOC.Name.EmailAddress (EmailAddressLike (..))
import ReOC.Name.FullName (FullNameLike (..))
import ReOC.Name.PhoneNumber (PhoneNumberLike (..))
import ReOC.Name.Position (PositionLike (..))
import ReOC.Primitive.EmailAddress (EmailAddress)
import ReOC.Primitive.FormText (FormLine)
import ReOC.Primitive.PhoneNumber (PhoneNumber)

-- | The main contact person for an application (CASA Form 101-02, question 3). Its valid form is @ContactPerson@, and its unfilled form @UnfilledContactPerson@.
data ContactPerson' a1 a2 a3 a4 = ContactPerson' a1 a2 a3 a4
  deriving (Eq, Ord, Show)

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

-- | Identity
instance (x' ~ ContactPerson' a1' a2' a3' a4') => ContactPerson'Like p f (ContactPerson' a1 a2 a3 a4) x' a1 a1' a2 a2' a3 a3' a4 a4' where
  contactPerson' = id

-- | Lens
instance (p ~ (->), Functor f, x' ~ ContactPerson' a1' a2 a3 a4) => FullNameLike p f (ContactPerson' a1 a2 a3 a4) x' a1 a1' where
  fullName f (ContactPerson' x1 x2 x3 x4) = fmap (\x1' -> ContactPerson' x1' x2 x3 x4) (f x1)

-- | Lens
instance (p ~ (->), Functor f, x' ~ ContactPerson' a1 a2' a3 a4) => PositionLike p f (ContactPerson' a1 a2 a3 a4) x' a2 a2' where
  position f (ContactPerson' x1 x2 x3 x4) = fmap (\x2' -> ContactPerson' x1 x2' x3 x4) (f x2)

-- | Lens
instance (p ~ (->), Functor f, x' ~ ContactPerson' a1 a2 a3' a4) => PhoneNumberLike p f (ContactPerson' a1 a2 a3 a4) x' a3 a3' where
  phoneNumber f (ContactPerson' x1 x2 x3 x4) = fmap (\x3' -> ContactPerson' x1 x2 x3' x4) (f x3)

-- | Lens
instance (p ~ (->), Functor f, x' ~ ContactPerson' a1 a2 a3 a4') => EmailAddressLike p f (ContactPerson' a1 a2 a3 a4) x' a4 a4' where
  emailAddress f (ContactPerson' x1 x2 x3 x4) = fmap (ContactPerson' x1 x2 x3) (f x4)

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

Laws:

> lawNamesContactPerson' == id
-}
lawNamesContactPerson' :: ContactPerson' a1 a2 a3 a4 -> ContactPerson' a1 a2 a3 a4
lawNamesContactPerson' s =
  ContactPerson'
    (view (cloneLens fullName) s)
    (view (cloneLens position) s)
    (view (cloneLens phoneNumber) s)
    (view (cloneLens emailAddress) s)

-- | A valid @ContactPerson'@.
type ContactPerson = ContactPerson' FormLine FormLine PhoneNumber EmailAddress

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

-- | An unfilled @ContactPerson'@ with nothing entered.
mkUnfilledContactPerson :: UnfilledContactPerson
mkUnfilledContactPerson =
  ContactPerson'
    Nothing
    Nothing
    Nothing
    Nothing

-- | The classes that a data type holding @ContactPerson'@ in one field, or in one or more constructors, inherits.
type InheritContactPerson' s a1 a2 a3 a4 =
  ( ContactPerson'Like (->) (Const ()) s s a1 a1 a2 a2 a3 a3 a4 a4
  , FullNameLike (->) (Const ()) s s a1 a1
  , PositionLike (->) (Const ()) s s a2 a2
  , PhoneNumberLike (->) (Const ()) s s a3 a3
  , EmailAddressLike (->) (Const ()) s s a4 a4
  )

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