diff --git a/LICENCE b/LICENCE --- a/LICENCE +++ b/LICENCE @@ -1,27 +1,30 @@ -Copyright 2021 Tony Morris +Copyright (c) 2021-2026 Tony Morris All rights reserved. Redistribution and use in source and binary forms, with or without -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. +modification, are permitted provided that the following conditions are met: -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. + * 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. + +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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,55 @@ +# 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 + +| 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 | + +## Type aliases + +```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 +``` + +## Usage + +```haskell +import System.FilePather +import Data.Kleisli (Kleisli(..)) +import Data.Functor.Identity (runIdentity) + +-- Pure operations return FilePatherA' (Kleisli (->) FilePath Identity a) +-- >>> runIdentity (let Kleisli f = takeExtension in f "/foo/bar.hs") +-- ".hs" + +-- Effectful operations return FilePatherA IO a (Kleisli (->) FilePath IO a) +-- >>> let Kleisli f = doesFileExist in f "/tmp/example.txt" +-- False + +-- Partial operations return FilePatherA Maybe a +-- >>> let Kleisli f = stripExtension ".hs" in f "/foo/bar.hs" +-- Just "/foo/bar" + +-- Compose with Functor/Applicative/Monad instances +-- >>> runIdentity (let Kleisli f = fmap (++ ".bak") takeFileName in f "/tmp/notes.txt") +-- "notes.txt.bak" +``` + +## Building + +``` +cabal build +cabal test doctest +cabal bench +``` diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,3 +1,8 @@ -import Distribution.Simple -main = defaultMain +{-# OPTIONS_GHC -Wall -Werror #-} +module Main (main) where + +import Distribution.Simple (defaultMain) + +main :: IO () +main = defaultMain diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs new file mode 100644 --- /dev/null +++ b/benchmarks/Main.hs @@ -0,0 +1,196 @@ +{-# 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") + ] + ] diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,18 @@ +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 +* Remove unused language extensions +* Remove duplicate benchmark + +0.5.6 + +* Add `traverseFilePath` function +* Add `opticFilePaths` function + 0.5.5 * Update `readProcessWithExitCode` function diff --git a/filepather.cabal b/filepather.cabal --- a/filepather.cabal +++ b/filepather.cabal @@ -1,51 +1,91 @@ +cabal-version: 2.4 name: filepather -version: 0.5.5 -synopsis: Functions on System.FilePath +version: 0.6.0 +synopsis: FilePath and Directory operations via Kleisli type aliases description: - Functions over @System.FilePath@ including a find function for recursing down directories. -license: BSD3 + Re-implementations of @System.FilePath@ and @System.Directory@ using + @Kleisli@ type aliases from the + 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 <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> -maintainer: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> -copyright: Copyright (C) 2021-2023 Tony Morris -category: Test +author: Tony Morris +maintainer: Tony Morris +category: System build-type: Simple -extra-source-files: changelog.md -cabal-version: >=1.10 +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.0.2 +bug-reports: https://gitlab.com/tonymorris/filepather/-/issues +tested-with: GHC == 9.6.7 +flag dev + description: Enable development warnings (-Werror, -O2 for benchmarks) + manual: True + default: False + source-repository head type: git - location: git@gitlab.com:tonymorris/filepather.git + location: https://gitlab.com/tonymorris/filepather.git library exposed-modules: - System.FilePath.FilePather - System.FilePath.FilePather.ByteString - System.FilePath.FilePather.Directory - System.FilePath.FilePather.Find - System.FilePath.FilePather.IO - System.FilePath.FilePather.Posix - System.FilePath.FilePather.Process - System.FilePath.FilePather.ReadFilePath - System.FilePath.FilePather.ReadFilePaths + System.FilePather + , System.FilePather.FilePather + , System.FilePather.FilePather.Posix + , System.FilePather.FilePather.Windows - build-depends: base >= 4.15 && < 6 - , bytestring >= 0.11.2.0 && < 0.12 - , containers >= 0.6.4.1 && < 0.7 - , contravariant >= 1.5.5 && < 2 - , directory >= 1.3.7.1 && < 2 - , exitcode >= 0.1.0.9 && < 2 - , filepath >= 1.4.2.1 && < 2 - , lens >= 5.2.3 && < 6 - , mmorph >= 1.2.0 && < 2 - , mtl >= 2.2.2 && < 3 - , semigroupoids >= 6.0.0.1 && < 7 - , time >= 1.9.3 && < 2 - , transformers >= 0.5.6.2 && < 0.6 + 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 hs-source-dirs: src + + default-language: Haskell2010 + + ghc-options: -Wall + + if flag(dev) + ghc-options: -Werror + +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 + , filepather + default-language: Haskell2010 + ghc-options: -Wall + + if flag(dev) + ghc-options: -Werror -O2 + +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 diff --git a/src/System/FilePath/FilePather.hs b/src/System/FilePath/FilePather.hs deleted file mode 100644 --- a/src/System/FilePath/FilePather.hs +++ /dev/null @@ -1,12 +0,0 @@ -module System.FilePath.FilePather( - module P -) where - -import System.FilePath.FilePather.ByteString as P -import System.FilePath.FilePather.Directory as P -import System.FilePath.FilePather.Find as P -import System.FilePath.FilePather.IO as P -import System.FilePath.FilePather.Posix as P -import System.FilePath.FilePather.Process as P -import System.FilePath.FilePather.ReadFilePath as P -import System.FilePath.FilePather.ReadFilePaths as P diff --git a/src/System/FilePath/FilePather/ByteString.hs b/src/System/FilePath/FilePather/ByteString.hs deleted file mode 100644 --- a/src/System/FilePath/FilePather/ByteString.hs +++ /dev/null @@ -1,47 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module System.FilePath.FilePather.ByteString( - fromFilePath -, readFileB -, writeFileB -, appendFileB -, module B -) where - -import Control.Exception ( Exception ) -import Data.ByteString( ByteString ) -import qualified Data.ByteString as B -import System.FilePath.FilePather.ReadFilePath - ( ReadFilePathT, tryReadFilePath ) -import System.IO ( IO ) - -fromFilePath :: - Exception e => - ReadFilePathT e IO ByteString -fromFilePath = - tryReadFilePath B.fromFilePath -{-# INLINE fromFilePath #-} - -readFileB :: - Exception e => - ReadFilePathT e IO ByteString -readFileB = - tryReadFilePath B.readFile -{-# INLINE readFileB #-} - -writeFileB :: - Exception e => - ByteString - -> ReadFilePathT e IO () -writeFileB s = - tryReadFilePath (`B.writeFile` s) -{-# INLINE writeFileB #-} - -appendFileB :: - Exception e => - ByteString - -> ReadFilePathT e IO () -appendFileB s = - tryReadFilePath (`B.appendFile` s) -{-# INLINE appendFileB #-} diff --git a/src/System/FilePath/FilePather/Directory.hs b/src/System/FilePath/FilePather/Directory.hs deleted file mode 100644 --- a/src/System/FilePath/FilePather/Directory.hs +++ /dev/null @@ -1,422 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module System.FilePath.FilePather.Directory( - createDirectory -, createDirectoryIfMissing -, removeDirectory -, removeDirectoryRecursive -, removePathForcibly -, renameDirectory -, listDirectory -, getDirectoryContents -, getCurrentDirectory -, setCurrentDirectory -, getHomeDirectory -, withCurrentDirectory -, getXdgDirectory -, getAppUserDataDirectory -, getUserDocumentsDirectory -, getTemporaryDirectory -, getXdgDirectoryList -, removeFile -, renameFile -, renamePath -, copyFile -, copyFileWithMetadata -, getFileSize -, canonicalizePath -, makeAbsolute -, makeRelativeToCurrentDirectory -, doesPathExist -, doesFileExist -, doesDirectoryExist -, findExecutable -, findExecutables -, findExecutablesInDirectories -, findFile -, findFiles -, findFileWith -, findFilesWith -, createFileLink -, createDirectoryLink -, removeDirectoryLink -, pathIsSymbolicLink -, getSymbolicLinkTarget -, getPermissions -, setPermissions -, copyPermissions -, getAccessTime -, getModificationTime -, setAccessTime -, setModificationTime -, module SD -) where - -import Control.Applicative ( Applicative(pure) ) -import Control.Category ( Category((.)) ) -import Control.Exception ( Exception ) -import Control.Lens ( over, _Wrapped ) -import Data.Maybe ( Maybe, maybe ) -import Data.Bool ( Bool(..) ) -import Data.Either ( Either(Right, Left), either ) -import Data.Functor ( Functor(fmap) ) -import Data.Time ( UTCTime ) -import GHC.Num( Integer ) -import qualified System.Directory as D -import System.Directory as SD( XdgDirectory(..), XdgDirectoryList(..), exeExtension, Permissions(..), emptyPermissions, readable, writable, executable, searchable, setOwnerReadable, setOwnerWritable, setOwnerExecutable, setOwnerSearchable) -import System.FilePath.FilePather.ReadFilePath - ( ReadFilePathT1, - ReadFilePathT, - successReadFilePath, - tryReadFilePath ) -import System.FilePath ( FilePath ) -import System.IO ( IO ) - -createDirectory :: - Exception e => - ReadFilePathT1 e IO -createDirectory = - tryReadFilePath D.createDirectory -{-# INLINE createDirectory #-} - -createDirectoryIfMissing :: - Exception e => - Bool - -> ReadFilePathT1 e IO -createDirectoryIfMissing = - tryReadFilePath . D.createDirectoryIfMissing -{-# INLINE createDirectoryIfMissing #-} - -removeDirectory :: - Exception e => - ReadFilePathT1 e IO -removeDirectory = - tryReadFilePath D.removeDirectory -{-# INLINE removeDirectory #-} - -removeDirectoryRecursive :: - Exception e => - ReadFilePathT1 e IO -removeDirectoryRecursive = - tryReadFilePath D.removeDirectoryRecursive -{-# INLINE removeDirectoryRecursive #-} - -removePathForcibly :: - Exception e => - ReadFilePathT1 e IO -removePathForcibly = - tryReadFilePath D.removePathForcibly -{-# INLINE removePathForcibly #-} - -renameDirectory :: - Exception e => - FilePath - -> ReadFilePathT1 e IO -renameDirectory = - tryReadFilePath . D.renameDirectory -{-# INLINE renameDirectory #-} - -listDirectory :: - Exception e => - ReadFilePathT e IO [FilePath] -listDirectory = - tryReadFilePath D.listDirectory -{-# INLINE listDirectory #-} - -getDirectoryContents :: - Exception e => - ReadFilePathT e IO [FilePath] -getDirectoryContents = - tryReadFilePath D.listDirectory -{-# INLINE getDirectoryContents #-} - -getCurrentDirectory :: - Exception e => - ReadFilePathT e IO FilePath -getCurrentDirectory = - tryReadFilePath (pure D.getCurrentDirectory) -{-# INLINE getCurrentDirectory #-} - -setCurrentDirectory :: - Exception e => - ReadFilePathT e IO () -setCurrentDirectory = - tryReadFilePath D.setCurrentDirectory -{-# INLINE setCurrentDirectory #-} - -getHomeDirectory :: - Exception e => - ReadFilePathT e IO FilePath -getHomeDirectory = - tryReadFilePath (pure D.getHomeDirectory) -{-# INLINE getHomeDirectory #-} - -withCurrentDirectory :: - Exception e => - IO a - -> ReadFilePathT e IO a -withCurrentDirectory io = - tryReadFilePath (`D.withCurrentDirectory` io) -{-# INLINE withCurrentDirectory #-} - -getXdgDirectory :: - Exception e => - XdgDirectory - -> ReadFilePathT e IO FilePath -getXdgDirectory = - tryReadFilePath . D.getXdgDirectory -{-# INLINE getXdgDirectory #-} - -getAppUserDataDirectory :: - Exception e => - ReadFilePathT e IO FilePath -getAppUserDataDirectory = - tryReadFilePath D.getAppUserDataDirectory -{-# INLINE getAppUserDataDirectory #-} - -getUserDocumentsDirectory :: - Exception e => - ReadFilePathT e IO FilePath -getUserDocumentsDirectory = - tryReadFilePath (pure D.getUserDocumentsDirectory) -{-# INLINE getUserDocumentsDirectory #-} - -getTemporaryDirectory :: - Exception e => - ReadFilePathT e IO FilePath -getTemporaryDirectory = - tryReadFilePath (pure D.getTemporaryDirectory) -{-# INLINE getTemporaryDirectory #-} - -getXdgDirectoryList :: - Exception e => - XdgDirectoryList - -> ReadFilePathT e IO [FilePath] -getXdgDirectoryList = - tryReadFilePath . pure . D.getXdgDirectoryList -{-# INLINE getXdgDirectoryList #-} - -removeFile :: - Exception e => - ReadFilePathT1 e IO -removeFile = - tryReadFilePath D.removeFile -{-# INLINE removeFile #-} - -renameFile :: - Exception e => - FilePath - -> ReadFilePathT1 e IO -renameFile = - tryReadFilePath . D.renameFile -{-# INLINE renameFile #-} - -renamePath :: - Exception e => - FilePath - -> ReadFilePathT1 e IO -renamePath = - tryReadFilePath . D.renamePath -{-# INLINE renamePath #-} - -copyFile :: - Exception e => - FilePath - -> ReadFilePathT1 e IO -copyFile = - tryReadFilePath . D.copyFile -{-# INLINE copyFile #-} - -copyFileWithMetadata :: - Exception e => - FilePath - -> ReadFilePathT1 e IO -copyFileWithMetadata = - tryReadFilePath . D.copyFileWithMetadata -{-# INLINE copyFileWithMetadata #-} - -getFileSize :: - Exception e => - ReadFilePathT e IO Integer -getFileSize = - tryReadFilePath D.getFileSize -{-# INLINE getFileSize #-} - -canonicalizePath :: - Exception e => - ReadFilePathT e IO FilePath -canonicalizePath = - tryReadFilePath D.canonicalizePath -{-# INLINE canonicalizePath #-} - -makeAbsolute :: - Exception e => - ReadFilePathT e IO FilePath -makeAbsolute = - tryReadFilePath D.makeAbsolute -{-# INLINE makeAbsolute #-} - -makeRelativeToCurrentDirectory :: - Exception e => - ReadFilePathT e IO FilePath -makeRelativeToCurrentDirectory = - tryReadFilePath D.makeRelativeToCurrentDirectory -{-# INLINE makeRelativeToCurrentDirectory #-} - -doesPathExist :: - ReadFilePathT e IO Bool -doesPathExist = - successReadFilePath D.doesPathExist -{-# INLINE doesPathExist #-} - -doesFileExist :: - ReadFilePathT e IO Bool -doesFileExist = - successReadFilePath D.doesFileExist -{-# INLINE doesFileExist #-} - -doesDirectoryExist :: - ReadFilePathT e IO Bool -doesDirectoryExist = - successReadFilePath D.doesDirectoryExist -{-# INLINE doesDirectoryExist #-} - -findExecutable :: - ReadFilePathT e IO (Maybe FilePath) -findExecutable = - successReadFilePath D.findExecutable -{-# INLINE findExecutable #-} - -findExecutables :: - ReadFilePathT e IO [FilePath] -findExecutables = - successReadFilePath D.findExecutables -{-# INLINE findExecutables #-} - -findExecutablesInDirectories :: - [FilePath] - -> ReadFilePathT e IO [FilePath] -findExecutablesInDirectories = - successReadFilePath . D.findExecutablesInDirectories -{-# INLINE findExecutablesInDirectories #-} - -findFile :: - [FilePath] - -> ReadFilePathT e IO (Maybe FilePath) -findFile = - successReadFilePath . D.findFile -{-# INLINE findFile #-} - -findFiles :: - [FilePath] - -> ReadFilePathT e IO [FilePath] -findFiles = - successReadFilePath . D.findFiles -{-# INLINE findFiles #-} - -findFileWith :: - ReadFilePathT () IO () - -> [FilePath] - -> ReadFilePathT () IO FilePath -findFileWith x ps = - over _Wrapped (\k -> fmap (maybe (Left ()) Right) . D.findFileWith (fmap (either (\() -> False) (\() -> True)) . k) ps) x -{-# INLINE findFileWith #-} - -findFilesWith :: - ReadFilePathT () IO () - -> [FilePath] - -> ReadFilePathT e' IO [FilePath] -findFilesWith x ps = - over _Wrapped (\w -> fmap Right . D.findFilesWith (fmap (either (\() -> False) (\() -> True)) . w) ps) x -{-# INLINE findFilesWith #-} - -createFileLink :: - Exception e => - FilePath - -> ReadFilePathT1 e IO -createFileLink = - tryReadFilePath . D.createFileLink -{-# INLINE createFileLink #-} - -createDirectoryLink :: - Exception e => - FilePath - -> ReadFilePathT1 e IO -createDirectoryLink = - tryReadFilePath . D.createDirectoryLink -{-# INLINE createDirectoryLink #-} - -removeDirectoryLink :: - Exception e => - ReadFilePathT1 e IO -removeDirectoryLink = - tryReadFilePath D.removeDirectoryLink -{-# INLINE removeDirectoryLink #-} - -pathIsSymbolicLink :: - Exception e => - ReadFilePathT e IO Bool -pathIsSymbolicLink = - tryReadFilePath D.pathIsSymbolicLink -{-# INLINE pathIsSymbolicLink #-} - -getSymbolicLinkTarget :: - Exception e => - ReadFilePathT e IO FilePath -getSymbolicLinkTarget = - tryReadFilePath D.getSymbolicLinkTarget -{-# INLINE getSymbolicLinkTarget #-} - -getPermissions :: - Exception e => - ReadFilePathT e IO Permissions -getPermissions = - tryReadFilePath D.getPermissions -{-# INLINE getPermissions #-} - -setPermissions :: - Exception e => - Permissions - -> ReadFilePathT1 e IO -setPermissions p = - tryReadFilePath (`D.setPermissions` p) -{-# INLINE setPermissions #-} - -copyPermissions :: - Exception e => - FilePath - -> ReadFilePathT1 e IO -copyPermissions = - tryReadFilePath . D.copyPermissions -{-# INLINE copyPermissions #-} - -getAccessTime :: - Exception e => - ReadFilePathT e IO UTCTime -getAccessTime = - tryReadFilePath D.getAccessTime -{-# INLINE getAccessTime #-} - -getModificationTime :: - Exception e => - ReadFilePathT e IO UTCTime -getModificationTime = - tryReadFilePath D.getModificationTime -{-# INLINE getModificationTime #-} - -setAccessTime :: - Exception e => - UTCTime - -> ReadFilePathT1 e IO -setAccessTime u = - tryReadFilePath (`D.setAccessTime` u) -{-# INLINE setAccessTime #-} - -setModificationTime :: - Exception e => - UTCTime - -> ReadFilePathT1 e IO -setModificationTime u = - tryReadFilePath (`D.setModificationTime` u) -{-# INLINE setModificationTime #-} diff --git a/src/System/FilePath/FilePather/Find.hs b/src/System/FilePath/FilePather/Find.hs deleted file mode 100644 --- a/src/System/FilePath/FilePather/Find.hs +++ /dev/null @@ -1,83 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module System.FilePath.FilePather.Find( - findWith -, findWith' -, findAllDirectories -, findAll -, findAllFiles -) where - -import Control.Applicative ( Applicative(pure) ) -import Control.Category ( Category((.)) ) -import Control.Exception ( Exception ) -import Control.Lens ( view, _Wrapped, _1, _2 ) -import Control.Monad ( Monad((>>=)), filterM ) -import Control.Monad.IO.Class ( MonadIO(liftIO) ) -import Control.Monad.Reader - ( MonadReader(local, ask) ) -import Data.Bool ( Bool(True), bool ) -import Data.Foldable ( fold ) -import Data.Functor ( Functor(fmap), (<$>) ) -import Data.Maybe ( Maybe(..), catMaybes ) -import Data.Semigroup ( Semigroup((<>)) ) -import Data.Traversable ( Traversable(traverse) ) -import System.FilePath ( FilePath, () ) -import System.FilePath.FilePather.Directory - ( listDirectory, doesFileExist, doesDirectoryExist ) -import System.FilePath.FilePather.ReadFilePath ( ReadFilePathT ) -import System.IO ( IO ) -import System.IO.Unsafe( unsafeInterleaveIO ) - -findWith :: - Exception e => - ReadFilePathT e IO (Maybe b) - -> ReadFilePathT e IO [b] -findWith p = - let setl = - local . pure - mapMaybeM f xs = - catMaybes <$> traverse f xs - in do z <- ask - a <- listDirectory - let y = (z ) <$> a - b <- mapMaybeM (\fp -> fmap (fmap (\s -> (s, fp))) (fp `setl` p)) y - d <- filterM (`setl` doesDirectoryExist) (fmap (view _2) b) - let bs = fmap (view _1) b - case d of - [] -> - pure bs - _ -> - do n <- liftIO (unsafeInterleaveIO (fmap (>>= fold) (traverse (view _Wrapped (findWith p)) d))) - pure (bs <> n) -{-# INLINE findWith #-} - -findWith' :: - Exception e => - ReadFilePathT e IO Bool - -> ReadFilePathT e IO [FilePath] -findWith' s = - findWith (ask >>= \d -> fmap (bool Nothing (Just d)) s) -{-# INLINE findWith' #-} - -findAllDirectories :: - Exception e => - ReadFilePathT e IO [FilePath] -findAllDirectories = - findWith' doesDirectoryExist -{-# INLINE findAllDirectories #-} - -findAll :: - Exception e => - ReadFilePathT e IO [FilePath] -findAll = - findWith' (pure True) -{-# INLINE findAll #-} - -findAllFiles :: - Exception e => - ReadFilePathT e IO [FilePath] -findAllFiles = - findAll >>= filterM (\p -> local (pure p) doesFileExist) -{-# INLINE findAllFiles #-} diff --git a/src/System/FilePath/FilePather/IO.hs b/src/System/FilePath/FilePather/IO.hs deleted file mode 100644 --- a/src/System/FilePath/FilePather/IO.hs +++ /dev/null @@ -1,133 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module System.FilePath.FilePather.IO( - readFile -, readFile' -, appendFile -, writeFile -, withFile -, openFile -, withBinaryFile -, openBinaryFile -, openTempFile -, openBinaryTempFile -, openTempFileWithDefaultPermissions -, openBinaryTempFileWithDefaultPermissions -) where - -import Control.Exception ( Exception ) -import Data.String ( String ) -import System.FilePath(FilePath) -import System.FilePath.FilePather.ReadFilePath - ( ReadFilePathT, tryReadFilePath ) -import qualified System.IO as I - ( appendFile, - readFile, - writeFile, - openBinaryFile, - openFile, - openBinaryTempFile, - openBinaryTempFileWithDefaultPermissions, - openTempFile, - openTempFileWithDefaultPermissions, - readFile', - withBinaryFile, - withFile ) -import System.IO(IO, IOMode, Handle) - -readFile :: - Exception e => - ReadFilePathT e IO String -readFile = - tryReadFilePath I.readFile -{-# INLINE readFile #-} - -readFile' :: - Exception e => - ReadFilePathT e IO String -readFile' = - tryReadFilePath I.readFile' -{-# INLINE readFile' #-} - -appendFile :: - Exception e => - String - -> ReadFilePathT e IO () -appendFile s = - tryReadFilePath (`I.appendFile` s) -{-# INLINE appendFile #-} - -writeFile :: - Exception e => - String - -> ReadFilePathT e IO () -writeFile s = - tryReadFilePath (`I.writeFile` s) -{-# INLINE writeFile #-} - -withFile :: - Exception e => - IOMode - -> (Handle -> IO r) - -> ReadFilePathT e IO r -withFile mode k = - tryReadFilePath (\p -> I.withFile p mode k) -{-# INLINE withFile #-} - -openFile :: - Exception e => - IOMode - -> ReadFilePathT e IO Handle -openFile mode = - tryReadFilePath (`I.openFile` mode) -{-# INLINE openFile #-} - -withBinaryFile :: - Exception e => - IOMode - -> (Handle -> IO r) - -> ReadFilePathT e IO r -withBinaryFile mode k = - tryReadFilePath (\p -> I.withBinaryFile p mode k) -{-# INLINE withBinaryFile #-} - -openBinaryFile :: - Exception e => - IOMode - -> ReadFilePathT e IO Handle -openBinaryFile mode = - tryReadFilePath (`I.openBinaryFile` mode) -{-# INLINE openBinaryFile #-} - -openTempFile :: - Exception e => - String - -> ReadFilePathT e IO (FilePath, Handle) -openTempFile s = - tryReadFilePath (`I.openTempFile` s) -{-# INLINE openTempFile #-} - -openBinaryTempFile :: - Exception e => - String - -> ReadFilePathT e IO (FilePath, Handle) -openBinaryTempFile s = - tryReadFilePath (`I.openBinaryTempFile` s) -{-# INLINE openBinaryTempFile #-} - -openTempFileWithDefaultPermissions :: - Exception e => - String - -> ReadFilePathT e IO (FilePath, Handle) -openTempFileWithDefaultPermissions s = - tryReadFilePath (`I.openTempFileWithDefaultPermissions` s) -{-# INLINE openTempFileWithDefaultPermissions #-} - -openBinaryTempFileWithDefaultPermissions :: - Exception e => - String - -> ReadFilePathT e IO (FilePath, Handle) -openBinaryTempFileWithDefaultPermissions s = - tryReadFilePath (`I.openBinaryTempFileWithDefaultPermissions` s) -{-# INLINE openBinaryTempFileWithDefaultPermissions #-} diff --git a/src/System/FilePath/FilePather/Posix.hs b/src/System/FilePath/FilePather/Posix.hs deleted file mode 100644 --- a/src/System/FilePath/FilePather/Posix.hs +++ /dev/null @@ -1,350 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module System.FilePath.FilePather.Posix ( - splitExtension -, takeExtension -, replaceExtension -, dropExtension -, addExtension -, hasExtension -, splitExtensions -, dropExtensions -, takeExtensions -, replaceExtensions -, isExtensionOf -, stripExtension -, splitFileName -, takeFileName -, replaceFileName -, dropFileName -, takeBaseName -, replaceBaseName -, takeDirectory -, replaceDirectory -, combine -, splitPath -, joinPath -, splitDirectories -, splitDrive -, joinDrive -, takeDrive -, hasDrive -, dropDrive -, isDrive -, hasTrailingPathSeparator -, addTrailingPathSeparator -, dropTrailingPathSeparator -, normalise -, equalFilePath -, makeRelative -, isRelative -, isAbsolute -, isValid -, makeValid -, module SFP -) where - -import Control.Applicative ( Applicative ) -import Control.Category((.)) -import Data.String( String ) -import Data.Bool( Bool ) -import Data.Maybe ( Maybe ) -import qualified System.FilePath.Posix as FP -import System.FilePath.Posix as SFP( FilePath ) -import System.FilePath.FilePather.ReadFilePath - ( ReadFilePathT, liftReadFilePath ) -import System.FilePath.FilePather.ReadFilePaths - ( ReadFilePathsT, liftReadFilePaths ) - -splitExtension :: - Applicative f => - ReadFilePathT e f (String, String) -splitExtension = - liftReadFilePath FP.splitExtension -{-# INLINE splitExtension #-} - -takeExtension :: - Applicative f => - ReadFilePathT e f String -takeExtension = - liftReadFilePath FP.takeExtension -{-# INLINE takeExtension #-} - -replaceExtension :: - Applicative f => - String - -> ReadFilePathT e f FilePath -replaceExtension = - liftReadFilePath . FP.replaceExtension -{-# INLINE replaceExtension #-} - -dropExtension :: - Applicative f => - ReadFilePathT e f FilePath -dropExtension = - liftReadFilePath FP.dropExtensions -{-# INLINE dropExtension #-} - -addExtension :: - Applicative f => - String - -> ReadFilePathT e f FilePath -addExtension = - liftReadFilePath . FP.addExtension -{-# INLINE addExtension #-} - -hasExtension :: - Applicative f => - ReadFilePathT e f Bool -hasExtension = - liftReadFilePath FP.hasExtension -{-# INLINE hasExtension #-} - -splitExtensions :: - Applicative f => - ReadFilePathT e f (FilePath, String) -splitExtensions = - liftReadFilePath FP.splitExtensions -{-# INLINE splitExtensions #-} - -dropExtensions :: - Applicative f => - ReadFilePathT e f FilePath -dropExtensions = - liftReadFilePath FP.dropExtensions -{-# INLINE dropExtensions #-} - -takeExtensions :: - Applicative f => - ReadFilePathT e f String -takeExtensions = - liftReadFilePath FP.takeExtensions -{-# INLINE takeExtensions #-} - -replaceExtensions :: - Applicative f => - String - -> ReadFilePathT e f FilePath -replaceExtensions = - liftReadFilePath . FP.replaceExtensions -{-# INLINE replaceExtensions #-} - -isExtensionOf :: - Applicative f => - String - -> ReadFilePathT e f Bool -isExtensionOf = - liftReadFilePath . FP.isExtensionOf -{-# INLINE isExtensionOf #-} - -stripExtension :: - Applicative f => - String - -> ReadFilePathT e f (Maybe FilePath) -stripExtension = - liftReadFilePath . FP.stripExtension -{-# INLINE stripExtension #-} - -splitFileName :: - Applicative f => - ReadFilePathT e f (String, String) -splitFileName = - liftReadFilePath FP.splitFileName -{-# INLINE splitFileName #-} - -takeFileName :: - Applicative f => - ReadFilePathT e f String -takeFileName = - liftReadFilePath FP.takeFileName -{-# INLINE takeFileName #-} - -replaceFileName :: - Applicative f => - String - -> ReadFilePathT e f FilePath -replaceFileName = - liftReadFilePath . FP.replaceFileName -{-# INLINE replaceFileName #-} - -dropFileName :: - Applicative f => - ReadFilePathT e f FilePath -dropFileName = - liftReadFilePath FP.dropFileName -{-# INLINE dropFileName #-} - -takeBaseName :: - Applicative f => - ReadFilePathT e f String -takeBaseName = - liftReadFilePath FP.takeBaseName -{-# INLINE takeBaseName #-} - -replaceBaseName :: - Applicative f => - String -> - ReadFilePathT e f FilePath -replaceBaseName = - liftReadFilePath . FP.replaceBaseName -{-# INLINE replaceBaseName #-} - -takeDirectory :: - Applicative f => - ReadFilePathT e f FilePath -takeDirectory = - liftReadFilePath FP.takeDirectory -{-# INLINE takeDirectory #-} - -replaceDirectory :: - Applicative f => - String -> - ReadFilePathT e f FilePath -replaceDirectory = - liftReadFilePath . FP.replaceDirectory -{-# INLINE replaceDirectory #-} - -combine :: - Applicative f => - FilePath - -> ReadFilePathT e f FilePath -combine = - liftReadFilePath . FP.combine -{-# INLINE combine #-} - -splitPath :: - Applicative f => - ReadFilePathT e f [FilePath] -splitPath = - liftReadFilePath FP.splitPath -{-# INLINE splitPath #-} - -joinPath :: - Applicative f => - ReadFilePathsT e f FilePath -joinPath = - liftReadFilePaths FP.joinPath -{-# INLINE joinPath #-} - -splitDirectories :: - Applicative f => - ReadFilePathT e f [FilePath] -splitDirectories = - liftReadFilePath FP.splitDirectories -{-# INLINE splitDirectories #-} - -splitDrive :: - Applicative f => - ReadFilePathT e f (FilePath, FilePath) -splitDrive = - liftReadFilePath FP.splitDrive -{-# INLINE splitDrive #-} - -joinDrive :: - Applicative f => - FilePath - -> ReadFilePathT e f FilePath -joinDrive = - liftReadFilePath . FP.joinDrive -{-# INLINE joinDrive #-} - -takeDrive :: - Applicative f => - ReadFilePathT e f FilePath -takeDrive = - liftReadFilePath FP.takeDrive -{-# INLINE takeDrive #-} - -hasDrive :: - Applicative f => - ReadFilePathT e f Bool -hasDrive = - liftReadFilePath FP.hasDrive -{-# INLINE hasDrive #-} - -dropDrive :: - Applicative f => - ReadFilePathT e f FilePath -dropDrive = - liftReadFilePath FP.dropDrive -{-# INLINE dropDrive #-} - -isDrive :: - Applicative f => - ReadFilePathT e f Bool -isDrive = - liftReadFilePath FP.isDrive -{-# INLINE isDrive #-} - -hasTrailingPathSeparator :: - Applicative f => - ReadFilePathT e f Bool -hasTrailingPathSeparator = - liftReadFilePath FP.hasTrailingPathSeparator -{-# INLINE hasTrailingPathSeparator #-} - -addTrailingPathSeparator :: - Applicative f => - ReadFilePathT e f FilePath -addTrailingPathSeparator = - liftReadFilePath FP.addTrailingPathSeparator -{-# INLINE addTrailingPathSeparator #-} - -dropTrailingPathSeparator :: - Applicative f => - ReadFilePathT e f FilePath -dropTrailingPathSeparator = - liftReadFilePath FP.dropTrailingPathSeparator -{-# INLINE dropTrailingPathSeparator #-} - -normalise :: - Applicative f => - ReadFilePathT e f FilePath -normalise = - liftReadFilePath FP.normalise -{-# INLINE normalise #-} - -equalFilePath :: - Applicative f => - FilePath - -> ReadFilePathT e f Bool -equalFilePath = - liftReadFilePath . FP.equalFilePath -{-# INLINE equalFilePath #-} - -makeRelative :: - Applicative f => - FilePath - -> ReadFilePathT e f FilePath -makeRelative = - liftReadFilePath . FP.makeRelative -{-# INLINE makeRelative #-} - -isRelative :: - Applicative f => - ReadFilePathT e f Bool -isRelative = - liftReadFilePath FP.isRelative -{-# INLINE isRelative #-} - -isAbsolute :: - Applicative f => - ReadFilePathT e f Bool -isAbsolute = - liftReadFilePath FP.isAbsolute -{-# INLINE isAbsolute #-} - -isValid :: - Applicative f => - ReadFilePathT e f Bool -isValid = - liftReadFilePath FP.isValid -{-# INLINE isValid #-} - -makeValid :: - Applicative f => - ReadFilePathT e f FilePath -makeValid = - liftReadFilePath FP.makeValid -{-# INLINE makeValid #-} diff --git a/src/System/FilePath/FilePather/Process.hs b/src/System/FilePath/FilePather/Process.hs deleted file mode 100644 --- a/src/System/FilePath/FilePather/Process.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module System.FilePath.FilePather.Process( - spawnProcess -, showCommandForUser -, readProcess -, proc -, callProcess -, readProcessWithExitCode -) where - -import Control.Exitcode as E ( ExitcodeT ) -import Control.Exception ( Exception ) -import Control.Monad.Reader.Class ( MonadReader(reader) ) -import Control.Monad.Except ( ExceptT ) -import Control.Process( ProcessHandle, CreateProcess ) -import qualified Control.Process as P -import Data.String ( String ) -import System.FilePath.FilePather.ReadFilePath - ( ReadFilePath, - ReadFilePathT, - successReadFilePath, - tryReadFilePath ) -import System.IO ( IO ) - -spawnProcess :: - Exception e => - [String] - -> ReadFilePathT e IO ProcessHandle -spawnProcess x = - tryReadFilePath (`P.spawnProcess` x) - -showCommandForUser :: - [String] - -> ReadFilePath e String -showCommandForUser x = - reader (`P.showCommandForUser` x) - -readProcess :: - Exception e => - [String] - -> String - -> ReadFilePathT e IO String -readProcess args i = - tryReadFilePath (\p -> P.readProcess p args i) - -proc :: - [String] - -> ReadFilePath e CreateProcess -proc s = - reader (`P.proc` s) - -callProcess :: - Exception e => - [String] - -> ReadFilePathT e IO () -callProcess s = - tryReadFilePath (`P.callProcess` s) - -readProcessWithExitCode :: - Exception e' => - [String] - -> String - -> ReadFilePathT e (ExitcodeT (ExceptT e' IO) (String, String)) (String, String) -readProcessWithExitCode as a = - successReadFilePath (\p -> P.readProcessWithExitCode p as a) diff --git a/src/System/FilePath/FilePather/ReadFilePath.hs b/src/System/FilePath/FilePather/ReadFilePath.hs deleted file mode 100644 --- a/src/System/FilePath/FilePather/ReadFilePath.hs +++ /dev/null @@ -1,284 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module System.FilePath.FilePather.ReadFilePath( - ReadFilePathT(..) -, ReadFilePath -, ReadFilePathT1 -, ReadFilePath1 -, readFilePath -, swapReadFilePath -, pureReadFilePath -, liftReadFilePath -, successReadFilePath -, errorReadFilePath -, maybeReadFilePath -, tryReadFilePath -) where - -import Control.Applicative ( Applicative((<*>), pure) ) -import Control.Category ( Category((.)) ) -import Control.Exception ( try, Exception ) -import Control.Lens - ( view, - iso, - swapped, - _Wrapped, - Field1(_1), - Iso, - Rewrapped, - Wrapped(..) ) -import Control.Monad - ( join, Monad(return, (>>=)) ) -import Control.Monad.Cont.Class ( MonadCont(callCC) ) -import Control.Monad.Error.Class ( MonadError(throwError, catchError) ) -import Control.Monad.Fail ( MonadFail(fail) ) -import Control.Monad.Fix ( MonadFix(mfix) ) -import Control.Monad.IO.Class ( MonadIO(liftIO) ) -import Control.Monad.Morph ( MFunctor(hoist), MMonad(embed) ) -import Control.Monad.Reader.Class ( MonadReader(reader, local, ask) ) -import Control.Monad.State.Class ( MonadState(state, get, put) ) -import Control.Monad.Trans.Class(MonadTrans(lift)) -import Control.Monad.Writer.Class ( MonadWriter(pass, tell, writer, listen) ) -import Control.Monad.Zip ( MonadZip(mzipWith) ) -import Data.Either ( Either(..), either ) -import Data.Functor ( Functor(fmap) ) -import Data.Functor.Alt ( Apply((<.>)), Alt(()) ) -import Data.Functor.Bind ( Bind((>>-)) ) -import Data.Functor.Identity( Identity(..) ) -import Data.Maybe ( Maybe, maybe ) -import Data.Monoid ( Monoid(mempty, mappend) ) -import Data.Semigroup ( Semigroup((<>)) ) -import System.FilePath ( FilePath ) -import System.IO ( IO ) - -newtype ReadFilePathT e f a = - ReadFilePathT (FilePath -> f (Either e a)) - -instance ReadFilePathT e f a ~ t => - Rewrapped (ReadFilePathT e' f' a') t - -instance Wrapped (ReadFilePathT e f a) where - type Unwrapped (ReadFilePathT e f a) = - FilePath - -> f (Either e a) - _Wrapped' = - iso (\(ReadFilePathT x) -> x) ReadFilePathT - {-# INLINE _Wrapped' #-} - -type ReadFilePath e a = - ReadFilePathT e Identity a - -type ReadFilePathT1 e f = - ReadFilePathT e f () - -type ReadFilePath1 e f = - ReadFilePath e () - -readFilePath :: - Iso - (ReadFilePath e a) - (ReadFilePath e' a') - (FilePath -> Either e a) - (FilePath -> Either e' a') -readFilePath = - iso - (\(ReadFilePathT x) -> runIdentity . x) - (\p -> ReadFilePathT (Identity . p)) -{-# INLINE readFilePath #-} - -swapReadFilePath :: - Functor f => - Iso - (ReadFilePathT e f a) - (ReadFilePathT e' f a') - (ReadFilePathT a f e) - (ReadFilePathT a' f e') -swapReadFilePath = - iso - (\r -> ReadFilePathT (fmap (view swapped) . view _Wrapped r)) - (\r -> ReadFilePathT (fmap (view swapped) . view _Wrapped r)) -{-# INLINE swapReadFilePath #-} - -pureReadFilePath :: - Applicative f => - ReadFilePath e a - -> ReadFilePathT e f a -pureReadFilePath = - hoist (pure . runIdentity) -{-# INLINE pureReadFilePath #-} - -liftReadFilePath :: - Applicative f => - (FilePath -> a) - -> ReadFilePathT e f a -liftReadFilePath = - pureReadFilePath . reader -{-# INLINE liftReadFilePath #-} - -successReadFilePath :: - Functor f => - (FilePath -> f a) - -> ReadFilePathT e f a -successReadFilePath k = - ReadFilePathT (fmap Right . k) -{-# INLINE successReadFilePath #-} - -errorReadFilePath :: - Functor f => - (FilePath -> f e) - -> ReadFilePathT e f a -errorReadFilePath k = - ReadFilePathT (fmap Left . k) -{-# INLINE errorReadFilePath #-} - -maybeReadFilePath :: - Functor f => - (FilePath -> f (Maybe a)) - -> ReadFilePathT () f a -maybeReadFilePath k = - ReadFilePathT (fmap (maybe (Left ()) Right) . k) -{-# INLINE maybeReadFilePath #-} - -tryReadFilePath :: - Exception e => - (FilePath -> IO a) - -> ReadFilePathT e IO a -tryReadFilePath k = - ReadFilePathT (try . k) -{-# INLINE tryReadFilePath #-} - -instance (Monad f, Semigroup a) => Semigroup (ReadFilePathT e f a) where - ReadFilePathT x <> ReadFilePathT y = - ReadFilePathT (\p -> x p >>= either (pure . Left) (\a -> fmap (fmap (a <>)) (y p))) - {-# INLINE (<>) #-} - -instance (Monad f, Monoid a) => Monoid (ReadFilePathT e f a) where - mappend = - (<>) - {-# INLINE mappend #-} - mempty = - ReadFilePathT (pure (pure (pure mempty))) - {-# INLINE mempty #-} - -instance Functor f => Functor (ReadFilePathT e f) where - fmap f (ReadFilePathT x) = - ReadFilePathT (fmap (fmap (fmap f)) x) - {-# INLINE fmap #-} - -instance Monad f => Apply (ReadFilePathT e f) where - ReadFilePathT f <.> ReadFilePathT k = - ReadFilePathT (\p -> f p >>= either (pure . Left) (\a -> fmap (fmap a) (k p))) - {-# INLINE (<.>) #-} - -instance Monad f => Bind (ReadFilePathT e f) where - ReadFilePathT f >>- g = - ReadFilePathT (\p -> f p >>= either (pure . Left) (\a -> view _Wrapped (g a) p)) - {-# INLINE (>>-) #-} - -instance Monad f => Applicative (ReadFilePathT e f) where - (<*>) = - (<.>) - pure = - ReadFilePathT . pure . pure . pure - -instance Monad f => Alt (ReadFilePathT e f) where - ReadFilePathT a ReadFilePathT b = - ReadFilePathT (\p -> a p >>= either (pure (b p)) (pure . pure)) - {-# INLINE () #-} - -instance Monad f => Monad (ReadFilePathT e f) where - (>>=) = - (>>-) - {-# INLINE (>>=) #-} - return = - pure - {-# INLINE return #-} - -instance MonadTrans (ReadFilePathT e) where - lift = - ReadFilePathT . pure . fmap pure - {-# INLINE lift #-} - -instance MonadIO f => MonadIO (ReadFilePathT e f) where - liftIO = - ReadFilePathT . pure . liftIO . fmap pure - {-# INLINE liftIO #-} - -instance MFunctor (ReadFilePathT e) where - hoist k (ReadFilePathT f) = - ReadFilePathT (k .f) - {-# INLINE hoist #-} - -instance MMonad (ReadFilePathT e) where - embed k (ReadFilePathT f) = - ReadFilePathT (\p -> fmap join (view _Wrapped (k (f p)) p)) - {-# INLINE embed #-} - -instance Monad f => MonadReader FilePath (ReadFilePathT e f) where - ask = - ReadFilePathT (pure . pure) - {-# INLINE ask #-} - local k (ReadFilePathT f) = - ReadFilePathT (f . k) - {-# INLINE local #-} - reader k = - ReadFilePathT (pure . pure . k) - {-# INLINE reader #-} - -instance MonadState FilePath f => MonadState FilePath (ReadFilePathT e f) where - state = - lift . state - {-# INLINE state #-} - get = - lift get - {-# INLINE get #-} - put = - lift . put - {-# INLINE put #-} - -instance MonadWriter FilePath f => MonadWriter FilePath (ReadFilePathT e f) where - writer = - lift . writer - {-# INLINE writer #-} - tell = - lift . tell - {-# INLINE tell #-} - listen (ReadFilePathT f) = - ReadFilePathT (\p -> fmap (fmap (\a -> (a, p))) (f p)) - {-# INLINE listen #-} - pass (ReadFilePathT f) = - ReadFilePathT (fmap (fmap (view _1)) . f) - {-# INLINE pass #-} - -instance MonadFail f => MonadFail (ReadFilePathT e f) where - fail = - lift . fail - {-# INLINE fail #-} - -instance MonadFix f => MonadFix (ReadFilePathT e f) where - mfix f = - ReadFilePathT (\p -> mfix (either (pure . Left) (\a -> view _Wrapped (f a) p))) - {-# INLINE mfix #-} - -instance MonadZip f => MonadZip (ReadFilePathT e f) where - mzipWith f (ReadFilePathT m) (ReadFilePathT n) = - ReadFilePathT (\p -> m p >>= either (pure . Left) (\a -> fmap (fmap (f a)) (n p))) - {-# INLINE mzipWith #-} - -instance MonadCont f => MonadCont (ReadFilePathT e f) where - callCC p = - ReadFilePathT (\r -> callCC (\c -> view _Wrapped (p (ReadFilePathT . pure . c . pure)) r)) - {-# INLINE callCC #-} - -instance MonadError e f => MonadError e (ReadFilePathT e f) where - throwError = - lift . throwError - {-# INLINE throwError #-} - catchError (ReadFilePathT f) g = - ReadFilePathT (\ r -> catchError (f r) (\ e -> view _Wrapped (g e) r)) - {-# INLINE catchError #-} diff --git a/src/System/FilePath/FilePather/ReadFilePaths.hs b/src/System/FilePath/FilePather/ReadFilePaths.hs deleted file mode 100644 --- a/src/System/FilePath/FilePather/ReadFilePaths.hs +++ /dev/null @@ -1,295 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module System.FilePath.FilePather.ReadFilePaths ( - ReadFilePathsT -, ReadFilePaths -, ReadFilePathsT1 -, ReadFilePaths1 -, readFilePaths1 -, readFilePaths -, swapReadFilePaths -, pureReadFilePaths -, liftReadFilePaths -, successReadFilePaths -, errorReadFilePaths -, maybeReadFilePaths -, tryReadFilePaths -) where - -import Control.Applicative ( Applicative((<*>), pure) ) -import Control.Category ( Category((.)) ) -import Control.Exception ( try, Exception ) -import Control.Lens - ( view, - iso, - swapped, - _Wrapped, - Field1(_1), - Iso, - Rewrapped, - Wrapped(..) ) -import Control.Monad - ( join, Monad(return, (>>=)) ) -import Control.Monad.Cont.Class ( MonadCont(callCC) ) -import Control.Monad.Error.Class ( MonadError(throwError, catchError) ) -import Control.Monad.Fail ( MonadFail(fail) ) -import Control.Monad.Fix ( MonadFix(mfix) ) -import Control.Monad.IO.Class ( MonadIO(liftIO) ) -import Control.Monad.Morph ( MFunctor(hoist), MMonad(embed) ) -import Control.Monad.Reader.Class ( MonadReader(reader, local, ask) ) -import Control.Monad.State.Class ( MonadState(state, get, put) ) -import Control.Monad.Trans.Class(MonadTrans(lift)) -import Control.Monad.Writer.Class ( MonadWriter(pass, tell, writer, listen) ) -import Control.Monad.Zip ( MonadZip(mzipWith) ) -import Data.Either ( Either(..), either ) -import Data.Functor ( Functor(fmap) ) -import Data.Functor.Alt ( Apply((<.>)), Alt(()) ) -import Data.Functor.Bind ( Bind((>>-)) ) -import Data.Functor.Identity( Identity(..) ) -import Data.Maybe ( Maybe, maybe ) -import Data.Monoid ( Monoid(mempty, mappend) ) -import Data.Semigroup ( Semigroup((<>)) ) -import System.FilePath ( FilePath ) -import System.FilePath.FilePather.ReadFilePath - ( ReadFilePathT(..) ) -import System.IO ( IO ) - -newtype ReadFilePathsT e f a = - ReadFilePathsT ([FilePath] -> f (Either e a)) - -instance ReadFilePathsT e f a ~ t => - Rewrapped (ReadFilePathsT e' f' a') t - -instance Wrapped (ReadFilePathsT e f a) where - type Unwrapped (ReadFilePathsT e f a) = - [FilePath] - -> f (Either e a) - _Wrapped' = - iso (\(ReadFilePathsT x) -> x) ReadFilePathsT - {-# INLINE _Wrapped' #-} - -type ReadFilePaths e a = - ReadFilePathsT e Identity a - -type ReadFilePathsT1 e f = - ReadFilePathsT e f () - -type ReadFilePaths1 e f = - ReadFilePaths e () - -readFilePaths1 :: - ReadFilePathsT e f a - -> ReadFilePathT e f a -readFilePaths1 x = - ReadFilePathT (view _Wrapped x . pure) -{-# INLINE readFilePaths1 #-} - -readFilePaths :: - Iso - (ReadFilePaths e a) - (ReadFilePaths e' a') - ([FilePath] -> Either e a) - ([FilePath] -> Either e' a') -readFilePaths = - iso - (\(ReadFilePathsT x) -> runIdentity . x) - (\p -> ReadFilePathsT (Identity . p)) -{-# INLINE readFilePaths #-} - -swapReadFilePaths :: - Functor f => - Iso - (ReadFilePathsT e f a) - (ReadFilePathsT e' f a') - (ReadFilePathsT a f e) - (ReadFilePathsT a' f e') -swapReadFilePaths = - iso - (\r -> ReadFilePathsT (fmap (view swapped) . view _Wrapped r)) - (\r -> ReadFilePathsT (fmap (view swapped) . view _Wrapped r)) -{-# INLINE swapReadFilePaths #-} - -pureReadFilePaths :: - Applicative f => - ReadFilePaths e a - -> ReadFilePathsT e f a -pureReadFilePaths = - hoist (pure . runIdentity) -{-# INLINE pureReadFilePaths #-} - -liftReadFilePaths :: - Applicative f => - ([FilePath] -> a) - -> ReadFilePathsT e f a -liftReadFilePaths = - pureReadFilePaths . reader -{-# INLINE liftReadFilePaths #-} - -successReadFilePaths :: - Functor f => - ([FilePath] -> f a) - -> ReadFilePathsT e f a -successReadFilePaths k = - ReadFilePathsT (fmap Right . k) -{-# INLINE successReadFilePaths #-} - -errorReadFilePaths :: - Functor f => - ([FilePath] -> f e) - -> ReadFilePathsT e f a -errorReadFilePaths k = - ReadFilePathsT (fmap Left . k) -{-# INLINE errorReadFilePaths #-} - -maybeReadFilePaths :: - Functor f => - ([FilePath] -> f (Maybe a)) - -> ReadFilePathsT () f a -maybeReadFilePaths k = - ReadFilePathsT (fmap (maybe (Left ()) Right) . k) -{-# INLINE maybeReadFilePaths #-} - -tryReadFilePaths :: - Exception e => - ([FilePath] -> IO a) - -> ReadFilePathsT e IO a -tryReadFilePaths k = - ReadFilePathsT (try . k) -{-# INLINE tryReadFilePaths #-} - -instance (Monad f, Semigroup a) => Semigroup (ReadFilePathsT e f a) where - ReadFilePathsT x <> ReadFilePathsT y = - ReadFilePathsT (\p -> x p >>= either (pure . Left) (\a -> fmap (fmap (a <>)) (y p))) - {-# INLINE (<>) #-} - -instance (Monad f, Monoid a) => Monoid (ReadFilePathsT e f a) where - mappend = - (<>) - {-# INLINE mappend #-} - mempty = - ReadFilePathsT (pure (pure (pure mempty))) - {-# INLINE mempty #-} - -instance Functor f => Functor (ReadFilePathsT e f) where - fmap f (ReadFilePathsT x) = - ReadFilePathsT (fmap (fmap (fmap f)) x) - {-# INLINE fmap #-} - -instance Monad f => Apply (ReadFilePathsT e f) where - ReadFilePathsT f <.> ReadFilePathsT k = - ReadFilePathsT (\p -> f p >>= either (pure . Left) (\a -> fmap (fmap a) (k p))) - {-# INLINE (<.>) #-} - -instance Monad f => Bind (ReadFilePathsT e f) where - ReadFilePathsT f >>- g = - ReadFilePathsT (\p -> f p >>= either (pure . Left) (\a -> view _Wrapped (g a) p)) - {-# INLINE (>>-) #-} - -instance Monad f => Applicative (ReadFilePathsT e f) where - (<*>) = - (<.>) - pure = - ReadFilePathsT . pure . pure . pure - -instance Monad f => Alt (ReadFilePathsT e f) where - ReadFilePathsT a ReadFilePathsT b = - ReadFilePathsT (\p -> a p >>= either (pure (b p)) (pure . pure)) - {-# INLINE () #-} - -instance Monad f => Monad (ReadFilePathsT e f) where - (>>=) = - (>>-) - {-# INLINE (>>=) #-} - return = - pure - {-# INLINE return #-} - -instance MonadTrans (ReadFilePathsT e) where - lift = - ReadFilePathsT . pure . fmap pure - {-# INLINE lift #-} - -instance MonadIO f => MonadIO (ReadFilePathsT e f) where - liftIO = - ReadFilePathsT . pure . liftIO . fmap pure - {-# INLINE liftIO #-} - -instance MFunctor (ReadFilePathsT e) where - hoist k (ReadFilePathsT f) = - ReadFilePathsT (k .f) - {-# INLINE hoist #-} - -instance MMonad (ReadFilePathsT e) where - embed k (ReadFilePathsT f) = - ReadFilePathsT (\p -> fmap join (view _Wrapped (k (f p)) p)) - {-# INLINE embed #-} - -instance Monad f => MonadReader [FilePath] (ReadFilePathsT e f) where - ask = - ReadFilePathsT (pure . pure) - {-# INLINE ask #-} - local k (ReadFilePathsT f) = - ReadFilePathsT (f . k) - {-# INLINE local #-} - reader k = - ReadFilePathsT (pure . pure . k) - {-# INLINE reader #-} - -instance MonadState [FilePath] f => MonadState [FilePath] (ReadFilePathsT e f) where - state = - lift . state - {-# INLINE state #-} - get = - lift get - {-# INLINE get #-} - put = - lift . put - {-# INLINE put #-} - -instance MonadWriter [FilePath] f => MonadWriter [FilePath] (ReadFilePathsT e f) where - writer = - lift . writer - {-# INLINE writer #-} - tell = - lift . tell - {-# INLINE tell #-} - listen (ReadFilePathsT f) = - ReadFilePathsT (\p -> fmap (fmap (\a -> (a, p))) (f p)) - {-# INLINE listen #-} - pass (ReadFilePathsT f) = - ReadFilePathsT (fmap (fmap (view _1)) . f) - {-# INLINE pass #-} - -instance MonadFail f => MonadFail (ReadFilePathsT e f) where - fail = - lift . fail - {-# INLINE fail #-} - -instance MonadFix f => MonadFix (ReadFilePathsT e f) where - mfix f = - ReadFilePathsT (\p -> mfix (either (pure . Left) (\a -> view _Wrapped (f a) p))) - {-# INLINE mfix #-} - -instance MonadZip f => MonadZip (ReadFilePathsT e f) where - mzipWith f (ReadFilePathsT m) (ReadFilePathsT n) = - ReadFilePathsT (\p -> m p >>= either (pure . Left) (\a -> fmap (fmap (f a)) (n p))) - {-# INLINE mzipWith #-} - -instance MonadCont f => MonadCont (ReadFilePathsT e f) where - callCC p = - ReadFilePathsT (\r -> callCC (\c -> view _Wrapped (p (ReadFilePathsT . pure . c . pure)) r)) - {-# INLINE callCC #-} - -instance MonadError e f => MonadError e (ReadFilePathsT e f) where - throwError = - lift . throwError - {-# INLINE throwError #-} - catchError (ReadFilePathsT f) g = - ReadFilePathsT (\ r -> catchError (f r) (\ e -> view _Wrapped (g e) r)) - {-# INLINE catchError #-} - diff --git a/src/System/FilePather.hs b/src/System/FilePather.hs new file mode 100644 --- /dev/null +++ b/src/System/FilePather.hs @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wall #-} + +-- | +-- Module : System.FilePather +-- Description : FilePath and Directory operations via Kleisli type aliases +module System.FilePather + ( module System.FilePather.FilePather, + ) +where + +import System.FilePather.FilePather diff --git a/src/System/FilePather/FilePather.hs b/src/System/FilePather/FilePather.hs new file mode 100644 --- /dev/null +++ b/src/System/FilePather/FilePather.hs @@ -0,0 +1,950 @@ +{-# 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, + + -- * 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 Data.Functor.Identity +import Data.Kleisli (Kleisli (..), mkKleisli') +import Data.Time.Clock (UTCTime) +import qualified System.Directory as Dir +import qualified System.FilePath as FP + +-- $setup +-- >>> import Data.Functor.Identity (Identity(..)) +-- >>> import Data.Kleisli (Kleisli(..)) +-- >>> import qualified System.Directory as Dir +-- >>> 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 + +------------------------------------------------------------ +-- 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 + +-- | 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 + +-- | 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) + +-- | 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 + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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) + +-- | 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) + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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) + +-- | 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 + +-- | 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) + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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) + +-- | Get the drive of a file path. +-- +-- >>> run takeDrive "/tmp/foo" +-- "/" +-- +-- >>> run takeDrive "tmp/foo" +-- "" +takeDrive :: FilePatherA' FilePath +takeDrive = mkKleisli' FP.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 + +-- | 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 + +-- | Is the file path a drive? +-- +-- >>> run isDrive "/" +-- True +-- +-- >>> run isDrive "/tmp" +-- False +isDrive :: FilePatherA' Bool +isDrive = mkKleisli' FP.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 + +-- | 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 + +-- | Drop the trailing path separator if present. +-- +-- >>> run dropTrailingPathSeparator "/tmp/" +-- "/tmp" +-- +-- >>> run dropTrailingPathSeparator "/tmp" +-- "/tmp" +-- +-- >>> run dropTrailingPathSeparator "/" +-- "/" +dropTrailingPathSeparator :: FilePatherA' FilePath +dropTrailingPathSeparator = mkKleisli' FP.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 + +-- | 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) + +-- | 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) + +-- | 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 + +-- | 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 + +-- | Is the file path valid? +-- +-- >>> run isValid "/tmp/foo" +-- True +-- +-- >>> run isValid "" +-- False +isValid :: FilePatherA' Bool +isValid = mkKleisli' FP.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 + +-- | 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 + +-- | 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 + +-- | 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 + +------------------------------------------------------------ +-- 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 + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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) + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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) + +-- | 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) + +-- | 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) + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | Does the file exist? +-- +-- >>> let Kleisli f = doesFileExist in f "/nonexistent_file_938271" +-- False +doesFileExist :: FilePatherIOA Bool +doesFileExist = Kleisli Dir.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 + +-- | 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) + +-- | 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) + +-- | 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 + +-- | 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 + +-- | Is the path a symbolic link? +-- +-- >>> let Kleisli f = isSymbolicLink in f "/" +-- False +isSymbolicLink :: FilePatherIOA Bool +isSymbolicLink = Kleisli Dir.pathIsSymbolicLink + +-- | Is the path a symbolic link? (Same as 'isSymbolicLink'.) +-- +-- >>> let Kleisli f = pathIsSymbolicLink in f "/" +-- False +pathIsSymbolicLink :: FilePatherIOA Bool +pathIsSymbolicLink = Kleisli Dir.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 + +-- | 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) + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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) + +-- | 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) + +-- | 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 diff --git a/src/System/FilePather/FilePather/Posix.hs b/src/System/FilePather/FilePather/Posix.hs new file mode 100644 --- /dev/null +++ b/src/System/FilePather/FilePather/Posix.hs @@ -0,0 +1,561 @@ +{-# 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 +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 + +-- | 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 + +-- | 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) + +-- | 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 + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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) + +-- | 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) + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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) + +-- | 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 + +-- | 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) + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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) + +-- | Get the drive of a file path (Posix). +-- +-- >>> run takeDrive "/tmp/foo" +-- "/" +-- +-- >>> run takeDrive "tmp/foo" +-- "" +takeDrive :: FilePatherA' FilePath +takeDrive = mkKleisli' FP.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 + +-- | 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 + +-- | Is the file path a drive? (Posix) +-- +-- >>> run isDrive "/" +-- True +-- +-- >>> run isDrive "/tmp" +-- False +isDrive :: FilePatherA' Bool +isDrive = mkKleisli' FP.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 + +-- | 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 + +-- | 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 + +-- | Normalise a file path (Posix). +-- +-- >>> run normalise "/tmp//foo" +-- "/tmp/foo" +-- +-- >>> run normalise "/tmp/./foo" +-- "/tmp/foo" +normalise :: FilePatherA' FilePath +normalise = mkKleisli' FP.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) + +-- | 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) + +-- | Is the file path relative? (Posix) +-- +-- >>> run isRelative "foo/bar" +-- True +-- +-- >>> run isRelative "/foo/bar" +-- False +isRelative :: FilePatherA' Bool +isRelative = mkKleisli' FP.isRelative + +-- | Is the file path absolute? (Posix) +-- +-- >>> run isAbsolute "/foo/bar" +-- True +-- +-- >>> run isAbsolute "foo/bar" +-- False +isAbsolute :: FilePatherA' Bool +isAbsolute = mkKleisli' FP.isAbsolute + +-- | Is the file path valid? (Posix) +-- +-- >>> run isValid "/tmp/foo" +-- True +-- +-- >>> run isValid "" +-- False +isValid :: FilePatherA' Bool +isValid = mkKleisli' FP.isValid + +-- | Make a file path valid (Posix). +-- +-- >>> run makeValid "" +-- "_" +-- +-- >>> run makeValid "/tmp/foo" +-- "/tmp/foo" +makeValid :: FilePatherA' FilePath +makeValid = mkKleisli' FP.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 + +-- | 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 + +-- | 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 diff --git a/src/System/FilePather/FilePather/Windows.hs b/src/System/FilePather/FilePather/Windows.hs new file mode 100644 --- /dev/null +++ b/src/System/FilePather/FilePather/Windows.hs @@ -0,0 +1,574 @@ +{-# 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 +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 + +-- | 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 + +-- | 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) + +-- | 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 + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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) + +-- | 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) + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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) + +-- | 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 + +-- | 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) + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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 + +-- | Is the file path a drive? (Windows) +-- +-- >>> run isDrive "C:\\" +-- True +-- +-- >>> run isDrive "C:\\tmp" +-- False +isDrive :: FilePatherA' Bool +isDrive = mkKleisli' FP.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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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) + +-- | 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) + +-- | 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 + +-- | 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 + +-- | 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 + +-- | Make a file path valid (Windows). +-- +-- >>> run makeValid "" +-- "_" +-- +-- >>> run makeValid "C:\\tmp\\foo" +-- "C:\\tmp\\foo" +makeValid :: FilePatherA' FilePath +makeValid = mkKleisli' FP.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 + +-- | 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 + +-- | 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 diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,18 @@ +{-# 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" + ]