VersionChange.hs

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

-- | The data type @VersionChange@: how a revision of the operations manual changes its version: a major revision increments the major version and resets the minor version to 0.
module ReOC.Data.VersionChange (
  VersionChange (..),
  VersionChangeLike (..),
  lawNamesVersionChange,
  InheritVersionChange,
  inheritVersionChange,
) where

import Control.Lens (Choice, Optic, prism', review)
import Data.Functor.Const (Const)
import ReOC.Name.MajorRevision (MajorRevisionLike (..))
import ReOC.Name.MinorRevision (MinorRevisionLike (..))

-- | How a revision of the operations manual changes its version: a major revision increments the major version and resets the minor version to 0.
data VersionChange
  = MajorRevision
  | MinorRevision
  deriving (Eq, Ord, Show)

-- | The name of the data type @VersionChange@.
class VersionChangeLike p f x x' where
  versionChange ::
    Optic p f x x' VersionChange VersionChange

-- | Identity
instance (x' ~ VersionChange) => VersionChangeLike p f VersionChange x' where
  versionChange = id

-- | Prism
instance (Choice p, Applicative f, x' ~ VersionChange) => MajorRevisionLike p f VersionChange x' where
  majorRevision = prism' (\() -> MajorRevision) (\case MajorRevision -> Just (); MinorRevision -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ VersionChange) => MinorRevisionLike p f VersionChange x' where
  minorRevision = prism' (\() -> MinorRevision) (\case MajorRevision -> Nothing; MinorRevision -> Just ())

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

Laws:

> lawNamesVersionChange == id
-}
lawNamesVersionChange :: VersionChange -> VersionChange
lawNamesVersionChange = \case
  MajorRevision -> review majorRevision ()
  MinorRevision -> review minorRevision ()

-- | The classes that a data type holding @VersionChange@ in one field, or in one or more constructors, inherits.
type InheritVersionChange s =
  ( VersionChangeLike (->) (Const ()) s s
  , MajorRevisionLike (->) (Const ()) s s
  , MinorRevisionLike (->) (Const ()) s s
  )

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