AustralianState.hs

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

-- | The data type @AustralianState@: a state or territory of Australia.
module ReOC.Data.AustralianState (
  AustralianState (..),
  AustralianStateLike (..),
  lawNamesAustralianState,
  InheritAustralianState,
  inheritAustralianState,
) where

import Control.Lens (Choice, Optic, prism', review)
import Data.Functor.Const (Const)
import ReOC.Name.AustralianCapitalTerritory (AustralianCapitalTerritoryLike (..))
import ReOC.Name.NewSouthWales (NewSouthWalesLike (..))
import ReOC.Name.NorthernTerritory (NorthernTerritoryLike (..))
import ReOC.Name.Queensland (QueenslandLike (..))
import ReOC.Name.SouthAustralia (SouthAustraliaLike (..))
import ReOC.Name.Tasmania (TasmaniaLike (..))
import ReOC.Name.Victoria (VictoriaLike (..))
import ReOC.Name.WesternAustralia (WesternAustraliaLike (..))

-- | A state or territory of Australia.
data AustralianState
  = NewSouthWales
  | Victoria
  | Queensland
  | WesternAustralia
  | SouthAustralia
  | Tasmania
  | AustralianCapitalTerritory
  | NorthernTerritory
  deriving (Eq, Ord, Show)

-- | The name of the data type @AustralianState@.
class AustralianStateLike p f x x' where
  australianState ::
    Optic p f x x' AustralianState AustralianState

-- | Identity
instance (x' ~ AustralianState) => AustralianStateLike p f AustralianState x' where
  australianState = id

-- | Prism
instance (Choice p, Applicative f, x' ~ AustralianState) => NewSouthWalesLike p f AustralianState x' where
  newSouthWales = prism' (\() -> NewSouthWales) (\case NewSouthWales -> Just (); Victoria -> Nothing; Queensland -> Nothing; WesternAustralia -> Nothing; SouthAustralia -> Nothing; Tasmania -> Nothing; AustralianCapitalTerritory -> Nothing; NorthernTerritory -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ AustralianState) => VictoriaLike p f AustralianState x' where
  victoria = prism' (\() -> Victoria) (\case NewSouthWales -> Nothing; Victoria -> Just (); Queensland -> Nothing; WesternAustralia -> Nothing; SouthAustralia -> Nothing; Tasmania -> Nothing; AustralianCapitalTerritory -> Nothing; NorthernTerritory -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ AustralianState) => QueenslandLike p f AustralianState x' where
  queensland = prism' (\() -> Queensland) (\case NewSouthWales -> Nothing; Victoria -> Nothing; Queensland -> Just (); WesternAustralia -> Nothing; SouthAustralia -> Nothing; Tasmania -> Nothing; AustralianCapitalTerritory -> Nothing; NorthernTerritory -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ AustralianState) => WesternAustraliaLike p f AustralianState x' where
  westernAustralia = prism' (\() -> WesternAustralia) (\case NewSouthWales -> Nothing; Victoria -> Nothing; Queensland -> Nothing; WesternAustralia -> Just (); SouthAustralia -> Nothing; Tasmania -> Nothing; AustralianCapitalTerritory -> Nothing; NorthernTerritory -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ AustralianState) => SouthAustraliaLike p f AustralianState x' where
  southAustralia = prism' (\() -> SouthAustralia) (\case NewSouthWales -> Nothing; Victoria -> Nothing; Queensland -> Nothing; WesternAustralia -> Nothing; SouthAustralia -> Just (); Tasmania -> Nothing; AustralianCapitalTerritory -> Nothing; NorthernTerritory -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ AustralianState) => TasmaniaLike p f AustralianState x' where
  tasmania = prism' (\() -> Tasmania) (\case NewSouthWales -> Nothing; Victoria -> Nothing; Queensland -> Nothing; WesternAustralia -> Nothing; SouthAustralia -> Nothing; Tasmania -> Just (); AustralianCapitalTerritory -> Nothing; NorthernTerritory -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ AustralianState) => AustralianCapitalTerritoryLike p f AustralianState x' where
  australianCapitalTerritory = prism' (\() -> AustralianCapitalTerritory) (\case NewSouthWales -> Nothing; Victoria -> Nothing; Queensland -> Nothing; WesternAustralia -> Nothing; SouthAustralia -> Nothing; Tasmania -> Nothing; AustralianCapitalTerritory -> Just (); NorthernTerritory -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ AustralianState) => NorthernTerritoryLike p f AustralianState x' where
  northernTerritory = prism' (\() -> NorthernTerritory) (\case NewSouthWales -> Nothing; Victoria -> Nothing; Queensland -> Nothing; WesternAustralia -> Nothing; SouthAustralia -> Nothing; Tasmania -> Nothing; AustralianCapitalTerritory -> Nothing; NorthernTerritory -> Just ())

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

Laws:

> lawNamesAustralianState == id
-}
lawNamesAustralianState :: AustralianState -> AustralianState
lawNamesAustralianState = \case
  NewSouthWales -> review newSouthWales ()
  Victoria -> review victoria ()
  Queensland -> review queensland ()
  WesternAustralia -> review westernAustralia ()
  SouthAustralia -> review southAustralia ()
  Tasmania -> review tasmania ()
  AustralianCapitalTerritory -> review australianCapitalTerritory ()
  NorthernTerritory -> review northernTerritory ()

-- | The classes that a data type holding @AustralianState@ in one field, or in one or more constructors, inherits.
type InheritAustralianState s =
  ( AustralianStateLike (->) (Const ()) s s
  , NewSouthWalesLike (->) (Const ()) s s
  , VictoriaLike (->) (Const ()) s s
  , QueenslandLike (->) (Const ()) s s
  , WesternAustraliaLike (->) (Const ()) s s
  , SouthAustraliaLike (->) (Const ()) s s
  , TasmaniaLike (->) (Const ()) s s
  , AustralianCapitalTerritoryLike (->) (Const ()) s s
  , NorthernTerritoryLike (->) (Const ()) s s
  )

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