filepather 0.6.1 → 0.7.0.0

raw patch · 21 files changed

+3394/−2711 lines, 21 filesdep +either-ndep +exitcodedep +hedgehogdep −comonaddep −kleislidep −tasty-benchdep ~adjunctionsdep ~basedep ~contravariantsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: either-n, exitcode, hedgehog, hedgehog-fn, witherable

Dependencies removed: comonad, kleisli, tasty-bench, time

Dependency ranges changed: adjunctions, base, contravariant, deepseq, directory, distributive, filepath, lens, mtl, process, selective, semigroupoids, transformers

API changes (from Hackage documentation)

Files

• FUSION.md +72/−0
• LICENCE +21/−24
• README.md +60/−37
• Setup.hs +0/−8
• benchmarks/Main.hs +0/−196
• changelog.md +34/−64
• filepather.cabal +131/−76
• src/System/FilePather.hs +18/−7
• src/System/FilePather/Combinators.hs +261/−0
• src/System/FilePather/FilePather.hs +357/−1064
• src/System/FilePather/FilePather/Posix.hs +0/−601
• src/System/FilePather/FilePather/Windows.hs +0/−616
• src/System/FilePather/Tracked.hs +596/−0
• src/System/FilePather/Trail.hs +575/−0
• test/FilePatherTests.hs +488/−0
• test/Gens.hs +83/−0
• test/Laws.hs +63/−0
• test/Main.hs +0/−18
• test/TrackedTests.hs +587/−0
• test/doctest_tests.hs +25/−0
• test/hedgehog_tests.hs +23/−0

@@ -0,0 +1,72 @@+# Fusion Rules in filepather++## What is Fusion?++A `FilePather f a` is a function `FilePath -> f a`. Mapping over it twice,+as in `fmap f (fmap g x)`, builds an intermediate `FilePather` and maps over+`f` twice for every file path it is applied to. The rewrite rules replace such+compositions with a single map, so that `f` is traversed once.++## Rule Categories++The rules are written on the worker functions `mapFilePather` and+`mapMaybeFilePather`, and `mapTracked` and `mapMaybeTracked`, never on the+class methods: `fmap = mapFilePather` and `mapMaybe = mapMaybeFilePather` (and+likewise for `Tracked`), and each instance method is `INLINE`, so that it is+rewritten to its worker before the rules are tried.++### 1. Functor Fusion++* `mapFilePather/mapFilePather`:+  `mapFilePather f (mapFilePather g x) = mapFilePather (f . g) x`+* Removes the intermediate `FilePather` of `fmap f . fmap g`.+* Based on the Functor composition law of `f`.++### 2. Filterable Fusion++* `mapMaybeFilePather/mapMaybeFilePather`:+  `mapMaybeFilePather f (mapMaybeFilePather g x) = mapMaybeFilePather (g >=> f) x`+* `mapMaybeFilePather/mapFilePather`:+  `mapMaybeFilePather f (mapFilePather g x) = mapMaybeFilePather (f . g) x`+* Based on the Filterable composition laws of `f`.++### 3. Tracked Fusion++* `mapTracked/mapTracked`, `mapMaybeTracked/mapMaybeTracked` and+  `mapMaybeTracked/mapTracked`: the same rules for `Tracked`, which maps+  inside `f`, the `Either Cycle` of a stopped chain, and the pair of outputs+  and result.++## Phase Control++The workers are `NOINLINE [1]`, and the rules are active before phase 1+(`[~1]`). In phases 2 and 1 the rules fuse compositions of workers; from+phase 1 the workers may inline, exposing the `fmap` and `mapMaybe` of `f` to+the rules of `f` itself.++## Verifying Fusion++Check the rules fire in a module that composes the operations:++```bash+cabal build --ghc-options="-ddump-rule-firings"+cabal bench+```++## Performance Impact++The `FilePather/fmap x1000` benchmark maps over a `FilePather` 1000 times.+Build steps spend almost all of their time in the external programs they+run, so fusion matters for pure `FilePather` values, such as those used as+predicates and rules over many files.++## Law Foundation++| Rule | Law |+|---|---|+| `mapFilePather/mapFilePather` | `fmap f . fmap g = fmap (f . g)` |+| `mapMaybeFilePather/mapMaybeFilePather` | `mapMaybe f . mapMaybe g = mapMaybe (g >=> f)` |+| `mapMaybeFilePather/mapFilePather` | `mapMaybe f . fmap g = mapMaybe (f . g)` |+| `mapTracked/mapTracked` | `fmap f . fmap g = fmap (f . g)` |+| `mapMaybeTracked/mapMaybeTracked` | `mapMaybe f . mapMaybe g = mapMaybe (g >=> f)` |+| `mapMaybeTracked/mapTracked` | `mapMaybe f . fmap g = mapMaybe (f . g)` |

@@ -3,28 +3,25 @@ All rights reserved.  Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.--    * Redistributions in binary form must reproduce the above-      copyright notice, this list of conditions and the following-      disclaimer in the documentation and/or other materials provided-      with the distribution.--    * Neither the name of Tony Morris nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.

@@ -1,55 +1,78 @@ # filepather -Re-implementations of `System.FilePath` and `System.Directory` using `Kleisli` type aliases from the [kleisli](https://hackage.haskell.org/package/kleisli) package.--Each function that takes a `FilePath` as its subject argument is expressed as a `Kleisli` value, enabling composition via Functor, Applicative, Monad, and other type class instances.--## Modules+![System F Logo](https://logo.systemf.com.au/systemf-450x450.png) -| Module | Description |-|--------|-------------|-| `System.FilePather` | Re-exports the platform-native module |-| `System.FilePather.FilePather` | Platform-native filepath and directory operations |-| `System.FilePather.FilePather.Posix` | Posix filepath operations |-| `System.FilePather.FilePather.Windows` | Windows filepath operations |+Computations that depend on a file path, and named build steps that record+the files they make. -## Type aliases+## `FilePather`  ```haskell-type FilePather  p f a = Kleisli p FilePath f a-type FilePather' p a   = FilePather p Identity a-type FilePatherA f a   = FilePather (->) f a-type FilePatherA' a    = FilePatherA Identity a+newtype FilePather f a = FilePather (FilePath -> f a)+type FilePather' a = FilePather Identity a ``` -## Usage+A `FilePather` is isomorphic to `ReaderT FilePath f a`, with the same+instances, and `ask` is the file path being operated on.+`System.FilePather.Combinators` builds larger `FilePather` values from+smaller ones: -```haskell-import System.FilePather-import Data.Kleisli (Kleisli(..))-import Data.Functor.Identity (runIdentity)+* `p ~> q` runs `q` on the file path that `p` produces, and `p ~>> q` runs `q`+  on each of the file paths that `p` produces.+* `onFile` runs on another file path, and `hoistFilePather` changes `f`.+* A `Rule f a` is a `FilePather` that applies to some file paths and not+  others. Make one with `rule predicate x`, and combine rules with `<|>`,+  where the first rule that applies is used.+* `everyFile directoryFiles r` applies the rule `r` to every file in the+  directory being operated on. --- Pure operations return FilePatherA' (Kleisli (->) FilePath Identity a)--- >>> runIdentity (let Kleisli f = takeExtension in f "/foo/bar.hs")--- ".hs"+## `Tracked` --- Effectful operations return FilePatherA IO a (Kleisli (->) FilePath IO a)--- >>> let Kleisli f = doesFileExist in f "/tmp/example.txt"--- False+```haskell+newtype Tracked f a = Tracked (FilePather (ReaderT Trail (ExceptT Cycle f)) (Outputs, a))+type Outputs = [(FilePath, Step)]+``` --- Partial operations return FilePatherA Maybe a--- >>> let Kleisli f = stripExtension ".hs" in f "/foo/bar.hs"--- Just "/foo/bar"+A `Tracked` value is a build step, or several, run on a file path with the+`Trail` of that file: the `Step`s that built it, nearest first, back to its+source file. It produces its result and the files it made, each with the step+that made it. --- Compose with Functor/Applicative/Monad instances--- >>> runIdentity (let Kleisli f = fmap (++ ".bak") takeFileName in f "/tmp/notes.txt")--- "notes.txt.bak"+* `step name outputs x` names the `FilePather` `x`, which makes the files+  `outputs` gives for its input. Before `x` runs, the step is checked against+  the trail: a step whose name is already in the trail (`RepeatsStep`), or+  that would make a file already in the trail (`ReproducesInput`), is+  stopped with a `Cycle`, and `x` does not run.+* `step' name x` names a `FilePather` that returns the files it made, for a+  step whose outputs are known only after it runs. It is checked after it+  runs.+* `stepWith Repeatable` allows a step to appear more than once in a trail.+* `whenPath`, `whenTrail`, `onPath`, `askTrail` and `untracked` choose+  files, and run `FilePather` values that make no files.+* `displayCycle` describes the chain of a `Cycle`:+ ```+src/a.md → markdown to pdf → public/a.pdf → pdf page 1 → public/a_page1.pdf → pdf page 1 again+``` -## Building+`Tracked` is separate from `FilePather`, so that `FilePather` keeps all of its+instances (`Distributive`, `Representable`, `Selective`, `Decidable`, and the+`MonadError` and `MonadWriter` of `f`). `Tracked` has `Functor`, `Apply`,+`Applicative`, `Bind`, `Monad`, `Selective`, `Alt`, `Plus`, `Alternative`,+`MonadPlus`, `Semigroup`, `Monoid`, `Filterable`, `MonadTrans`, `MonadIO`,+`MonadFail`, `MonadReader FilePath`, `MonadState`, `MonadError`,+`MonadWriter` and `Contravariant` instances. `<>` runs both steps and keeps+the outputs of both; `<|>` and `catchError` alternate in `f`; and a `Cycle`+is never caught or discarded by any of them. +## Development++This package is built and tested with+[document-build](https://gitlab.com/tonymorris/document-build), which+uses it:+ ```-cabal build-cabal test doctest-cabal bench+cabal build all+cabal test all+bin/lint.sh --check ```

