Combinators.hs

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}

{- | Combinators for building larger 'FilePather' values from smaller ones.

* Composition: run a 'FilePather' on the output of another, with '~>' and
  '~>>'.
* Rules: a 'Rule' is a 'FilePather' that applies to some file paths and not
  others. Rules combine with 'Control.Applicative.<|>', where the first rule
  that applies is used. Use 'everyFile' to apply a rule to every file in a
  directory.
* Directories: list the files in a directory with 'directoryFiles'.
-}
module System.FilePather.Combinators (
  -- * Composition
  (~>),
  (~>>),
  onFile,
  hoistFilePather,

  -- * Rules
  Rule,
  whenFile,
  rule,
  everyFile,

  -- * Predicates
  hasExtension,
  isFile,
  isWithin,

  -- * Directories
  directoryFiles,
  directoryFilesWhere,
) where

import Control.Applicative (Alternative (empty))
import Control.Lens (cloneLens, over, view)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Reader (local)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (MaybeT (..))
import Data.Bool (bool)
import Data.List (isPrefixOf, sort)
import System.Directory (doesDirectoryExist, listDirectory)
import System.FilePath (equalFilePath, isExtensionOf, normalise, splitDirectories, (</>))
import System.FilePather.FilePather (FilePather (..))
import System.FilePather.Name.PathFunction (PathFunctionLike (..))
import Witherable (wither)

{- $setup
>>> import Control.Applicative ((<|>))
>>> import Control.Lens (cloneLens, view)
>>> import Control.Monad.Reader (ask, asks)
>>> import Control.Monad.Trans.Maybe (runMaybeT)
>>> import Data.Functor.Identity (Identity (..))
>>> import System.FilePath (replaceExtension)
>>> import System.FilePather.FilePather (FilePather (..))
>>> import System.FilePather.Name.PathFunction (pathFunction)
-}

infixr 1 ~>

infixr 1 ~>>

