Trail.hs

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wall #-}

{- | How a file came to be built, and why a chain of build steps is stopped.

A 'Step' is one application of a named build step to a file. A 'Trail' is the
steps that built a file, from the file back to its source file. A 'Cycle' is
the reason a chain of steps is stopped: a step would make a file that is
already in the chain, or a step is already in the chain.
-}
module System.FilePather.Trail (
  -- * Steps
  Step (..),
  stepName,
  stepInput,
  GetStep (..),
  HasStep (..),
  ReviewStep (..),
  AsStep (..),

  -- * Trails
  Trail (..),
  trailFiles,
  lastStep,
  GetTrail (..),
  HasTrail (..),
  ReviewTrail (..),
  AsTrail (..),

  -- * Repetition
  Repetition (..),
  _Once,
  _Repeatable,
  GetRepetition (..),
  HasRepetition (..),
  ReviewRepetition (..),
  AsRepetition (..),

  -- * Cycles
  Cycle (..),
  _ReproducesInput,
  _RepeatsStep,
  cycleStep,
  cycleTrail,
  checkStep,
  displayCycle,
  GetCycle (..),
  HasCycle (..),
  ReviewCycle (..),
  AsCycle (..),
) where

import Control.DeepSeq (NFData)
import Control.Lens (AsEmpty (..), Cons (..), Each (..), Field1, Field2, Getter, Index, IxValue, Ixed (..), Lens', Prism', Reversing (..), Review, Rewrapped, Snoc (..), Traversal', Wrapped (..), iso, lens, nearly, prism, prism', review, toListOf, unsnoc, unto, view, _1, _2, _Wrapped, _head)
import Data.Data (Data)
import Data.Lens.Injection (Injection1 (..), Injection2 (..))
import Data.List (find, intercalate)
import GHC.Generics (Generic)
import System.FilePath (normalise)

