Revision.hs

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

-- | The data type @Revision'@: a later entry in the amendment record of the operations manual. Its version and date follow from the entry before it: the version changes by its version change, and the date is a number of months later.
module ReOC.Data.Revision (
  Revision' (..),
  Revision'Like (..),
  lawNamesRevision',
  Revision,
  UnfilledRevision,
  mkUnfilledRevision,
  InheritRevision',
  inheritRevision',
) where

import Control.Lens (Optic, cloneLens, view)
import Data.Functor.Const (Const)
import Data.Text (Text)
import Numeric.Natural (Natural)
import ReOC.Data.VersionChange (VersionChange)
import ReOC.Name.Details (DetailsLike (..))
import ReOC.Name.Effective (EffectiveLike (..))
import ReOC.Name.MonthsAfter (MonthsAfterLike (..))
import ReOC.Name.Parts (PartsLike (..))
import ReOC.Name.VersionIncrement (VersionIncrementLike (..))
import ReOC.Primitive.Text1 (Text1)

-- | A later entry in the amendment record of the operations manual. Its version and date follow from the entry before it: the version changes by its version change, and the date is a number of months later. Its valid form is @Revision@, and its unfilled form @UnfilledRevision@.
data Revision' a1 a2 a3 a4 a5 = Revision' a1 a2 a3 a4 a5
  deriving (Eq, Ord, Show)

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

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

-- | Lens
instance (p ~ (->), Functor f, x' ~ Revision' a1' a2 a3 a4 a5) => VersionIncrementLike p f (Revision' a1 a2 a3 a4 a5) x' a1 a1' where
  versionIncrement f (Revision' x1 x2 x3 x4 x5) = fmap (\x1' -> Revision' x1' x2 x3 x4 x5) (f x1)

-- | Lens
instance (p ~ (->), Functor f, x' ~ Revision' a1 a2' a3 a4 a5) => MonthsAfterLike p f (Revision' a1 a2 a3 a4 a5) x' a2 a2' where
  monthsAfter f (Revision' x1 x2 x3 x4 x5) = fmap (\x2' -> Revision' x1 x2' x3 x4 x5) (f x2)

-- | Lens
instance (p ~ (->), Functor f, x' ~ Revision' a1 a2 a3' a4 a5) => EffectiveLike p f (Revision' a1 a2 a3 a4 a5) x' a3 a3' where
  effective f (Revision' x1 x2 x3 x4 x5) = fmap (\x3' -> Revision' x1 x2 x3' x4 x5) (f x3)

-- | Lens
instance (p ~ (->), Functor f, x' ~ Revision' a1 a2 a3 a4' a5) => PartsLike p f (Revision' a1 a2 a3 a4 a5) x' a4 a4' where
  parts f (Revision' x1 x2 x3 x4 x5) = fmap (\x4' -> Revision' x1 x2 x3 x4' x5) (f x4)

-- | Lens
instance (p ~ (->), Functor f, x' ~ Revision' a1 a2 a3 a4 a5') => DetailsLike p f (Revision' a1 a2 a3 a4 a5) x' a5 a5' where
  details f (Revision' x1 x2 x3 x4 x5) = fmap (Revision' x1 x2 x3 x4) (f x5)

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

Laws:

> lawNamesRevision' == id
-}
lawNamesRevision' :: Revision' a1 a2 a3 a4 a5 -> Revision' a1 a2 a3 a4 a5
lawNamesRevision' s =
  Revision'
    (view (cloneLens versionIncrement) s)
    (view (cloneLens monthsAfter) s)
    (view (cloneLens effective) s)
    (view (cloneLens parts) s)
    (view (cloneLens details) s)

-- | A valid @Revision'@.
type Revision = Revision' VersionChange Natural Text1 Text1 Text1

-- | An unfilled @Revision'@: each field holds what has been entered, if anything, to be checked by @fillRevision@.
type UnfilledRevision = Revision' (Maybe VersionChange) (Maybe Natural) (Maybe Text) (Maybe Text) (Maybe Text)

-- | An unfilled @Revision'@ with nothing entered.
mkUnfilledRevision :: UnfilledRevision
mkUnfilledRevision =
  Revision'
    Nothing
    Nothing
    Nothing
    Nothing
    Nothing

-- | The classes that a data type holding @Revision'@ in one field, or in one or more constructors, inherits.
type InheritRevision' s a1 a2 a3 a4 a5 =
  ( Revision'Like (->) (Const ()) s s a1 a1 a2 a2 a3 a3 a4 a4 a5 a5
  , VersionIncrementLike (->) (Const ()) s s a1 a1
  , MonthsAfterLike (->) (Const ()) s s a2 a2
  , EffectiveLike (->) (Const ()) s s a3 a3
  , PartsLike (->) (Const ()) s s a4 a4
  , DetailsLike (->) (Const ()) s s a5 a5
  )

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