ReproducesInput.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 would make a file that is already in its chain.

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

  -- * Optics
  ReproducesInputLike (..),
  lawNamesReproducesInput,
  InheritReproducesInput,
  inheritReproducesInput,
  inheritsReproducesInput,
) 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.File (FileLike (..))
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 would make a file that is already in its chain: the file
('file'), which is its input file or the input file of a step in the trail,
the step ('step'), and the trail of its input file ('trail').

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

{- | The class of 'ReproducesInput'.

@since 0.8.0.0
-}
class ReproducesInputLike p f x x' where
  reproducesInput ::
    Optic p f x x' ReproducesInput ReproducesInput

{- | Identity

@since 0.8.0.0
-}
instance (x' ~ ReproducesInput) => ReproducesInputLike p f ReproducesInput x' where
  reproducesInput =
    id
  {-# INLINE reproducesInput #-}

{- | Lens

@since 0.8.0.0
-}
instance (p ~ (->), Functor f, x' ~ ReproducesInput) => FileLike p f ReproducesInput x' where
  file f (ReproducesInput o s t) =
    fmap (\o' -> ReproducesInput o' s t) (f o)
  {-# INLINE file #-}

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

@since 0.8.0.0
-}
instance (p ~ (->), Functor f, x' ~ ReproducesInput) => StepLike p f ReproducesInput x' where
  step f (ReproducesInput o s t) =
    fmap (\s' -> ReproducesInput o s' 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' ~ ReproducesInput) => TrailLike p f ReproducesInput x' where
  trail f (ReproducesInput o s t) =
    fmap (ReproducesInput o 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' ~ ReproducesInput) => StepNameLike p f ReproducesInput 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' ~ ReproducesInput) => StepInputLike p f ReproducesInput 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' ~ ReproducesInput) => StepsLike p f ReproducesInput x' where
  steps =
    trail . steps
  {-# INLINE steps #-}

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

Laws:

> lawNamesReproducesInput == id

@since 0.8.0.0
-}
lawNamesReproducesInput :: ReproducesInput -> ReproducesInput
lawNamesReproducesInput s =
  ReproducesInput (view (cloneLens file) s) (view (cloneLens step) s) (view (cloneLens trail) s)

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

@since 0.8.0.0
-}
type InheritReproducesInput s =
  ( ReproducesInputLike (->) (Const ()) s s
  , FileLike (->) (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
'ReproducesInput'.

@since 0.8.0.0
-}
inheritReproducesInput :: (InheritReproducesInput s) => proxy s -> ()
inheritReproducesInput _ =
  ()

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

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