Repetition.hs

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wall #-}

{- | Whether a step may appear more than once in a trail.

A 'Repetition' is a sum: its constructors are named 'once' and 'repeatable'.
-}
module System.FilePather.Repetition (
  -- * Type
  Repetition (..),

  -- * Optics
  RepetitionLike (..),
  lawNamesRepetition,
  InheritRepetition,
  inheritRepetition,
) where

import Control.DeepSeq (NFData)
import Control.Lens (Choice, Optic, prism', review)
import Data.Data (Data)
import Data.Functor.Const (Const)
import GHC.Generics (Generic)
import System.FilePather.Name.Once (OnceLike (..))
import System.FilePather.Name.Repeatable (RepeatableLike (..))

{- | Whether a step may appear more than once in a trail. A step that may
not is stopped with 'System.FilePather.Cycle.CycleRepeatsStep' when it is
already in the trail.

@since 0.7.0.0
-}
data Repetition
  = -- | The step may appear once in a trail ('once').
    Once
  | -- | The step may appear any number of times in a trail ('repeatable').
    Repeatable
  deriving stock (Eq, Ord, Show, Generic, Data)
  deriving anyclass (NFData)

{- | The class of 'Repetition'.

@since 0.8.0.0
-}
class RepetitionLike p f x x' where
  repetition ::
    Optic p f x x' Repetition Repetition

{- | Identity

@since 0.8.0.0
-}
instance (x' ~ Repetition) => RepetitionLike p f Repetition x' where
  repetition =
    id
  {-# INLINE repetition #-}

{- | Prism

@since 0.8.0.0
-}
instance (Choice p, Applicative f, x' ~ Repetition) => OnceLike p f Repetition x' where
  once =
    prism' (\() -> Once) (\case Once -> Just (); Repeatable -> Nothing)
  {-# INLINE once #-}

{- | Prism

@since 0.8.0.0
-}
instance (Choice p, Applicative f, x' ~ Repetition) => RepeatableLike p f Repetition x' where
  repeatable =
    prism' (\() -> Repeatable) (\case Repeatable -> Just (); Once -> Nothing)
  {-# INLINE repeatable #-}

{- | Rebuild a value using only the name of each constructor.

Laws:

> lawNamesRepetition == id

@since 0.8.0.0
-}
lawNamesRepetition :: Repetition -> Repetition
lawNamesRepetition = \case
  Once -> review once ()
  Repeatable -> review repeatable ()

{- | The classes that a data type holding 'Repetition' inherits.

@since 0.8.0.0
-}
type InheritRepetition s =
  ( RepetitionLike (->) (Const ()) s s
  , OnceLike (->) (Const ()) s s
  , RepeatableLike (->) (Const ()) s s
  )

{- | Check, where it is applied, that @s@ inherits every name of 'Repetition'.

@since 0.8.0.0
-}
inheritRepetition :: (InheritRepetition s) => proxy s -> ()
inheritRepetition _ =
  ()