ReOCError.hs

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

-- | The data type @ReOCError@: a reason that an unfilled ReOC is not a valid ReOC.
module ReOC.Data.ReOCError (
  ReOCError (..),
  ReOCErrorLike (..),
  lawNamesReOCError,
  InheritReOCError,
  inheritReOCError,
  inheritsReOCError,
) where

import Control.Lens (Choice, Optic, prism', review)
import Data.Functor.Const (Const)
import Data.Proxy (Proxy (..))
import ReOC.Data.Invalid (Invalid, InvalidLike (..), inheritInvalid)
import ReOC.Data.InvalidValue (InvalidValueLike (..))
import ReOC.Data.TooMany (TooMany, TooManyLike (..), inheritTooMany)
import ReOC.Data.Unfilled (Unfilled, UnfilledLike (..), inheritUnfilled)
import ReOC.Name.GivenElements (GivenElementsLike (..))
import ReOC.Name.InvalidABN (InvalidABNLike (..))
import ReOC.Name.InvalidARN (InvalidARNLike (..))
import ReOC.Name.InvalidEmailAddress (InvalidEmailAddressLike (..))
import ReOC.Name.InvalidFormText (InvalidFormTextLike (..))
import ReOC.Name.InvalidGrossWeight (InvalidGrossWeightLike (..))
import ReOC.Name.InvalidPassMark (InvalidPassMarkLike (..))
import ReOC.Name.InvalidPercentage (InvalidPercentageLike (..))
import ReOC.Name.InvalidPhoneNumber (InvalidPhoneNumberLike (..))
import ReOC.Name.InvalidPositive (InvalidPositiveLike (..))
import ReOC.Name.InvalidPostcode (InvalidPostcodeLike (..))
import ReOC.Name.InvalidReviewMonths (InvalidReviewMonthsLike (..))
import ReOC.Name.InvalidText1 (InvalidText1Like (..))
import ReOC.Name.MostElements (MostElementsLike (..))
import ReOC.Name.Path (PathLike (..))

-- | A reason that an unfilled ReOC is not a valid ReOC.
data ReOCError
  = ReOCErrorUnfilled Unfilled
  | ReOCErrorInvalid Invalid
  | ReOCErrorTooMany TooMany
  deriving (Eq, Ord, Show)

-- | The name of the data type @ReOCError@.
class ReOCErrorLike p f x x' where
  reOCError ::
    Optic p f x x' ReOCError ReOCError

-- | Identity
instance (x' ~ ReOCError) => ReOCErrorLike p f ReOCError x' where
  reOCError = id

-- | Prism
instance (Choice p, Applicative f, x' ~ ReOCError) => UnfilledLike p f ReOCError x' where
  unfilled = prism' ReOCErrorUnfilled (\case ReOCErrorUnfilled x -> Just x; ReOCErrorInvalid _ -> Nothing; ReOCErrorTooMany _ -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ ReOCError) => InvalidLike p f ReOCError x' where
  invalid = prism' ReOCErrorInvalid (\case ReOCErrorUnfilled _ -> Nothing; ReOCErrorInvalid x -> Just x; ReOCErrorTooMany _ -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ ReOCError) => TooManyLike p f ReOCError x' where
  tooMany = prism' ReOCErrorTooMany (\case ReOCErrorUnfilled _ -> Nothing; ReOCErrorInvalid _ -> Nothing; ReOCErrorTooMany x -> Just x)

-- | Affine traversal: @path@ is reached through @ReOCErrorUnfilled@, @ReOCErrorInvalid@, @ReOCErrorTooMany@, once each.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => PathLike p f ReOCError x' where
  path f = \case
    ReOCErrorUnfilled x -> ReOCErrorUnfilled <$> path f x
    ReOCErrorInvalid x -> ReOCErrorInvalid <$> path f x
    ReOCErrorTooMany x -> ReOCErrorTooMany <$> path f x

-- | Affine traversal: through @invalid@, then @invalidValue@ of @Invalid@.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => InvalidValueLike p f ReOCError x' where
  invalidValue = invalid . invalidValue

-- | Affine traversal: through @invalid@, then @invalidText1@ of @Invalid@.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => InvalidText1Like p f ReOCError x' where
  invalidText1 = invalid . invalidText1

-- | Affine traversal: through @invalid@, then @invalidFormText@ of @Invalid@.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => InvalidFormTextLike p f ReOCError x' where
  invalidFormText = invalid . invalidFormText

-- | Affine traversal: through @invalid@, then @invalidABN@ of @Invalid@.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => InvalidABNLike p f ReOCError x' where
  invalidABN = invalid . invalidABN

-- | Affine traversal: through @invalid@, then @invalidARN@ of @Invalid@.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => InvalidARNLike p f ReOCError x' where
  invalidARN = invalid . invalidARN

-- | Affine traversal: through @invalid@, then @invalidEmailAddress@ of @Invalid@.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => InvalidEmailAddressLike p f ReOCError x' where
  invalidEmailAddress = invalid . invalidEmailAddress

-- | Affine traversal: through @invalid@, then @invalidPhoneNumber@ of @Invalid@.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => InvalidPhoneNumberLike p f ReOCError x' where
  invalidPhoneNumber = invalid . invalidPhoneNumber

-- | Affine traversal: through @invalid@, then @invalidPostcode@ of @Invalid@.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => InvalidPostcodeLike p f ReOCError x' where
  invalidPostcode = invalid . invalidPostcode

-- | Affine traversal: through @invalid@, then @invalidPositive@ of @Invalid@.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => InvalidPositiveLike p f ReOCError x' where
  invalidPositive = invalid . invalidPositive

-- | Affine traversal: through @invalid@, then @invalidPercentage@ of @Invalid@.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => InvalidPercentageLike p f ReOCError x' where
  invalidPercentage = invalid . invalidPercentage

-- | Affine traversal: through @invalid@, then @invalidGrossWeight@ of @Invalid@.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => InvalidGrossWeightLike p f ReOCError x' where
  invalidGrossWeight = invalid . invalidGrossWeight

-- | Affine traversal: through @invalid@, then @invalidReviewMonths@ of @Invalid@.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => InvalidReviewMonthsLike p f ReOCError x' where
  invalidReviewMonths = invalid . invalidReviewMonths

-- | Affine traversal: through @invalid@, then @invalidPassMark@ of @Invalid@.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => InvalidPassMarkLike p f ReOCError x' where
  invalidPassMark = invalid . invalidPassMark

-- | Affine traversal: through @tooMany@, then @mostElements@ of @TooMany@.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => MostElementsLike p f ReOCError x' where
  mostElements = tooMany . mostElements

-- | Affine traversal: through @tooMany@, then @givenElements@ of @TooMany@.
instance (p ~ (->), Applicative f, x' ~ ReOCError) => GivenElementsLike p f ReOCError x' where
  givenElements = tooMany . givenElements

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

Laws:

> lawNamesReOCError == id
-}
lawNamesReOCError :: ReOCError -> ReOCError
lawNamesReOCError = \case
  ReOCErrorUnfilled x -> review unfilled x
  ReOCErrorInvalid x -> review invalid x
  ReOCErrorTooMany x -> review tooMany x

-- | The classes that a data type holding @ReOCError@ in one field, or in one or more constructors, inherits.
type InheritReOCError s =
  ( ReOCErrorLike (->) (Const ()) s s
  , UnfilledLike (->) (Const ()) s s
  , InvalidLike (->) (Const ()) s s
  , TooManyLike (->) (Const ()) s s
  , PathLike (->) (Const ()) s s
  , InvalidValueLike (->) (Const ()) s s
  , InvalidText1Like (->) (Const ()) s s
  , InvalidFormTextLike (->) (Const ()) s s
  , InvalidABNLike (->) (Const ()) s s
  , InvalidARNLike (->) (Const ()) s s
  , InvalidEmailAddressLike (->) (Const ()) s s
  , InvalidPhoneNumberLike (->) (Const ()) s s
  , InvalidPostcodeLike (->) (Const ()) s s
  , InvalidPositiveLike (->) (Const ()) s s
  , InvalidPercentageLike (->) (Const ()) s s
  , InvalidGrossWeightLike (->) (Const ()) s s
  , InvalidReviewMonthsLike (->) (Const ()) s s
  , InvalidPassMarkLike (->) (Const ()) s s
  , MostElementsLike (->) (Const ()) s s
  , GivenElementsLike (->) (Const ()) s s
  )

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

-- | The checks of inheritance of @ReOCError@.
inheritsReOCError :: [()]
inheritsReOCError =
  [ inheritUnfilled p
  , inheritInvalid p
  , inheritTooMany p
  ]
 where
  p = Proxy :: Proxy ReOCError