@@ -1,8 +0,0 @@-{-# OPTIONS_GHC -Wall -Werror #-}--module Main (main) where--import Distribution.Simple (defaultMain)--main :: IO ()-main = defaultMain

@@ -1,196 +0,0 @@-{-# OPTIONS_GHC -Wall -Werror #-}--module Main (main) where--import Data.Functor.Identity (Identity (..))-import Data.Kleisli (Kleisli (..), mkKleisli')-import qualified System.Directory as Dir-import qualified System.FilePath as FP-import System.FilePather.FilePather-  ( FilePatherA',-    addExtension,-    addTrailingPathSeparator,-    combine,-    dropExtension,-    dropTrailingPathSeparator,-    hasExtension,-    isAbsolute,-    isRelative,-    makeRelative,-    makeValid,-    normalise,-    splitDirectories,-    splitExtension,-    splitFileName,-    splitPath,-    takeBaseName,-    takeDirectory,-    takeExtension,-    takeFileName,-  )-import qualified System.FilePather.FilePather as FPR-import Test.Tasty.Bench-  ( bench,-    bgroup,-    defaultMain,-    nf,-    nfIO,-    whnfIO,-  )--run :: FilePatherA' a -> FilePath -> a-run (Kleisli f) = runIdentity . f--shortPath :: FilePath-shortPath = "/tmp/foo.hs"--deepPath :: FilePath-deepPath = "/home/user/projects/haskell/filepather/src/System/FilePather/FilePather.hs"--multiExtPath :: FilePath-multiExtPath = "/var/log/archive/system.log.2024-01-15.tar.gz"--main :: IO ()-main =-  defaultMain-    [ bgroup-        "splitExtension"-        [ bench "filepather/short" $ nf (run splitExtension) shortPath,-          bench "filepath/short" $ nf FP.splitExtension shortPath,-          bench "filepather/deep" $ nf (run splitExtension) deepPath,-          bench "filepath/deep" $ nf FP.splitExtension deepPath-        ],-      bgroup-        "takeExtension"-        [ bench "filepather/short" $ nf (run takeExtension) shortPath,-          bench "filepath/short" $ nf FP.takeExtension shortPath,-          bench "filepather/deep" $ nf (run takeExtension) deepPath,-          bench "filepath/deep" $ nf FP.takeExtension deepPath-        ],-      bgroup-        "takeFileName"-        [ bench "filepather/short" $ nf (run takeFileName) shortPath,-          bench "filepath/short" $ nf FP.takeFileName shortPath,-          bench "filepather/deep" $ nf (run takeFileName) deepPath,-          bench "filepath/deep" $ nf FP.takeFileName deepPath-        ],-      bgroup-        "takeDirectory"-        [ bench "filepather/short" $ nf (run takeDirectory) shortPath,-          bench "filepath/short" $ nf FP.takeDirectory shortPath,-          bench "filepather/deep" $ nf (run takeDirectory) deepPath,-          bench "filepath/deep" $ nf FP.takeDirectory deepPath-        ],-      bgroup-        "takeBaseName"-        [ bench "filepather/short" $ nf (run takeBaseName) shortPath,-          bench "filepath/short" $ nf FP.takeBaseName shortPath,-          bench "filepather/deep" $ nf (run takeBaseName) deepPath,-          bench "filepath/deep" $ nf FP.takeBaseName deepPath-        ],-      bgroup-        "splitFileName"-        [ bench "filepather/short" $ nf (run splitFileName) shortPath,-          bench "filepath/short" $ nf FP.splitFileName shortPath,-          bench "filepather/deep" $ nf (run splitFileName) deepPath,-          bench "filepath/deep" $ nf FP.splitFileName deepPath-        ],-      bgroup-        "splitPath"-        [ bench "filepather/short" $ nf (run splitPath) shortPath,-          bench "filepath/short" $ nf FP.splitPath shortPath,-          bench "filepather/deep" $ nf (run splitPath) deepPath,-          bench "filepath/deep" $ nf FP.splitPath deepPath-        ],-      bgroup-        "splitDirectories"-        [ bench "filepather/short" $ nf (run splitDirectories) shortPath,-          bench "filepath/short" $ nf FP.splitDirectories shortPath,-          bench "filepather/deep" $ nf (run splitDirectories) deepPath,-          bench "filepath/deep" $ nf FP.splitDirectories deepPath-        ],-      bgroup-        "normalise"-        [ bench "filepather" $ nf (run normalise) "/tmp/./foo/../bar//baz.hs",-          bench "filepath" $ nf FP.normalise "/tmp/./foo/../bar//baz.hs"-        ],-      bgroup-        "dropExtension"-        [ bench "filepather" $ nf (run dropExtension) multiExtPath,-          bench "filepath" $ nf FP.dropExtension multiExtPath-        ],-      bgroup-        "addExtension"-        [ bench "filepather" $ nf (run (addExtension ".bak")) "/tmp/foo",-          bench "filepath" $ nf (`FP.addExtension` ".bak") "/tmp/foo"-        ],-      bgroup-        "hasExtension"-        [ bench "filepather" $ nf (run hasExtension) shortPath,-          bench "filepath" $ nf FP.hasExtension shortPath-        ],-      bgroup-        "isAbsolute"-        [ bench "filepather" $ nf (run isAbsolute) shortPath,-          bench "filepath" $ nf FP.isAbsolute shortPath-        ],-      bgroup-        "isRelative"-        [ bench "filepather" $ nf (run isRelative) "foo/bar.hs",-          bench "filepath" $ nf FP.isRelative "foo/bar.hs"-        ],-      bgroup-        "makeRelative"-        [ bench "filepather" $ nf (run (makeRelative "/home/user")) "/home/user/projects/foo.hs",-          bench "filepath" $ nf (FP.makeRelative "/home/user") "/home/user/projects/foo.hs"-        ],-      bgroup-        "combine"-        [ bench "filepather" $ nf (run (combine "/tmp")) "foo.hs",-          bench "filepath" $ nf (FP.combine "/tmp") "foo.hs"-        ],-      bgroup-        "makeValid"-        [ bench "filepather" $ nf (run makeValid) "",-          bench "filepath" $ nf FP.makeValid ""-        ],-      bgroup-        "addTrailingPathSeparator"-        [ bench "filepather" $ nf (run addTrailingPathSeparator) "/tmp",-          bench "filepath" $ nf FP.addTrailingPathSeparator "/tmp"-        ],-      bgroup-        "dropTrailingPathSeparator"-        [ bench "filepather" $ nf (run dropTrailingPathSeparator) "/tmp/",-          bench "filepath" $ nf FP.dropTrailingPathSeparator "/tmp/"-        ],-      bgroup-        "composition"-        [ bench "filepather/takeDir-then-addExt" $-            nf (run (addExtension ".bak") . run takeDirectory) deepPath,-          bench "filepath/takeDir-then-addExt" $-            nf ((`FP.addExtension` ".bak") . FP.takeDirectory) deepPath,-          bench "filepather/kleisli-compose" $-            nf (run (mkKleisli' (run (addExtension ".bak") . run takeDirectory))) deepPath-        ],-      bgroup-        "IO/doesDirectoryExist"-        [ bench "filepather" $ nfIO (let Kleisli f = FPR.doesDirectoryExist in f "/tmp"),-          bench "directory" $ nfIO (Dir.doesDirectoryExist "/tmp")-        ],-      bgroup-        "IO/doesFileExist"-        [ bench "filepather" $ nfIO (let Kleisli f = FPR.doesFileExist in f "/tmp/nonexistent_bench_file"),-          bench "directory" $ nfIO (Dir.doesFileExist "/tmp/nonexistent_bench_file")-        ],-      bgroup-        "IO/canonicalizePath"-        [ bench "filepather" $ nfIO (let Kleisli f = FPR.canonicalizePath in f "/tmp"),-          bench "directory" $ nfIO (Dir.canonicalizePath "/tmp")-        ],-      bgroup-        "IO/getPermissions"-        [ bench "filepather" $ whnfIO (let Kleisli f = FPR.getPermissions in f "/tmp"),-          bench "directory" $ whnfIO (Dir.getPermissions "/tmp")-        ]-    ]

@@ -1,66 +1,36 @@-0.6.1--* Add doctests to `filePather`, `proFilePather`, and `contraFilePather` isomorphisms-* Add explicit `INLINE` pragmas to all function definitions-* Fix imports to use explicit import lists--0.6.0--* Replace `Kleisli (Identity . f)` with `mkKleisli'` throughout-* Add `FilePatherMaybe`, `FilePatherMaybeA`, `FilePatherIO`, and `FilePatherIOA` type aliases-* Export all type aliases from all modules-* Use `FilePatherIOA` for all IO function signatures-* Use `FilePatherMaybeA` for `stripExtension` signature-* Add `filePather`, `proFilePather`, and `contraFilePather` lens isomorphisms-* Add `lens` dependency and `Control.Lens` integration-* Tighten `filepath` version bounds-* Remove unused language extensions-* Remove duplicate benchmark--0.5.6--* Add `traverseFilePath` function-* Add `opticFilePaths` function--0.5.5--* Update `readProcessWithExitCode` function--0.5.4--* add `Process` module--0.5.3--* Re-export some `System.Directory` functions as `ReadFilePathT`--0.5.2--* Add `ReadFilePathsT` to read a list of `FilePath`-* Add `joinPath` value--0.5.1--* Fix bug in `Find` module-* Add function to `Find` module-* `INLINE` definitions--0.5--* Introduce `Either` into filepath reader-* Remove `ToFilePath`-* Remove some functions that do not fit-* Update GHC version requirement >= 9--0.4.1--* Add `System.Directory`-* Other minor improvements--0.4.0--* Rewrite of filepather+# Changelog -0.3.0+## 0.7.0.0 -* This change log starts+* Start again, replacing filepather 0.6, in the document-build repository+* Add System.FilePather.FilePather: FilePather f a, a newtype for+  FilePath -> f a, with type aliases (FilePather', FilePatherIO,+  FilePatherMaybe, FilePatherList, FilePatherNonEmpty, FilePatherEither,+  FilePatherMaybeT, FilePatherExceptT, FilePatherExitcode,+  FilePatherExitcode'), and instances, derived through ReaderT FilePath f+  where possible, for Generic, Generic1, NFData, Semigroup, Monoid, Functor,+  Apply, Applicative, Bind, Monad, Alt, Plus, Alternative, MonadPlus,+  MonadFail, MonadFix, MonadZip, MonadIO, MonadTrans, MonadReader FilePath,+  MonadState, MonadWriter, MonadError, MonadCont, Selective, Filterable,+  Distributive, Representable, Contravariant, Divisible, Decidable, Wrapped+  and Rewrapped+* Add filePatherReaderT, the isomorphism between FilePather and ReaderT,+  and the classy optics GetFilePather, HasFilePather, ReviewFilePather and+  AsFilePather+* Add System.FilePather.Combinators: (~>), (~>>), onFile, hoistFilePather,+  Rule, whenFile, rule, everyFile, hasExtension, isFile, isWithin,+  directoryFiles and directoryFilesWhere+* Add System.FilePather.Trail: Step, Trail, Repetition and Cycle, with+  lenses, prisms and classy optics, checkStep and displayCycle+* Add System.FilePather.Tracked: Tracked f a, named build steps that record+  the files they make, with step, stepWith, step', stepWith', untracked,+  askTrail, onPath, whenPath, whenTrail, hoistTracked, trackedFunction and+  classy optics, and instances for Generic, NFData, Functor, Apply,+  Applicative, Bind, Monad, Selective, Alt, Plus, Alternative, MonadPlus,+  Semigroup, Monoid, Filterable, MonadTrans, MonadIO, MonadFail,+  MonadReader FilePath, MonadState, MonadError, MonadWriter, Contravariant,+  Wrapped and Rewrapped+* Add rewrite rules fusing compositions of fmap and mapMaybe for FilePather+  and Tracked+* Add hedgehog property tests for the laws of every instance and optic, and+  doctests

@@ -1,91 +1,146 @@-cabal-version:        2.4-name:                 filepather-version:              0.6.1-synopsis:             FilePath and Directory operations via Kleisli type aliases+cabal-version:      2.4+name:               filepather+version:            0.7.0.0+license:            BSD-3-Clause+license-file:       LICENCE+author:             Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> <dibblego>+maintainer:         Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> <dibblego>+copyright:          Copyright (c) 2021-2026 Tony Morris+synopsis:           Computations that depend on a file path, and tracked build steps+category:           System description:-  Re-implementations of @System.FilePath@ and @System.Directory@ using-  @Kleisli@ type aliases from the-  <https://hackage.haskell.org/package/kleisli kleisli> package. Each function-  that takes a @FilePath@ as its subject argument is expressed as a @Kleisli@-  value, enabling composition via Functor, Applicative, Monad, and other type-  class instances. Platform-specific modules for Posix and Windows path-  semantics are also provided.-license:              BSD-3-Clause-license-file:         LICENCE-author:               Tony Morris <tmorris@tmorris.net>-maintainer:           Tony Morris <tmorris@tmorris.net>-category:             System-build-type:           Simple-extra-doc-files:      changelog.md-                    , README.md-homepage:             https://gitlab.com/tonymorris/filepather-bug-reports:          https://gitlab.com/tonymorris/filepather/-/issues-tested-with:          GHC == 9.6.7+  <<https://logo.systemf.com.au/systemf-450x450.png>>+  .+  @FilePather f a@ is a computation that depends on the file path being+  operated on:+  .+  > newtype FilePather f a = FilePather (FilePath -> f a)+  .+  It is isomorphic to @ReaderT FilePath f a@, with the same instances, and+  combinators to run one @FilePather@ on the output of another, and to apply+  rules to every file in a directory.+  .+  @Tracked f a@ is a named build step, or several, that records the files it+  makes, with the steps that made them, so that a chain of build steps that+  would go round in a cycle is stopped before it does:+  .+  > newtype Tracked f a = Tracked (FilePather (ReaderT Trail (ExceptT Cycle f)) (Outputs, a)) -flag dev-  description:        Enable development warnings (-Werror, -O2 for benchmarks)-  manual:             True-  default:            False+homepage:           https://gitlab.com/tonymorris/document-build+bug-reports:        https://gitlab.com/tonymorris/document-build/issues+build-type:         Simple+extra-doc-files:    README.md+                    changelog.md+                    FUSION.md+tested-with:        GHC == 9.14.1, GHC == 9.12.4, GHC == 9.10.3, GHC == 9.8.4, GHC == 9.6.7 -source-repository     head-  type:               git-  location:           https://gitlab.com/tonymorris/filepather.git+source-repository   head+  type:             git+  location:         https://gitlab.com/tonymorris/document-build.git+  subdir:           filepather +flag doctest+  description:      Build the doctest test suite, which runs doctest through cabal. It is enabled in cabal.project, and disabled by default so that builds from the source distribution do not need cabal or doctest at test time.+  default:          False+  manual:           True+ library-  exposed-modules:-                      System.FilePather-                    , System.FilePather.FilePather-                    , System.FilePather.FilePather.Posix-                    , System.FilePather.FilePather.Windows+  default-language:+                    Haskell2010 -  build-depends:        base >= 4.8 && < 6-                      , adjunctions >= 4.3 && < 5-                      , comonad >= 5 && < 6-                      , contravariant >= 1 && < 2-                      , deepseq >= 1.4 && < 2-                      , directory >= 1.3 && < 2-                      , distributive >= 0.5 && < 1-                      , filepath >= 1.4 && < 2-                      , kleisli >= 0.0.3 && < 1-                      , lens >= 4 && < 6-                      , mtl >= 2.2 && < 3-                      , selective >= 0.5 && < 1-                      , semigroupoids >= 5.2 && < 7-                      , time >= 1.9 && < 2-                      , transformers >= 0.5 && < 1+  build-depends:+                      base              >= 4.18      && < 5+                    , adjunctions       >= 4.4.2     && < 5+                    , contravariant     >= 1.5.5     && < 2+                    , deepseq           >= 1.4.8.1   && < 2+                    , directory         >= 1.3.8.5   && < 2+                    , distributive      >= 0.6.2.1   && < 1+                    , either-n          >= 0.1       && < 0.2+                    , exitcode          >= 0.3.0.1   && < 0.4+                    , filepath          >= 1.4.301.0 && < 1.6+                    , lens              >= 5.2.1     && < 6+                    , mtl               >= 2.3.1     && < 2.4+                    , selective         >= 0.7       && < 1+                    , semigroupoids     >= 6.0.0.1   && < 7+                    , transformers      >= 0.6.1     && < 0.7+                    , witherable        >= 0.4.2     && < 1 -  hs-source-dirs:     src+  ghc-options:+                    -Wall+                    -Wcompat+                    -Wincomplete-record-updates+                    -Wincomplete-uni-patterns+                    -Wredundant-constraints -  default-language:   Haskell2010+  hs-source-dirs:+                    src -  ghc-options:        -Wall+  exposed-modules:+                    System.FilePather+                    System.FilePather.Combinators+                    System.FilePather.FilePather+                    System.FilePather.Trail+                    System.FilePather.Tracked -  if flag(dev)-    ghc-options:      -Werror+test-suite hedgehog+  type:+                    exitcode-stdio-1.0 -benchmark bench-  type:               exitcode-stdio-1.0-  hs-source-dirs:     benchmarks-  main-is:            Main.hs-  build-depends:      base >= 4.8 && < 6-                    , deepseq >= 1.4 && < 2-                    , directory >= 1.3 && < 2-                    , filepath >= 1.4 && < 2-                    , kleisli >= 0.0.2 && < 1-                    , tasty-bench >= 0.3 && < 1+  main-is:+                    hedgehog_tests.hs++  other-modules:+                    FilePatherTests+                    Gens+                    Laws+                    TrackedTests++  default-language:+                    Haskell2010++  build-depends:+                      base              >= 4.18      && < 5+                    , adjunctions       >= 4.4.2     && < 5+                    , contravariant     >= 1.5.5     && < 2+                    , distributive      >= 0.6.2.1   && < 1                     , filepather-  default-language:   Haskell2010-  ghc-options:        -Wall+                    , hedgehog          >= 1.2       && < 2+                    , hedgehog-fn       >= 1.1       && < 2+                    , lens              >= 5.2.1     && < 6+                    , mtl               >= 2.3.1     && < 2.4+                    , selective         >= 0.7       && < 1+                    , semigroupoids     >= 6.0.0.1   && < 7+                    , transformers      >= 0.6.1     && < 0.7+                    , witherable        >= 0.4.2     && < 1 -  if flag(dev)-    ghc-options:      -Werror -O2+  ghc-options:+                    -Wall+                    -threaded +  hs-source-dirs:+                    test+ test-suite doctest-  type:               exitcode-stdio-1.0-  hs-source-dirs:     test-  main-is:            Main.hs-  build-depends:      base >= 4.8 && < 6-                    , process >= 1 && < 2-  build-tool-depends: doctest:doctest >= 0.22 && < 1-  default-language:   Haskell2010-  ghc-options:        -Wall+  type:+                    exitcode-stdio-1.0++  if !flag(doctest)+    buildable:      False++  main-is:+                    doctest_tests.hs++  default-language:+                    Haskell2010++  build-depends:+                      base    >= 4.18     && < 5+                    , process >= 1.6.19.0 && < 2+                    , filepather++  ghc-options:+                    -Wall+                    -threaded++  hs-source-dirs:+                    test

@@ -1,11 +1,22 @@ {-# OPTIONS_GHC -Wall #-} --- |--- Module      : System.FilePather--- Description : FilePath and Directory operations via Kleisli type aliases-module System.FilePather-  ( module System.FilePather.FilePather,-  )-where+{- | Computations that depend on the file path being operated on, and named+build steps that record the files they make. +See "System.FilePather.FilePather" for the 'FilePather' type,+"System.FilePather.Combinators" for combining them,+"System.FilePather.Tracked" for 'Tracked' build steps, and+"System.FilePather.Trail" for the trails of built files and the cycles that+stop a chain of build steps.+-}+module System.FilePather (+  module System.FilePather.Combinators,+  module System.FilePather.FilePather,+  module System.FilePather.Trail,+  module System.FilePather.Tracked,+) where++import System.FilePather.Combinators import System.FilePather.FilePather+import System.FilePather.Tracked+import System.FilePather.Trail

@@ -0,0 +1,261 @@+{-# 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 (over, view, _Wrapped)+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 Witherable (wither)++{- $setup+>>> import Control.Applicative ((<|>))+>>> import Control.Lens (view, _Wrapped)+>>> 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 (..))+-}++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 _Wrapped (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 _Wrapped (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 _Wrapped (onFile "other.md" ask) "notes.md")+"other.md"++@since 0.7.0.0+-}+onFile :: FilePath -> FilePather f a -> FilePather f a+onFile p =+  over _Wrapped (\g -> const (g p))+{-# INLINE onFile #-}++{- | Change the type constructor of a 'FilePather' with a natural+transformation.++>>> view _Wrapped (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 _Wrapped (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 _Wrapped (whenFile (hasExtension ["md"]) ask) "notes.md" :: Maybe FilePath+Just "notes.md"++>>> view _Wrapped (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 _Wrapped (\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 _Wrapped r "special.md"))+Just "special"++>>> runIdentity (runMaybeT (view _Wrapped r "notes.md"))+Just "markdown"++>>> runIdentity (runMaybeT (view _Wrapped 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 _Wrapped (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 _Wrapped 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/cv.odt"+True++>>> hasExtension ["fodt", "odt"] "src/cv.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/cv.fodt" "./src//cv.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/cv.fodt"+True++>>> isWithin "src/a" "src/b/cv.fodt"+False++>>> isWithin "." "src/cv.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/cv.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 #-}

@@ -1,1064 +1,357 @@-{-# OPTIONS_GHC -Wall #-}---- |--- Module      : System.FilePather.FilePather--- Description : Platform-native FilePath and Directory operations via Kleisli type aliases-module System.FilePather.FilePather-  ( -- * Types-    FilePather,-    FilePather',-    FilePatherA,-    FilePatherA',-    FilePatherMaybe,-    FilePatherMaybeA,-    FilePatherIO,-    FilePatherIOA,--    -- * Isomorphisms-    filePather,-    proFilePather,-    contraFilePather,--    -- * System.FilePath re-implementations-    splitExtension,-    takeExtension,-    replaceExtension,-    dropExtension,-    addExtension,-    hasExtension,-    splitExtensions,-    takeExtensions,-    dropExtensions,-    replaceExtensions,-    isExtensionOf,-    stripExtension,-    splitFileName,-    takeFileName,-    replaceFileName,-    dropFileName,-    takeBaseName,-    replaceBaseName,-    takeDirectory,-    replaceDirectory,-    combine,-    splitPath,-    FP.joinPath,-    splitDirectories,-    splitDrive,-    joinDrive,-    takeDrive,-    hasDrive,-    dropDrive,-    isDrive,-    hasTrailingPathSeparator,-    addTrailingPathSeparator,-    dropTrailingPathSeparator,-    normalise,-    makeRelative,-    equalFilePath,-    isRelative,-    isAbsolute,-    isValid,-    makeValid,-    (</>),-    (<.>),-    (-<.>),--    -- * System.FilePath re-exports-    FP.FilePath,-    FP.pathSeparator,-    FP.pathSeparators,-    FP.isPathSeparator,-    FP.searchPathSeparator,-    FP.isSearchPathSeparator,-    FP.extSeparator,-    FP.isExtSeparator,-    FP.splitSearchPath,-    FP.getSearchPath,--    -- * System.Directory re-implementations-    createDirectory,-    createDirectoryIfMissing,-    removeDirectory,-    removeDirectoryRecursive,-    removePathForcibly,-    renameDirectory,-    listDirectory,-    getDirectoryContents,-    setCurrentDirectory,-    withCurrentDirectory,-    getXdgDirectory,-    getAppUserDataDirectory,-    removeFile,-    renameFile,-    renamePath,-    copyFile,-    copyFileWithMetadata,-    canonicalizePath,-    makeAbsolute,-    makeRelativeToCurrentDirectory,-    doesPathExist,-    doesFileExist,-    doesDirectoryExist,-    Dir.findFile,-    Dir.findFiles,-    Dir.findFileWith,-    Dir.findFilesWith,-    createFileLink,-    createDirectoryLink,-    removeDirectoryLink,-    getSymbolicLinkTarget,-    isSymbolicLink,-    pathIsSymbolicLink,-    getPermissions,-    setPermissions,-    copyPermissions,-    getAccessTime,-    getModificationTime,-    setAccessTime,-    setModificationTime,-    getFileSize,--    -- * System.Directory re-exports-    Dir.Permissions,-    Dir.emptyPermissions,-    Dir.setOwnerReadable,-    Dir.setOwnerWritable,-    Dir.setOwnerExecutable,-    Dir.setOwnerSearchable,-    Dir.XdgDirectory (..),-    Dir.XdgDirectoryList (..),-    Dir.getXdgDirectoryList,-    Dir.exeExtension,-    Dir.getCurrentDirectory,-    Dir.getHomeDirectory,-    Dir.getTemporaryDirectory,-    Dir.getUserDocumentsDirectory,-    Dir.findExecutable,-    Dir.findExecutables,-    Dir.findExecutablesInDirectories,-  )-where--import Control.Lens (Iso, _Wrapped)-import Data.Functor.Identity (Identity)-import Data.Kleisli (ContraKleisli, Kleisli (..), ProKleisli, mkKleisli', _Kleisli_ContraKleisli, _Kleisli_ProKleisli)-import Data.Time.Clock (UTCTime)-import qualified System.Directory as Dir-import qualified System.FilePath as FP---- $setup--- >>> import Control.Lens (view, review)--- >>> import Data.Functor.Identity (Identity(..))--- >>> import Data.Kleisli (Kleisli(..), ProKleisli(..), ContraKleisli(..))--- >>> import qualified System.Directory as Dir--- >>> import qualified System.FilePath as FP--- >>> let run (Kleisli f) x = runIdentity (f x)--type FilePather p f a = Kleisli p FilePath f a--type FilePather' p a = FilePather p Identity a--type FilePatherA f a = FilePather (->) f a--type FilePatherA' a = FilePatherA Identity a--type FilePatherMaybe p a = FilePather p Maybe a--type FilePatherMaybeA a = FilePatherMaybe (->) a--type FilePatherIO p a = FilePather p IO a--type FilePatherIOA a = FilePatherIO (->) a---- | An isomorphism between a 'FilePather' and its unwrapped representation.------ >>> view filePather takeExtension "/tmp/foo.hs"--- Identity ".hs"------ >>> run (review filePather (Identity . FP.takeExtension)) "/tmp/foo.hs"--- ".hs"-filePather :: Iso (FilePather p f a) (FilePather p' f' a') (p FilePath (f a)) (p' FilePath (f' a'))-filePather = _Wrapped-{-# INLINE filePather #-}---- | An isomorphism between a 'FilePather' and a 'ProKleisli', reordering--- type parameters to enable 'Category' and 'Arrow' instances.------ >>> let ProKleisli f = view proFilePather takeExtension in runIdentity (f "/tmp/foo.hs")--- ".hs"-proFilePather :: Iso (FilePather p f a) (FilePather p' f' a') (ProKleisli p f FilePath a) (ProKleisli p' f' FilePath a')-proFilePather = _Kleisli_ProKleisli-{-# INLINE proFilePather #-}---- | An isomorphism between a 'FilePather' and a 'ContraKleisli', reordering--- type parameters to enable 'Contravariant' instances.------ >>> let ContraKleisli f = view contraFilePather takeExtension in runIdentity (f "/tmp/foo.hs")--- ".hs"-contraFilePather :: Iso (FilePather p f a) (FilePather p' f' a') (ContraKleisli p a f FilePath) (ContraKleisli p' a' f' FilePath)-contraFilePather = _Kleisli_ContraKleisli-{-# INLINE contraFilePather #-}----------------------------------------------------------------- System.FilePath----------------------------------------------------------------- | Split a file path into the stem and extension.------ >>> run splitExtension "/tmp/foo.hs"--- ("/tmp/foo",".hs")------ >>> run splitExtension "/tmp/foo"--- ("/tmp/foo","")------ >>> run splitExtension "/tmp/foo.tar.gz"--- ("/tmp/foo.tar",".gz")-splitExtension :: FilePatherA' (String, String)-splitExtension = mkKleisli' FP.splitExtension-{-# INLINE splitExtension #-}---- | Get the extension of a file path.------ >>> run takeExtension "/tmp/foo.hs"--- ".hs"------ >>> run takeExtension "/tmp/foo"--- ""------ >>> run takeExtension "/tmp/foo.tar.gz"--- ".gz"-takeExtension :: FilePatherA' String-takeExtension = mkKleisli' FP.takeExtension-{-# INLINE takeExtension #-}---- | Replace the extension of a file path.------ >>> run (replaceExtension ".md") "/tmp/foo.hs"--- "/tmp/foo.md"------ >>> run (replaceExtension ".txt") "/tmp/foo"--- "/tmp/foo.txt"------ >>> run (replaceExtension "") "/tmp/foo.hs"--- "/tmp/foo"-replaceExtension :: String -> FilePatherA' FilePath-replaceExtension s = mkKleisli' (`FP.replaceExtension` s)-{-# INLINE replaceExtension #-}---- | Remove the extension from a file path.------ >>> run dropExtension "/tmp/foo.hs"--- "/tmp/foo"------ >>> run dropExtension "/tmp/foo"--- "/tmp/foo"------ >>> run dropExtension "/tmp/foo.tar.gz"--- "/tmp/foo.tar"-dropExtension :: FilePatherA' FilePath-dropExtension = mkKleisli' FP.dropExtension-{-# INLINE dropExtension #-}---- | Add an extension to a file path.------ >>> run (addExtension ".hs") "/tmp/foo"--- "/tmp/foo.hs"------ >>> run (addExtension ".gz") "/tmp/foo.tar"--- "/tmp/foo.tar.gz"------ >>> run (addExtension "hs") "/tmp/foo"--- "/tmp/foo.hs"-addExtension :: String -> FilePatherA' FilePath-addExtension s = mkKleisli' (`FP.addExtension` s)-{-# INLINE addExtension #-}---- | Does the file path have an extension?------ >>> run hasExtension "/tmp/foo.hs"--- True------ >>> run hasExtension "/tmp/foo"--- False-hasExtension :: FilePatherA' Bool-hasExtension = mkKleisli' FP.hasExtension-{-# INLINE hasExtension #-}---- | Split all extensions from a file path.------ >>> run splitExtensions "/tmp/foo.tar.gz"--- ("/tmp/foo",".tar.gz")------ >>> run splitExtensions "/tmp/foo"--- ("/tmp/foo","")-splitExtensions :: FilePatherA' (FilePath, String)-splitExtensions = mkKleisli' FP.splitExtensions-{-# INLINE splitExtensions #-}---- | Get all extensions from a file path.------ >>> run takeExtensions "/tmp/foo.tar.gz"--- ".tar.gz"------ >>> run takeExtensions "/tmp/foo"--- ""------ >>> run takeExtensions "/tmp/foo.a.b.c"--- ".a.b.c"-takeExtensions :: FilePatherA' String-takeExtensions = mkKleisli' FP.takeExtensions-{-# INLINE takeExtensions #-}---- | Drop all extensions from a file path.------ >>> run dropExtensions "/tmp/foo.tar.gz"--- "/tmp/foo"------ >>> run dropExtensions "/tmp/foo"--- "/tmp/foo"-dropExtensions :: FilePatherA' FilePath-dropExtensions = mkKleisli' FP.dropExtensions-{-# INLINE dropExtensions #-}---- | Replace all extensions of a file path.------ >>> run (replaceExtensions ".txt") "/tmp/foo.tar.gz"--- "/tmp/foo.txt"------ >>> run (replaceExtensions ".a.b") "/tmp/foo.c"--- "/tmp/foo.a.b"-replaceExtensions :: String -> FilePatherA' FilePath-replaceExtensions s = mkKleisli' (`FP.replaceExtensions` s)-{-# INLINE replaceExtensions #-}---- | Is the given string an extension of the file path?------ >>> run (isExtensionOf ".hs") "/tmp/foo.hs"--- True------ >>> run (isExtensionOf ".md") "/tmp/foo.hs"--- False------ >>> run (isExtensionOf "hs") "/tmp/foo.hs"--- True------ >>> run (isExtensionOf ".gz") "/tmp/foo.tar.gz"--- True-isExtensionOf :: String -> FilePatherA' Bool-isExtensionOf s = mkKleisli' (FP.isExtensionOf s)-{-# INLINE isExtensionOf #-}---- | Strip an extension from a file path, returning 'Nothing' if the--- extension does not match.------ >>> let Kleisli f = stripExtension ".hs" in f "/tmp/foo.hs"--- Just "/tmp/foo"------ >>> let Kleisli f = stripExtension ".md" in f "/tmp/foo.hs"--- Nothing------ >>> let Kleisli f = stripExtension ".gz" in f "/tmp/foo.tar.gz"--- Just "/tmp/foo.tar"------ >>> let Kleisli f = stripExtension ".tar.gz" in f "/tmp/foo.tar.gz"--- Just "/tmp/foo"-stripExtension :: String -> FilePatherMaybeA FilePath-stripExtension s = Kleisli (FP.stripExtension s)-{-# INLINE stripExtension #-}---- | Split a file path into directory and file components.------ >>> run splitFileName "/tmp/foo.hs"--- ("/tmp/","foo.hs")------ >>> run splitFileName "/tmp/"--- ("/tmp/","")------ >>> run splitFileName "foo.hs"--- ("./","foo.hs")-splitFileName :: FilePatherA' (String, String)-splitFileName = mkKleisli' FP.splitFileName-{-# INLINE splitFileName #-}---- | Get the file name component of a file path.------ >>> run takeFileName "/tmp/foo.hs"--- "foo.hs"------ >>> run takeFileName "/tmp/"--- ""------ >>> run takeFileName "foo.hs"--- "foo.hs"-takeFileName :: FilePatherA' FilePath-takeFileName = mkKleisli' FP.takeFileName-{-# INLINE takeFileName #-}---- | Replace the file name component of a file path.------ >>> run (replaceFileName "bar.md") "/tmp/foo.hs"--- "/tmp/bar.md"------ >>> run (replaceFileName "baz") "/tmp/foo.hs"--- "/tmp/baz"-replaceFileName :: String -> FilePatherA' FilePath-replaceFileName s = mkKleisli' (`FP.replaceFileName` s)-{-# INLINE replaceFileName #-}---- | Drop the file name component of a file path.------ >>> run dropFileName "/tmp/foo.hs"--- "/tmp/"------ >>> run dropFileName "foo.hs"--- "./"-dropFileName :: FilePatherA' FilePath-dropFileName = mkKleisli' FP.dropFileName-{-# INLINE dropFileName #-}---- | Get the base name (file name without extension) of a file path.------ >>> run takeBaseName "/tmp/foo.hs"--- "foo"------ >>> run takeBaseName "/tmp/foo.tar.gz"--- "foo.tar"------ >>> run takeBaseName "/tmp/"--- ""-takeBaseName :: FilePatherA' String-takeBaseName = mkKleisli' FP.takeBaseName-{-# INLINE takeBaseName #-}---- | Replace the base name of a file path.------ >>> run (replaceBaseName "bar") "/tmp/foo.hs"--- "/tmp/bar.hs"------ >>> run (replaceBaseName "quux") "/tmp/foo.tar.gz"--- "/tmp/quux.gz"-replaceBaseName :: String -> FilePatherA' FilePath-replaceBaseName s = mkKleisli' (`FP.replaceBaseName` s)-{-# INLINE replaceBaseName #-}---- | Get the directory component of a file path.------ >>> run takeDirectory "/tmp/foo.hs"--- "/tmp"------ >>> run takeDirectory "/tmp/"--- "/tmp"------ >>> run takeDirectory "foo.hs"--- "."------ >>> run takeDirectory "/tmp/src/foo.hs"--- "/tmp/src"-takeDirectory :: FilePatherA' FilePath-takeDirectory = mkKleisli' FP.takeDirectory-{-# INLINE takeDirectory #-}---- | Replace the directory component of a file path.------ >>> run (replaceDirectory "/usr") "/tmp/foo.hs"--- "/usr/foo.hs"------ >>> run (replaceDirectory "src") "/tmp/foo.hs"--- "src/foo.hs"-replaceDirectory :: String -> FilePatherA' FilePath-replaceDirectory s = mkKleisli' (`FP.replaceDirectory` s)-{-# INLINE replaceDirectory #-}---- | Combine a directory path with a file path.------ >>> run (combine "/tmp") "foo.hs"--- "/tmp/foo.hs"------ >>> run (combine "/tmp") "/usr/foo.hs"--- "/usr/foo.hs"------ >>> run (combine "src") "Data/Foo.hs"--- "src/Data/Foo.hs"-combine :: FilePath -> FilePatherA' FilePath-combine s = mkKleisli' (FP.combine s)-{-# INLINE combine #-}---- | Split a file path into its path components.------ >>> run splitPath "/tmp/src/foo.hs"--- ["/","tmp/","src/","foo.hs"]------ >>> run splitPath "src/foo.hs"--- ["src/","foo.hs"]------ >>> run splitPath "foo.hs"--- ["foo.hs"]-splitPath :: FilePatherA' [FilePath]-splitPath = mkKleisli' FP.splitPath-{-# INLINE splitPath #-}---- | Split a file path into its directory components.------ >>> run splitDirectories "/tmp/src/foo.hs"--- ["/","tmp","src","foo.hs"]------ >>> run splitDirectories "src/foo.hs"--- ["src","foo.hs"]------ >>> run splitDirectories "/"--- ["/"]-splitDirectories :: FilePatherA' [FilePath]-splitDirectories = mkKleisli' FP.splitDirectories-{-# INLINE splitDirectories #-}---- | Split a file path into drive and remainder.------ >>> run splitDrive "/tmp/foo"--- ("/","tmp/foo")------ >>> run splitDrive "tmp/foo"--- ("","tmp/foo")-splitDrive :: FilePatherA' (FilePath, FilePath)-splitDrive = mkKleisli' FP.splitDrive-{-# INLINE splitDrive #-}---- | Join a drive and the rest of a path.------ >>> run (joinDrive "/") "tmp/foo"--- "/tmp/foo"------ >>> run (joinDrive "") "tmp/foo"--- "tmp/foo"-joinDrive :: FilePath -> FilePatherA' FilePath-joinDrive s = mkKleisli' (FP.joinDrive s)-{-# INLINE joinDrive #-}---- | Get the drive of a file path.------ >>> run takeDrive "/tmp/foo"--- "/"------ >>> run takeDrive "tmp/foo"--- ""-takeDrive :: FilePatherA' FilePath-takeDrive = mkKleisli' FP.takeDrive-{-# INLINE takeDrive #-}---- | Does the file path have a drive?------ >>> run hasDrive "/tmp/foo"--- True------ >>> run hasDrive "tmp/foo"--- False-hasDrive :: FilePatherA' Bool-hasDrive = mkKleisli' FP.hasDrive-{-# INLINE hasDrive #-}---- | Drop the drive from a file path.------ >>> run dropDrive "/tmp/foo"--- "tmp/foo"------ >>> run dropDrive "tmp/foo"--- "tmp/foo"-dropDrive :: FilePatherA' FilePath-dropDrive = mkKleisli' FP.dropDrive-{-# INLINE dropDrive #-}---- | Is the file path a drive?------ >>> run isDrive "/"--- True------ >>> run isDrive "/tmp"--- False-isDrive :: FilePatherA' Bool-isDrive = mkKleisli' FP.isDrive-{-# INLINE isDrive #-}---- | Does the file path have a trailing path separator?------ >>> run hasTrailingPathSeparator "/tmp/"--- True------ >>> run hasTrailingPathSeparator "/tmp"--- False-hasTrailingPathSeparator :: FilePatherA' Bool-hasTrailingPathSeparator = mkKleisli' FP.hasTrailingPathSeparator-{-# INLINE hasTrailingPathSeparator #-}---- | Add a trailing path separator if one is not present.------ >>> run addTrailingPathSeparator "/tmp"--- "/tmp/"------ >>> run addTrailingPathSeparator "/tmp/"--- "/tmp/"-addTrailingPathSeparator :: FilePatherA' FilePath-addTrailingPathSeparator = mkKleisli' FP.addTrailingPathSeparator-{-# INLINE addTrailingPathSeparator #-}---- | Drop the trailing path separator if present.------ >>> run dropTrailingPathSeparator "/tmp/"--- "/tmp"------ >>> run dropTrailingPathSeparator "/tmp"--- "/tmp"------ >>> run dropTrailingPathSeparator "/"--- "/"-dropTrailingPathSeparator :: FilePatherA' FilePath-dropTrailingPathSeparator = mkKleisli' FP.dropTrailingPathSeparator-{-# INLINE dropTrailingPathSeparator #-}---- | Normalise a file path.------ >>> run normalise "/tmp//foo"--- "/tmp/foo"------ >>> run normalise "/tmp/./foo"--- "/tmp/foo"------ >>> run normalise "/tmp/foo/"--- "/tmp/foo/"-normalise :: FilePatherA' FilePath-normalise = mkKleisli' FP.normalise-{-# INLINE normalise #-}---- | Make a file path relative to a given directory.------ >>> run (makeRelative "/tmp") "/tmp/foo.hs"--- "foo.hs"------ >>> run (makeRelative "/tmp") "/tmp/src/foo.hs"--- "src/foo.hs"------ >>> run (makeRelative "/usr") "/tmp/foo.hs"--- "/tmp/foo.hs"-makeRelative :: FilePath -> FilePatherA' FilePath-makeRelative s = mkKleisli' (FP.makeRelative s)-{-# INLINE makeRelative #-}---- | Are two file paths equal (accounting for normalisation)?------ >>> run (equalFilePath "/tmp/foo") "/tmp/foo"--- True------ >>> run (equalFilePath "/tmp/foo") "/tmp/bar"--- False------ >>> run (equalFilePath "/tmp/foo") "/tmp/./foo"--- True-equalFilePath :: FilePath -> FilePatherA' Bool-equalFilePath s = mkKleisli' (FP.equalFilePath s)-{-# INLINE equalFilePath #-}---- | Is the file path relative?------ >>> run isRelative "foo/bar"--- True------ >>> run isRelative "/foo/bar"--- False------ >>> run isRelative "./foo"--- True-isRelative :: FilePatherA' Bool-isRelative = mkKleisli' FP.isRelative-{-# INLINE isRelative #-}---- | Is the file path absolute?------ >>> run isAbsolute "/foo/bar"--- True------ >>> run isAbsolute "foo/bar"--- False------ >>> run isAbsolute "/"--- True-isAbsolute :: FilePatherA' Bool-isAbsolute = mkKleisli' FP.isAbsolute-{-# INLINE isAbsolute #-}---- | Is the file path valid?------ >>> run isValid "/tmp/foo"--- True------ >>> run isValid ""--- False-isValid :: FilePatherA' Bool-isValid = mkKleisli' FP.isValid-{-# INLINE isValid #-}---- | Make a file path valid by replacing invalid characters.------ >>> run makeValid ""--- "_"------ >>> run makeValid "/tmp/foo"--- "/tmp/foo"-makeValid :: FilePatherA' FilePath-makeValid = mkKleisli' FP.makeValid-{-# INLINE makeValid #-}---- | Combine two file paths with a path separator. Synonym for 'combine'.------ >>> run (combine "/tmp") "foo.hs"--- "/tmp/foo.hs"------ >>> run (combine "src") "Data/Foo.hs"--- "src/Data/Foo.hs"-(</>) :: FilePath -> FilePatherA' FilePath-(</>) = combine-{-# INLINE (</>) #-}---- | Add an extension to a file path. Synonym for 'addExtension'.------ >>> run (addExtension ".hs") "/tmp/foo"--- "/tmp/foo.hs"------ >>> run (addExtension ".gz") "/tmp/foo.tar"--- "/tmp/foo.tar.gz"-(<.>) :: String -> FilePatherA' FilePath-(<.>) = addExtension-{-# INLINE (<.>) #-}---- | Replace the extension of a file path. Synonym for 'replaceExtension'.------ >>> run (replaceExtension ".md") "/tmp/foo.hs"--- "/tmp/foo.md"------ >>> run (replaceExtension ".txt") "/tmp/foo"--- "/tmp/foo.txt"-(-<.>) :: String -> FilePatherA' FilePath-(-<.>) = replaceExtension-{-# INLINE (-<.>) #-}----------------------------------------------------------------- System.Directory----------------------------------------------------------------- | Create a directory.------ >>> let Kleisli f = createDirectory in f "/tmp/filepather_test_create_938271" >> Dir.removeDirectory "/tmp/filepather_test_create_938271"-createDirectory :: FilePatherIOA ()-createDirectory = Kleisli Dir.createDirectory-{-# INLINE createDirectory #-}---- | Create a directory and any missing parent directories.------ >>> let Kleisli f = createDirectoryIfMissing True in f "/tmp/filepather_test_mkdirs_938271/a/b" >> Dir.removeDirectoryRecursive "/tmp/filepather_test_mkdirs_938271"-createDirectoryIfMissing :: Bool -> FilePatherIOA ()-createDirectoryIfMissing b = Kleisli (Dir.createDirectoryIfMissing b)-{-# INLINE createDirectoryIfMissing #-}---- | Remove an existing directory.------ >>> Dir.createDirectory "/tmp/filepather_test_rmdir_938271"--- >>> let Kleisli f = removeDirectory in f "/tmp/filepather_test_rmdir_938271"-removeDirectory :: FilePatherIOA ()-removeDirectory = Kleisli Dir.removeDirectory-{-# INLINE removeDirectory #-}---- | Remove a directory and all its contents recursively.------ >>> Dir.createDirectoryIfMissing True "/tmp/filepather_test_rmr_938271/x/y"--- >>> let Kleisli f = removeDirectoryRecursive in f "/tmp/filepather_test_rmr_938271"-removeDirectoryRecursive :: FilePatherIOA ()-removeDirectoryRecursive = Kleisli Dir.removeDirectoryRecursive-{-# INLINE removeDirectoryRecursive #-}---- | Remove a path forcibly (file or directory, recursively).------ >>> Dir.createDirectory "/tmp/filepather_test_rmf_938271"--- >>> let Kleisli f = removePathForcibly in f "/tmp/filepather_test_rmf_938271"-removePathForcibly :: FilePatherIOA ()-removePathForcibly = Kleisli Dir.removePathForcibly-{-# INLINE removePathForcibly #-}---- | Rename a directory to a new path.------ >>> Dir.createDirectory "/tmp/filepather_test_rend_938271"--- >>> let Kleisli f = renameDirectory "/tmp/filepather_test_rend2_938271" in f "/tmp/filepather_test_rend_938271"--- >>> Dir.removeDirectory "/tmp/filepather_test_rend2_938271"-renameDirectory :: FilePath -> FilePatherIOA ()-renameDirectory dest = Kleisli (`Dir.renameDirectory` dest)-{-# INLINE renameDirectory #-}---- | List the contents of a directory (excluding @.@ and @..@).------ >>> let Kleisli f = listDirectory in f "/" >>= \xs -> pure (not (null xs))--- True-listDirectory :: FilePatherIOA [FilePath]-listDirectory = Kleisli Dir.listDirectory-{-# INLINE listDirectory #-}---- | Get all entries in a directory (including @.@ and @..@).------ >>> let Kleisli f = getDirectoryContents in f "/" >>= \xs -> pure (elem "." xs && elem ".." xs)--- True-getDirectoryContents :: FilePatherIOA [FilePath]-getDirectoryContents = Kleisli Dir.getDirectoryContents-{-# INLINE getDirectoryContents #-}---- | Set the current working directory.------ >>> let Kleisli f = setCurrentDirectory in Dir.getCurrentDirectory >>= \old -> f "/tmp" >> Dir.getCurrentDirectory >>= \new -> Dir.setCurrentDirectory old >> pure (new == "/tmp")--- True-setCurrentDirectory :: FilePatherIOA ()-setCurrentDirectory = Kleisli Dir.setCurrentDirectory-{-# INLINE setCurrentDirectory #-}---- | Run an IO action with the given directory as the working directory.------ >>> let Kleisli f = withCurrentDirectory (pure ()) in f "/tmp"-withCurrentDirectory :: IO a -> FilePatherIOA a-withCurrentDirectory act = Kleisli (`Dir.withCurrentDirectory` act)-{-# INLINE withCurrentDirectory #-}---- | Get an XDG directory for the given application.------ >>> let Kleisli f = getXdgDirectory Dir.XdgConfig in f "myapp" >>= \d -> pure (not (null d))--- True-getXdgDirectory :: Dir.XdgDirectory -> FilePatherIOA FilePath-getXdgDirectory xdg = Kleisli (Dir.getXdgDirectory xdg)-{-# INLINE getXdgDirectory #-}---- | Get the application user data directory.------ >>> let Kleisli f = getAppUserDataDirectory in f "myapp" >>= \d -> pure (not (null d))--- True-getAppUserDataDirectory :: FilePatherIOA FilePath-getAppUserDataDirectory = Kleisli Dir.getAppUserDataDirectory-{-# INLINE getAppUserDataDirectory #-}---- | Remove a file.------ >>> writeFile "/tmp/filepather_test_rm_938271" ""--- >>> let Kleisli f = removeFile in f "/tmp/filepather_test_rm_938271"-removeFile :: FilePatherIOA ()-removeFile = Kleisli Dir.removeFile-{-# INLINE removeFile #-}---- | Rename a file to a new path.------ >>> writeFile "/tmp/filepather_test_renf_938271" ""--- >>> let Kleisli f = renameFile "/tmp/filepather_test_renf2_938271" in f "/tmp/filepather_test_renf_938271"--- >>> Dir.removeFile "/tmp/filepather_test_renf2_938271"-renameFile :: FilePath -> FilePatherIOA ()-renameFile dest = Kleisli (`Dir.renameFile` dest)-{-# INLINE renameFile #-}---- | Rename a file or directory to a new path.------ >>> writeFile "/tmp/filepather_test_renp_938271" ""--- >>> let Kleisli f = renamePath "/tmp/filepather_test_renp2_938271" in f "/tmp/filepather_test_renp_938271"--- >>> Dir.removeFile "/tmp/filepather_test_renp2_938271"-renamePath :: FilePath -> FilePatherIOA ()-renamePath dest = Kleisli (`Dir.renamePath` dest)-{-# INLINE renamePath #-}---- | Copy a file to a new path.------ >>> writeFile "/tmp/filepather_test_cp_938271" ""--- >>> let Kleisli f = copyFile "/tmp/filepather_test_cp2_938271" in f "/tmp/filepather_test_cp_938271"--- >>> Dir.removeFile "/tmp/filepather_test_cp_938271" >> Dir.removeFile "/tmp/filepather_test_cp2_938271"-copyFile :: FilePath -> FilePatherIOA ()-copyFile dest = Kleisli (`Dir.copyFile` dest)-{-# INLINE copyFile #-}---- | Copy a file preserving metadata.------ >>> writeFile "/tmp/filepather_test_cpm_938271" ""--- >>> let Kleisli f = copyFileWithMetadata "/tmp/filepather_test_cpm2_938271" in f "/tmp/filepather_test_cpm_938271"--- >>> Dir.removeFile "/tmp/filepather_test_cpm_938271" >> Dir.removeFile "/tmp/filepather_test_cpm2_938271"-copyFileWithMetadata :: FilePath -> FilePatherIOA ()-copyFileWithMetadata dest = Kleisli (`Dir.copyFileWithMetadata` dest)-{-# INLINE copyFileWithMetadata #-}---- | Canonicalize a file path (resolve symlinks and relative components).------ >>> let Kleisli f = canonicalizePath in f "/" >>= \d -> pure (d == "/")--- True------ >>> let Kleisli f = canonicalizePath in f "/tmp/../tmp" >>= \d -> pure (not (null d))--- True-canonicalizePath :: FilePatherIOA FilePath-canonicalizePath = Kleisli Dir.canonicalizePath-{-# INLINE canonicalizePath #-}---- | Make a file path absolute.------ >>> let Kleisli f = makeAbsolute in f "/tmp" >>= \d -> pure (d == "/tmp")--- True------ >>> let Kleisli f = makeAbsolute in f "foo" >>= \d -> pure (head d == '/')--- True-makeAbsolute :: FilePatherIOA FilePath-makeAbsolute = Kleisli Dir.makeAbsolute-{-# INLINE makeAbsolute #-}---- | Make a file path relative to the current directory.------ >>> let Kleisli f = makeRelativeToCurrentDirectory in f "/" >>= \d -> pure (not (null d))--- True-makeRelativeToCurrentDirectory :: FilePatherIOA FilePath-makeRelativeToCurrentDirectory = Kleisli Dir.makeRelativeToCurrentDirectory-{-# INLINE makeRelativeToCurrentDirectory #-}---- | Does the path exist (file or directory)?------ >>> let Kleisli f = doesPathExist in f "/"--- True------ >>> let Kleisli f = doesPathExist in f "/nonexistent_path_938271"--- False-doesPathExist :: FilePatherIOA Bool-doesPathExist = Kleisli Dir.doesPathExist-{-# INLINE doesPathExist #-}---- | Does the file exist?------ >>> let Kleisli f = doesFileExist in f "/nonexistent_file_938271"--- False-doesFileExist :: FilePatherIOA Bool-doesFileExist = Kleisli Dir.doesFileExist-{-# INLINE doesFileExist #-}---- | Does the directory exist?------ >>> let Kleisli f = doesDirectoryExist in f "/"--- True------ >>> let Kleisli f = doesDirectoryExist in f "/nonexistent_dir_938271"--- False-doesDirectoryExist :: FilePatherIOA Bool-doesDirectoryExist = Kleisli Dir.doesDirectoryExist-{-# INLINE doesDirectoryExist #-}---- | Create a file symbolic link. The first argument is the link target.------ >>> Dir.removePathForcibly "/tmp/filepather_test_flink_938271"--- >>> let Kleisli f = createFileLink "/dev/null" in f "/tmp/filepather_test_flink_938271" >> Dir.pathIsSymbolicLink "/tmp/filepather_test_flink_938271" >>= \b -> Dir.removeFile "/tmp/filepather_test_flink_938271" >> pure b--- True-createFileLink :: FilePath -> FilePatherIOA ()-createFileLink target = Kleisli (Dir.createFileLink target)-{-# INLINE createFileLink #-}---- | Create a directory symbolic link. The first argument is the link target.------ >>> Dir.removePathForcibly "/tmp/filepather_test_dlink_938271"--- >>> let Kleisli f = createDirectoryLink "/tmp" in f "/tmp/filepather_test_dlink_938271" >> Dir.pathIsSymbolicLink "/tmp/filepather_test_dlink_938271" >>= \b -> Dir.removeDirectoryLink "/tmp/filepather_test_dlink_938271" >> pure b--- True-createDirectoryLink :: FilePath -> FilePatherIOA ()-createDirectoryLink target = Kleisli (Dir.createDirectoryLink target)-{-# INLINE createDirectoryLink #-}---- | Remove a directory symbolic link.------ >>> Dir.removePathForcibly "/tmp/filepather_test_rmdl_938271"--- >>> Dir.createDirectoryLink "/tmp" "/tmp/filepather_test_rmdl_938271"--- >>> let Kleisli f = removeDirectoryLink in f "/tmp/filepather_test_rmdl_938271"-removeDirectoryLink :: FilePatherIOA ()-removeDirectoryLink = Kleisli Dir.removeDirectoryLink-{-# INLINE removeDirectoryLink #-}---- | Get the target of a symbolic link.------ >>> Dir.removePathForcibly "/tmp/filepather_test_gsl_938271"--- >>> Dir.createFileLink "/dev/null" "/tmp/filepather_test_gsl_938271"--- >>> let Kleisli f = getSymbolicLinkTarget in f "/tmp/filepather_test_gsl_938271" >>= \t -> Dir.removeFile "/tmp/filepather_test_gsl_938271" >> pure t--- "/dev/null"-getSymbolicLinkTarget :: FilePatherIOA FilePath-getSymbolicLinkTarget = Kleisli Dir.getSymbolicLinkTarget-{-# INLINE getSymbolicLinkTarget #-}---- | Is the path a symbolic link?------ >>> let Kleisli f = isSymbolicLink in f "/"--- False-isSymbolicLink :: FilePatherIOA Bool-isSymbolicLink = Kleisli Dir.pathIsSymbolicLink-{-# INLINE isSymbolicLink #-}---- | Is the path a symbolic link? (Same as 'isSymbolicLink'.)------ >>> let Kleisli f = pathIsSymbolicLink in f "/"--- False-pathIsSymbolicLink :: FilePatherIOA Bool-pathIsSymbolicLink = Kleisli Dir.pathIsSymbolicLink-{-# INLINE pathIsSymbolicLink #-}---- | Get the permissions of a file or directory.------ >>> let Kleisli f = getPermissions in f "/" >>= \p -> pure (Dir.searchable p)--- True-getPermissions :: FilePatherIOA Dir.Permissions-getPermissions = Kleisli Dir.getPermissions-{-# INLINE getPermissions #-}---- | Set the permissions of a file or directory.------ >>> writeFile "/tmp/filepather_test_sp_938271" ""--- >>> let Kleisli f = setPermissions (Dir.setOwnerReadable True (Dir.setOwnerWritable True Dir.emptyPermissions)) in f "/tmp/filepather_test_sp_938271" >> Dir.getPermissions "/tmp/filepather_test_sp_938271" >>= \p -> Dir.removeFile "/tmp/filepather_test_sp_938271" >> pure (Dir.readable p)--- True-setPermissions :: Dir.Permissions -> FilePatherIOA ()-setPermissions p = Kleisli (`Dir.setPermissions` p)-{-# INLINE setPermissions #-}---- | Copy the permissions from one path to another.------ >>> writeFile "/tmp/filepather_test_cpp_src_938271" ""--- >>> writeFile "/tmp/filepather_test_cpp_938271" ""--- >>> let Kleisli f = copyPermissions "/tmp/filepather_test_cpp_src_938271" in f "/tmp/filepather_test_cpp_938271" >> Dir.removeFile "/tmp/filepather_test_cpp_938271" >> Dir.removeFile "/tmp/filepather_test_cpp_src_938271"-copyPermissions :: FilePath -> FilePatherIOA ()-copyPermissions dest = Kleisli (`Dir.copyPermissions` dest)-{-# INLINE copyPermissions #-}---- | Get the access time of a file or directory.------ >>> let Kleisli f = getAccessTime in f "/" >>= \t -> pure (t > read "2000-01-01 00:00:00 UTC")--- True-getAccessTime :: FilePatherIOA UTCTime-getAccessTime = Kleisli Dir.getAccessTime-{-# INLINE getAccessTime #-}---- | Get the modification time of a file or directory.------ >>> let Kleisli f = getModificationTime in f "/" >>= \t -> pure (t > read "2000-01-01 00:00:00 UTC")--- True-getModificationTime :: FilePatherIOA UTCTime-getModificationTime = Kleisli Dir.getModificationTime-{-# INLINE getModificationTime #-}---- | Set the access time of a file or directory.------ >>> writeFile "/tmp/filepather_test_sat_938271" ""--- >>> let Kleisli f = setAccessTime (read "2020-06-15 12:00:00 UTC") in f "/tmp/filepather_test_sat_938271" >> Dir.getAccessTime "/tmp/filepather_test_sat_938271" >>= \t -> Dir.removeFile "/tmp/filepather_test_sat_938271" >> pure (t == read "2020-06-15 12:00:00 UTC")--- True-setAccessTime :: UTCTime -> FilePatherIOA ()-setAccessTime t = Kleisli (`Dir.setAccessTime` t)-{-# INLINE setAccessTime #-}---- | Set the modification time of a file or directory.------ >>> writeFile "/tmp/filepather_test_smt_938271" ""--- >>> let Kleisli f = setModificationTime (read "2020-06-15 12:00:00 UTC") in f "/tmp/filepather_test_smt_938271" >> Dir.getModificationTime "/tmp/filepather_test_smt_938271" >>= \t -> Dir.removeFile "/tmp/filepather_test_smt_938271" >> pure (t == read "2020-06-15 12:00:00 UTC")--- True-setModificationTime :: UTCTime -> FilePatherIOA ()-setModificationTime t = Kleisli (`Dir.setModificationTime` t)-{-# INLINE setModificationTime #-}---- | Get the size of a file in bytes.------ >>> writeFile "/tmp/filepather_test_gs_938271" "hello"--- >>> let Kleisli f = getFileSize in f "/tmp/filepather_test_gs_938271" >>= \s -> Dir.removeFile "/tmp/filepather_test_gs_938271" >> pure s--- 5-getFileSize :: FilePatherIOA Integer-getFileSize = Kleisli Dir.getFileSize-{-# INLINE getFileSize #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+-- Required for the MonadState, MonadWriter and MonadError instances: the+-- functional dependency of each class (for example, m -> s) is not covered by+-- the instance head MonadState s (FilePather f), because s does not occur in+-- FilePather f.+-- Terminates: each instance context is the same class at f, which is a strict+-- subterm of the instance head FilePather f, so resolution moves to a smaller+-- type at each step.+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++{- | A 'FilePather' is a computation that depends on the file path being+operated on, producing a value in a type constructor @f@.++@+newtype FilePather f a = FilePather (FilePath -> f a)+@++A 'FilePather' is isomorphic to @ReaderT FilePath f a@ (see+'filePatherReaderT'), and has the same instances. In particular, when @f@ is a+'Monad', so is @FilePather f@, and 'Control.Monad.Reader.ask' returns the file path being operated+on.+-}+module System.FilePather.FilePather (+  -- * Types+  FilePather (..),++  -- * Type aliases+  FilePather',+  FilePatherIO,+  FilePatherMaybe,+  FilePatherList,+  FilePatherNonEmpty,+  FilePatherEither,+  FilePatherMaybeT,+  FilePatherExceptT,+  FilePatherExitcode,+  FilePatherExitcode',++  -- * Optics+  filePatherReaderT,+  GetFilePather (..),+  HasFilePather (..),+  ReviewFilePather (..),+  AsFilePather (..),++  -- * Fusion workers+  mapFilePather,+  mapMaybeFilePather,+) where++import Control.Applicative (Alternative)+import Control.DeepSeq (NFData)+import Control.Exitcode (Exitcode)+import Control.Lens (Getter, Iso, Lens', Prism', Review, Rewrapped, Wrapped (..), iso, lens, prism', review, unto, view, _Wrapped)+import Control.Monad (MonadPlus)+import Control.Monad.Cont.Class (MonadCont)+import Control.Monad.Error.Class (MonadError)+import Control.Monad.Fix (MonadFix)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Reader (ReaderT (..))+import Control.Monad.Reader.Class (MonadReader)+import Control.Monad.State.Class (MonadState)+import Control.Monad.Trans.Class (MonadTrans)+import Control.Monad.Trans.Except (ExceptT)+import Control.Monad.Trans.Maybe (MaybeT)+import Control.Monad.Writer.Class (MonadWriter)+import Control.Monad.Zip (MonadZip)+import Control.Selective (Selective)+import Data.Distributive (Distributive (..))+import Data.Functor.Alt (Alt (..))+import Data.Functor.Apply (Apply)+import Data.Functor.Bind (Bind (..))+import Data.Functor.Contravariant (Contravariant)+import Data.Functor.Contravariant.Divisible (Decidable, Divisible)+import Data.Functor.Identity (Identity)+import Data.Functor.Plus (Plus)+import Data.Functor.Rep (Representable (..))+import Data.Kind (Type)+import Data.List.NonEmpty (NonEmpty)+import GHC.Generics (Generic, Generic1)+import Witherable (Filterable (..))++{- $setup+>>> import Control.Lens (view, _Wrapped)+>>> import Control.Monad.Reader (ask, asks)+>>> import Data.Functor.Identity (Identity (..))+>>> import System.FilePath (takeExtension)+>>> import Witherable (mapMaybe)+-}++{- | A computation that depends on the file path being operated on.++The file path is typically an input file, and the result is typically one or+more output files, or some information about the input file. Use 'Control.Monad.Reader.ask' for the+file path, and 'Control.Monad.Reader.local' to operate on a different file path.++==== __Examples__++>>> runIdentity (view _Wrapped (asks takeExtension :: FilePather' String) "notes.md")+".md"++>>> view _Wrapped (FilePather (\p -> [p, p ++ ".bak"])) "notes.md"+["notes.md","notes.md.bak"]++>>> runIdentity (view _Wrapped ((,) <$> ask <*> asks length :: FilePather' (FilePath, Int)) "notes.md")+("notes.md",8)++@since 0.7.0.0+-}+type FilePather :: (Type -> Type) -> Type -> Type+newtype FilePather f a+  = FilePather (FilePath -> f a)+  deriving stock (Generic, Generic1)+  deriving newtype (NFData)+  deriving+    ( Apply+    , Applicative+    , Alternative+    , Plus+    , Monad+    , MonadPlus+    , MonadFail+    , MonadFix+    , MonadZip+    , MonadIO+    , MonadCont+    , MonadReader FilePath+    , Selective+    , Contravariant+    , Divisible+    , Decidable+    )+    via (ReaderT FilePath f)+  deriving (Semigroup, Monoid) via (FilePath -> f a)++deriving via (ReaderT FilePath) instance MonadTrans FilePather++deriving via (ReaderT FilePath f) instance (MonadState s f) => MonadState s (FilePather f)++deriving via (ReaderT FilePath f) instance (MonadWriter w f) => MonadWriter w (FilePather f)++deriving via (ReaderT FilePath f) instance (MonadError e f) => MonadError e (FilePather f)++{- | A 'FilePather' that produces a value without effects.++@since 0.7.0.0+-}+type FilePather' a = FilePather Identity a++-- | @since 0.7.0.0+type FilePatherIO a = FilePather IO a++-- | @since 0.7.0.0+type FilePatherMaybe a = FilePather Maybe a++-- | @since 0.7.0.0+type FilePatherList a = FilePather [] a++-- | @since 0.7.0.0+type FilePatherNonEmpty a = FilePather NonEmpty a++-- | @since 0.7.0.0+type FilePatherEither e a = FilePather (Either e) a++-- | @since 0.7.0.0+type FilePatherMaybeT f a = FilePather (MaybeT f) a++-- | @since 0.7.0.0+type FilePatherExceptT e f a = FilePather (ExceptT e f) a++{- | A 'FilePather' that fails with an exit code, using 'Exitcode'.++@since 0.7.0.0+-}+type FilePatherExitcode e f a = FilePather (Exitcode e f) a++-- | @since 0.7.0.0+type FilePatherExitcode' e a = FilePather (Exitcode e Identity) a++{- | Map over the result of a 'FilePather'. This is 'fmap', and is the+function that the fusion rules match.++>>> runIdentity (view _Wrapped (mapFilePather length ask) "notes.md")+8++@since 0.7.0.0+-}+mapFilePather :: (Functor f) => (a -> b) -> FilePather f a -> FilePather f b+mapFilePather f (FilePather g) =+  FilePather (fmap f . g)+{-# NOINLINE [1] mapFilePather #-}++{- | Filter and map over the result of a 'FilePather'. This is 'mapMaybe', and+is the function that the fusion rules match.++>>> view _Wrapped (mapMaybeFilePather (\x -> if x > 1 then Just (x * 10) else Nothing) (FilePather (\p -> [1, length p]))) "abc"+[30]++@since 0.7.0.0+-}+mapMaybeFilePather :: (Filterable f) => (a -> Maybe b) -> FilePather f a -> FilePather f b+mapMaybeFilePather f (FilePather g) =+  FilePather (mapMaybe f . g)+{-# NOINLINE [1] mapMaybeFilePather #-}++{-# RULES+"mapFilePather/mapFilePather" [~1] forall f g x.+  mapFilePather f (mapFilePather g x) =+    mapFilePather (f . g) x+"mapMaybeFilePather/mapMaybeFilePather" [~1] forall f g x.+  mapMaybeFilePather f (mapMaybeFilePather g x) =+    mapMaybeFilePather (\a -> g a >>= f) x+"mapMaybeFilePather/mapFilePather" [~1] forall f g x.+  mapMaybeFilePather f (mapFilePather g x) =+    mapMaybeFilePather (f . g) x+  #-}++-- | @since 0.7.0.0+instance (Functor f) => Functor (FilePather f) where+  fmap =+    mapFilePather+  {-# INLINE fmap #-}++-- | @since 0.7.0.0+instance (Bind f) => Bind (FilePather f) where+  FilePather g >>- k =+    FilePather (\p -> g p >>- \a -> view _Wrapped (k a) p)+  {-# INLINE (>>-) #-}++-- | @since 0.7.0.0+instance (Alt f) => Alt (FilePather f) where+  FilePather g <!> FilePather h =+    FilePather (\p -> g p <!> h p)+  {-# INLINE (<!>) #-}++-- | @since 0.7.0.0+instance (Filterable f) => Filterable (FilePather f) where+  mapMaybe =+    mapMaybeFilePather+  {-# INLINE mapMaybe #-}++-- | @since 0.7.0.0+instance (Distributive f) => Distributive (FilePather f) where+  distribute w =+    FilePather (\p -> distribute (fmap (\x -> view _Wrapped x p) w))+  {-# INLINE distribute #-}++{- | The representation pairs the file path with the representation of @f@.++@since 0.7.0.0+-}+instance (Representable f) => Representable (FilePather f) where+  type Rep (FilePather f) = (FilePath, Rep f)+  tabulate h =+    FilePather (\p -> tabulate (\r -> h (p, r)))+  {-# INLINE tabulate #-}+  index (FilePather g) (p, r) =+    index (g p) r+  {-# INLINE index #-}++-- | @since 0.7.0.0+instance Wrapped (FilePather f a) where+  type Unwrapped (FilePather f a) = FilePath -> f a+  _Wrapped' =+    iso (\(FilePather g) -> g) FilePather+  {-# INLINE _Wrapped' #-}++-- | @since 0.7.0.0+instance (t ~ FilePather g b) => Rewrapped (FilePather f a) t++{- | The isomorphism between 'FilePather' and 'ReaderT'.++>>> runIdentity (runReaderT (view filePatherReaderT (asks length)) "notes.md")+8++@since 0.7.0.0+-}+filePatherReaderT :: Iso (FilePather f a) (FilePather g b) (ReaderT FilePath f a) (ReaderT FilePath g b)+filePatherReaderT =+  iso (\(FilePather g) -> ReaderT g) (\(ReaderT g) -> FilePather g)+{-# INLINE filePatherReaderT #-}++{- | Values that can be viewed as a 'FilePather'.++>>> runIdentity (view (getFilePather . _Wrapped) (asks length :: FilePather' Int) "notes.md")+8++@since 0.7.0.0+-}+class GetFilePather s f a | s -> f a where+  getFilePather :: Getter s (FilePather f a)++-- | @since 0.7.0.0+instance GetFilePather (FilePather f a) f a where+  getFilePather =+    id+  {-# INLINE getFilePather #-}++{- | Values with a lens to a 'FilePather'.++@since 0.7.0.0+-}+class (GetFilePather s f a) => HasFilePather s f a | s -> f a where+  {-# MINIMAL setFilePather #-}+  setFilePather :: FilePather f a -> s -> s++  filePather :: Lens' s (FilePather f a)+  filePather =+    lens (view getFilePather) (flip setFilePather)+  {-# INLINE filePather #-}++-- | @since 0.7.0.0+instance HasFilePather (FilePather f a) f a where+  setFilePather =+    const+  {-# INLINE setFilePather #-}++{- | Values that can be constructed from a 'FilePather'.++@since 0.7.0.0+-}+class ReviewFilePather t f a | t -> f a where+  reviewFilePather :: Review t (FilePather f a)++-- | @since 0.7.0.0+instance ReviewFilePather (FilePather f a) f a where+  reviewFilePather =+    unto id+  {-# INLINE reviewFilePather #-}++{- | Values with a prism to a 'FilePather'.++@since 0.7.0.0+-}+class (ReviewFilePather t f a) => AsFilePather t f a | t -> f a where+  {-# MINIMAL matchFilePather #-}+  matchFilePather :: t -> Maybe (FilePather f a)++  _FilePather :: Prism' t (FilePather f a)+  _FilePather =+    prism' (review reviewFilePather) matchFilePather+  {-# INLINE _FilePather #-}++-- | @since 0.7.0.0+instance AsFilePather (FilePather f a) f a where+  matchFilePather =+    Just+  {-# INLINE matchFilePather #-}

@@ -1,601 +0,0 @@-{-# OPTIONS_GHC -Wall #-}---- |--- Module      : System.FilePather.FilePather.Posix--- Description : Posix FilePath operations via Kleisli type aliases-module System.FilePather.FilePather.Posix-  ( -- * Types-    FilePather,-    FilePather',-    FilePatherA,-    FilePatherA',-    FilePatherMaybe,-    FilePatherMaybeA,-    FilePatherIO,-    FilePatherIOA,--    -- * System.FilePath.Posix re-implementations-    splitExtension,-    takeExtension,-    replaceExtension,-    dropExtension,-    addExtension,-    hasExtension,-    splitExtensions,-    takeExtensions,-    dropExtensions,-    replaceExtensions,-    isExtensionOf,-    stripExtension,-    splitFileName,-    takeFileName,-    replaceFileName,-    dropFileName,-    takeBaseName,-    replaceBaseName,-    takeDirectory,-    replaceDirectory,-    combine,-    splitPath,-    FP.joinPath,-    splitDirectories,-    splitDrive,-    joinDrive,-    takeDrive,-    hasDrive,-    dropDrive,-    isDrive,-    hasTrailingPathSeparator,-    addTrailingPathSeparator,-    dropTrailingPathSeparator,-    normalise,-    makeRelative,-    equalFilePath,-    isRelative,-    isAbsolute,-    isValid,-    makeValid,-    (</>),-    (<.>),-    (-<.>),--    -- * System.FilePath.Posix re-exports-    FP.FilePath,-    FP.pathSeparator,-    FP.pathSeparators,-    FP.isPathSeparator,-    FP.searchPathSeparator,-    FP.isSearchPathSeparator,-    FP.extSeparator,-    FP.isExtSeparator,-    FP.splitSearchPath,-    FP.getSearchPath,-  )-where--import Data.Functor.Identity (Identity)-import Data.Kleisli (Kleisli (..), mkKleisli')-import qualified System.FilePath.Posix as FP---- $setup--- >>> import Data.Functor.Identity (Identity(..))--- >>> import Data.Kleisli (Kleisli(..))--- >>> let run (Kleisli f) x = runIdentity (f x)--type FilePather p f a = Kleisli p FilePath f a--type FilePather' p a = FilePather p Identity a--type FilePatherA f a = FilePather (->) f a--type FilePatherA' a = FilePatherA Identity a--type FilePatherMaybe p a = FilePather p Maybe a--type FilePatherMaybeA a = FilePatherMaybe (->) a--type FilePatherIO p a = FilePather p IO a--type FilePatherIOA a = FilePatherIO (->) a---- | Split a file path into the stem and extension (Posix).------ >>> run splitExtension "/tmp/foo.hs"--- ("/tmp/foo",".hs")------ >>> run splitExtension "/tmp/foo"--- ("/tmp/foo","")------ >>> run splitExtension "/tmp/foo.tar.gz"--- ("/tmp/foo.tar",".gz")-splitExtension :: FilePatherA' (String, String)-splitExtension = mkKleisli' FP.splitExtension-{-# INLINE splitExtension #-}---- | Get the extension of a file path (Posix).------ >>> run takeExtension "/tmp/foo.hs"--- ".hs"------ >>> run takeExtension "/tmp/foo"--- ""-takeExtension :: FilePatherA' String-takeExtension = mkKleisli' FP.takeExtension-{-# INLINE takeExtension #-}---- | Replace the extension of a file path (Posix).------ >>> run (replaceExtension ".md") "/tmp/foo.hs"--- "/tmp/foo.md"------ >>> run (replaceExtension ".txt") "/tmp/foo"--- "/tmp/foo.txt"------ >>> run (replaceExtension "") "/tmp/foo.hs"--- "/tmp/foo"-replaceExtension :: String -> FilePatherA' FilePath-replaceExtension s = mkKleisli' (`FP.replaceExtension` s)-{-# INLINE replaceExtension #-}---- | Remove the extension from a file path (Posix).------ >>> run dropExtension "/tmp/foo.hs"--- "/tmp/foo"------ >>> run dropExtension "/tmp/foo"--- "/tmp/foo"-dropExtension :: FilePatherA' FilePath-dropExtension = mkKleisli' FP.dropExtension-{-# INLINE dropExtension #-}---- | Add an extension to a file path (Posix).------ >>> run (addExtension ".hs") "/tmp/foo"--- "/tmp/foo.hs"------ >>> run (addExtension ".gz") "/tmp/foo.tar"--- "/tmp/foo.tar.gz"------ >>> run (addExtension "hs") "/tmp/foo"--- "/tmp/foo.hs"-addExtension :: String -> FilePatherA' FilePath-addExtension s = mkKleisli' (`FP.addExtension` s)-{-# INLINE addExtension #-}---- | Does the file path have an extension? (Posix)------ >>> run hasExtension "/tmp/foo.hs"--- True------ >>> run hasExtension "/tmp/foo"--- False-hasExtension :: FilePatherA' Bool-hasExtension = mkKleisli' FP.hasExtension-{-# INLINE hasExtension #-}---- | Split all extensions from a file path (Posix).------ >>> run splitExtensions "/tmp/foo.tar.gz"--- ("/tmp/foo",".tar.gz")------ >>> run splitExtensions "/tmp/foo"--- ("/tmp/foo","")-splitExtensions :: FilePatherA' (FilePath, String)-splitExtensions = mkKleisli' FP.splitExtensions-{-# INLINE splitExtensions #-}---- | Get all extensions from a file path (Posix).------ >>> run takeExtensions "/tmp/foo.tar.gz"--- ".tar.gz"------ >>> run takeExtensions "/tmp/foo"--- ""-takeExtensions :: FilePatherA' String-takeExtensions = mkKleisli' FP.takeExtensions-{-# INLINE takeExtensions #-}---- | Drop all extensions from a file path (Posix).------ >>> run dropExtensions "/tmp/foo.tar.gz"--- "/tmp/foo"------ >>> run dropExtensions "/tmp/foo"--- "/tmp/foo"-dropExtensions :: FilePatherA' FilePath-dropExtensions = mkKleisli' FP.dropExtensions-{-# INLINE dropExtensions #-}---- | Replace all extensions of a file path (Posix).------ >>> run (replaceExtensions ".txt") "/tmp/foo.tar.gz"--- "/tmp/foo.txt"------ >>> run (replaceExtensions ".a.b") "/tmp/foo.c"--- "/tmp/foo.a.b"-replaceExtensions :: String -> FilePatherA' FilePath-replaceExtensions s = mkKleisli' (`FP.replaceExtensions` s)-{-# INLINE replaceExtensions #-}---- | Is the given string an extension of the file path? (Posix)------ >>> run (isExtensionOf ".hs") "/tmp/foo.hs"--- True------ >>> run (isExtensionOf ".md") "/tmp/foo.hs"--- False------ >>> run (isExtensionOf "hs") "/tmp/foo.hs"--- True-isExtensionOf :: String -> FilePatherA' Bool-isExtensionOf s = mkKleisli' (FP.isExtensionOf s)-{-# INLINE isExtensionOf #-}---- | Strip an extension from a file path (Posix), returning 'Nothing' if it--- does not match.------ >>> let Kleisli f = stripExtension ".hs" in f "/tmp/foo.hs"--- Just "/tmp/foo"------ >>> let Kleisli f = stripExtension ".md" in f "/tmp/foo.hs"--- Nothing------ >>> let Kleisli f = stripExtension ".gz" in f "/tmp/foo.tar.gz"--- Just "/tmp/foo.tar"-stripExtension :: String -> FilePatherMaybeA FilePath-stripExtension s = Kleisli (FP.stripExtension s)-{-# INLINE stripExtension #-}---- | Split a file path into directory and file components (Posix).------ >>> run splitFileName "/tmp/foo.hs"--- ("/tmp/","foo.hs")------ >>> run splitFileName "/tmp/"--- ("/tmp/","")------ >>> run splitFileName "foo.hs"--- ("./","foo.hs")-splitFileName :: FilePatherA' (String, String)-splitFileName = mkKleisli' FP.splitFileName-{-# INLINE splitFileName #-}---- | Get the file name component of a file path (Posix).------ >>> run takeFileName "/tmp/foo.hs"--- "foo.hs"------ >>> run takeFileName "/tmp/"--- ""------ >>> run takeFileName "foo.hs"--- "foo.hs"-takeFileName :: FilePatherA' FilePath-takeFileName = mkKleisli' FP.takeFileName-{-# INLINE takeFileName #-}---- | Replace the file name component of a file path (Posix).------ >>> run (replaceFileName "bar.md") "/tmp/foo.hs"--- "/tmp/bar.md"------ >>> run (replaceFileName "baz") "/tmp/foo.hs"--- "/tmp/baz"-replaceFileName :: String -> FilePatherA' FilePath-replaceFileName s = mkKleisli' (`FP.replaceFileName` s)-{-# INLINE replaceFileName #-}---- | Drop the file name component of a file path (Posix).------ >>> run dropFileName "/tmp/foo.hs"--- "/tmp/"------ >>> run dropFileName "foo.hs"--- "./"-dropFileName :: FilePatherA' FilePath-dropFileName = mkKleisli' FP.dropFileName-{-# INLINE dropFileName #-}---- | Get the base name (file name without extension) of a file path (Posix).------ >>> run takeBaseName "/tmp/foo.hs"--- "foo"------ >>> run takeBaseName "/tmp/foo.tar.gz"--- "foo.tar"------ >>> run takeBaseName "/tmp/"--- ""-takeBaseName :: FilePatherA' String-takeBaseName = mkKleisli' FP.takeBaseName-{-# INLINE takeBaseName #-}---- | Replace the base name of a file path (Posix).------ >>> run (replaceBaseName "bar") "/tmp/foo.hs"--- "/tmp/bar.hs"------ >>> run (replaceBaseName "quux") "/tmp/foo.tar.gz"--- "/tmp/quux.gz"-replaceBaseName :: String -> FilePatherA' FilePath-replaceBaseName s = mkKleisli' (`FP.replaceBaseName` s)-{-# INLINE replaceBaseName #-}---- | Get the directory component of a file path (Posix).------ >>> run takeDirectory "/tmp/foo.hs"--- "/tmp"------ >>> run takeDirectory "/tmp/"--- "/tmp"------ >>> run takeDirectory "foo.hs"--- "."-takeDirectory :: FilePatherA' FilePath-takeDirectory = mkKleisli' FP.takeDirectory-{-# INLINE takeDirectory #-}---- | Replace the directory component of a file path (Posix).------ >>> run (replaceDirectory "/usr") "/tmp/foo.hs"--- "/usr/foo.hs"------ >>> run (replaceDirectory "src") "/tmp/foo.hs"--- "src/foo.hs"-replaceDirectory :: String -> FilePatherA' FilePath-replaceDirectory s = mkKleisli' (`FP.replaceDirectory` s)-{-# INLINE replaceDirectory #-}---- | Combine a directory path with a file path (Posix).------ >>> run (combine "/tmp") "foo.hs"--- "/tmp/foo.hs"------ >>> run (combine "/tmp") "/usr/foo.hs"--- "/usr/foo.hs"------ >>> run (combine "src") "Data/Foo.hs"--- "src/Data/Foo.hs"-combine :: FilePath -> FilePatherA' FilePath-combine s = mkKleisli' (FP.combine s)-{-# INLINE combine #-}---- | Split a file path into its path components (Posix).------ >>> run splitPath "/tmp/src/foo.hs"--- ["/","tmp/","src/","foo.hs"]------ >>> run splitPath "src/foo.hs"--- ["src/","foo.hs"]-splitPath :: FilePatherA' [FilePath]-splitPath = mkKleisli' FP.splitPath-{-# INLINE splitPath #-}---- | Split a file path into its directory components (Posix).------ >>> run splitDirectories "/tmp/src/foo.hs"--- ["/","tmp","src","foo.hs"]------ >>> run splitDirectories "/"--- ["/"]-splitDirectories :: FilePatherA' [FilePath]-splitDirectories = mkKleisli' FP.splitDirectories-{-# INLINE splitDirectories #-}---- | Split a file path into drive and remainder (Posix).------ >>> run splitDrive "/tmp/foo"--- ("/","tmp/foo")------ >>> run splitDrive "tmp/foo"--- ("","tmp/foo")-splitDrive :: FilePatherA' (FilePath, FilePath)-splitDrive = mkKleisli' FP.splitDrive-{-# INLINE splitDrive #-}---- | Join a drive and the rest of a path (Posix).------ >>> run (joinDrive "/") "tmp/foo"--- "/tmp/foo"------ >>> run (joinDrive "") "tmp/foo"--- "tmp/foo"-joinDrive :: FilePath -> FilePatherA' FilePath-joinDrive s = mkKleisli' (FP.joinDrive s)-{-# INLINE joinDrive #-}---- | Get the drive of a file path (Posix).------ >>> run takeDrive "/tmp/foo"--- "/"------ >>> run takeDrive "tmp/foo"--- ""-takeDrive :: FilePatherA' FilePath-takeDrive = mkKleisli' FP.takeDrive-{-# INLINE takeDrive #-}---- | Does the file path have a drive? (Posix)------ >>> run hasDrive "/tmp/foo"--- True------ >>> run hasDrive "tmp/foo"--- False-hasDrive :: FilePatherA' Bool-hasDrive = mkKleisli' FP.hasDrive-{-# INLINE hasDrive #-}---- | Drop the drive from a file path (Posix).------ >>> run dropDrive "/tmp/foo"--- "tmp/foo"------ >>> run dropDrive "tmp/foo"--- "tmp/foo"-dropDrive :: FilePatherA' FilePath-dropDrive = mkKleisli' FP.dropDrive-{-# INLINE dropDrive #-}---- | Is the file path a drive? (Posix)------ >>> run isDrive "/"--- True------ >>> run isDrive "/tmp"--- False-isDrive :: FilePatherA' Bool-isDrive = mkKleisli' FP.isDrive-{-# INLINE isDrive #-}---- | Does the file path have a trailing path separator? (Posix)------ >>> run hasTrailingPathSeparator "/tmp/"--- True------ >>> run hasTrailingPathSeparator "/tmp"--- False-hasTrailingPathSeparator :: FilePatherA' Bool-hasTrailingPathSeparator = mkKleisli' FP.hasTrailingPathSeparator-{-# INLINE hasTrailingPathSeparator #-}---- | Add a trailing path separator if one is not present (Posix).------ >>> run addTrailingPathSeparator "/tmp"--- "/tmp/"------ >>> run addTrailingPathSeparator "/tmp/"--- "/tmp/"-addTrailingPathSeparator :: FilePatherA' FilePath-addTrailingPathSeparator = mkKleisli' FP.addTrailingPathSeparator-{-# INLINE addTrailingPathSeparator #-}---- | Drop the trailing path separator if present (Posix).------ >>> run dropTrailingPathSeparator "/tmp/"--- "/tmp"------ >>> run dropTrailingPathSeparator "/tmp"--- "/tmp"------ >>> run dropTrailingPathSeparator "/"--- "/"-dropTrailingPathSeparator :: FilePatherA' FilePath-dropTrailingPathSeparator = mkKleisli' FP.dropTrailingPathSeparator-{-# INLINE dropTrailingPathSeparator #-}---- | Normalise a file path (Posix).------ >>> run normalise "/tmp//foo"--- "/tmp/foo"------ >>> run normalise "/tmp/./foo"--- "/tmp/foo"-normalise :: FilePatherA' FilePath-normalise = mkKleisli' FP.normalise-{-# INLINE normalise #-}---- | Make a file path relative to a given directory (Posix).------ >>> run (makeRelative "/tmp") "/tmp/foo.hs"--- "foo.hs"------ >>> run (makeRelative "/tmp") "/tmp/src/foo.hs"--- "src/foo.hs"------ >>> run (makeRelative "/usr") "/tmp/foo.hs"--- "/tmp/foo.hs"-makeRelative :: FilePath -> FilePatherA' FilePath-makeRelative s = mkKleisli' (FP.makeRelative s)-{-# INLINE makeRelative #-}---- | Are two file paths equal? (Posix, accounting for normalisation)------ >>> run (equalFilePath "/tmp/foo") "/tmp/foo"--- True------ >>> run (equalFilePath "/tmp/foo") "/tmp/bar"--- False------ >>> run (equalFilePath "/tmp/foo") "/tmp/./foo"--- True-equalFilePath :: FilePath -> FilePatherA' Bool-equalFilePath s = mkKleisli' (FP.equalFilePath s)-{-# INLINE equalFilePath #-}---- | Is the file path relative? (Posix)------ >>> run isRelative "foo/bar"--- True------ >>> run isRelative "/foo/bar"--- False-isRelative :: FilePatherA' Bool-isRelative = mkKleisli' FP.isRelative-{-# INLINE isRelative #-}---- | Is the file path absolute? (Posix)------ >>> run isAbsolute "/foo/bar"--- True------ >>> run isAbsolute "foo/bar"--- False-isAbsolute :: FilePatherA' Bool-isAbsolute = mkKleisli' FP.isAbsolute-{-# INLINE isAbsolute #-}---- | Is the file path valid? (Posix)------ >>> run isValid "/tmp/foo"--- True------ >>> run isValid ""--- False-isValid :: FilePatherA' Bool-isValid = mkKleisli' FP.isValid-{-# INLINE isValid #-}---- | Make a file path valid (Posix).------ >>> run makeValid ""--- "_"------ >>> run makeValid "/tmp/foo"--- "/tmp/foo"-makeValid :: FilePatherA' FilePath-makeValid = mkKleisli' FP.makeValid-{-# INLINE makeValid #-}---- | Combine two file paths (Posix). Synonym for 'combine'.------ >>> run (combine "/tmp") "foo.hs"--- "/tmp/foo.hs"------ >>> run (combine "src") "Data/Foo.hs"--- "src/Data/Foo.hs"-(</>) :: FilePath -> FilePatherA' FilePath-(</>) = combine-{-# INLINE (</>) #-}---- | Add an extension (Posix). Synonym for 'addExtension'.------ >>> run (addExtension ".hs") "/tmp/foo"--- "/tmp/foo.hs"------ >>> run (addExtension ".gz") "/tmp/foo.tar"--- "/tmp/foo.tar.gz"-(<.>) :: String -> FilePatherA' FilePath-(<.>) = addExtension-{-# INLINE (<.>) #-}---- | Replace the extension (Posix). Synonym for 'replaceExtension'.------ >>> run (replaceExtension ".md") "/tmp/foo.hs"--- "/tmp/foo.md"------ >>> run (replaceExtension ".txt") "/tmp/foo"--- "/tmp/foo.txt"-(-<.>) :: String -> FilePatherA' FilePath-(-<.>) = replaceExtension-{-# INLINE (-<.>) #-}

@@ -1,616 +0,0 @@-{-# OPTIONS_GHC -Wall #-}---- |--- Module      : System.FilePather.FilePather.Windows--- Description : Windows FilePath operations via Kleisli type aliases-module System.FilePather.FilePather.Windows-  ( -- * Types-    FilePather,-    FilePather',-    FilePatherA,-    FilePatherA',-    FilePatherMaybe,-    FilePatherMaybeA,-    FilePatherIO,-    FilePatherIOA,--    -- * System.FilePath.Windows re-implementations-    splitExtension,-    takeExtension,-    replaceExtension,-    dropExtension,-    addExtension,-    hasExtension,-    splitExtensions,-    takeExtensions,-    dropExtensions,-    replaceExtensions,-    isExtensionOf,-    stripExtension,-    splitFileName,-    takeFileName,-    replaceFileName,-    dropFileName,-    takeBaseName,-    replaceBaseName,-    takeDirectory,-    replaceDirectory,-    combine,-    splitPath,-    FP.joinPath,-    splitDirectories,-    splitDrive,-    joinDrive,-    takeDrive,-    hasDrive,-    dropDrive,-    isDrive,-    hasTrailingPathSeparator,-    addTrailingPathSeparator,-    dropTrailingPathSeparator,-    normalise,-    makeRelative,-    equalFilePath,-    isRelative,-    isAbsolute,-    isValid,-    makeValid,-    (</>),-    (<.>),-    (-<.>),--    -- * System.FilePath.Windows re-exports-    FP.FilePath,-    FP.pathSeparator,-    FP.pathSeparators,-    FP.isPathSeparator,-    FP.searchPathSeparator,-    FP.isSearchPathSeparator,-    FP.extSeparator,-    FP.isExtSeparator,-    FP.splitSearchPath,-    FP.getSearchPath,-  )-where--import Data.Functor.Identity (Identity)-import Data.Kleisli (Kleisli (..), mkKleisli')-import qualified System.FilePath.Windows as FP---- $setup--- >>> import Data.Functor.Identity (Identity(..))--- >>> import Data.Kleisli (Kleisli(..))--- >>> let run (Kleisli f) x = runIdentity (f x)--type FilePather p f a = Kleisli p FilePath f a--type FilePather' p a = FilePather p Identity a--type FilePatherA f a = FilePather (->) f a--type FilePatherA' a = FilePatherA Identity a--type FilePatherMaybe p a = FilePather p Maybe a--type FilePatherMaybeA a = FilePatherMaybe (->) a--type FilePatherIO p a = FilePather p IO a--type FilePatherIOA a = FilePatherIO (->) a---- | Split a file path into the stem and extension (Windows).------ >>> run splitExtension "C:\\tmp\\foo.hs"--- ("C:\\tmp\\foo",".hs")------ >>> run splitExtension "C:\\tmp\\foo"--- ("C:\\tmp\\foo","")------ >>> run splitExtension "C:\\tmp\\foo.tar.gz"--- ("C:\\tmp\\foo.tar",".gz")-splitExtension :: FilePatherA' (String, String)-splitExtension = mkKleisli' FP.splitExtension-{-# INLINE splitExtension #-}---- | Get the extension of a file path (Windows).------ >>> run takeExtension "C:\\tmp\\foo.hs"--- ".hs"------ >>> run takeExtension "C:\\tmp\\foo"--- ""------ >>> run takeExtension "C:\\tmp\\foo.tar.gz"--- ".gz"-takeExtension :: FilePatherA' String-takeExtension = mkKleisli' FP.takeExtension-{-# INLINE takeExtension #-}---- | Replace the extension of a file path (Windows).------ >>> run (replaceExtension ".md") "C:\\tmp\\foo.hs"--- "C:\\tmp\\foo.md"------ >>> run (replaceExtension ".txt") "C:\\tmp\\foo"--- "C:\\tmp\\foo.txt"------ >>> run (replaceExtension "") "C:\\tmp\\foo.hs"--- "C:\\tmp\\foo"-replaceExtension :: String -> FilePatherA' FilePath-replaceExtension s = mkKleisli' (`FP.replaceExtension` s)-{-# INLINE replaceExtension #-}---- | Remove the extension from a file path (Windows).------ >>> run dropExtension "C:\\tmp\\foo.hs"--- "C:\\tmp\\foo"------ >>> run dropExtension "C:\\tmp\\foo"--- "C:\\tmp\\foo"-dropExtension :: FilePatherA' FilePath-dropExtension = mkKleisli' FP.dropExtension-{-# INLINE dropExtension #-}---- | Add an extension to a file path (Windows).------ >>> run (addExtension ".hs") "C:\\tmp\\foo"--- "C:\\tmp\\foo.hs"------ >>> run (addExtension ".gz") "C:\\tmp\\foo.tar"--- "C:\\tmp\\foo.tar.gz"------ >>> run (addExtension "hs") "C:\\tmp\\foo"--- "C:\\tmp\\foo.hs"-addExtension :: String -> FilePatherA' FilePath-addExtension s = mkKleisli' (`FP.addExtension` s)-{-# INLINE addExtension #-}---- | Does the file path have an extension? (Windows)------ >>> run hasExtension "C:\\tmp\\foo.hs"--- True------ >>> run hasExtension "C:\\tmp\\foo"--- False-hasExtension :: FilePatherA' Bool-hasExtension = mkKleisli' FP.hasExtension-{-# INLINE hasExtension #-}---- | Split all extensions from a file path (Windows).------ >>> run splitExtensions "C:\\tmp\\foo.tar.gz"--- ("C:\\tmp\\foo",".tar.gz")------ >>> run splitExtensions "C:\\tmp\\foo"--- ("C:\\tmp\\foo","")-splitExtensions :: FilePatherA' (FilePath, String)-splitExtensions = mkKleisli' FP.splitExtensions-{-# INLINE splitExtensions #-}---- | Get all extensions from a file path (Windows).------ >>> run takeExtensions "C:\\tmp\\foo.tar.gz"--- ".tar.gz"------ >>> run takeExtensions "C:\\tmp\\foo"--- ""-takeExtensions :: FilePatherA' String-takeExtensions = mkKleisli' FP.takeExtensions-{-# INLINE takeExtensions #-}---- | Drop all extensions from a file path (Windows).------ >>> run dropExtensions "C:\\tmp\\foo.tar.gz"--- "C:\\tmp\\foo"------ >>> run dropExtensions "C:\\tmp\\foo"--- "C:\\tmp\\foo"-dropExtensions :: FilePatherA' FilePath-dropExtensions = mkKleisli' FP.dropExtensions-{-# INLINE dropExtensions #-}---- | Replace all extensions of a file path (Windows).------ >>> run (replaceExtensions ".txt") "C:\\tmp\\foo.tar.gz"--- "C:\\tmp\\foo.txt"------ >>> run (replaceExtensions ".a.b") "C:\\tmp\\foo.c"--- "C:\\tmp\\foo.a.b"-replaceExtensions :: String -> FilePatherA' FilePath-replaceExtensions s = mkKleisli' (`FP.replaceExtensions` s)-{-# INLINE replaceExtensions #-}---- | Is the given string an extension of the file path? (Windows)------ >>> run (isExtensionOf ".hs") "C:\\tmp\\foo.hs"--- True------ >>> run (isExtensionOf ".md") "C:\\tmp\\foo.hs"--- False------ >>> run (isExtensionOf "hs") "C:\\tmp\\foo.hs"--- True-isExtensionOf :: String -> FilePatherA' Bool-isExtensionOf s = mkKleisli' (FP.isExtensionOf s)-{-# INLINE isExtensionOf #-}---- | Strip an extension from a file path (Windows), returning 'Nothing' if--- it does not match.------ >>> let Kleisli f = stripExtension ".hs" in f "C:\\tmp\\foo.hs"--- Just "C:\\tmp\\foo"------ >>> let Kleisli f = stripExtension ".md" in f "C:\\tmp\\foo.hs"--- Nothing------ >>> let Kleisli f = stripExtension ".gz" in f "C:\\tmp\\foo.tar.gz"--- Just "C:\\tmp\\foo.tar"-stripExtension :: String -> FilePatherMaybeA FilePath-stripExtension s = Kleisli (FP.stripExtension s)-{-# INLINE stripExtension #-}---- | Split a file path into directory and file components (Windows).------ >>> run splitFileName "C:\\tmp\\foo.hs"--- ("C:\\tmp\\","foo.hs")------ >>> run splitFileName "C:\\tmp\\"--- ("C:\\tmp\\","")------ >>> run splitFileName "foo.hs"--- ("./","foo.hs")-splitFileName :: FilePatherA' (String, String)-splitFileName = mkKleisli' FP.splitFileName-{-# INLINE splitFileName #-}---- | Get the file name component of a file path (Windows).------ >>> run takeFileName "C:\\tmp\\foo.hs"--- "foo.hs"------ >>> run takeFileName "C:\\tmp\\"--- ""------ >>> run takeFileName "foo.hs"--- "foo.hs"-takeFileName :: FilePatherA' FilePath-takeFileName = mkKleisli' FP.takeFileName-{-# INLINE takeFileName #-}---- | Replace the file name component of a file path (Windows).------ >>> run (replaceFileName "bar.md") "C:\\tmp\\foo.hs"--- "C:\\tmp\\bar.md"------ >>> run (replaceFileName "baz") "C:\\tmp\\foo.hs"--- "C:\\tmp\\baz"-replaceFileName :: String -> FilePatherA' FilePath-replaceFileName s = mkKleisli' (`FP.replaceFileName` s)-{-# INLINE replaceFileName #-}---- | Drop the file name component of a file path (Windows).------ >>> run dropFileName "C:\\tmp\\foo.hs"--- "C:\\tmp\\"------ >>> run dropFileName "foo.hs"--- "./"-dropFileName :: FilePatherA' FilePath-dropFileName = mkKleisli' FP.dropFileName-{-# INLINE dropFileName #-}---- | Get the base name (file name without extension) of a file path (Windows).------ >>> run takeBaseName "C:\\tmp\\foo.hs"--- "foo"------ >>> run takeBaseName "C:\\tmp\\foo.tar.gz"--- "foo.tar"------ >>> run takeBaseName "C:\\tmp\\"--- ""-takeBaseName :: FilePatherA' String-takeBaseName = mkKleisli' FP.takeBaseName-{-# INLINE takeBaseName #-}---- | Replace the base name of a file path (Windows).------ >>> run (replaceBaseName "bar") "C:\\tmp\\foo.hs"--- "C:\\tmp\\bar.hs"------ >>> run (replaceBaseName "quux") "C:\\tmp\\foo.tar.gz"--- "C:\\tmp\\quux.gz"-replaceBaseName :: String -> FilePatherA' FilePath-replaceBaseName s = mkKleisli' (`FP.replaceBaseName` s)-{-# INLINE replaceBaseName #-}---- | Get the directory component of a file path (Windows).------ >>> run takeDirectory "C:\\tmp\\foo.hs"--- "C:\\tmp"------ >>> run takeDirectory "C:\\tmp\\"--- "C:\\tmp"------ >>> run takeDirectory "foo.hs"--- "."-takeDirectory :: FilePatherA' FilePath-takeDirectory = mkKleisli' FP.takeDirectory-{-# INLINE takeDirectory #-}---- | Replace the directory component of a file path (Windows).------ >>> run (replaceDirectory "D:\\usr") "C:\\tmp\\foo.hs"--- "D:\\usr\\foo.hs"------ >>> run (replaceDirectory "src") "C:\\tmp\\foo.hs"--- "src\\foo.hs"-replaceDirectory :: String -> FilePatherA' FilePath-replaceDirectory s = mkKleisli' (`FP.replaceDirectory` s)-{-# INLINE replaceDirectory #-}---- | Combine a directory path with a file path (Windows).------ >>> run (combine "C:\\tmp") "foo.hs"--- "C:\\tmp\\foo.hs"------ >>> run (combine "C:\\tmp") "D:\\usr\\foo.hs"--- "D:\\usr\\foo.hs"------ >>> run (combine "src") "Data\\Foo.hs"--- "src\\Data\\Foo.hs"-combine :: FilePath -> FilePatherA' FilePath-combine s = mkKleisli' (FP.combine s)-{-# INLINE combine #-}---- | Split a file path into its path components (Windows).------ >>> run splitPath "C:\\tmp\\src\\foo.hs"--- ["C:\\","tmp\\","src\\","foo.hs"]------ >>> run splitPath "src\\foo.hs"--- ["src\\","foo.hs"]-splitPath :: FilePatherA' [FilePath]-splitPath = mkKleisli' FP.splitPath-{-# INLINE splitPath #-}---- | Split a file path into its directory components (Windows).------ >>> run splitDirectories "C:\\tmp\\src\\foo.hs"--- ["C:\\","tmp","src","foo.hs"]------ >>> run splitDirectories "C:\\"--- ["C:\\"]-splitDirectories :: FilePatherA' [FilePath]-splitDirectories = mkKleisli' FP.splitDirectories-{-# INLINE splitDirectories #-}---- | Split a file path into drive and remainder (Windows).------ >>> run splitDrive "C:\\tmp\\foo"--- ("C:\\","tmp\\foo")------ >>> run splitDrive "tmp\\foo"--- ("","tmp\\foo")-splitDrive :: FilePatherA' (FilePath, FilePath)-splitDrive = mkKleisli' FP.splitDrive-{-# INLINE splitDrive #-}---- | Join a drive and the rest of a path (Windows).------ >>> run (joinDrive "C:\\") "tmp\\foo"--- "C:\\tmp\\foo"------ >>> run (joinDrive "") "tmp\\foo"--- "tmp\\foo"-joinDrive :: FilePath -> FilePatherA' FilePath-joinDrive s = mkKleisli' (FP.joinDrive s)-{-# INLINE joinDrive #-}---- | Get the drive of a file path (Windows).------ >>> run takeDrive "C:\\tmp\\foo"--- "C:\\"------ >>> run takeDrive "tmp\\foo"--- ""-takeDrive :: FilePatherA' FilePath-takeDrive = mkKleisli' FP.takeDrive-{-# INLINE takeDrive #-}---- | Does the file path have a drive? (Windows)------ >>> run hasDrive "C:\\tmp\\foo"--- True------ >>> run hasDrive "tmp\\foo"--- False-hasDrive :: FilePatherA' Bool-hasDrive = mkKleisli' FP.hasDrive-{-# INLINE hasDrive #-}---- | Drop the drive from a file path (Windows).------ >>> run dropDrive "C:\\tmp\\foo"--- "tmp\\foo"------ >>> run dropDrive "tmp\\foo"--- "tmp\\foo"-dropDrive :: FilePatherA' FilePath-dropDrive = mkKleisli' FP.dropDrive-{-# INLINE dropDrive #-}---- | Is the file path a drive? (Windows)------ >>> run isDrive "C:\\"--- True------ >>> run isDrive "C:\\tmp"--- False-isDrive :: FilePatherA' Bool-isDrive = mkKleisli' FP.isDrive-{-# INLINE isDrive #-}---- | Does the file path have a trailing path separator? (Windows)------ >>> run hasTrailingPathSeparator "C:\\tmp\\"--- True------ >>> run hasTrailingPathSeparator "C:\\tmp"--- False-hasTrailingPathSeparator :: FilePatherA' Bool-hasTrailingPathSeparator = mkKleisli' FP.hasTrailingPathSeparator-{-# INLINE hasTrailingPathSeparator #-}---- | Add a trailing path separator if one is not present (Windows).------ >>> run addTrailingPathSeparator "C:\\tmp"--- "C:\\tmp\\"------ >>> run addTrailingPathSeparator "C:\\tmp\\"--- "C:\\tmp\\"-addTrailingPathSeparator :: FilePatherA' FilePath-addTrailingPathSeparator = mkKleisli' FP.addTrailingPathSeparator-{-# INLINE addTrailingPathSeparator #-}---- | Drop the trailing path separator if present (Windows).------ >>> run dropTrailingPathSeparator "C:\\tmp\\"--- "C:\\tmp"------ >>> run dropTrailingPathSeparator "C:\\tmp"--- "C:\\tmp"------ >>> run dropTrailingPathSeparator "C:\\"--- "C:\\"-dropTrailingPathSeparator :: FilePatherA' FilePath-dropTrailingPathSeparator = mkKleisli' FP.dropTrailingPathSeparator-{-# INLINE dropTrailingPathSeparator #-}---- | Normalise a file path (Windows).------ >>> run normalise "C:\\tmp\\\\foo"--- "C:\\tmp\\foo"------ >>> run normalise "C:\\tmp\\.\\foo"--- "C:\\tmp\\foo"------ >>> run normalise "C:/tmp/foo"--- "C:\\tmp\\foo"-normalise :: FilePatherA' FilePath-normalise = mkKleisli' FP.normalise-{-# INLINE normalise #-}---- | Make a file path relative to a given directory (Windows).------ >>> run (makeRelative "C:\\tmp") "C:\\tmp\\foo.hs"--- "foo.hs"------ >>> run (makeRelative "C:\\tmp") "C:\\tmp\\src\\foo.hs"--- "src\\foo.hs"------ >>> run (makeRelative "C:\\usr") "D:\\tmp\\foo.hs"--- "D:\\tmp\\foo.hs"-makeRelative :: FilePath -> FilePatherA' FilePath-makeRelative s = mkKleisli' (FP.makeRelative s)-{-# INLINE makeRelative #-}---- | Are two file paths equal? (Windows, case-insensitive)------ >>> run (equalFilePath "C:\\tmp\\foo") "C:\\tmp\\foo"--- True------ >>> run (equalFilePath "C:\\tmp\\foo") "C:\\TMP\\FOO"--- True------ >>> run (equalFilePath "C:\\tmp\\foo") "C:\\tmp\\bar"--- False-equalFilePath :: FilePath -> FilePatherA' Bool-equalFilePath s = mkKleisli' (FP.equalFilePath s)-{-# INLINE equalFilePath #-}---- | Is the file path relative? (Windows)------ >>> run isRelative "foo\\bar"--- True------ >>> run isRelative "C:\\foo\\bar"--- False------ >>> run isRelative ".\\foo"--- True-isRelative :: FilePatherA' Bool-isRelative = mkKleisli' FP.isRelative-{-# INLINE isRelative #-}---- | Is the file path absolute? (Windows)------ >>> run isAbsolute "C:\\foo\\bar"--- True------ >>> run isAbsolute "foo\\bar"--- False------ >>> run isAbsolute "\\\\server\\share"--- True-isAbsolute :: FilePatherA' Bool-isAbsolute = mkKleisli' FP.isAbsolute-{-# INLINE isAbsolute #-}---- | Is the file path valid? (Windows)------ >>> run isValid "C:\\tmp\\foo"--- True------ >>> run isValid ""--- False------ >>> run isValid "C:\\tmp\\f?oo"--- False-isValid :: FilePatherA' Bool-isValid = mkKleisli' FP.isValid-{-# INLINE isValid #-}---- | Make a file path valid (Windows).------ >>> run makeValid ""--- "_"------ >>> run makeValid "C:\\tmp\\foo"--- "C:\\tmp\\foo"-makeValid :: FilePatherA' FilePath-makeValid = mkKleisli' FP.makeValid-{-# INLINE makeValid #-}---- | Combine two file paths (Windows). Synonym for 'combine'.------ >>> run (combine "C:\\tmp") "foo.hs"--- "C:\\tmp\\foo.hs"------ >>> run (combine "src") "Data\\Foo.hs"--- "src\\Data\\Foo.hs"-(</>) :: FilePath -> FilePatherA' FilePath-(</>) = combine-{-# INLINE (</>) #-}---- | Add an extension (Windows). Synonym for 'addExtension'.------ >>> run (addExtension ".hs") "C:\\tmp\\foo"--- "C:\\tmp\\foo.hs"------ >>> run (addExtension ".gz") "C:\\tmp\\foo.tar"--- "C:\\tmp\\foo.tar.gz"-(<.>) :: String -> FilePatherA' FilePath-(<.>) = addExtension-{-# INLINE (<.>) #-}---- | Replace the extension (Windows). Synonym for 'replaceExtension'.------ >>> run (replaceExtension ".md") "C:\\tmp\\foo.hs"--- "C:\\tmp\\foo.md"------ >>> run (replaceExtension ".txt") "C:\\tmp\\foo"--- "C:\\tmp\\foo.txt"-(-<.>) :: String -> FilePatherA' FilePath-(-<.>) = replaceExtension-{-# INLINE (-<.>) #-}

@@ -0,0 +1,596 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+-- Required for the MonadState, MonadWriter and MonadError instances: the+-- functional dependency of each class (for example, m -> s) is not covered by+-- the instance head MonadState s (Tracked f), because s does not occur in+-- Tracked f.+-- Terminates: each instance context is the same class at f, which is a strict+-- subterm of the instance head Tracked f, so resolution moves to a smaller+-- type at each step.+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++{- | Named build steps that record the files they make, so that a chain of+build steps that would go round in a cycle is stopped before it does.++@+newtype Tracked f a =+  Tracked (FilePather (ReaderT Trail (ExceptT Cycle f)) (Outputs, a))+@++A 'Tracked' value is run on a file path, with the 'Trail' of that file: the+steps that built it. It produces its result, and the files it made, each with+the 'Step' that made it. Make one from a 'FilePather' with 'step', which+names the step and checks it against the trail before it runs, or 'step'',+which checks after it runs, for steps whose outputs are known only then.++'Tracked' is separate from 'FilePather', so that 'FilePather' keeps all of+its instances: tracking adds a result to the function, so 'Tracked' has no+'Data.Distributive.Distributive' or 'Data.Functor.Rep.Representable'+instance, and its 'Alt', 'Alternative', 'Semigroup' and 'MonadError'+instances are written so that a 'Cycle' is never caught or discarded.+-}+module System.FilePather.Tracked (+  -- * Types+  Outputs,+  Tracked (..),+  Tracked',++  -- * Steps+  step,+  stepWith,+  step',+  stepWith',+  untracked,++  -- * Combinators+  askTrail,+  onPath,+  whenPath,+  whenTrail,+  hoistTracked,++  -- * Optics+  trackedFunction,+  GetTracked (..),+  HasTracked (..),+  ReviewTracked (..),+  AsTracked (..),++  -- * Fusion workers+  mapTracked,+  mapMaybeTracked,+) where++import Control.Applicative (Alternative (..))+import Control.DeepSeq (NFData)+import Control.Lens (Getter, Iso, Lens', Prism', Review, Rewrapped, Wrapped (..), from, iso, lens, over, prism', review, unto, view, _Wrapped)+import Control.Monad (MonadPlus)+import Control.Monad.Error.Class (MonadError (..))+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Reader (ReaderT (..))+import Control.Monad.Reader.Class (MonadReader (..))+import Control.Monad.State.Class (MonadState (..))+import Control.Monad.Trans.Class (MonadTrans (..))+import Control.Monad.Trans.Except (ExceptT (..), runExceptT)+import Control.Monad.Writer.Class (MonadWriter (..))+import Control.Selective (Selective (..), selectM)+import Data.Bifunctor (first)+import Data.Bool (bool)+import Data.Functor.Alt (Alt (..))+import Data.Functor.Apply (Apply (..))+import Data.Functor.Bind (Bind (..))+import Data.Functor.Contravariant (Contravariant (..))+import Data.Functor.Identity (Identity)+import Data.Functor.Plus (Plus (..))+import Data.Kind (Type)+import GHC.Generics (Generic)+import System.FilePather.FilePather (FilePather (..))+import System.FilePather.Trail (Cycle, Repetition (..), Step (..), Trail, checkStep)+import Witherable (Filterable (..))++{- $setup+>>> import Control.Lens (view)+>>> import Control.Monad.Reader (asks)+>>> import Data.Functor.Identity (Identity (..))+>>> import System.FilePath (replaceExtension)+>>> import System.FilePather.Trail+>>> let run x t p = runIdentity (view trackedFunction x t p)+-}++{- | The files that build steps made, each with the step that made it.++@since 0.7.0.0+-}+type Outputs = [(FilePath, Step)]++{- | A build step, or several, that records the files it makes.++==== __Examples__++>>> let pdf = step "markdown to pdf" (\p -> [replaceExtension p "pdf"]) (asks length) :: Tracked Identity Int+>>> run pdf (Trail []) "src/a.md"+Right ([("src/a.pdf",Step "markdown to pdf" "src/a.md")],8)++>>> run pdf (Trail [Step "markdown to pdf" "src/b.md"]) "src/a.md"+Left (RepeatsStep (Step "markdown to pdf" "src/a.md") (Trail [Step "markdown to pdf" "src/b.md"]))++@since 0.7.0.0+-}+type Tracked :: (Type -> Type) -> Type -> Type+newtype Tracked f a+  = Tracked (FilePather (ReaderT Trail (ExceptT Cycle f)) (Outputs, a))+  deriving stock (Generic)+  deriving newtype (NFData)++{- | A 'Tracked' value without effects.++@since 0.7.0.0+-}+type Tracked' a = Tracked Identity a++{- | The isomorphism between a 'Tracked' value and the function it is: from+the trail of a file and its path, to the result and the files it made, or the+'Cycle' that stopped it.++>>> run (pure 'x') (Trail []) "a.md"+Right ([],'x')++@since 0.7.0.0+-}+trackedFunction :: Iso (Tracked f a) (Tracked g b) (Trail -> FilePath -> f (Either Cycle (Outputs, a))) (Trail -> FilePath -> g (Either Cycle (Outputs, b)))+trackedFunction =+  iso+    (\(Tracked (FilePather k)) t p -> runExceptT (runReaderT (k p) t))+    (\h -> Tracked (FilePather (\p -> ReaderT (ExceptT . (`h` p)))))+{-# INLINE trackedFunction #-}++-- | Make a 'Tracked' value from its function.+tracked :: (Trail -> FilePath -> f (Either Cycle (Outputs, a))) -> Tracked f a+tracked =+  view (from trackedFunction)+{-# INLINE tracked #-}++-- | Run a 'Tracked' value as its function.+runTracked :: Tracked f a -> Trail -> FilePath -> f (Either Cycle (Outputs, a))+runTracked =+  view trackedFunction+{-# INLINE runTracked #-}++-- | Bind for 'Tracked': the outputs of both are kept, and a 'Cycle' stops.+bindTracked :: (Monad f) => Tracked f a -> (a -> Tracked f b) -> Tracked f b+bindTracked m k =+  tracked $ \t p ->+    runTracked m t p+      >>= either+        (pure . Left)+        (\(os, a) -> fmap (fmap (first (os <>))) (runTracked (k a) t p))+{-# INLINE bindTracked #-}++{- | Map over the result of a 'Tracked' value. This is 'fmap', and is the+function that the fusion rules match.++>>> run (mapTracked (+ 1) (pure 1)) (Trail []) "a.md"+Right ([],2)++@since 0.7.0.0+-}+mapTracked :: (Functor f) => (a -> b) -> Tracked f a -> Tracked f b+mapTracked g =+  over trackedFunction (\h t p -> fmap (fmap (fmap g)) (h t p))+{-# NOINLINE [1] mapTracked #-}++{- | Filter and map over the result of a 'Tracked' value. This is+'mapMaybe', and is the function that the fusion rules match. A result that is+filtered out is removed in @f@, as 'mapMaybe' of @f@ removes it, with the+files it made. A 'Cycle' is never removed.++@since 0.7.0.0+-}+mapMaybeTracked :: (Filterable f) => (a -> Maybe b) -> Tracked f a -> Tracked f b+mapMaybeTracked g =+  over trackedFunction (\h t p -> mapMaybe (traverse (traverse g)) (h t p))+{-# NOINLINE [1] mapMaybeTracked #-}++{-# RULES+"mapTracked/mapTracked" [~1] forall f g x.+  mapTracked f (mapTracked g x) =+    mapTracked (f . g) x+"mapMaybeTracked/mapMaybeTracked" [~1] forall f g x.+  mapMaybeTracked f (mapMaybeTracked g x) =+    mapMaybeTracked (\a -> g a >>= f) x+"mapMaybeTracked/mapTracked" [~1] forall f g x.+  mapMaybeTracked f (mapTracked g x) =+    mapMaybeTracked (f . g) x+  #-}++-- | @since 0.7.0.0+instance (Functor f) => Functor (Tracked f) where+  fmap =+    mapTracked+  {-# INLINE fmap #-}++{- | Both are run on the same file path, and the outputs of both are kept. A+'Cycle' in the first stops the second from running.++@since 0.7.0.0+-}+instance (Monad f) => Apply (Tracked f) where+  mf <.> mx =+    bindTracked mf (`mapTracked` mx)+  {-# INLINE (<.>) #-}++-- | @since 0.7.0.0+instance (Monad f) => Applicative (Tracked f) where+  pure a =+    tracked (\_ _ -> pure (Right ([], a)))+  {-# INLINE pure #-}+  (<*>) =+    (<.>)+  {-# INLINE (<*>) #-}++-- | @since 0.7.0.0+instance (Monad f) => Bind (Tracked f) where+  (>>-) =+    bindTracked+  {-# INLINE (>>-) #-}++-- | @since 0.7.0.0+instance (Monad f) => Monad (Tracked f) where+  (>>=) =+    bindTracked+  {-# INLINE (>>=) #-}++-- | @since 0.7.0.0+instance (Monad f) => Selective (Tracked f) where+  select =+    selectM+  {-# INLINE select #-}++{- | Alternation in @f@: the second is run only if the first fails in @f@. A+'Cycle' is a result in @f@, not a failure, so it is never caught.++@since 0.7.0.0+-}+instance (Alt f) => Alt (Tracked f) where+  x <!> y =+    tracked (\t p -> runTracked x t p <!> runTracked y t p)+  {-# INLINE (<!>) #-}++-- | @since 0.7.0.0+instance (Plus f) => Plus (Tracked f) where+  zero =+    tracked (\_ _ -> zero)+  {-# INLINE zero #-}++{- | As for 'Alt', a 'Cycle' is never caught.++@since 0.7.0.0+-}+instance (Alternative f, Monad f) => Alternative (Tracked f) where+  empty =+    tracked (\_ _ -> empty)+  {-# INLINE empty #-}+  x <|> y =+    tracked (\t p -> runTracked x t p <|> runTracked y t p)+  {-# INLINE (<|>) #-}++-- | @since 0.7.0.0+instance (MonadPlus f) => MonadPlus (Tracked f)++{- | Both are run on the same file path, their results are combined, and the+outputs of both are kept. A 'Cycle' in the first stops the second from+running, and is the result.++@since 0.7.0.0+-}+instance (Monad f, Semigroup a) => Semigroup (Tracked f a) where+  x <> y =+    (<>) <$> x <*> y+  {-# INLINE (<>) #-}++-- | @since 0.7.0.0+instance (Monad f, Monoid a) => Monoid (Tracked f a) where+  mempty =+    pure mempty+  {-# INLINE mempty #-}++-- | @since 0.7.0.0+instance (Filterable f) => Filterable (Tracked f) where+  mapMaybe =+    mapMaybeTracked+  {-# INLINE mapMaybe #-}++{- | An effect of @f@, which makes no files.++@since 0.7.0.0+-}+instance MonadTrans Tracked where+  lift m =+    tracked (\_ _ -> fmap (\a -> Right ([], a)) m)+  {-# INLINE lift #-}++-- | @since 0.7.0.0+instance (MonadIO f) => MonadIO (Tracked f) where+  liftIO =+    lift . liftIO+  {-# INLINE liftIO #-}++-- | @since 0.7.0.0+instance (MonadFail f) => MonadFail (Tracked f) where+  fail =+    lift . fail+  {-# INLINE fail #-}++{- | 'ask' is the file path being operated on, and 'local' runs on another+file path, with the same trail.++@since 0.7.0.0+-}+instance (Monad f) => MonadReader FilePath (Tracked f) where+  ask =+    tracked (\_ p -> pure (Right ([], p)))+  {-# INLINE ask #-}+  local g x =+    tracked (\t -> runTracked x t . g)+  {-# INLINE local #-}++{- | The state of @f@.++@since 0.7.0.0+-}+instance (MonadState s f) => MonadState s (Tracked f) where+  state =+    lift . state+  {-# INLINE state #-}++{- | The errors of @f@. 'catchError' catches the errors of @f@, and never a+'Cycle'.++@since 0.7.0.0+-}+instance (MonadError e f) => MonadError e (Tracked f) where+  throwError =+    lift . throwError+  {-# INLINE throwError #-}+  catchError x h =+    tracked (\t p -> catchError (runTracked x t p) (\e -> runTracked (h e) t p))+  {-# INLINE catchError #-}++{- | The output of @f@, which is separate from the files that steps make.++@since 0.7.0.0+-}+instance (MonadWriter w f) => MonadWriter w (Tracked f) where+  writer =+    lift . writer+  {-# INLINE writer #-}+  tell =+    lift . tell+  {-# INLINE tell #-}+  listen x =+    tracked (\t p -> fmap (\(r, w) -> fmap (fmap (,w)) r) (listen (runTracked x t p)))+  {-# INLINE listen #-}+  pass x =+    tracked $ \t p ->+      pass+        ( fmap+            ( either+                (\c -> (Left c, id))+                (\(os, (a, g)) -> (Right (os, a), g))+            )+            (runTracked x t p)+        )+  {-# INLINE pass #-}++-- | @since 0.7.0.0+instance (Contravariant f) => Contravariant (Tracked f) where+  contramap g =+    over trackedFunction (\h t p -> contramap (fmap (fmap g)) (h t p))+  {-# INLINE contramap #-}++-- | @since 0.7.0.0+instance Wrapped (Tracked f a) where+  type Unwrapped (Tracked f a) = FilePather (ReaderT Trail (ExceptT Cycle f)) (Outputs, a)+  _Wrapped' =+    iso (\(Tracked x) -> x) Tracked+  {-# INLINE _Wrapped' #-}++-- | @since 0.7.0.0+instance (t ~ Tracked g b) => Rewrapped (Tracked f a) t++{- | A named step that makes the files given by a function of its input file,+and may appear 'Once' in a trail. See 'stepWith'.++@since 0.7.0.0+-}+step :: (Applicative f) => String -> (FilePath -> [FilePath]) -> FilePather f a -> Tracked f a+step =+  stepWith Once+{-# INLINE step #-}++{- | A named step that makes the files given by a function of its input file.+The step is checked against the trail of its input file with 'checkStep'+before it runs: if it is stopped, the 'FilePather' is not run.++>>> let page1 = stepWith Once "pdf page 1" (\p -> [p <> ".page1.pdf"]) (pure ()) :: Tracked Identity ()+>>> run page1 (Trail [Step "markdown to pdf" "a.md"]) "a.pdf"+Right ([("a.pdf.page1.pdf",Step "pdf page 1" "a.pdf")],())++>>> run page1 (Trail [Step "pdf page 1" "a.pdf"]) "a.pdf.page1.pdf"+Left (RepeatsStep (Step "pdf page 1" "a.pdf.page1.pdf") (Trail [Step "pdf page 1" "a.pdf"]))++@since 0.7.0.0+-}+stepWith :: (Applicative f) => Repetition -> String -> (FilePath -> [FilePath]) -> FilePather f a -> Tracked f a+stepWith r n outs x =+  tracked $ \t p ->+    let s = Step n p+        os = outs p+     in either+          (pure . Left)+          (\() -> fmap (\a -> Right (fmap (,s) os, a)) (view _Wrapped x p))+          (checkStep r s os t)+{-# INLINE stepWith #-}++{- | A named step that returns the files it made, and may appear 'Once' in a+trail. See 'stepWith''.++@since 0.7.0.0+-}+step' :: (Functor f) => String -> FilePather f ([FilePath], a) -> Tracked f a+step' =+  stepWith' Once+{-# INLINE step' #-}++{- | A named step that returns the files it made, for a step whose outputs are+known only after it runs, such as an image for each page of a PDF file. The+step is checked against the trail of its input file with 'checkStep' after it+runs, so it cannot be stopped before it runs, but its outputs are not passed+on.++>>> let pages = stepWith' Once "pdf pages" (asks (\p -> ([p <> "-0.png", p <> "-1.png"], ()))) :: Tracked Identity ()+>>> run pages (Trail []) "a.pdf"+Right ([("a.pdf-0.png",Step "pdf pages" "a.pdf"),("a.pdf-1.png",Step "pdf pages" "a.pdf")],())++@since 0.7.0.0+-}+stepWith' :: (Functor f) => Repetition -> String -> FilePather f ([FilePath], a) -> Tracked f a+stepWith' r n x =+  tracked $ \t p ->+    let s = Step n p+     in fmap (\(os, a) -> fmap (\() -> (fmap (,s) os, a)) (checkStep r s os t)) (view _Wrapped x p)+{-# INLINE stepWith' #-}++{- | A 'FilePather' that makes no files, such as one that gets information+about a file, or a condition.++>>> run (untracked (asks length)) (Trail []) "a.md"+Right ([],4)++@since 0.7.0.0+-}+untracked :: (Functor f) => FilePather f a -> Tracked f a+untracked x =+  tracked (\_ p -> fmap (\a -> Right ([], a)) (view _Wrapped x p))+{-# INLINE untracked #-}++{- | The trail of the file being operated on.++>>> run askTrail (Trail [Step "prepare" "src/a.md"]) "public/a.md"+Right ([],Trail [Step "prepare" "src/a.md"])++@since 0.7.0.0+-}+askTrail :: (Applicative f) => Tracked f Trail+askTrail =+  tracked (\t _ -> pure (Right ([], t)))+{-# INLINE askTrail #-}++{- | Run on the given file path, instead of the one being operated on, with+the same trail. This is 'local' with a constant function.++@since 0.7.0.0+-}+onPath :: FilePath -> Tracked f a -> Tracked f a+onPath q x =+  tracked (\t _ -> runTracked x t q)+{-# INLINE onPath #-}++{- | Run only on file paths that satisfy a predicate. On other file paths, the+result is 'mempty' and no files are made.++>>> let md = whenPath (\p -> p == "a.md") (step "copy" (\p -> [p <> ".bak"]) (pure ())) :: Tracked Identity ()+>>> run md (Trail []) "a.md"+Right ([("a.md.bak",Step "copy" "a.md")],())++>>> run md (Trail []) "a.txt"+Right ([],())++@since 0.7.0.0+-}+whenPath :: (Applicative f, Monoid a) => (FilePath -> Bool) -> Tracked f a -> Tracked f a+whenPath f x =+  tracked (\t p -> bool (pure (Right ([], mempty))) (runTracked x t p) (f p))+{-# INLINE whenPath #-}++{- | Run only on files whose trail satisfies a predicate, such as files made+by a particular step. On other files, the result is 'mempty' and no files are+made.++@since 0.7.0.0+-}+whenTrail :: (Applicative f, Monoid a) => (Trail -> Bool) -> Tracked f a -> Tracked f a+whenTrail f x =+  tracked (\t p -> bool (pure (Right ([], mempty))) (runTracked x t p) (f t))+{-# INLINE whenTrail #-}++{- | Change the type constructor of a 'Tracked' value with a natural+transformation.++@since 0.7.0.0+-}+hoistTracked :: (forall x. f x -> g x) -> Tracked f a -> Tracked g a+hoistTracked nat =+  over trackedFunction (\h t -> nat . h t)+{-# INLINE hoistTracked #-}++-- | @since 0.7.0.0+class GetTracked s f a | s -> f a where+  getTracked :: Getter s (Tracked f a)++-- | @since 0.7.0.0+instance GetTracked (Tracked f a) f a where+  getTracked =+    id+  {-# INLINE getTracked #-}++-- | @since 0.7.0.0+class (GetTracked s f a) => HasTracked s f a | s -> f a where+  {-# MINIMAL setTracked #-}+  setTracked :: Tracked f a -> s -> s++  trackedLens :: Lens' s (Tracked f a)+  trackedLens =+    lens (view getTracked) (flip setTracked)+  {-# INLINE trackedLens #-}++-- | @since 0.7.0.0+instance HasTracked (Tracked f a) f a where+  setTracked =+    const+  {-# INLINE setTracked #-}++-- | @since 0.7.0.0+class ReviewTracked t f a | t -> f a where+  reviewTracked :: Review t (Tracked f a)++-- | @since 0.7.0.0+instance ReviewTracked (Tracked f a) f a where+  reviewTracked =+    unto id+  {-# INLINE reviewTracked #-}++-- | @since 0.7.0.0+class (ReviewTracked t f a) => AsTracked t f a | t -> f a where+  {-# MINIMAL matchTracked #-}+  matchTracked :: t -> Maybe (Tracked f a)++  _Tracked :: Prism' t (Tracked f a)+  _Tracked =+    prism' (review reviewTracked) matchTracked+  {-# INLINE _Tracked #-}++-- | @since 0.7.0.0+instance AsTracked (Tracked f a) f a where+  matchTracked =+    Just+  {-# INLINE matchTracked #-}

@@ -0,0 +1,575 @@+{-# 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 #-}

@@ -0,0 +1,488 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}++{- HLINT ignore "Functor law" -}+{- HLINT ignore "Monad law, left identity" -}+{- HLINT ignore "Monad law, right identity" -}+{- HLINT ignore "Use <$>" -}+{- HLINT ignore "Alternative law, left identity" -}+{- HLINT ignore "Alternative law, right identity" -}+{- HLINT ignore "Monoid law, left identity" -}+{- HLINT ignore "Monoid law, right identity" -}+{- HLINT ignore "Use asks" -}++{- | Laws of the instances of 'FilePather', and of the combinators.++A 'FilePather' is a function, so it is observed by applying it to a generated+file path. Functions are generated with hedgehog-fn.+-}+module FilePatherTests (+  filePatherTests,+) where++import Control.Applicative (Alternative (..), Const (..))+import Control.Lens (view, _Wrapped)+import Control.Monad ((>=>))+import Control.Monad.Fix (fix, mfix)+import Control.Monad.Reader (ask, asks, local)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Zip (munzip, mzip)+import Control.Selective ((<*?))+import Data.Functor.Alt ((<!>))+import Data.Functor.Apply ((<.>))+import Data.Functor.Bind ((>>-))+import Data.Functor.Contravariant (Contravariant (..), Predicate (..))+import Data.Functor.Contravariant.Divisible (choose, conquer, divide, lose)+import Data.Functor.Identity (Identity (..))+import Data.Functor.Plus (zero)+import Data.Functor.Rep (index, tabulate)+import Data.Void (absurd)+import Gens+import Hedgehog+import Hedgehog.Function (Fn, apply, fn)+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Laws (Laws)+import System.FilePather+import Witherable (mapMaybe)++-- | Apply a 'FilePather' to a file path.+at :: FilePather f a -> FilePath -> f a+at =+  view _Wrapped++-- | A Kleisli arrow from 'Int' to 'FilePather' @[]@.+genKleisli :: Gen (Fn (Int, Int) [Int])+genKleisli =+  fn genIntList++kleisli :: Fn (Int, Int) [Int] -> Int -> FilePather [] Int+kleisli g a =+  FilePather (\p -> apply g (a, pathKey p))++-- | A 'FilePather' that produces file paths.+genPaths :: Gen (Fn Int [FilePath])+genPaths =+  fn (Gen.list (Range.linear 0 2) genPath)++filePatherTests :: Laws+filePatherTests =+  [ ("Functor identity", prop_functorIdentity)+  , ("Functor composition", prop_functorComposition)+  , ("Applicative identity", prop_applicativeIdentity)+  , ("Applicative composition", prop_applicativeComposition)+  , ("Applicative homomorphism", prop_applicativeHomomorphism)+  , ("Applicative interchange", prop_applicativeInterchange)+  , ("Apply agrees with Applicative", prop_applyAgrees)+  , ("Monad left identity", prop_monadLeftIdentity)+  , ("Monad right identity", prop_monadRightIdentity)+  , ("Monad associativity", prop_monadAssociativity)+  , ("Bind agrees with Monad", prop_bindAgrees)+  , ("Alternative left identity", prop_alternativeLeftIdentity)+  , ("Alternative right identity", prop_alternativeRightIdentity)+  , ("Alternative associativity", prop_alternativeAssociativity)+  , ("Alt and Plus agree with Alternative", prop_altAgrees)+  , ("Semigroup associativity", prop_semigroupAssociativity)+  , ("Monoid identity", prop_monoidIdentity)+  , ("Filterable identity", prop_filterableIdentity)+  , ("Filterable composition", prop_filterableComposition)+  , ("Selective identity", prop_selectiveIdentity)+  , ("MonadFix purity", prop_monadFixPurity)+  , ("MonadZip information preservation", prop_monadZip)+  , ("MonadReader ask", prop_ask)+  , ("MonadReader local", prop_local)+  , ("MonadTrans lift . pure", prop_liftPure)+  , ("MonadTrans lift bind", prop_liftBind)+  , ("Representable index . tabulate", prop_indexTabulate)+  , ("Representable tabulate . index", prop_tabulateIndex)+  , ("Contravariant identity", prop_contravariantIdentity)+  , ("Contravariant composition", prop_contravariantComposition)+  , ("Divisible identity", prop_divisibleIdentity)+  , ("Decidable identity", prop_decidableIdentity)+  , ("~> left identity", prop_pipeLeftIdentity)+  , ("~> right identity", prop_pipeRightIdentity)+  , ("~> associativity", prop_pipeAssociativity)+  , ("onFile", prop_onFile)+  , ("whenFile const True", prop_whenFileTrue)+  , ("whenFile const False", prop_whenFileFalse)+  , ("hoistFilePather id", prop_hoistIdentity)+  , ("everyFile applies to every file", prop_everyFileAll)+  , ("everyFile skips every file", prop_everyFileNone)+  , ("isWithin parent", prop_isWithin)+  ]++prop_functorIdentity :: Property+prop_functorIdentity =+  property $+    do+      x <- forAll genFilePatherList+      p <- forAll genPath+      at (fmap id (toFilePather x)) p === at (toFilePather x) p++prop_functorComposition :: Property+prop_functorComposition =+  property $+    do+      x <- forAll genFilePatherList+      f <- forAll genFnInt+      g <- forAll genFnInt+      p <- forAll genPath+      at (fmap (apply f . apply g) (toFilePather x)) p === at (fmap (apply f) (fmap (apply g) (toFilePather x))) p++prop_applicativeIdentity :: Property+prop_applicativeIdentity =+  property $+    do+      x <- forAll genFilePatherList+      p <- forAll genPath+      at (pure id <*> toFilePather x) p === at (toFilePather x) p++prop_applicativeComposition :: Property+prop_applicativeComposition =+  property $+    do+      u <- forAll genFilePatherListFn+      v <- forAll genFilePatherListFn+      w <- forAll genFilePatherList+      p <- forAll genPath+      let (u', v', w') = (toFilePatherFn u, toFilePatherFn v, toFilePather w)+      at (pure (.) <*> u' <*> v' <*> w') p === at (u' <*> (v' <*> w')) p++prop_applicativeHomomorphism :: Property+prop_applicativeHomomorphism =+  property $+    do+      f <- forAll genFnInt+      x <- forAll genInt+      p <- forAll genPath+      at (pure (apply f) <*> pure x :: FilePather [] Int) p === at (pure (apply f x)) p++prop_applicativeInterchange :: Property+prop_applicativeInterchange =+  property $+    do+      u <- forAll genFilePatherListFn+      y <- forAll genInt+      p <- forAll genPath+      at (toFilePatherFn u <*> pure y) p === at (pure ($ y) <*> toFilePatherFn u) p++prop_applyAgrees :: Property+prop_applyAgrees =+  property $+    do+      u <- forAll genFilePatherListFn+      w <- forAll genFilePatherList+      p <- forAll genPath+      at (toFilePatherFn u <.> toFilePather w) p === at (toFilePatherFn u <*> toFilePather w) p++prop_monadLeftIdentity :: Property+prop_monadLeftIdentity =+  property $+    do+      a <- forAll genInt+      k <- forAll genKleisli+      p <- forAll genPath+      at (pure a >>= kleisli k) p === at (kleisli k a) p++prop_monadRightIdentity :: Property+prop_monadRightIdentity =+  property $+    do+      m <- forAll genFilePatherList+      p <- forAll genPath+      at (toFilePather m >>= pure) p === at (toFilePather m) p++prop_monadAssociativity :: Property+prop_monadAssociativity =+  property $+    do+      m <- forAll genFilePatherList+      k <- forAll genKleisli+      h <- forAll genKleisli+      p <- forAll genPath+      at ((toFilePather m >>= kleisli k) >>= kleisli h) p === at (toFilePather m >>= (kleisli k >=> kleisli h)) p++prop_bindAgrees :: Property+prop_bindAgrees =+  property $+    do+      m <- forAll genFilePatherList+      k <- forAll genKleisli+      p <- forAll genPath+      at (toFilePather m >>- kleisli k) p === at (toFilePather m >>= kleisli k) p++prop_alternativeLeftIdentity :: Property+prop_alternativeLeftIdentity =+  property $+    do+      x <- forAll genFilePatherList+      p <- forAll genPath+      at (empty <|> toFilePather x) p === at (toFilePather x) p++prop_alternativeRightIdentity :: Property+prop_alternativeRightIdentity =+  property $+    do+      x <- forAll genFilePatherList+      p <- forAll genPath+      at (toFilePather x <|> empty) p === at (toFilePather x) p++prop_alternativeAssociativity :: Property+prop_alternativeAssociativity =+  property $+    do+      x <- forAll genFilePatherMaybe+      y <- forAll genFilePatherMaybe+      z <- forAll genFilePatherMaybe+      p <- forAll genPath+      let (x', y', z') = (toFilePather x, toFilePather y, toFilePather z)+      at ((x' <|> y') <|> z') p === at (x' <|> (y' <|> z')) p++prop_altAgrees :: Property+prop_altAgrees =+  property $+    do+      x <- forAll genFilePatherList+      y <- forAll genFilePatherList+      p <- forAll genPath+      at (toFilePather x <!> toFilePather y) p === at (toFilePather x <|> toFilePather y) p+      at (zero :: FilePather [] Int) p === at empty p++prop_semigroupAssociativity :: Property+prop_semigroupAssociativity =+  property $+    do+      x <- forAll genFilePatherList+      y <- forAll genFilePatherList+      z <- forAll genFilePatherList+      p <- forAll genPath+      let (x', y', z') = (toFilePather x, toFilePather y, toFilePather z)+      at ((x' <> y') <> z') p === at (x' <> (y' <> z')) p++prop_monoidIdentity :: Property+prop_monoidIdentity =+  property $+    do+      x <- forAll genFilePatherList+      p <- forAll genPath+      at (mempty <> toFilePather x) p === at (toFilePather x) p+      at (toFilePather x <> mempty) p === at (toFilePather x) p++prop_filterableIdentity :: Property+prop_filterableIdentity =+  property $+    do+      x <- forAll genFilePatherList+      p <- forAll genPath+      at (mapMaybe Just (toFilePather x)) p === at (toFilePather x) p++prop_filterableComposition :: Property+prop_filterableComposition =+  property $+    do+      x <- forAll genFilePatherList+      f <- forAll (fn (Gen.maybe genInt) :: Gen (Fn Int (Maybe Int)))+      g <- forAll (fn (Gen.maybe genInt) :: Gen (Fn Int (Maybe Int)))+      p <- forAll genPath+      at (mapMaybe (apply f) (mapMaybe (apply g) (toFilePather x))) p === at (mapMaybe (apply g >=> apply f) (toFilePather x)) p++prop_selectiveIdentity :: Property+prop_selectiveIdentity =+  property $+    do+      x <- forAll (fn (Gen.list (Range.linear 0 3) (Gen.either genInt genInt)) :: Gen (Fn Int [Either Int Int]))+      p <- forAll genPath+      at (toFilePather x <*? pure id) p === at (either id id <$> toFilePather x) p++prop_monadFixPurity :: Property+prop_monadFixPurity =+  property $+    do+      n <- forAll genInt+      p <- forAll genPath+      at (mfix (pure . const n) :: FilePather Maybe Int) p === at (pure (fix (const n))) p++prop_monadZip :: Property+prop_monadZip =+  property $+    do+      a <- forAll (fn genInt :: Gen (Fn Int Int))+      b <- forAll (fn genInt :: Gen (Fn Int Int))+      p <- forAll genPath+      let (ma, mb) = (FilePather (Identity . apply a . pathKey), FilePather (Identity . apply b . pathKey))+          (x, y) = munzip (mzip ma mb)+      (at x p, at y p) === (at ma p, at mb p)++prop_ask :: Property+prop_ask =+  property $+    do+      p <- forAll genPath+      at (ask :: FilePather Identity FilePath) p === Identity p++prop_local :: Property+prop_local =+  property $+    do+      f <- forAll (fn genPath :: Gen (Fn Int String))+      p <- forAll genPath+      let g = apply f . pathKey+      at (local g ask :: FilePather Identity FilePath) p === at (asks g) p++prop_liftPure :: Property+prop_liftPure =+  property $+    do+      a <- forAll genInt+      p <- forAll genPath+      at (lift (pure a) :: FilePather [] Int) p === at (pure a) p++prop_liftBind :: Property+prop_liftBind =+  property $+    do+      m <- forAll genIntList+      f <- forAll (fn genIntList :: Gen (Fn Int [Int]))+      p <- forAll genPath+      at (lift (m >>= apply f)) p === at (lift m >>= (lift . apply f)) p++prop_indexTabulate :: Property+prop_indexTabulate =+  property $+    do+      h <- forAll (fn genInt :: Gen (Fn Int Int))+      p <- forAll genPath+      index (tabulate (\(q, ()) -> apply h (pathKey q)) :: FilePather Identity Int) (p, ()) === apply h (pathKey p)++prop_tabulateIndex :: Property+prop_tabulateIndex =+  property $+    do+      h <- forAll (fn genInt :: Gen (Fn Int Int))+      p <- forAll genPath+      let x = FilePather (Identity . apply h . pathKey)+      at (tabulate (index x)) p === at x p++prop_contravariantIdentity :: Property+prop_contravariantIdentity =+  property $+    do+      h <- forAll (fn genIntList :: Gen (Fn Int [Int]))+      p <- forAll genPath+      let x = FilePather (Const . apply h . pathKey) :: FilePather (Const [Int]) Int+      at (contramap id x) p === at x p++prop_contravariantComposition :: Property+prop_contravariantComposition =+  property $+    do+      h <- forAll (fn genIntList :: Gen (Fn Int [Int]))+      f <- forAll genFnInt+      g <- forAll genFnInt+      p <- forAll genPath+      let x = FilePather (Const . apply h . pathKey) :: FilePather (Const [Int]) Int+      at (contramap (apply f) (contramap (apply g) x)) p === at (contramap (apply g . apply f) x) p++prop_divisibleIdentity :: Property+prop_divisibleIdentity =+  property $+    do+      h <- forAll (fn genIntList :: Gen (Fn Int [Int]))+      p <- forAll genPath+      let x = FilePather (Const . apply h . pathKey) :: FilePather (Const [Int]) Int+      at (divide (\a -> (a, a)) x conquer) p === at x p+      at (divide (\a -> (a, a)) conquer x) p === at x p++prop_decidableIdentity :: Property+prop_decidableIdentity =+  property $+    do+      h <- forAll (fn (fn Gen.bool) :: Gen (Fn Int (Fn Int Bool)))+      p <- forAll genPath+      a <- forAll genInt+      let x = FilePather (Predicate . apply . apply h . pathKey) :: FilePather Predicate Int+      getPredicate (at (choose Left x (lose absurd)) p) a === getPredicate (at x p) a++prop_pipeLeftIdentity :: Property+prop_pipeLeftIdentity =+  property $+    do+      x <- forAll genFilePatherList+      p <- forAll genPath+      at (ask ~> toFilePather x) p === at (toFilePather x) p++prop_pipeRightIdentity :: Property+prop_pipeRightIdentity =+  property $+    do+      x <- forAll genPaths+      p <- forAll genPath+      at (toFilePather x ~> ask) p === at (toFilePather x) p++prop_pipeAssociativity :: Property+prop_pipeAssociativity =+  property $+    do+      x <- forAll genPaths+      y <- forAll genPaths+      z <- forAll genFilePatherList+      p <- forAll genPath+      let (x', y', z') = (toFilePather x, toFilePather y, toFilePather z)+      at ((x' ~> y') ~> z') p === at (x' ~> (y' ~> z')) p++prop_onFile :: Property+prop_onFile =+  property $+    do+      x <- forAll genFilePatherList+      p <- forAll genPath+      q <- forAll genPath+      at (onFile q (toFilePather x)) p === at (toFilePather x) q++prop_whenFileTrue :: Property+prop_whenFileTrue =+  property $+    do+      x <- forAll genFilePatherList+      p <- forAll genPath+      at (whenFile (const True) (toFilePather x)) p === at (toFilePather x) p++prop_whenFileFalse :: Property+prop_whenFileFalse =+  property $+    do+      x <- forAll genFilePatherList+      p <- forAll genPath+      at (whenFile (const False) (toFilePather x)) p === []++prop_hoistIdentity :: Property+prop_hoistIdentity =+  property $+    do+      x <- forAll genFilePatherList+      p <- forAll genPath+      at (hoistFilePather id (toFilePather x)) p === at (toFilePather x) p++prop_everyFileAll :: Property+prop_everyFileAll =+  property $+    do+      fs <- forAll (Gen.list (Range.linear 0 5) genPath)+      d <- forAll genPath+      at (everyFile (pure fs) (rule (const True) ask) :: FilePather Identity [(FilePath, FilePath)]) d === Identity (zip fs fs)++prop_everyFileNone :: Property+prop_everyFileNone =+  property $+    do+      fs <- forAll (Gen.list (Range.linear 0 5) genPath)+      d <- forAll genPath+      at (everyFile (pure fs) (rule (const False) ask) :: FilePather Identity [(FilePath, FilePath)]) d === Identity []++prop_isWithin :: Property+prop_isWithin =+  property $+    do+      d <- forAll genPath+      f <- forAll genPath+      assert (isWithin d (d <> "/" <> f))

@@ -0,0 +1,83 @@+{-# OPTIONS_GHC -Wall #-}++-- | Generators shared by the property tests.+module Gens (+  genInt,+  genString,+  genPath,+  genIntList,+  genFnInt,+  pathKey,+  genFilePatherList,+  genFilePatherListFn,+  genFilePatherMaybe,+  toFilePather,+  toFilePatherFn,+) where++import Data.Char (ord)+import Hedgehog (Gen)+import Hedgehog.Function (Fn, apply, fn)+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import System.FilePather (FilePather (..))++genInt :: Gen Int+genInt =+  Gen.int (Range.linear (-100) 100)++genString :: Gen String+genString =+  Gen.string (Range.linear 0 30) Gen.unicode++{- | An 'Int' that is determined by a file path, so that a generated function of+'Int' is a function of file paths. hedgehog-fn cannot generate functions of+'String', as it has no instance for 'Char'.+-}+pathKey :: FilePath -> Int+pathKey =+  foldr (\c k -> (k * 31 + ord c) `mod` 1000003) 7++-- | A file path, such as @src/a/cv.fodt@.+genPath :: Gen FilePath+genPath =+  let part = Gen.string (Range.linear 1 6) Gen.alphaNum+   in (\ds f e -> concatMap (<> "/") ds <> f <> "." <> e)+        <$> Gen.list (Range.linear 0 3) part+        <*> part+        <*> Gen.element ["fodt", "md", "pdf", "png", "txt"]++genIntList :: Gen [Int]+genIntList =+  Gen.list (Range.linear 0 4) genInt++genFnInt :: Gen (Fn Int Int)+genFnInt =+  fn genInt++{- | A function from file paths to lists of 'Int', to make a 'FilePather'+with 'toFilePather'.+-}+genFilePatherList :: Gen (Fn Int [Int])+genFilePatherList =+  fn genIntList++{- | A function from file paths to lists of functions, to make a+'FilePather' with 'toFilePatherFn'.+-}+genFilePatherListFn :: Gen (Fn Int [Fn Int Int])+genFilePatherListFn =+  fn (Gen.list (Range.linear 0 3) genFnInt)++-- | A function from file paths to 'Maybe' 'Int'.+genFilePatherMaybe :: Gen (Fn Int (Maybe Int))+genFilePatherMaybe =+  fn (Gen.maybe genInt)++toFilePather :: Fn Int (f a) -> FilePather f a+toFilePather f =+  FilePather (apply f . pathKey)++toFilePatherFn :: (Functor f) => Fn Int (f (Fn Int Int)) -> FilePather f (Int -> Int)+toFilePatherFn f =+  FilePather (fmap apply . apply f . pathKey)

@@ -0,0 +1,63 @@+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -Wall #-}++-- | Laws of lenses and prisms.+module Laws (+  Laws,+  lensLaws,+  prismLaws,+) where++import Control.Lens (ALens', APrism', cloneLens, clonePrism, preview, review, set, view)+import Data.String (fromString)+import Hedgehog++type Laws = [(PropertyName, Property)]++-- | The lens laws: view-set, set-view and set-set.+lensLaws :: (Eq s, Show s, Eq a, Show a) => String -> ALens' s a -> Gen s -> Gen a -> Laws+lensLaws name l genS genA =+  [+    ( fromString (name <> " view . set")+    , property $+        do+          s <- forAll genS+          a <- forAll genA+          view (cloneLens l) (set (cloneLens l) a s) === a+    )+  ,+    ( fromString (name <> " set . view")+    , property $+        do+          s <- forAll genS+          set (cloneLens l) (view (cloneLens l) s) s === s+    )+  ,+    ( fromString (name <> " set . set")+    , property $+        do+          s <- forAll genS+          a <- forAll genA+          b <- forAll genA+          set (cloneLens l) b (set (cloneLens l) a s) === set (cloneLens l) b s+    )+  ]++-- | The prism laws: preview-review and review-preview.+prismLaws :: (Eq s, Show s, Eq a, Show a) => String -> APrism' s a -> Gen s -> Gen a -> Laws+prismLaws name p genS genA =+  [+    ( fromString (name <> " preview . review")+    , property $+        do+          a <- forAll genA+          preview (clonePrism p) (review (clonePrism p) a) === Just a+    )+  ,+    ( fromString (name <> " review . preview")+    , property $+        do+          s <- forAll genS+          maybe s (review (clonePrism p)) (preview (clonePrism p) s) === s+    )+  ]

@@ -1,18 +0,0 @@-{-# OPTIONS_GHC -Wall -Werror -Wno-orphans #-}--module Main (main) where--import System.Exit (exitWith)-import System.Process (rawSystem)--main :: IO ()-main =-  exitWith-    =<< rawSystem-      "cabal"-      [ "repl",-        "--with-compiler=doctest",-        "--repl-options=-w",-        "--repl-options=-Wdefault",-        "lib:filepather"-      ]

@@ -0,0 +1,587 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-}++{- | Laws of the instances of 'Tracked', of the steps that check a trail, and+of the optics of trails and cycles.++A 'Tracked' value is a function of a trail and a file path, so it is observed+by applying it to a generated trail and file path. Functions are generated+with hedgehog-fn.+-}+module TrackedTests (+  trackedTests,+) where++import Control.Applicative (Alternative (..), Const (..))+import Control.Lens (from, view, _Cons, _Snoc)+import Control.Monad ((>=>))+import Control.Monad.Error.Class (catchError, throwError)+import Control.Monad.Reader (ask, asks, local)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Writer (Writer, listen, runWriter, tell)+import Control.Selective ((<*?))+import Data.Functor (($>))+import Data.Functor.Alt ((<!>))+import Data.Functor.Apply ((<.>))+import Data.Functor.Bind ((>>-))+import Data.Functor.Contravariant (contramap)+import Data.Functor.Identity (Identity (..))+import Data.Functor.Plus (zero)+import Gens (genFnInt, genInt, genIntList, genPath, pathKey)+import Hedgehog+import Hedgehog.Function (Fn, apply, fn)+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Laws (Laws, lensLaws, prismLaws)+import System.FilePather+import Witherable (mapMaybe)++-- | The result of running a 'Tracked' value.+type Result a = Either Cycle (Outputs, a)++-- | Run a 'Tracked' value.+at :: Tracked f a -> Trail -> FilePath -> f (Result a)+at =+  view trackedFunction++-- | Make a 'Tracked' value from its function.+mk :: (Trail -> FilePath -> f (Result a)) -> Tracked f a+mk =+  view (from trackedFunction)++-- | An 'Int' that is determined by a trail and a file path.+key :: Trail -> FilePath -> Int+key t p =+  pathKey (p <> show t)++genName :: Gen String+genName =+  Gen.element ["prepare", "pdf page 1", "libreoffice pdf", "image png", "book"]++genStep :: Gen Step+genStep =+  Step <$> genName <*> genPath++genTrail :: Gen Trail+genTrail =+  Trail <$> Gen.list (Range.linear 0 3) genStep++genCycle :: Gen Cycle+genCycle =+  Gen.choice+    [ ReproducesInput <$> genPath <*> genStep <*> genTrail+    , RepeatsStep <$> genStep <*> genTrail+    ]++genOutputs :: Gen Outputs+genOutputs =+  Gen.list (Range.linear 0 2) ((,) <$> genPath <*> genStep)++genResult :: Gen a -> Gen (Result a)+genResult genA =+  Gen.frequency [(1, Left <$> genCycle), (4, fmap Right ((,) <$> genOutputs <*> genA))]++-- | A function to make a 'Tracked' value in @[]@.+genTrackedList :: Gen (Fn Int [Result Int])+genTrackedList =+  fn (Gen.list (Range.linear 0 2) (genResult genInt))++genTrackedListFn :: Gen (Fn Int [Result (Fn Int Int)])+genTrackedListFn =+  fn (Gen.list (Range.linear 0 2) (genResult genFnInt))++genTrackedMaybe :: Gen (Fn Int (Maybe (Result Int)))+genTrackedMaybe =+  fn (Gen.maybe (genResult genInt))++genTrackedMonoid :: Gen (Fn Int [Result [Int]])+genTrackedMonoid =+  fn (Gen.list (Range.linear 0 2) (genResult genIntList))++toTracked :: Fn Int (f (Result a)) -> Tracked f a+toTracked f =+  mk (\t p -> apply f (key t p))++toTrackedFn :: Fn Int [Result (Fn Int Int)] -> Tracked [] (Int -> Int)+toTrackedFn f =+  mk (\t p -> fmap (fmap (fmap apply)) (apply f (key t p)))++genKleisli :: Gen (Fn (Int, Int) [Result Int])+genKleisli =+  fn (Gen.list (Range.linear 0 2) (genResult genInt))++kleisli :: Fn (Int, Int) [Result Int] -> Int -> Tracked [] Int+kleisli g a =+  mk (\t p -> apply g (a, key t p))++-- | A 'Tracked' value that is stopped by a cycle.+stopped :: (Applicative f) => Cycle -> Tracked f a+stopped c =+  mk (\_ _ -> pure (Left c))++-- | A step that records that it ran.+ran :: FilePather (Writer [String]) ()+ran =+  FilePather (\_ -> tell ["ran"])++trackedTests :: Laws+trackedTests =+  [ ("Functor identity", prop_functorIdentity)+  , ("Functor composition", prop_functorComposition)+  , ("Applicative identity", prop_applicativeIdentity)+  , ("Applicative composition", prop_applicativeComposition)+  , ("Applicative homomorphism", prop_applicativeHomomorphism)+  , ("Applicative interchange", prop_applicativeInterchange)+  , ("Apply agrees with Applicative", prop_applyAgrees)+  , ("Monad left identity", prop_monadLeftIdentity)+  , ("Monad right identity", prop_monadRightIdentity)+  , ("Monad associativity", prop_monadAssociativity)+  , ("Bind agrees with Monad", prop_bindAgrees)+  , ("Alternative left identity", prop_alternativeLeftIdentity)+  , ("Alternative right identity", prop_alternativeRightIdentity)+  , ("Alternative associativity", prop_alternativeAssociativity)+  , ("Alt and Plus agree with Alternative", prop_altAgrees)+  , ("Semigroup associativity", prop_semigroupAssociativity)+  , ("Monoid identity", prop_monoidIdentity)+  , ("Filterable identity", prop_filterableIdentity)+  , ("Filterable composition", prop_filterableComposition)+  , ("Filterable keeps a cycle", prop_filterableCycle)+  , ("Selective identity", prop_selectiveIdentity)+  , ("MonadReader ask", prop_ask)+  , ("MonadReader local", prop_local)+  , ("MonadTrans lift . pure", prop_liftPure)+  , ("MonadTrans lift bind", prop_liftBind)+  , ("MonadError catchError . throwError", prop_catchThrow)+  , ("MonadError does not catch a cycle", prop_catchCycle)+  , ("MonadWriter listen . tell", prop_listenTell)+  , ("Contravariant identity", prop_contravariantIdentity)+  , ("<|> propagates a cycle", prop_altCycle)+  , ("<> propagates a cycle, and stops", prop_semigroupCycle)+  , ("step records its outputs", prop_stepOutputs)+  , ("step stops a repeated step before running", prop_stepRepeats)+  , ("step stops a reproduced input before running", prop_stepReproduces)+  , ("stepWith Repeatable allows a repeated step", prop_stepRepeatable)+  , ("step' stops after running", prop_step'Stops)+  , ("whenPath const False", prop_whenPathFalse)+  , ("whenTrail const True", prop_whenTrailTrue)+  , ("onPath", prop_onPath)+  , ("askTrail", prop_askTrail)+  , ("untracked", prop_untracked)+  , ("hoistTracked id", prop_hoistIdentity)+  ]+    <> lensLaws "stepName" stepName genStep genName+    <> lensLaws "stepInput" stepInput genStep genPath+    <> lensLaws "cycleStep" cycleStep genCycle genStep+    <> lensLaws "cycleTrail" cycleTrail genCycle genTrail+    <> prismLaws "_ReproducesInput" _ReproducesInput genCycle ((,,) <$> genPath <*> genStep <*> genTrail)+    <> prismLaws "_RepeatsStep" _RepeatsStep genCycle ((,) <$> genStep <*> genTrail)+    <> prismLaws "_Once" _Once (Gen.element [Once, Repeatable]) (pure ())+    <> prismLaws "_Repeatable" _Repeatable (Gen.element [Once, Repeatable]) (pure ())+    <> prismLaws "Trail _Cons" _Cons genTrail ((,) <$> genStep <*> genTrail)+    <> prismLaws "Trail _Snoc" _Snoc genTrail ((,) <$> genTrail <*> genStep)++prop_functorIdentity :: Property+prop_functorIdentity =+  property $+    do+      x <- forAll genTrackedList+      t <- forAll genTrail+      p <- forAll genPath+      at (fmap id (toTracked x)) t p === at (toTracked x) t p++prop_functorComposition :: Property+prop_functorComposition =+  property $+    do+      x <- forAll genTrackedList+      f <- forAll genFnInt+      g <- forAll genFnInt+      t <- forAll genTrail+      p <- forAll genPath+      at (fmap (apply f . apply g) (toTracked x)) t p === at (fmap (apply f) (fmap (apply g) (toTracked x))) t p++prop_applicativeIdentity :: Property+prop_applicativeIdentity =+  property $+    do+      x <- forAll genTrackedList+      t <- forAll genTrail+      p <- forAll genPath+      at (pure id <*> toTracked x) t p === at (toTracked x) t p++prop_applicativeComposition :: Property+prop_applicativeComposition =+  property $+    do+      u <- forAll genTrackedListFn+      v <- forAll genTrackedListFn+      w <- forAll genTrackedList+      t <- forAll genTrail+      p <- forAll genPath+      let (u', v', w') = (toTrackedFn u, toTrackedFn v, toTracked w)+      at (pure (.) <*> u' <*> v' <*> w') t p === at (u' <*> (v' <*> w')) t p++prop_applicativeHomomorphism :: Property+prop_applicativeHomomorphism =+  property $+    do+      f <- forAll genFnInt+      x <- forAll genInt+      t <- forAll genTrail+      p <- forAll genPath+      at (pure (apply f) <*> pure x :: Tracked [] Int) t p === at (pure (apply f x)) t p++prop_applicativeInterchange :: Property+prop_applicativeInterchange =+  property $+    do+      u <- forAll genTrackedListFn+      y <- forAll genInt+      t <- forAll genTrail+      p <- forAll genPath+      at (toTrackedFn u <*> pure y) t p === at (pure ($ y) <*> toTrackedFn u) t p++prop_applyAgrees :: Property+prop_applyAgrees =+  property $+    do+      u <- forAll genTrackedListFn+      w <- forAll genTrackedList+      t <- forAll genTrail+      p <- forAll genPath+      at (toTrackedFn u <.> toTracked w) t p === at (toTrackedFn u <*> toTracked w) t p++prop_monadLeftIdentity :: Property+prop_monadLeftIdentity =+  property $+    do+      a <- forAll genInt+      k <- forAll genKleisli+      t <- forAll genTrail+      p <- forAll genPath+      at (pure a >>= kleisli k) t p === at (kleisli k a) t p++prop_monadRightIdentity :: Property+prop_monadRightIdentity =+  property $+    do+      m <- forAll genTrackedList+      t <- forAll genTrail+      p <- forAll genPath+      at (toTracked m >>= pure) t p === at (toTracked m) t p++prop_monadAssociativity :: Property+prop_monadAssociativity =+  property $+    do+      m <- forAll genTrackedList+      k <- forAll genKleisli+      h <- forAll genKleisli+      t <- forAll genTrail+      p <- forAll genPath+      at ((toTracked m >>= kleisli k) >>= kleisli h) t p === at (toTracked m >>= (kleisli k >=> kleisli h)) t p++prop_bindAgrees :: Property+prop_bindAgrees =+  property $+    do+      m <- forAll genTrackedList+      k <- forAll genKleisli+      t <- forAll genTrail+      p <- forAll genPath+      at (toTracked m >>- kleisli k) t p === at (toTracked m >>= kleisli k) t p++prop_alternativeLeftIdentity :: Property+prop_alternativeLeftIdentity =+  property $+    do+      x <- forAll genTrackedList+      t <- forAll genTrail+      p <- forAll genPath+      at (empty <|> toTracked x) t p === at (toTracked x) t p++prop_alternativeRightIdentity :: Property+prop_alternativeRightIdentity =+  property $+    do+      x <- forAll genTrackedList+      t <- forAll genTrail+      p <- forAll genPath+      at (toTracked x <|> empty) t p === at (toTracked x) t p++prop_alternativeAssociativity :: Property+prop_alternativeAssociativity =+  property $+    do+      x <- forAll genTrackedMaybe+      y <- forAll genTrackedMaybe+      z <- forAll genTrackedMaybe+      t <- forAll genTrail+      p <- forAll genPath+      let (x', y', z') = (toTracked x, toTracked y, toTracked z)+      at ((x' <|> y') <|> z') t p === at (x' <|> (y' <|> z')) t p++prop_altAgrees :: Property+prop_altAgrees =+  property $+    do+      x <- forAll genTrackedList+      y <- forAll genTrackedList+      t <- forAll genTrail+      p <- forAll genPath+      at (toTracked x <!> toTracked y) t p === at (toTracked x <|> toTracked y) t p+      at (zero :: Tracked [] Int) t p === at empty t p++prop_semigroupAssociativity :: Property+prop_semigroupAssociativity =+  property $+    do+      x <- forAll genTrackedMonoid+      y <- forAll genTrackedMonoid+      z <- forAll genTrackedMonoid+      t <- forAll genTrail+      p <- forAll genPath+      let (x', y', z') = (toTracked x, toTracked y, toTracked z)+      at ((x' <> y') <> z') t p === at (x' <> (y' <> z')) t p++prop_monoidIdentity :: Property+prop_monoidIdentity =+  property $+    do+      x <- forAll genTrackedMonoid+      t <- forAll genTrail+      p <- forAll genPath+      at (mempty <> toTracked x) t p === at (toTracked x) t p+      at (toTracked x <> mempty) t p === at (toTracked x) t p++prop_filterableIdentity :: Property+prop_filterableIdentity =+  property $+    do+      x <- forAll genTrackedList+      t <- forAll genTrail+      p <- forAll genPath+      at (mapMaybe Just (toTracked x)) t p === at (toTracked x) t p++prop_filterableComposition :: Property+prop_filterableComposition =+  property $+    do+      x <- forAll genTrackedList+      f <- forAll (fn (Gen.maybe genInt) :: Gen (Fn Int (Maybe Int)))+      g <- forAll (fn (Gen.maybe genInt) :: Gen (Fn Int (Maybe Int)))+      t <- forAll genTrail+      p <- forAll genPath+      at (mapMaybe (apply f) (mapMaybe (apply g) (toTracked x))) t p === at (mapMaybe (apply g >=> apply f) (toTracked x)) t p++prop_filterableCycle :: Property+prop_filterableCycle =+  property $+    do+      c <- forAll genCycle+      t <- forAll genTrail+      p <- forAll genPath+      at (mapMaybe (const Nothing :: Int -> Maybe Int) (stopped c)) t p === [Left c]++prop_selectiveIdentity :: Property+prop_selectiveIdentity =+  property $+    do+      x <- forAll (fn (Gen.list (Range.linear 0 2) (genResult (Gen.either genInt genInt))) :: Gen (Fn Int [Result (Either Int Int)]))+      t <- forAll genTrail+      p <- forAll genPath+      at (toTracked x <*? pure id) t p === at (either id id <$> toTracked x) t p++prop_ask :: Property+prop_ask =+  property $+    do+      t <- forAll genTrail+      p <- forAll genPath+      at (ask :: Tracked Identity FilePath) t p === Identity (Right ([], p))++prop_local :: Property+prop_local =+  property $+    do+      f <- forAll (fn genPath :: Gen (Fn Int String))+      t <- forAll genTrail+      p <- forAll genPath+      let g = apply f . pathKey+      at (local g ask :: Tracked Identity FilePath) t p === at (asks g) t p++prop_liftPure :: Property+prop_liftPure =+  property $+    do+      a <- forAll genInt+      t <- forAll genTrail+      p <- forAll genPath+      at (lift (pure a) :: Tracked [] Int) t p === at (pure a) t p++prop_liftBind :: Property+prop_liftBind =+  property $+    do+      m <- forAll genIntList+      f <- forAll (fn genIntList :: Gen (Fn Int [Int]))+      t <- forAll genTrail+      p <- forAll genPath+      at (lift (m >>= apply f)) t p === at (lift m >>= (lift . apply f)) t p++prop_catchThrow :: Property+prop_catchThrow =+  property $+    do+      e <- forAll genInt+      h <- forAll (fn (genResult genInt) :: Gen (Fn Int (Result Int)))+      t <- forAll genTrail+      p <- forAll genPath+      let handler x = mk (\_ _ -> Right (apply h x)) :: Tracked (Either Int) Int+      at (catchError (throwError e) handler) t p === at (handler e) t p++prop_catchCycle :: Property+prop_catchCycle =+  property $+    do+      c <- forAll genCycle+      t <- forAll genTrail+      p <- forAll genPath+      at (catchError (stopped c) (const (pure 1)) :: Tracked (Either Int) Int) t p === Right (Left c)++prop_listenTell :: Property+prop_listenTell =+  property $+    do+      w <- forAll genIntList+      t <- forAll genTrail+      p <- forAll genPath+      runWriter (at (listen (tell w) :: Tracked (Writer [Int]) ((), [Int])) t p) === runWriter (at (tell w $> ((), w)) t p)++prop_contravariantIdentity :: Property+prop_contravariantIdentity =+  property $+    do+      h <- forAll (fn genIntList :: Gen (Fn Int [Int]))+      t <- forAll genTrail+      p <- forAll genPath+      let x = mk (\t' p' -> Const (apply h (key t' p'))) :: Tracked (Const [Int]) Int+      getConst (at (contramap id x) t p) === getConst (at x t p)++prop_altCycle :: Property+prop_altCycle =+  property $+    do+      c <- forAll genCycle+      y <- forAll genTrackedMaybe+      t <- forAll genTrail+      p <- forAll genPath+      at (stopped c <|> toTracked y) t p === Just (Left c)++prop_semigroupCycle :: Property+prop_semigroupCycle =+  property $+    do+      c <- forAll genCycle+      t <- forAll genTrail+      p <- forAll genPath+      let x = lift (tell ["x"]) *> stopped c :: Tracked (Writer [String]) ()+          y = lift (tell ["y"])+      runWriter (at (x <> y) t p) === (Left c, ["x"])++prop_stepOutputs :: Property+prop_stepOutputs =+  property $+    do+      p <- forAll genPath+      runWriter (at (step "copy" (\q -> [q <> ".bak"]) ran) (Trail []) p) === (Right ([(p <> ".bak", Step "copy" p)], ()), ["ran"])++prop_stepRepeats :: Property+prop_stepRepeats =+  property $+    do+      t <- forAll genTrail+      q <- forAll genPath+      p <- forAll genPath+      let t' = Trail [Step "copy" q] <> t+      runWriter (at (step "copy" (\r -> [r <> ".bak"]) ran) t' p) === (Left (RepeatsStep (Step "copy" p) t'), [])++prop_stepReproduces :: Property+prop_stepReproduces =+  property $+    do+      q <- forAll genPath+      p <- forAll genPath+      let t = Trail [Step "prepare" q]+      runWriter (at (step "unprepare" (const [q]) ran) t p) === (Left (ReproducesInput q (Step "unprepare" p) t), [])++prop_stepRepeatable :: Property+prop_stepRepeatable =+  property $+    do+      q <- forAll genPath+      p <- forAll genPath+      let t = Trail [Step "copy" q]+      fmap fst (fst (runWriter (at (stepWith Repeatable "copy" (\r -> [r <> ".bak"]) ran) t p))) === Right [(p <> ".bak", Step "copy" p)]++prop_step'Stops :: Property+prop_step'Stops =+  property $+    do+      q <- forAll genPath+      p <- forAll genPath+      let t = Trail [Step "prepare" q]+      runWriter (at (step' "unprepare" (([q], ()) <$ ran)) t p) === (Left (ReproducesInput q (Step "unprepare" p) t), ["ran"])++prop_whenPathFalse :: Property+prop_whenPathFalse =+  property $+    do+      x <- forAll genTrackedMonoid+      t <- forAll genTrail+      p <- forAll genPath+      at (whenPath (const False) (toTracked x)) t p === [Right ([], [])]++prop_whenTrailTrue :: Property+prop_whenTrailTrue =+  property $+    do+      x <- forAll genTrackedMonoid+      t <- forAll genTrail+      p <- forAll genPath+      at (whenTrail (const True) (toTracked x)) t p === at (toTracked x) t p++prop_onPath :: Property+prop_onPath =+  property $+    do+      x <- forAll genTrackedList+      t <- forAll genTrail+      p <- forAll genPath+      q <- forAll genPath+      at (onPath q (toTracked x)) t p === at (toTracked x) t q++prop_askTrail :: Property+prop_askTrail =+  property $+    do+      t <- forAll genTrail+      p <- forAll genPath+      at (askTrail :: Tracked Identity Trail) t p === Identity (Right ([], t))++prop_untracked :: Property+prop_untracked =+  property $+    do+      t <- forAll genTrail+      p <- forAll genPath+      at (untracked (asks length) :: Tracked Identity Int) t p === Identity (Right ([], length p))++prop_hoistIdentity :: Property+prop_hoistIdentity =+  property $+    do+      x <- forAll genTrackedList+      t <- forAll genTrail+      p <- forAll genPath+      at (hoistTracked id (toTracked x)) t p === at (toTracked x) t p

@@ -0,0 +1,25 @@+import Control.Monad (unless)+import System.Exit (ExitCode (..), exitFailure)+import System.Process (rawSystem)++main :: IO ()+main = do+  results <-+    mapM+      ( \f ->+          rawSystem+            "cabal"+            [ "exec"+            , "--"+            , "doctest"+            , "-isrc"+            , f+            ]+      )+      [ "src/System/FilePather/Combinators.hs"+      , "src/System/FilePather/FilePather.hs"+      , "src/System/FilePather/Trail.hs"+      , "src/System/FilePather/Tracked.hs"+      , "src/System/FilePather.hs"+      ]+  unless (all (== ExitSuccess) results) exitFailure

@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}++import Control.Monad (unless)+import FilePatherTests (filePatherTests)+import Hedgehog (Group (..), checkParallel)+import System.Exit (exitFailure)+import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)+import TrackedTests (trackedTests)++main :: IO ()+main = do+  hSetBuffering stdout LineBuffering+  hSetBuffering stderr LineBuffering++  result <-+    and+      <$> mapM+        checkParallel+        [ Group "FilePather" filePatherTests+        , Group "Tracked" trackedTests+        ]++  unless result exitFailure