RepeatsStep.hs

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

{- | A step that is already in its trail.

A 'RepeatsStep' is a product: its fields are named 'step' and 'trail'. It
holds a 'Step' and a 'Trail', so it inherits their names.
-}
module System.FilePather.RepeatsStep (
  -- * Type
  RepeatsStep (..),

  -- * Optics
  RepeatsStepLike (..),
  lawNamesRepeatsStep,
  InheritRepeatsStep,
  inheritRepeatsStep,
  inheritsRepeatsStep,
) where

import Control.DeepSeq (NFData)
import Control.Lens (Optic, cloneLens, view)
import Data.Data (Data)
import Data.Functor.Const (Const)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)
import System.FilePather.Name.StepInput (StepInputLike (..))
import System.FilePather.Name.StepName (StepNameLike (..))
import System.FilePather.Name.Steps (StepsLike (..))
import System.FilePather.Step (Step, StepLike (..), inheritStep)
import System.FilePather.Trail (Trail, TrailLike (..), inheritTrail)

{- | A step is already in the trail of its input file: the step ('step'), and
the trail ('trail').

@since 0.8.0.0
-}
data RepeatsStep
  = RepeatsStep Step Trail
  deriving stock (Eq, Ord, Show, Generic, Data)
  deriving anyclass (NFData)

{- | The class of 'RepeatsStep'.

@since 0.8.0.0
-}
class RepeatsStepLike p f x x' where
  repeatsStep ::
    Optic p f x x' RepeatsStep RepeatsStep

{- | Identity

@since 0.8.0.0
-}
instance (x' ~ RepeatsStep) => RepeatsStepLike p f RepeatsStep x' where
  repeatsStep =
    id
  {-# INLINE repeatsStep #-}

{- | Lens: 'step' is the default name of the field of type 'Step'.

@since 0.8.0.0
-}
instance (p ~ (->), Functor f, x' ~ RepeatsStep) => StepLike p f RepeatsStep x' where
  step f (RepeatsStep s t) =
    fmap (`RepeatsStep` t) (f s)
  {-# INLINE step #-}

{- | Lens: 'trail' is the default name of the field of type 'Trail'.

@since 0.8.0.0
-}
instance (p ~ (->), Functor f, x' ~ RepeatsStep) => TrailLike p f RepeatsStep x' where
  trail f (RepeatsStep s t) =
    fmap (RepeatsStep s) (f t)
  {-# INLINE trail #-}

{- | Lens: through 'step', a lens, then 'Step''s 'stepName', a lens.

@since 0.8.0.0
-}
instance (p ~ (->), Functor f, x' ~ RepeatsStep) => StepNameLike p f RepeatsStep x' where
  stepName =
    step . stepName
  {-# INLINE stepName #-}

{- | Lens: through 'step', a lens, then 'Step''s 'stepInput', a lens.

@since 0.8.0.0
-}
instance (p ~ (->), Functor f, x' ~ RepeatsStep) => StepInputLike p f RepeatsStep x' where
  stepInput =
    step . stepInput
  {-# INLINE stepInput #-}

{- | Lens: through 'trail', a lens, then 'Trail''s 'steps', a lens.

@since 0.8.0.0
-}
instance (p ~ (->), Functor f, x' ~ RepeatsStep) => StepsLike p f RepeatsStep x' where
  steps =
    trail . steps
  {-# INLINE steps #-}

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

Laws:

> lawNamesRepeatsStep == id

@since 0.8.0.0
-}
lawNamesRepeatsStep :: RepeatsStep -> RepeatsStep
lawNamesRepeatsStep s =
  RepeatsStep (view (cloneLens step) s) (view (cloneLens trail) s)

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

@since 0.8.0.0
-}
type InheritRepeatsStep s =
  ( RepeatsStepLike (->) (Const ()) s s
  , StepLike (->) (Const ()) s s
  , TrailLike (->) (Const ()) s s
  , StepNameLike (->) (Const ()) s s
  , StepInputLike (->) (Const ()) s s
  , StepsLike (->) (Const ()) s s
  )

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

@since 0.8.0.0
-}
inheritRepeatsStep :: (InheritRepeatsStep s) => proxy s -> ()
inheritRepeatsStep _ =
  ()

{- | 'RepeatsStep' inherits every name of 'Step' and of 'Trail'.

@since 0.8.0.0
-}
inheritsRepeatsStep :: [()]
inheritsRepeatsStep =
  let p = Proxy :: Proxy RepeatsStep
   in [inheritStep p, inheritTrail p]