BackupInterval.hs

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

-- | The data type @BackupInterval@: the longest interval between backups of the operator’s records.
module ReOC.Data.BackupInterval (
  BackupInterval (..),
  BackupIntervalLike (..),
  lawNamesBackupInterval,
  InheritBackupInterval,
  inheritBackupInterval,
) where

import Control.Lens (Choice, Optic, prism', review)
import Data.Functor.Const (Const)
import ReOC.Name.Daily (DailyLike (..))
import ReOC.Name.Monthly (MonthlyLike (..))
import ReOC.Name.Weekly (WeeklyLike (..))

-- | The longest interval between backups of the operator’s records.
data BackupInterval
  = Daily
  | Weekly
  | Monthly
  deriving (Eq, Ord, Show)

-- | The name of the data type @BackupInterval@.
class BackupIntervalLike p f x x' where
  backupInterval ::
    Optic p f x x' BackupInterval BackupInterval

-- | Identity
instance (x' ~ BackupInterval) => BackupIntervalLike p f BackupInterval x' where
  backupInterval = id

-- | Prism
instance (Choice p, Applicative f, x' ~ BackupInterval) => DailyLike p f BackupInterval x' where
  daily = prism' (\() -> Daily) (\case Daily -> Just (); Weekly -> Nothing; Monthly -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ BackupInterval) => WeeklyLike p f BackupInterval x' where
  weekly = prism' (\() -> Weekly) (\case Daily -> Nothing; Weekly -> Just (); Monthly -> Nothing)

-- | Prism
instance (Choice p, Applicative f, x' ~ BackupInterval) => MonthlyLike p f BackupInterval x' where
  monthly = prism' (\() -> Monthly) (\case Daily -> Nothing; Weekly -> Nothing; Monthly -> Just ())

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

Laws:

> lawNamesBackupInterval == id
-}
lawNamesBackupInterval :: BackupInterval -> BackupInterval
lawNamesBackupInterval = \case
  Daily -> review daily ()
  Weekly -> review weekly ()
  Monthly -> review monthly ()

-- | The classes that a data type holding @BackupInterval@ in one field, or in one or more constructors, inherits.
type InheritBackupInterval s =
  ( BackupIntervalLike (->) (Const ()) s s
  , DailyLike (->) (Const ()) s s
  , WeeklyLike (->) (Const ()) s s
  , MonthlyLike (->) (Const ()) s s
  )

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