Trail.hs

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

{- | The steps that built a file.

A 'Trail' is a product with one field, named 'steps'.
-}
module System.FilePather.Trail (
  -- * Type
  Trail (..),

  -- * Traversals
  trailFiles,
  lastStep,

  -- * Optics
  TrailLike (..),
  lawNamesTrail,
  InheritTrail,
  inheritTrail,
) where

import Control.DeepSeq (NFData)
import Control.Lens (AsEmpty (..), Cons (..), Each (..), Index, IxValue, Ixed (..), Optic, Reversing (..), Snoc (..), Traversal', cloneLens, nearly, prism, unsnoc, view, _head)
import Data.Data (Data)
import Data.Functor.Const (Const)
import GHC.Generics (Generic)
import System.FilePather.Name.StepInput (StepInputLike (..))
import System.FilePather.Name.Steps (StepsLike (..))
import System.FilePather.Step (Step)

{- $setup
>>> import Control.Lens ((^..), (^?))
>>> import System.FilePather.Step (Step (..))
>>> import System.FilePather.Name.StepName (stepName)
-}

{- | The steps that built a file ('steps'), nearest first: the step that made
the file, then the step that made its input, and so on, back to the step
whose input is a source file. A source file has the empty trail.

@since 0.7.0.0
-}
newtype Trail
  = Trail [Step]
  deriving stock (Eq, Ord, Show, Generic, Data)
  deriving newtype (NFData, Semigroup, Monoid)

-- | @since 0.7.0.0
instance Cons Trail Trail Step Step where
  _Cons =
    prism
      (\(s, Trail ss) -> Trail (s : ss))
      ( \(Trail x) ->
          case x of
            [] -> Left (Trail [])
            s : ss -> Right (s, Trail ss)
      )
  {-# INLINE _Cons #-}

-- | @since 0.7.0.0
instance Snoc Trail Trail Step Step where
  _Snoc =
    prism
      (\(Trail ss, s) -> Trail (ss <> [s]))
      (\t@(Trail x) -> maybe (Left t) (\(ss, s) -> Right (Trail ss, s)) (unsnoc x))
  {-# INLINE _Snoc #-}

-- | @since 0.7.0.0
instance AsEmpty Trail where
  _Empty =
    nearly (Trail []) (\(Trail x) -> null x)
  {-# INLINE _Empty #-}

-- | @since 0.7.0.0
instance Each Trail Trail Step Step where
  each =
    steps . traverse
  {-# INLINE each #-}

-- | @since 0.7.0.0
type instance Index Trail = Int

-- | @since 0.7.0.0
type instance IxValue Trail = Step

-- | @since 0.7.0.0
instance Ixed Trail where
  ix i =
    steps . ix i
  {-# INLINE ix #-}

-- | @since 0.7.0.0
instance Reversing Trail where
  reversing (Trail x) =
    Trail (reverse x)
  {-# INLINE reversing #-}

{- | The input files of the steps of a trail, nearest first.

>>> Trail [Step "pdf page 1" "public/a.pdf", Step "markdown to pdf" "src/a.md"] ^.. trailFiles
["public/a.pdf","src/a.md"]

@since 0.7.0.0
-}
trailFiles :: Traversal' Trail FilePath
trailFiles =
  each . stepInput
{-# INLINE trailFiles #-}

{- | The last step of a trail: the step that made the file. A source file has
no last step.

>>> Trail [Step "pdf page 1" "public/a.pdf", Step "markdown to pdf" "src/a.md"] ^? lastStep . stepName
Just "pdf page 1"

>>> Trail [] ^? lastStep
Nothing

@since 0.7.0.0
-}
lastStep :: Traversal' Trail Step
lastStep =
  steps . _head
{-# INLINE lastStep #-}

{- | The class of 'Trail'.

@since 0.8.0.0
-}
class TrailLike p f x x' where
  trail ::
    Optic p f x x' Trail Trail

{- | Identity

@since 0.8.0.0
-}
instance (x' ~ Trail) => TrailLike p f Trail x' where
  trail =
    id
  {-# INLINE trail #-}

{- | Lens

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

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

Laws:

> lawNamesTrail == id

@since 0.8.0.0
-}
lawNamesTrail :: Trail -> Trail
lawNamesTrail s =
  Trail (view (cloneLens steps) s)

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

@since 0.8.0.0
-}
type InheritTrail s =
  ( TrailLike (->) (Const ()) s s
  , StepsLike (->) (Const ()) s s
  )

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

@since 0.8.0.0
-}
inheritTrail :: (InheritTrail s) => proxy s -> ()
inheritTrail _ =
  ()