Address.hs

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

-- | The data type @Address'@: an Australian street address.
module ReOC.Data.Address (
  Address' (..),
  Address'Like (..),
  lawNamesAddress',
  Address,
  UnfilledAddress,
  mkUnfilledAddress,
  InheritAddress',
  inheritAddress',
) where

import Control.Lens (Optic, cloneLens, view)
import Data.Functor.Const (Const)
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import ReOC.Data.AustralianState (AustralianState)
import ReOC.Name.Postcode (PostcodeLike (..))
import ReOC.Name.StateOrTerritory (StateOrTerritoryLike (..))
import ReOC.Name.StreetAddress (StreetAddressLike (..))
import ReOC.Name.Suburb (SuburbLike (..))
import ReOC.Primitive.Postcode (Postcode)
import ReOC.Primitive.Text1 (Text1)

-- | An Australian street address. Its valid form is @Address@, and its unfilled form @UnfilledAddress@.
data Address' a1 a2 a3 a4 = Address' a1 a2 a3 a4
  deriving (Eq, Ord, Show)

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

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

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

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

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

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

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

Laws:

> lawNamesAddress' == id
-}
lawNamesAddress' :: Address' a1 a2 a3 a4 -> Address' a1 a2 a3 a4
lawNamesAddress' s =
  Address'
    (view (cloneLens streetAddress) s)
    (view (cloneLens suburb) s)
    (view (cloneLens stateOrTerritory) s)
    (view (cloneLens postcode) s)

-- | A valid @Address'@.
type Address = Address' (NonEmpty Text1) Text1 AustralianState Postcode

-- | An unfilled @Address'@: each field holds what has been entered, if anything, to be checked by @fillAddress@.
type UnfilledAddress = Address' [Text] (Maybe Text) (Maybe AustralianState) (Maybe Text)

-- | An unfilled @Address'@ with nothing entered.
mkUnfilledAddress :: UnfilledAddress
mkUnfilledAddress =
  Address'
    []
    Nothing
    Nothing
    Nothing

-- | The classes that a data type holding @Address'@ in one field, or in one or more constructors, inherits.
type InheritAddress' s a1 a2 a3 a4 =
  ( Address'Like (->) (Const ()) s s a1 a1 a2 a2 a3 a3 a4 a4
  , StreetAddressLike (->) (Const ()) s s a1 a1
  , SuburbLike (->) (Const ()) s s a2 a2
  , StateOrTerritoryLike (->) (Const ()) s s a3 a3
  , PostcodeLike (->) (Const ()) s s a4 a4
  )

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