{- | Run a 'FilePather', then run another on the file path that it produces.

This is composition in the Kleisli category of @f@, at 'FilePath'. It is
associative, with 'Control.Monad.Reader.ask' as the identity.

>>> runIdentity (view (cloneLens pathFunction) (asks (`replaceExtension` "pdf") ~> asks (++ ".png")) "notes.md")
"notes.pdf.png"

@since 0.7.0.0
-}
(~>) :: (Monad f) => FilePather f FilePath -> FilePather f a -> FilePather f a
p ~> q =
  p >>= \o -> local (const o) q
{-# INLINE (~>) #-}

{- | Run a 'FilePather', then run another on each file path that it produces.

>>> view (cloneLens pathFunction) (FilePather (\p -> [[p ++ "-0.png", p ++ "-1.png"]]) ~>> asks length) "a.pdf"
[[11,11]]

@since 0.7.0.0
-}
(~>>) :: (Monad f, Traversable t) => FilePather f (t FilePath) -> FilePather f a -> FilePather f (t a)
p ~>> q =
  p >>= traverse (\o -> local (const o) q)
{-# INLINE (~>>) #-}

{- | Run a 'FilePather' on the given file path, instead of the one being
operated on.

>>> runIdentity (view (cloneLens pathFunction) (onFile "other.md" ask) "notes.md")
"other.md"

@since 0.7.0.0
-}
onFile :: FilePath -> FilePather f a -> FilePather f a
onFile p =
  over pathFunction (\g -> const (g p))
{-# INLINE onFile #-}

{- | Change the type constructor of a 'FilePather' with a natural
transformation.

>>> view (cloneLens pathFunction) (hoistFilePather (Just . runIdentity) ask) "notes.md"
Just "notes.md"

@since 0.7.0.0
-}
hoistFilePather :: (forall x. f x -> g x) -> FilePather f a -> FilePather g a
hoistFilePather nat =
  over pathFunction (nat .)
{-# INLINE hoistFilePather #-}

{- | A 'FilePather' that applies to some file paths and not others.

A 'Rule' that does not apply produces 'Nothing' in 'MaybeT'. This is distinct
from failure in @f@: if @f@ is an 'Control.Exitcode.Exitcode' and a rule fails
with an exit code, the failure is not caught by 'Control.Applicative.<|>'.

@since 0.7.0.0
-}
type Rule f a = FilePather (MaybeT f) a

{- | Apply a 'FilePather' only to file paths that satisfy a predicate.

>>> view (cloneLens pathFunction) (whenFile (hasExtension ["md"]) ask) "notes.md" :: Maybe FilePath
Just "notes.md"

>>> view (cloneLens pathFunction) (whenFile (hasExtension ["md"]) ask) "notes.txt" :: Maybe FilePath
Nothing

@since 0.7.0.0
-}
whenFile :: (Alternative f) => (FilePath -> Bool) -> FilePather f a -> FilePather f a
whenFile p =
  over pathFunction (\g x -> bool empty (g x) (p x))
{-# INLINE whenFile #-}

{- | A 'Rule' that applies a 'FilePather' to file paths that satisfy a
predicate.

>>> let r = rule (isFile "special.md") (pure "special") <|> rule (hasExtension ["md"]) (pure "markdown") :: Rule Identity String
>>> runIdentity (runMaybeT (view (cloneLens pathFunction) r "special.md"))
Just "special"

>>> runIdentity (runMaybeT (view (cloneLens pathFunction) r "notes.md"))
Just "markdown"

>>> runIdentity (runMaybeT (view (cloneLens pathFunction) r "notes.txt"))
Nothing

@since 0.7.0.0
-}
rule :: (Monad f) => (FilePath -> Bool) -> FilePather f a -> Rule f a
rule p =
  whenFile p . hoistFilePather lift
{-# INLINE rule #-}

{- | Apply a 'Rule' to every file path produced by a 'FilePather', such as
'directoryFiles'. The result pairs each file path that the rule applies to
with the result of the rule. File paths that the rule does not apply to are
skipped.

>>> let files = FilePather (\d -> Identity [d ++ "/a.md", d ++ "/b.txt", d ++ "/c.md"])
>>> runIdentity (view (cloneLens pathFunction) (everyFile files (rule (hasExtension ["md"]) (asks length))) "src")
[("src/a.md",8),("src/c.md",8)]

@since 0.7.0.0
-}
everyFile :: (Monad f) => FilePather f [FilePath] -> Rule f a -> FilePather f [(FilePath, a)]
everyFile files r =
  files >>= lift . wither (\p -> runMaybeT (fmap (p,) (view (cloneLens pathFunction) r p)))
{-# INLINE everyFile #-}

{- | Whether a file path has one of the given extensions. An extension may be
given with or without the leading dot.

>>> hasExtension ["fodt", ".odt"] "src/report.odt"
True

>>> hasExtension ["fodt", "odt"] "src/report.pdf"
False

@since 0.7.0.0
-}
hasExtension :: [String] -> FilePath -> Bool
hasExtension es p =
  any (`isExtensionOf` p) es
{-# INLINE hasExtension #-}

{- | Whether two file paths are equal, after normalisation.

>>> isFile "src/report.fodt" "./src//report.fodt"
True

@since 0.7.0.0
-}
isFile :: FilePath -> FilePath -> Bool
isFile =
  equalFilePath
{-# INLINE isFile #-}

{- | Whether a file path is within a directory, after normalisation.

>>> isWithin "src" "src/a/report.fodt"
True

>>> isWithin "src/a" "src/b/report.fodt"
False

>>> isWithin "." "src/report.fodt"
True

@since 0.7.0.0
-}
isWithin :: FilePath -> FilePath -> Bool
isWithin d p =
  let d' = normalise d
   in d' == "." || splitDirectories d' `isPrefixOf` splitDirectories (normalise p)
{-# INLINE isWithin #-}

{- | The files in a directory and its subdirectories, in sorted order. The
file paths are the directory joined with the path of the file relative to it,
then normalised, so that the files of @"."@ are relative paths, such as
@"src/report.fodt"@. Symbolic links are followed.

@since 0.7.0.0
-}
directoryFiles :: (MonadIO f) => FilePather f [FilePath]
directoryFiles =
  directoryFilesWhere (const True)
{-# INLINE directoryFiles #-}

{- | The files in a directory, and in each subdirectory that satisfies a
predicate, in sorted order. The predicate is given the normalised path of each
subdirectory.

For example, @directoryFilesWhere (not . isFile ".git")@ skips the @.git@
directory.

@since 0.7.0.0
-}
directoryFilesWhere :: (MonadIO f) => (FilePath -> Bool) -> FilePather f [FilePath]
directoryFilesWhere descend =
  let go d =
        do
          names <- sort <$> listDirectory d
          concat
            <$> traverse
              ( \n ->
                  let p = normalise (d </> n)
                   in doesDirectoryExist p
                        >>= bool (pure [p]) (bool (pure []) (go p) (descend p))
              )
              names
   in FilePather (liftIO . go)
{-# INLINEABLE directoryFilesWhere #-}