{- $setup
>>> import Control.Lens ((^.), (^..), (^?), (#))
-}

{- | One application of a named build step to a file: the name of the step,
such as @"pdf page 1"@, and its input file.

>>> Step "pdf page 1" "public/a.pdf" ^. stepName
"pdf page 1"

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

-- | @since 0.7.0.0
instance Field1 Step Step String String

-- | @since 0.7.0.0
instance Field2 Step Step FilePath FilePath

{- | The name of a step.

@since 0.7.0.0
-}
stepName :: Lens' Step String
stepName =
  _1
{-# INLINE stepName #-}

{- | The input file of a step.

>>> Step "pdf page 1" "public/a.pdf" ^. stepInput
"public/a.pdf"

@since 0.7.0.0
-}
stepInput :: Lens' Step FilePath
stepInput =
  _2
{-# INLINE stepInput #-}

-- | @since 0.7.0.0
class GetStep s where
  getStep :: Getter s Step

-- | @since 0.7.0.0
instance GetStep Step where
  getStep =
    id
  {-# INLINE getStep #-}

-- | @since 0.7.0.0
class (GetStep s) => HasStep s where
  {-# MINIMAL setStep #-}
  setStep :: Step -> s -> s

  stepLens :: Lens' s Step
  stepLens =
    lens (view getStep) (flip setStep)
  {-# INLINE stepLens #-}

-- | @since 0.7.0.0
instance HasStep Step where
  setStep =
    const
  {-# INLINE setStep #-}

-- | @since 0.7.0.0
class ReviewStep t where
  reviewStep :: Review t Step

-- | @since 0.7.0.0
instance ReviewStep Step where
  reviewStep =
    unto id
  {-# INLINE reviewStep #-}

-- | @since 0.7.0.0
class (ReviewStep t) => AsStep t where
  {-# MINIMAL matchStep #-}
  matchStep :: t -> Maybe Step

  _Step :: Prism' t Step
  _Step =
    prism' (review reviewStep) matchStep
  {-# INLINE _Step #-}

-- | @since 0.7.0.0
instance AsStep Step where
  matchStep =
    Just
  {-# INLINE matchStep #-}

{- | The steps that built a file, 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 Wrapped Trail where
  type Unwrapped Trail = [Step]
  _Wrapped' =
    iso (\(Trail x) -> x) Trail
  {-# INLINE _Wrapped' #-}

-- | @since 0.7.0.0
instance (t ~ Trail) => Rewrapped Trail t

-- | @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 =
    _Wrapped . 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 =
    _Wrapped . 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 =
  _Wrapped . _head
{-# INLINE lastStep #-}

-- | @since 0.7.0.0
class GetTrail s where
  getTrail :: Getter s Trail

-- | @since 0.7.0.0
instance GetTrail Trail where
  getTrail =
    id
  {-# INLINE getTrail #-}

-- | @since 0.7.0.0
class (GetTrail s) => HasTrail s where
  {-# MINIMAL setTrail #-}
  setTrail :: Trail -> s -> s

  trail :: Lens' s Trail
  trail =
    lens (view getTrail) (flip setTrail)
  {-# INLINE trail #-}

-- | @since 0.7.0.0
instance HasTrail Trail where
  setTrail =
    const
  {-# INLINE setTrail #-}

-- | @since 0.7.0.0
class ReviewTrail t where
  reviewTrail :: Review t Trail

-- | @since 0.7.0.0
instance ReviewTrail Trail where
  reviewTrail =
    unto id
  {-# INLINE reviewTrail #-}

-- | @since 0.7.0.0
class (ReviewTrail t) => AsTrail t where
  {-# MINIMAL matchTrail #-}
  matchTrail :: t -> Maybe Trail

  _Trail :: Prism' t Trail
  _Trail =
    prism' (review reviewTrail) matchTrail
  {-# INLINE _Trail #-}

-- | @since 0.7.0.0
instance AsTrail Trail where
  matchTrail =
    Just
  {-# INLINE matchTrail #-}

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

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

-- | @since 0.7.0.0
instance Injection1 Repetition Repetition () ()

-- | @since 0.7.0.0
instance Injection2 Repetition Repetition () ()

-- | @since 0.7.0.0
_Once :: Prism' Repetition ()
_Once =
  _I1
{-# INLINE _Once #-}

-- | @since 0.7.0.0
_Repeatable :: Prism' Repetition ()
_Repeatable =
  _I2
{-# INLINE _Repeatable #-}

-- | @since 0.7.0.0
class GetRepetition s where
  getRepetition :: Getter s Repetition

-- | @since 0.7.0.0
instance GetRepetition Repetition where
  getRepetition =
    id
  {-# INLINE getRepetition #-}

-- | @since 0.7.0.0
class (GetRepetition s) => HasRepetition s where
  {-# MINIMAL setRepetition #-}
  setRepetition :: Repetition -> s -> s

  repetition :: Lens' s Repetition
  repetition =
    lens (view getRepetition) (flip setRepetition)
  {-# INLINE repetition #-}

-- | @since 0.7.0.0
instance HasRepetition Repetition where
  setRepetition =
    const
  {-# INLINE setRepetition #-}

-- | @since 0.7.0.0
class ReviewRepetition t where
  reviewRepetition :: Review t Repetition

-- | @since 0.7.0.0
instance ReviewRepetition Repetition where
  reviewRepetition =
    unto id
  {-# INLINE reviewRepetition #-}

-- | @since 0.7.0.0
class (ReviewRepetition t) => AsRepetition t where
  {-# MINIMAL matchRepetition #-}
  matchRepetition :: t -> Maybe Repetition

  _Repetition :: Prism' t Repetition
  _Repetition =
    prism' (review reviewRepetition) matchRepetition
  {-# INLINE _Repetition #-}

-- | @since 0.7.0.0
instance AsRepetition Repetition where
  matchRepetition =
    Just
  {-# INLINE matchRepetition #-}

{- | Why a chain of build steps is stopped, with the step that is stopped and
the trail of its input file.

@since 0.7.0.0
-}
data Cycle
  = -- | The step would make a file that is already in the chain: its input
    -- file, or an input file of a step in the trail.
    ReproducesInput FilePath Step Trail
  | -- | The step is already in the trail.
    RepeatsStep Step Trail
  deriving stock (Eq, Ord, Show, Generic, Data)
  deriving anyclass (NFData)

-- | @since 0.7.0.0
instance Injection1 Cycle Cycle (FilePath, Step, Trail) (FilePath, Step, Trail)

-- | @since 0.7.0.0
instance Injection2 Cycle Cycle (Step, Trail) (Step, Trail)

{- | >>> _RepeatsStep # (Step "pdf page 1" "a_page1.pdf", Trail [])
RepeatsStep (Step "pdf page 1" "a_page1.pdf") (Trail [])

@since 0.7.0.0
-}
_ReproducesInput :: Prism' Cycle (FilePath, Step, Trail)
_ReproducesInput =
  _I1
{-# INLINE _ReproducesInput #-}

-- | @since 0.7.0.0
_RepeatsStep :: Prism' Cycle (Step, Trail)
_RepeatsStep =
  _I2
{-# INLINE _RepeatsStep #-}

{- | The step that is stopped.

@since 0.7.0.0
-}
cycleStep :: Lens' Cycle Step
cycleStep =
  lens
    ( \case
        ReproducesInput _ s _ -> s
        RepeatsStep s _ -> s
    )
    ( \c s ->
        case c of
          ReproducesInput o _ t -> ReproducesInput o s t
          RepeatsStep _ t -> RepeatsStep s t
    )
{-# INLINE cycleStep #-}

{- | The trail of the input file of the step that is stopped.

@since 0.7.0.0
-}
cycleTrail :: Lens' Cycle Trail
cycleTrail =
  lens
    ( \case
        ReproducesInput _ _ t -> t
        RepeatsStep _ t -> t
    )
    ( \c t ->
        case c of
          ReproducesInput o s _ -> ReproducesInput o s t
          RepeatsStep s _ -> RepeatsStep s t
    )
{-# INLINE cycleTrail #-}

{- | Check a step, with the files it makes, against the trail of its input
file. A step that is already in the trail, and may appear 'Once', is a
'RepeatsStep'. Otherwise, a step that makes its input file, or the input file
of a step in the trail, is a 'ReproducesInput'. File paths are compared after
normalisation.

>>> let t = Trail [Step "markdown to pdf" "src/a.md"]
>>> checkStep Once (Step "pdf page 1" "public/a.pdf") ["public/a_page1.pdf"] t
Right ()

>>> checkStep Once (Step "markdown to pdf" "public/a.pdf") ["public/b.pdf"] t
Left (RepeatsStep (Step "markdown to pdf" "public/a.pdf") (Trail [Step "markdown to pdf" "src/a.md"]))

>>> checkStep Repeatable (Step "markdown to pdf" "public/a.pdf") ["public/b.pdf"] t
Right ()

>>> checkStep Once (Step "pdf to markdown" "public/a.pdf") ["./src/a.md"] t
Left (ReproducesInput "./src/a.md" (Step "pdf to markdown" "public/a.pdf") (Trail [Step "markdown to pdf" "src/a.md"]))

@since 0.7.0.0
-}
checkStep :: Repetition -> Step -> [FilePath] -> Trail -> Either Cycle ()
checkStep r s@(Step n i) os t =
  let repeated =
        case r of
          Once -> n `elem` toListOf (each . stepName) t
          Repeatable -> False
      files = fmap normalise (i : toListOf trailFiles t)
   in if repeated
        then Left (RepeatsStep s t)
        else maybe (Right ()) (\o -> Left (ReproducesInput o s t)) (find ((`elem` files) . normalise) os)

{- | A description of a cycle, for people to read: the chain of files and
steps from the source file.

>>> putStrLn (displayCycle (RepeatsStep (Step "pdf page 1" "public/a_page1.pdf") (Trail [Step "pdf page 1" "public/a.pdf", Step "markdown to pdf" "src/a.md"])))
src/a.md → markdown to pdf → public/a.pdf → pdf page 1 → public/a_page1.pdf → pdf page 1 again

>>> putStrLn (displayCycle (ReproducesInput "src/a.md" (Step "pdf to markdown" "public/a.pdf") (Trail [Step "markdown to pdf" "src/a.md"])))
src/a.md → markdown to pdf → public/a.pdf → pdf to markdown → src/a.md, which is already in the chain

@since 0.7.0.0
-}
displayCycle :: Cycle -> String
displayCycle c =
  let chain (Trail ss) = concatMap (\(Step n i) -> [i, n]) (reverse ss)
      arrows = intercalate " → "
   in case c of
        RepeatsStep (Step n i) t ->
          arrows (chain t <> [i, n <> " again"])
        ReproducesInput o (Step n i) t ->
          arrows (chain t <> [i, n, o]) <> ", which is already in the chain"

-- | @since 0.7.0.0
class GetCycle s where
  getCycle :: Getter s Cycle

-- | @since 0.7.0.0
instance GetCycle Cycle where
  getCycle =
    id
  {-# INLINE getCycle #-}

-- | @since 0.7.0.0
class (GetCycle s) => HasCycle s where
  {-# MINIMAL setCycle #-}
  setCycle :: Cycle -> s -> s

  cycleLens :: Lens' s Cycle
  cycleLens =
    lens (view getCycle) (flip setCycle)
  {-# INLINE cycleLens #-}

-- | @since 0.7.0.0
instance HasCycle Cycle where
  setCycle =
    const
  {-# INLINE setCycle #-}

-- | @since 0.7.0.0
class ReviewCycle t where
  reviewCycle :: Review t Cycle

-- | @since 0.7.0.0
instance ReviewCycle Cycle where
  reviewCycle =
    unto id
  {-# INLINE reviewCycle #-}

-- | @since 0.7.0.0
class (ReviewCycle t) => AsCycle t where
  {-# MINIMAL matchCycle #-}
  matchCycle :: t -> Maybe Cycle

  _Cycle :: Prism' t Cycle
  _Cycle =
    prism' (review reviewCycle) matchCycle
  {-# INLINE _Cycle #-}

-- | @since 0.7.0.0
instance AsCycle Cycle where
  matchCycle =
    Just
  {-# INLINE matchCycle #-}