Version.hs

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

-- | The data type @Version'@: the version of the operations manual.
module ReOC.Data.Version (
  Version' (..),
  Version'Like (..),
  lawNamesVersion',
  Version,
  UnfilledVersion,
  mkUnfilledVersion,
  InheritVersion',
  inheritVersion',
) where

import Control.Lens (Optic, cloneLens, view)
import Data.Functor.Const (Const)
import Numeric.Natural (Natural)
import ReOC.Name.MajorVersion (MajorVersionLike (..))
import ReOC.Name.MinorVersion (MinorVersionLike (..))

-- | The version of the operations manual. Its valid form is @Version@, and its unfilled form @UnfilledVersion@.
data Version' a1 a2 = Version' a1 a2
  deriving (Eq, Ord, Show)

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

-- | Identity
instance (x' ~ Version' a1' a2') => Version'Like p f (Version' a1 a2) x' a1 a1' a2 a2' where
  version' = id

-- | Lens
instance (p ~ (->), Functor f, x' ~ Version' a1' a2) => MajorVersionLike p f (Version' a1 a2) x' a1 a1' where
  majorVersion f (Version' x1 x2) = fmap (\x1' -> Version' x1' x2) (f x1)

-- | Lens
instance (p ~ (->), Functor f, x' ~ Version' a1 a2') => MinorVersionLike p f (Version' a1 a2) x' a2 a2' where
  minorVersion f (Version' x1 x2) = fmap (Version' x1) (f x2)

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

Laws:

> lawNamesVersion' == id
-}
lawNamesVersion' :: Version' a1 a2 -> Version' a1 a2
lawNamesVersion' s =
  Version'
    (view (cloneLens majorVersion) s)
    (view (cloneLens minorVersion) s)

-- | A valid @Version'@.
type Version = Version' Natural Natural

-- | An unfilled @Version'@: each field holds what has been entered, if anything, to be checked by @fillVersion@.
type UnfilledVersion = Version' (Maybe Natural) (Maybe Natural)

-- | An unfilled @Version'@ with nothing entered.
mkUnfilledVersion :: UnfilledVersion
mkUnfilledVersion =
  Version'
    Nothing
    Nothing

-- | The classes that a data type holding @Version'@ in one field, or in one or more constructors, inherits.
type InheritVersion' s a1 a2 =
  ( Version'Like (->) (Const ()) s s a1 a1 a2 a2
  , MajorVersionLike (->) (Const ()) s s a1 a1
  , MinorVersionLike (->) (Const ()) s s a2 a2
  )

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