turtle 1.5.25 → 1.6.0
raw patch · 10 files changed
+632/−133 lines, 10 filesdep +filepathdep +tastydep +tasty-hunitdep −system-fileiodep −system-filepathdep ~basedep ~unix-compat
Dependencies added: filepath, tasty, tasty-hunit
Dependencies removed: system-fileio, system-filepath
Dependency ranges changed: base, unix-compat
Files
- CHANGELOG.md +68/−0
- src/Turtle.hs +19/−17
- src/Turtle/Bytes.hs +0/−2
- src/Turtle/Format.hs +3/−4
- src/Turtle/Internal.hs +225/−3
- src/Turtle/Options.hs +2/−4
- src/Turtle/Prelude.hs +87/−96
- test/cptree.hs +0/−1
- test/system-filepath.hs +210/−0
- turtle.cabal +18/−6
CHANGELOG.md view
@@ -1,3 +1,71 @@+1.6.0++* BREAKING CHANGE: Switch to the `FilePath` type from `base` instead of+ `system-filepath`+ * This is a breaking change for a couple of reasons:+ * The `FilePath` type has changed, so the API is not backwards-compatible+ * The thing most likely to break is if you directly imported utilities+ from the `system-filepath` or `system-fileio` packages to operate on+ `turtle`'s `FilePath`s+ * If that happens, you should first check if the `Turtle` module+ exports a utility of the same name. If so, then switch to that+ * If there is no equivalent substitute from the `Turtle` module then+ you will have to change your code to use the closest equivalent+ utility from the `filepath` or `directory` package+ * If you were previously using any of the `system-filepath` or+ `system-fileio` utilities re-exported from the `Turtle` module then+ those utilities will not break as they have been replaced with+ versions compatible with the `FilePath` type from `base`+ * The second thing most likely to break is any code that relies on+ typeclasses since because if you defined any instances for the+ `FilePath` type exported by `turtle` then those instances will now+ overlap with any instances defined for the `String` type+ * The conversion utilities (e.g. `toText`, `encodeString`) will still+ work, so code that used those conversion utilities should be less+ affected by this change+ * The behavior of the `collapse` utility is subtly different+ * `collapse` no longer interprets `..` in paths+ * This new behavior is more correct in the presence of symlinks, so the+ change is (hopefully) an improvement to downstream code+ * The new API strives to match the old behavior as closely as possible+ * … so this should (hopefully) not break too much code in practice+ * With the exception of the `collapse` function the new API should be+ bug-for-bug compatible with the old API+ * Most of the surprising behavior inherited from the old API is around+ how `.` and `..` are handled in paths+ * `parent ".." == "."` is an example of such surprising behavior+ * At some point in the future we may fix bugs in these utilities inherited+ from `system-filepath` / `system-fileio`, but no decision either way has+ been made, yet+ * Some old utilities are marked `DEPRECATED` if their behavior exactly matches+ the behavior of an existing utility from the `filepath` or `directory`+ package+ * These may be eventually removed at some point in the future or they+ remain in a deprecated state indefinitely. No decision either way has+ been made+ * The `Turtle` module also re-exports any utility suggested by a+ `DEPRECATED` pragma as a convenience+ * Other utilities are not deprecated if the old behavior significantly departs+ from any existing utility from the `filepath` or `directory` package+ * For example, the behavior of the `filename` utility differs from the+ behavior of `System.FilePath.takeFileName` for filenames that begin with a+ `.`, so we have to preserve the old behavior to avoid breaking downstream+ code+ * At some point in the future utilities like these may be deprecated in+ favor of their closest analogs in the `filepath` / `directory` packages or+ they may be supported indefinitely. No decision either way has been made+ * If you want to try to author code that is compatible with both the+ pre-1.6 and post-1.6 API:+ * If you add any instances to the `FilePath` type, import it qualified+ directly from the `system-filepath` package and use it only for instances+ * Otherwise, don't import anything else from the `system-filepath` /+ `system-fileio` packages if you can help it. Instead, restrict yourself+ entirely to the utilities and `FilePath` type exported by the `Turtle`+ module+ * Use the conversion utilities (e.g. `encodeStrings`, even if they are not+ necessary post-1.6)+ * If that's still not enough, use `CPP` and good luck!+ 1.5.25 * Build against latest version of `Win32` package
src/Turtle.hs view
@@ -47,8 +47,6 @@ -- -- "Control.Monad.Managed.Safe" provides `Managed` resources ----- "Filesystem.Path.CurrentOS" provides `FilePath`-manipulation utilities--- -- Additionally, you might also want to import the following modules qualified: -- -- * "Options.Applicative" from @optparse-applicative@ for command-line option@@ -61,8 +59,6 @@ -- * "Data.Text" (for `Text`-manipulation utilities) -- -- * "Data.Text.IO" (for reading and writing `Text`)------ * "Filesystem.Path.CurrentOS" (for the remaining `FilePath` utilities) module Turtle ( -- * Modules@@ -77,7 +73,8 @@ , module Control.Monad.IO.Class , module Data.Monoid , module Control.Monad.Managed- , module Filesystem.Path.CurrentOS+ , module System.FilePath+ , module Turtle.Internal , Fold(..) , FoldM(..) , Text@@ -120,9 +117,23 @@ import Control.Monad.IO.Class (MonadIO(..)) import Data.Monoid (Monoid(..), (<>)) import Data.String (IsString(..))-import Filesystem.Path.CurrentOS+import Control.Monad.Managed (Managed, managed, runManaged, with)+import Control.Foldl (Fold(..), FoldM(..))+import Data.Text (Text)+import Data.Time (NominalDiffTime, UTCTime)+import System.FilePath ( FilePath- , root+ , dropExtension+ , hasExtension+ , isAbsolute+ , isRelative+ , (</>)+ , (<.>)+ )+import System.IO (Handle)+import System.Exit (ExitCode(..))+import Turtle.Internal+ ( root , directory , parent , filename@@ -130,27 +141,18 @@ , basename , absolute , relative- , (</>) , commonPrefix , stripPrefix , collapse , splitDirectories , extension- , hasExtension- , (<.>)- , dropExtension , splitExtension+ , splitExtensions , toText , fromText , encodeString , decodeString )-import Control.Monad.Managed (Managed, managed, runManaged, with)-import Control.Foldl (Fold(..), FoldM(..))-import Data.Text (Text)-import Data.Time (NominalDiffTime, UTCTime)-import System.IO (Handle)-import System.Exit (ExitCode(..)) import Prelude hiding (FilePath) #if __GLASGOW_HASKELL__ >= 710
src/Turtle/Bytes.hs view
@@ -53,8 +53,6 @@ import Data.Streaming.Zlib (Inflate, Popper, PopperRes(..), WindowBits(..)) import Data.Text (Text) import Data.Text.Encoding (Decoding(..))-import Filesystem.Path (FilePath)-import Prelude hiding (FilePath) import System.Exit (ExitCode(..)) import System.IO (Handle) import Turtle.Internal (ignoreSIGPIPE)
src/Turtle/Format.hs view
@@ -74,9 +74,8 @@ import Data.Text (Text, pack) import Data.Time (UTCTime) import Data.Word-import Filesystem.Path.CurrentOS (FilePath, toText) import Numeric (showEFloat, showFFloat, showGFloat, showHex, showOct)-import Prelude hiding ((.), id, FilePath)+import Prelude hiding ((.), id) import qualified System.IO as IO import Turtle.Line (Line) @@ -215,9 +214,9 @@ l :: Format r (Line -> r) l = makeFormat Turtle.Line.lineToText --- | `Format` a `Filesystem.Path.CurrentOS.FilePath` into `Text`+-- | `Format` a `FilePath` into `Text` fp :: Format r (FilePath -> r)-fp = makeFormat (\fpath -> either id id (toText fpath))+fp = makeFormat pack -- | `Format` a `UTCTime` into `Text` utc :: Format r (UTCTime -> r)
src/Turtle/Internal.hs view
@@ -1,11 +1,17 @@-module Turtle.Internal- ( ignoreSIGPIPE- ) where+module Turtle.Internal where +import Control.Applicative ((<|>)) import Control.Exception (handle, throwIO)+import Data.Text (Text) import Foreign.C.Error (Errno(..), ePIPE) import GHC.IO.Exception (IOErrorType(..), IOException(..))+import System.FilePath ((</>)) +import qualified Data.List as List+import qualified Data.Text as Text+import qualified Data.Text.IO as Text.IO+import qualified System.FilePath as FilePath+ ignoreSIGPIPE :: IO () -> IO () ignoreSIGPIPE = handle (\e -> case e of IOError@@ -14,3 +20,219 @@ | Errno ioe == ePIPE -> return () _ -> throwIO e )++{-| Convert a `FilePath` to human-readable `Text`++ Note that even though the type says `Either` this utility actually always+ succeeds and returns a `Right` value. The only reason for the `Either` is+ compatibility with the old type from the @system-filepath@ package.+-}+toText :: FilePath -> Either Text Text+toText = Right . Text.pack+{-# DEPRECATED toText "Use Data.Text.pack instead" #-}++-- | Convert `Text` to a `FilePath`+fromText :: Text -> FilePath+fromText = Text.unpack+{-# DEPRECATED fromText "Use Data.Text.unpack instead" #-}++-- | Convert a `String` to a `FilePath`+decodeString :: String -> FilePath+decodeString = id+{-# DEPRECATED decodeString "Use id instead" #-}++-- | Convert a `FilePath` to a `String`+encodeString :: FilePath -> String+encodeString = id+{-# DEPRECATED encodeString "Use id instead" #-}++-- | Find the greatest common prefix between a list of `FilePath`s+commonPrefix :: [FilePath] -> FilePath+commonPrefix [ ] = mempty+commonPrefix (path : paths) = foldr longestPathPrefix path paths+ where+ longestPathPrefix left right =+ FilePath.joinPath (longestPrefix leftComponents rightComponents)+ where+ leftComponents = splitExt (splitDirectories left)++ rightComponents = splitExt (splitDirectories right)++longestPrefix :: Eq a => [a] -> [a] -> [a]+longestPrefix (l : ls) (r : rs)+ | l == r = l : longestPrefix ls rs+longestPrefix _ _ = [ ]++-- | Remove a prefix from a path+stripPrefix :: FilePath -> FilePath -> Maybe FilePath+stripPrefix prefix path = do+ suffix <- List.stripPrefix prefixComponents pathComponents++ return (FilePath.joinPath suffix)+ where+ prefixComponents = splitExt (splitDirectories prefix)++ pathComponents = splitExt (splitDirectories path)++-- Internal helper function for `stripPrefix` and `commonPrefix`+splitExt :: [FilePath] -> [FilePath]+splitExt [ component ] = base : map ("." ++) exts+ where+ (base, exts) = splitExtensions component+splitExt [ ] =+ [ ]+splitExt (component : components) =+ component : splitExt components++-- | Normalise a path+collapse :: FilePath -> FilePath+collapse = FilePath.normalise+{-# DEPRECATED collapse "Use System.FilePath.normalise instead" #-}++-- | Read in a file as `Text`+readTextFile :: FilePath -> IO Text+readTextFile = Text.IO.readFile+{-# DEPRECATED readTextFile "Use Data.Text.IO.readFile instead" #-}++-- | Write out a file as `Text`+writeTextFile :: FilePath -> Text -> IO ()+writeTextFile = Text.IO.writeFile+{-# DEPRECATED writeTextFile "Use Data.Text.IO.writeFile instead" #-}++-- | Retrieves the `FilePath`'s root+root :: FilePath -> FilePath+root = fst . FilePath.splitDrive++-- | Retrieves the `FilePath`'s parent directory+parent :: FilePath -> FilePath+parent path = prefix </> suffix+ where+ (drive, rest) = FilePath.splitDrive path++ components = loop (splitDirectories rest)++ prefix =+ case components of+ "./" : _ -> drive+ "../" : _ -> drive+ _ | null drive -> "./"+ | otherwise -> drive++ suffix = FilePath.joinPath components++ loop [ _ ] = [ ]+ loop [ ] = [ ]+ loop (c : cs) = c : loop cs++-- | Retrieves the `FilePath`'s directory+directory :: FilePath -> FilePath+directory path+ | prefix == "" && suffix == ".." =+ "../"+ | otherwise =+ trailingSlash (FilePath.takeDirectory prefix) ++ suffix+ where+ (prefix, suffix) = trailingParent path+ where+ trailingParent ".." = ("" , "..")+ trailingParent [ a, b ] = ([ a, b ], "" )+ trailingParent [ a ] = ([ a ] , "" )+ trailingParent [ ] = ([ ] , "" )+ trailingParent (c : cs) = (c : p, s)+ where+ ~(p, s) = trailingParent cs++ trailingSlash "" = "/"+ trailingSlash "/" = "/"+ trailingSlash (c : cs) = c : trailingSlash cs++-- | Retrieves the `FilePath`'s filename component+filename :: FilePath -> FilePath+filename path+ | result == "." || result == ".." = ""+ | otherwise = result+ where+ result = FilePath.takeFileName path++-- | Retrieve a `FilePath`'s directory name+dirname :: FilePath -> FilePath+dirname path = loop (splitDirectories path)+ where+ loop [ x, y ] =+ case deslash y <|> deslash x of+ Just name -> name+ Nothing -> ""+ loop [ x ] =+ case deslash x of+ Just name -> name+ Nothing -> ""+ loop [ ] =+ ""+ loop (_ : xs) =+ loop xs++ deslash "" = Nothing+ deslash "/" = Just ""+ deslash (c : cs) = fmap (c :) (deslash cs)++-- | Retrieve a `FilePath`'s basename component+basename :: FilePath -> String+basename path =+ case name of+ '.' : _ -> name+ _ ->+ case splitExtensions name of+ (base, _) -> base+ where+ name = filename path++-- | Test whether a path is absolute+absolute :: FilePath -> Bool+absolute = FilePath.isAbsolute+{-# DEPRECATED absolute "Use System.FilePath.isAbsolute instead" #-}++-- | Test whether a path is relative+relative :: FilePath -> Bool+relative = FilePath.isRelative+{-# DEPRECATED relative "Use System.FilePath.isRelative instead" #-}++-- | Split a `FilePath` into its components+splitDirectories :: FilePath -> [FilePath]+splitDirectories path = loop (FilePath.splitPath path)+ where+ loop [ ] = [ ]+ loop [ ".." ] = [ "../" ]+ loop [ "." ] = [ "./" ]+ loop (c : cs) = c : loop cs++-- | Get a `FilePath`'s last extension, or `Nothing` if it has no extension+extension :: FilePath -> Maybe String+extension path =+ case suffix of+ '.' : ext -> Just ext+ _ -> Nothing+ where+ suffix = FilePath.takeExtension path++-- | Split a `FilePath` on its extension+splitExtension :: FilePath -> (String, Maybe String)+splitExtension path =+ case suffix of+ '.' : ext -> (prefix, Just ext)+ _ -> (prefix, Nothing)+ where+ (prefix, suffix) = FilePath.splitExtension path++-- | Split a `FilePath` on its extensions+splitExtensions :: FilePath -> (String, [String])+splitExtensions path0 = (prefix0, reverse exts0)+ where+ (prefix0, exts0) = loop path0++ loop path = case splitExtension path of+ (prefix, Just ext) ->+ (base, ext : exts)+ where+ (base, exts) = loop prefix+ (base, Nothing) ->+ (base, [])
src/Turtle/Options.hs view
@@ -83,9 +83,7 @@ import Data.Optional import Control.Applicative import Control.Monad.IO.Class-import Filesystem.Path.CurrentOS (FilePath, fromText) import Options.Applicative (Parser)-import Prelude hiding (FilePath) import Text.PrettyPrint.ANSI.Leijen (Doc, displayS, renderCompact) import Turtle.Line (Line) @@ -237,7 +235,7 @@ -- | Parse a `FilePath` value as a flag-based option optPath :: ArgName -> ShortName -> Optional HelpMessage -> Parser FilePath-optPath argName short msg = fmap fromText (optText argName short msg)+optPath argName short msg = fmap Text.unpack (optText argName short msg) {- | Build a positional argument parser for any type by providing a `Text`-parsing function@@ -277,7 +275,7 @@ -- | Parse a `FilePath` as a positional argument argPath :: ArgName -> Optional HelpMessage -> Parser FilePath-argPath argName msg = fmap fromText (argText argName msg)+argPath argName msg = fmap Text.unpack (argText argName msg) argParseToReadM :: (Text -> Maybe a) -> Opts.ReadM a argParseToReadM f = do
src/Turtle/Prelude.hs view
@@ -111,8 +111,8 @@ echo , err , readline- , Filesystem.readTextFile- , Filesystem.writeTextFile+ , Internal.readTextFile+ , Internal.writeTextFile , arguments #if __GLASGOW_HASKELL__ >= 710 , export@@ -326,9 +326,6 @@ import qualified Data.Text as Text import qualified Data.Text.IO as Text import Data.Typeable (Typeable)-import qualified Filesystem-import Filesystem.Path.CurrentOS (FilePath, (</>))-import qualified Filesystem.Path.CurrentOS as Filesystem import GHC.IO.Exception (IOErrorType(UnsupportedOperation)) import Network.HostName (getHostName) import System.Clock (Clock(..), TimeSpec(..), getTime)@@ -342,8 +339,9 @@ lookupEnv, #endif getEnvironment )-import qualified System.Directory import qualified System.Directory as Directory+import System.FilePath ((</>))+import qualified System.FilePath as FilePath import System.Exit (ExitCode(..), exitWith) import System.IO (Handle, hClose) import qualified System.IO as IO@@ -362,12 +360,12 @@ touchFile ) import System.Posix.Files (createSymbolicLink) #endif-import Prelude hiding (FilePath, lines)+import Prelude hiding (lines) import Turtle.Pattern (Pattern, anyChar, chars, match, selfless, sepBy) import Turtle.Shell import Turtle.Format (Format, format, makeFormat, d, w, (%), fp)-import Turtle.Internal (ignoreSIGPIPE)+import qualified Turtle.Internal as Internal import Turtle.Line {-| Run a command using @execvp@, retrieving the exit code@@ -567,7 +565,7 @@ mvar <- newMVar False let close handle = do modifyMVar_ mvar (\finalized -> do- unless finalized (ignoreSIGPIPE (hClose handle))+ unless finalized (Internal.ignoreSIGPIPE (hClose handle)) return True ) let close' (Just hIn, ph) = do close hIn@@ -578,7 +576,7 @@ let handle (Just hIn, ph) = do let feedIn :: (forall a. IO a -> IO a) -> IO () feedIn restore =- restore (ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn+ restore (Internal.ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn mask (\restore -> withAsync (feedIn restore) (\a -> restore (Process.waitForProcess ph) `finally` halt a) )@@ -616,13 +614,13 @@ mvar <- newMVar False let close handle = do modifyMVar_ mvar (\finalized -> do- unless finalized (ignoreSIGPIPE (hClose handle))+ unless finalized (Internal.ignoreSIGPIPE (hClose handle)) return True ) bracket open (\(hIn, _, ph) -> close hIn >> Process.terminateProcess ph) (\(hIn, hOut, ph) -> do let feedIn :: (forall a. IO a -> IO a) -> IO () feedIn restore =- restore (ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn+ restore (Internal.ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn concurrently (mask (\restore ->@@ -659,13 +657,13 @@ mvar <- newMVar False let close handle = do modifyMVar_ mvar (\finalized -> do- unless finalized (ignoreSIGPIPE (hClose handle))+ unless finalized (Internal.ignoreSIGPIPE (hClose handle)) return True ) bracket open (\(hIn, _, _, ph) -> close hIn >> Process.terminateProcess ph) (\(hIn, hOut, hErr, ph) -> do let feedIn :: (forall a. IO a -> IO a) -> IO () feedIn restore =- restore (ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn+ restore (Internal.ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn runConcurrently $ (,,) <$> Concurrently (mask (\restore ->@@ -743,12 +741,12 @@ mvar <- liftIO (newMVar False) let close handle = do modifyMVar_ mvar (\finalized -> do- unless finalized (ignoreSIGPIPE (hClose handle))+ unless finalized (Internal.ignoreSIGPIPE (hClose handle)) return True ) (hIn, hOut, ph) <- using (managed (bracket open (\(hIn, _, ph) -> close hIn >> Process.terminateProcess ph))) let feedIn :: (forall a. IO a -> IO a) -> IO ()- feedIn restore = restore (ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn+ feedIn restore = restore (Internal.ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn a <- using (managed (\k ->@@ -784,12 +782,12 @@ mvar <- liftIO (newMVar False) let close handle = do modifyMVar_ mvar (\finalized -> do- unless finalized (ignoreSIGPIPE (hClose handle))+ unless finalized (Internal.ignoreSIGPIPE (hClose handle)) return True ) (hIn, hOut, hErr, ph) <- using (managed (bracket open (\(hIn, _, _, ph) -> close hIn >> Process.terminateProcess ph))) let feedIn :: (forall a. IO a -> IO a) -> IO ()- feedIn restore = restore (ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn+ feedIn restore = restore (Internal.ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn queue <- liftIO TQueue.newTQueueIO let forwardOut :: (forall a. IO a -> IO a) -> IO ()@@ -930,7 +928,7 @@ threads since this modifies the global state of the process -} cd :: MonadIO io => FilePath -> io ()-cd path = liftIO (Filesystem.setWorkingDirectory path)+cd path = liftIO (Directory.setCurrentDirectory path) {-| Change the current directory. Once the current 'Shell' is done, it returns back to the original directory.@@ -949,23 +947,19 @@ -- | Get the current directory pwd :: MonadIO io => io FilePath-pwd = liftIO Filesystem.getWorkingDirectory+pwd = liftIO Directory.getCurrentDirectory -- | Get the home directory home :: MonadIO io => io FilePath-home = liftIO Filesystem.getHomeDirectory+home = liftIO Directory.getHomeDirectory -- | Get the path pointed to by a symlink readlink :: MonadIO io => FilePath -> io FilePath-readlink =- fmap Filesystem.decodeString- . liftIO- . System.Directory.getSymbolicLinkTarget- . Filesystem.encodeString+readlink path = liftIO (Directory.getSymbolicLinkTarget path) -- | Canonicalize a path realpath :: MonadIO io => FilePath -> io FilePath-realpath path = liftIO (Filesystem.canonicalizePath path)+realpath path = liftIO (Directory.canonicalizePath path) #ifdef mingw32_HOST_OS fILE_ATTRIBUTE_REPARSE_POINT :: Win32.FileAttributeOrFlag@@ -980,7 +974,7 @@ -} ls :: FilePath -> Shell FilePath ls path = Shell (\(FoldShell step begin done) -> do- let path' = Filesystem.encodeString path+ let path' = path canRead <- fmap Directory.readable (Directory.getPermissions (deslash path'))@@ -1005,12 +999,11 @@ if canRead then bracket (openDirStream path') closeDirStream (\dirp -> do let loop x = do- file' <- readDirStream dirp- case file' of+ file <- readDirStream dirp+ case file of "" -> done x _ -> do- let file = Filesystem.decodeString file'- x' <- if (file' /= "." && file' /= "..")+ x' <- if (file /= "." && file /= "..") then step x (path </> file) else return x loop $! x'@@ -1086,11 +1079,11 @@ but the operation will not be atomic -} mv :: MonadIO io => FilePath -> FilePath -> io ()-mv oldPath newPath = liftIO $ catchIOError (Filesystem.rename oldPath newPath)+mv oldPath newPath = liftIO $ catchIOError (Directory.renameFile oldPath newPath) (\ioe -> if ioeGetErrorType ioe == UnsupportedOperation -- certainly EXDEV then do- Filesystem.copyFile oldPath newPath- Filesystem.removeFile oldPath+ Directory.copyFile oldPath newPath+ Directory.removeFile oldPath else ioError ioe) {-| Create a directory@@ -1098,18 +1091,18 @@ Fails if the directory is present -} mkdir :: MonadIO io => FilePath -> io ()-mkdir path = liftIO (Filesystem.createDirectory False path)+mkdir path = liftIO (Directory.createDirectory path) {-| Create a directory tree (equivalent to @mkdir -p@) Does not fail if the directory is present -} mktree :: MonadIO io => FilePath -> io ()-mktree path = liftIO (Filesystem.createTree path)+mktree path = liftIO (Directory.createDirectoryIfMissing True path) -- | Copy a file cp :: MonadIO io => FilePath -> FilePath -> io ()-cp oldPath newPath = liftIO (Filesystem.copyFile oldPath newPath)+cp oldPath newPath = liftIO (Directory.copyFile oldPath newPath) #if !defined(mingw32_HOST_OS) -- | Create a symlink from one @FilePath@ to another@@ -1138,7 +1131,7 @@ -- a directory and fails to strip it as a prefix from `/tmp/foo`. Adding -- `(</> "")` to the end of the path makes clear that the path is a -- directory- Just suffix <- return (Filesystem.stripPrefix (oldTree </> "") oldPath)+ Just suffix <- return (Internal.stripPrefix (oldTree ++ "/") oldPath) let newPath = newTree </> suffix @@ -1148,14 +1141,14 @@ if PosixCompat.isSymbolicLink fileStatus then do- oldTarget <- liftIO (PosixCompat.readSymbolicLink (Filesystem.encodeString oldPath))+ oldTarget <- liftIO (PosixCompat.readSymbolicLink oldPath) - mktree (Filesystem.directory newPath)+ mktree (FilePath.takeDirectory newPath) - liftIO (PosixCompat.createSymbolicLink oldTarget (Filesystem.encodeString newPath))+ liftIO (PosixCompat.createSymbolicLink oldTarget newPath) else if isFile then do- mktree (Filesystem.directory newPath)+ mktree (FilePath.takeDirectory newPath) cp oldPath newPath else do@@ -1165,21 +1158,21 @@ cptreeL :: MonadIO io => FilePath -> FilePath -> io () cptreeL oldTree newTree = sh (do oldPath <- lstree oldTree- Just suffix <- return (Filesystem.stripPrefix (oldTree </> "") oldPath)+ Just suffix <- return (Internal.stripPrefix (oldTree ++ "/") oldPath) let newPath = newTree </> suffix isFile <- testfile oldPath if isFile- then mktree (Filesystem.directory newPath) >> cp oldPath newPath+ then mktree (FilePath.takeDirectory newPath) >> cp oldPath newPath else mktree newPath ) -- | Remove a file rm :: MonadIO io => FilePath -> io ()-rm path = liftIO (Filesystem.removeFile path)+rm path = liftIO (Directory.removeFile path) -- | Remove a directory rmdir :: MonadIO io => FilePath -> io ()-rmdir path = liftIO (Filesystem.removeDirectory path)+rmdir path = liftIO (Directory.removeDirectory path) {-| Remove a directory tree (equivalent to @rm -r@) @@ -1203,11 +1196,11 @@ -- | Check if a file exists testfile :: MonadIO io => FilePath -> io Bool-testfile path = liftIO (Filesystem.isFile path)+testfile path = liftIO (Directory.doesFileExist path) -- | Check if a directory exists testdir :: MonadIO io => FilePath -> io Bool-testdir path = liftIO (Filesystem.isDirectory path)+testdir path = liftIO (Directory.doesDirectoryExist path) -- | Check if a path exists testpath :: MonadIO io => FilePath -> io Bool@@ -1239,13 +1232,13 @@ systemTime <- Win32.getSystemTimeAsFileTime Win32.setFileTime handle (Just creationTime) (Just systemTime) (Just systemTime) #else- then touchFile (Filesystem.encodeString file)+ then touchFile file #endif else output file empty ) -{-| This type is the same as @"System.Directory".`System.Directory.Permissions`@- type except combining the `System.Directory.executable` and- `System.Directory.searchable` fields into a single `executable` field for+{-| This type is the same as @"System.Directory".`Directory.Permissions`@+ type except combining the `Directory.executable` and+ `Directory.searchable` fields into a single `executable` field for consistency with the Unix @chmod@. This simplification is still entirely consistent with the behavior of "System.Directory", which treats the two fields as interchangeable.@@ -1257,26 +1250,26 @@ } deriving (Eq, Read, Ord, Show) {-| Under the hood, "System.Directory" does not distinguish between- `System.Directory.executable` and `System.Directory.searchable`. They both+ `Directory.executable` and `Directory.searchable`. They both translate to the same `System.Posix.ownerExecuteMode` permission. That- means that we can always safely just set the `System.Directory.executable`- field and safely leave the `System.Directory.searchable` field as `False`+ means that we can always safely just set the `Directory.executable`+ field and safely leave the `Directory.searchable` field as `False` because the two fields are combined with (`||`) to determine whether to set the executable bit. -}-toSystemDirectoryPermissions :: Permissions -> System.Directory.Permissions+toSystemDirectoryPermissions :: Permissions -> Directory.Permissions toSystemDirectoryPermissions p =- ( System.Directory.setOwnerReadable (_readable p)- . System.Directory.setOwnerWritable (_writable p)- . System.Directory.setOwnerExecutable (_executable p)- ) System.Directory.emptyPermissions+ ( Directory.setOwnerReadable (_readable p)+ . Directory.setOwnerWritable (_writable p)+ . Directory.setOwnerExecutable (_executable p)+ ) Directory.emptyPermissions -fromSystemDirectoryPermissions :: System.Directory.Permissions -> Permissions+fromSystemDirectoryPermissions :: Directory.Permissions -> Permissions fromSystemDirectoryPermissions p = Permissions- { _readable = System.Directory.readable p- , _writable = System.Directory.writable p+ { _readable = Directory.readable p+ , _writable = Directory.writable p , _executable =- System.Directory.executable p || System.Directory.searchable p+ Directory.executable p || Directory.searchable p } {-| Update a file or directory's user permissions@@ -1311,7 +1304,7 @@ -> io Permissions -- ^ Updated permissions chmod modifyPermissions path = liftIO (do- let path' = deslash (Filesystem.encodeString path)+ let path' = deslash path permissions <- Directory.getPermissions path' let permissions' = fromSystemDirectoryPermissions permissions let permissions'' = modifyPermissions permissions'@@ -1323,21 +1316,21 @@ -- | Get a file or directory's user permissions getmod :: MonadIO io => FilePath -> io Permissions getmod path = liftIO (do- let path' = deslash (Filesystem.encodeString path)+ let path' = deslash path permissions <- Directory.getPermissions path' return (fromSystemDirectoryPermissions permissions)) -- | Set a file or directory's user permissions setmod :: MonadIO io => Permissions -> FilePath -> io () setmod permissions path = liftIO (do- let path' = deslash (Filesystem.encodeString path)+ let path' = deslash path Directory.setPermissions path' (toSystemDirectoryPermissions permissions) ) -- | Copy a file or directory's permissions (analogous to @chmod --reference@) copymod :: MonadIO io => FilePath -> FilePath -> io () copymod sourcePath targetPath = liftIO (do- let sourcePath' = deslash (Filesystem.encodeString sourcePath)- targetPath' = deslash (Filesystem.encodeString targetPath)+ let sourcePath' = deslash sourcePath+ targetPath' = deslash targetPath Directory.copyPermissions sourcePath' targetPath' ) -- | @+r@@@ -1425,7 +1418,7 @@ whichAll :: FilePath -> Shell FilePath whichAll cmd = do Just paths <- need "PATH"- path <- select (Filesystem.splitSearchPathString . Text.unpack $ paths)+ path <- select (fmap Text.unpack (Text.splitOn ":" paths)) let path' = path </> cmd True <- testfile path'@@ -1498,10 +1491,8 @@ -- ^ Directory name template -> managed FilePath mktempdir parent prefix = using (do- let parent' = Filesystem.encodeString parent let prefix' = unpack prefix- dir' <- managed (withTempDirectory parent' prefix')- return (Filesystem.decodeString dir'))+ managed (withTempDirectory parent prefix')) {-| Create a temporary file underneath the given directory @@ -1520,11 +1511,10 @@ -- ^ File name template -> managed (FilePath, Handle) mktemp parent prefix = using (do- let parent' = Filesystem.encodeString parent let prefix' = unpack prefix (file', handle) <- managed (\k ->- withTempFile parent' prefix' (\file' handle -> k (file', handle)) )- return (Filesystem.decodeString file', handle) )+ withTempFile parent prefix' (\file' handle -> k (file', handle)) )+ return (file', handle) ) {-| Create a temporary file underneath the given directory @@ -1538,12 +1528,11 @@ -- ^ File name template -> managed FilePath mktempfile parent prefix = using (do- let parent' = Filesystem.encodeString parent let prefix' = unpack prefix (file', handle) <- managed (\k ->- withTempFile parent' prefix' (\file' handle -> k (file', handle)) )+ withTempFile parent prefix' (\file' handle -> k (file', handle)) ) liftIO (hClose handle)- return (Filesystem.decodeString file') )+ return file' ) -- | Fork a thread, acquiring an `Async` value fork :: MonadManaged managed => IO a -> managed (Async a)@@ -1614,15 +1603,15 @@ -- | Acquire a `Managed` read-only `Handle` from a `FilePath` readonly :: MonadManaged managed => FilePath -> managed Handle-readonly file = using (managed (Filesystem.withTextFile file IO.ReadMode))+readonly file = using (managed (IO.withFile file IO.ReadMode)) -- | Acquire a `Managed` write-only `Handle` from a `FilePath` writeonly :: MonadManaged managed => FilePath -> managed Handle-writeonly file = using (managed (Filesystem.withTextFile file IO.WriteMode))+writeonly file = using (managed (IO.withFile file IO.WriteMode)) -- | Acquire a `Managed` append-only `Handle` from a `FilePath` appendonly :: MonadManaged managed => FilePath -> managed Handle-appendonly file = using (managed (Filesystem.withTextFile file IO.AppendMode))+appendonly file = using (managed (IO.withFile file IO.AppendMode)) -- | Combine the output of multiple `Shell`s, in order cat :: [Shell a] -> Shell a@@ -1689,11 +1678,7 @@ -- | Make a `Shell Text -> Shell Text` function work on `FilePath`s instead. -- | Ignores any paths which cannot be decoded as valid `Text`. onFiles :: (Shell Text -> Shell Text) -> Shell FilePath -> Shell FilePath-onFiles f = fmap Filesystem.fromText . f . getRights . fmap Filesystem.toText- where- getRights :: forall a. Shell (Either a Text) -> Shell Text- getRights s = s >>= either (const empty) return-+onFiles f = fmap Text.unpack . f . fmap Text.pack -- | Like `sed`, but operates in place on a `FilePath` (analogous to @sed -i@) inplace :: MonadIO io => Pattern Text -> FilePath -> io ()@@ -1733,8 +1718,11 @@ find :: Pattern a -> FilePath -> Shell FilePath find pattern' dir = do path <- lsif isNotSymlink dir- Right txt <- return (Filesystem.toText path)- _:_ <- return (match pattern' txt)++ let txt = Text.pack path++ _:_ <- return (match pattern' txt)+ return path where isNotSymlink :: FilePath -> IO Bool@@ -1746,8 +1734,11 @@ findtree :: Pattern a -> Shell FilePath -> Shell FilePath findtree pat files = do path <- files- Right txt <- return (Filesystem.toText path)++ let txt = Text.pack path+ _:_ <- return (match pat txt)+ return path {- | Check if a file was last modified after a given@@ -1944,7 +1935,7 @@ -- | Get the time a file was last modified datefile :: MonadIO io => FilePath -> io UTCTime-datefile path = liftIO (Filesystem.getModified path)+datefile path = liftIO (Directory.getModificationTime path) -- | Get the size of a file or a directory du :: MonadIO io => FilePath -> io Size@@ -1956,9 +1947,9 @@ let sizes = do child <- lstree path True <- testfile child- liftIO (Filesystem.getSize child)+ liftIO (Directory.getFileSize child) fold sizes Control.Foldl.sum- else Filesystem.getSize path+ else Directory.getFileSize path return (Size size) ) {-| An abstract file size@@ -2174,7 +2165,7 @@ -- | Get the status of a file stat :: MonadIO io => FilePath -> io PosixCompat.FileStatus-stat = liftIO . PosixCompat.getFileStatus . Filesystem.encodeString+stat = liftIO . PosixCompat.getFileStatus -- | Size of the file in bytes. Does not follow symlinks fileSize :: PosixCompat.FileStatus -> Size@@ -2194,7 +2185,7 @@ -- | Get the status of a file, but don't follow symbolic links lstat :: MonadIO io => FilePath -> io PosixCompat.FileStatus-lstat = liftIO . PosixCompat.getSymbolicLinkStatus . Filesystem.encodeString+lstat = liftIO . PosixCompat.getSymbolicLinkStatus data WithHeader a = Header a
test/cptree.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} import Turtle-import Filesystem.Path.CurrentOS () import System.IO.Temp (withSystemTempDirectory) import qualified Control.Monad.Fail as Fail import Control.Monad (unless)
+ test/system-filepath.hs view
@@ -0,0 +1,210 @@+{-# Language CPP #-}+{-# Options_GHC -Wno-deprecations #-}++module Main (main) where++import Test.Tasty+import Test.Tasty.HUnit+import Turtle++main :: IO ()+main = defaultMain $ testGroup "system-filepath tests"+ [ test_Root+ , test_Directory+ , test_Parent+ , test_CommonPrefix+ , test_StripPrefix+ , test_Collapse+ , test_Filename+ , test_Dirname+ , test_Basename+ , test_Absolute+ , test_Relative+ , test_SplitDirectories+ , test_SplitExtension+ ]++test_Root :: TestTree+test_Root = testCase "root" $ do+ "" @=? root ""+ "/" @=? root "/"+ "" @=? root "foo"+ "/" @=? root "/foo"++test_Directory :: TestTree+test_Directory = testCase "directory" $ do+ "./" @=? directory ""+ "/" @=? directory "/"+ "/foo/" @=? directory "/foo/bar"+ "/foo/bar/" @=? directory "/foo/bar/"+ "./" @=? directory "."+ "../" @=? directory ".."+ "../" @=? directory "../foo"+ "../foo/" @=? directory "../foo/"+ "./" @=? directory "foo"+ "foo/" @=? directory "foo/bar"++test_Parent :: TestTree+test_Parent = testCase "parent" $ do+ -- The behavior in the presence of `.` / `..` is messed up, but that's how+ -- the old system-filepath package worked, so we're preserving that for+ -- backwards compatibility (for now)+ "./" @=? parent ""+ "./" @=? parent "."+ "./" @=? parent ".."+ "/" @=? parent "/.."+ "/" @=? parent "/."+ "./" @=? parent "./."+ "./" @=? parent "./.."+ "../" @=? parent "../.."+ "../" @=? parent "../."++ "/" @=? parent "/"+ "./" @=? parent "foo"+ "./" @=? parent "./foo"+ "./foo/" @=? parent "foo/bar"+ "./foo/" @=? parent "foo/bar/"+ "./foo/" @=? parent "./foo/bar"+ "/" @=? parent "/foo"+ "/foo/" @=? parent "/foo/bar"++test_Filename :: TestTree+test_Filename = testCase "filename" $ do+ "" @=? filename ""+ "" @=? filename "."+ "" @=? filename ".."+ "" @=? filename "/"+ "" @=? filename "/foo/"+ "bar" @=? filename "/foo/bar"+ "bar.txt" @=? filename "/foo/bar.txt"++test_Dirname :: TestTree+test_Dirname = testCase "dirname" $ do+ "" @=? dirname ""+ "" @=? dirname "/"+ "" @=? dirname "foo"+ ".." @=? dirname ".."+ "foo" @=? dirname "foo/bar"+ "bar" @=? dirname "foo/bar/"+ "bar" @=? dirname "foo/bar/baz.txt"++ -- the directory name will be re-parsed to a file name.+ let dirnameExts q = snd (splitExtensions (dirname q))+ ["d"] @=? dirnameExts "foo.d/bar"++test_Basename :: TestTree+test_Basename = testCase "basename" $ do+ "" @=? basename ".."+ "" @=? basename "/"+ "" @=? basename "."+ ".txt" @=? basename ".txt"+ "foo" @=? basename "foo.txt"+ "bar" @=? basename "foo/bar.txt"++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+ "bar" @=? basename "c:\\foo\\bar"+ "bar" @=? basename "c:\\foo\\bar.txt"+#else+ "bar" @=? basename "/foo/bar"+ "bar" @=? basename "/foo/bar.txt"+#endif++test_Absolute :: TestTree+test_Absolute = testCase "absolute" $ do+ let myAssert q = assertBool ("absolute " ++ show q) $ absolute q+ let myAssert' q = assertBool ("not $ absolute " ++ show q) $ not $ absolute q++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+ myAssert "c:\\"+ myAssert "c:\\foo\\bar"+ myAssert' ""+ myAssert' "foo\\bar"+ myAssert' "\\foo\\bar"+#else+ myAssert "/"+ myAssert "/foo/bar"+ myAssert' ""+ myAssert' "foo/bar"+#endif+++test_Relative :: TestTree+test_Relative = testCase "relative" $ do+ let myAssert q = assertBool ("relative " ++ show q) $ relative q+ let myAssert' q = assertBool ("not $ relative " ++ show q) $ not $ relative q++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+ myAssert' "c:\\"+ myAssert' "c:\\foo\\bar"+ myAssert ""+ myAssert "foo\\bar"+ myAssert' "\\foo\\bar"+#else+ myAssert' "/"+ myAssert' "/foo/bar"+ myAssert ""+ myAssert "foo/bar"+#endif++test_CommonPrefix :: TestTree+test_CommonPrefix = testCase "commonPrefix" $ do+ "" @=? commonPrefix []+ "./" @=? commonPrefix [".", "."]+ "" @=? commonPrefix [".", ".."]+ "foo/" @=? commonPrefix ["foo/bar", "foo/baz"]+ "" @=? commonPrefix ["foo/", "bar/"]++test_StripPrefix :: TestTree+test_StripPrefix = testCase "stripPrefix" $ do+ Just "" @=? stripPrefix "" ""+ Just "/" @=? stripPrefix "" "/"+ Just "" @=? stripPrefix "/" "/"+ Just "foo" @=? stripPrefix "/" "/foo"+ Just "foo/bar" @=? stripPrefix "/" "/foo/bar"+ Just "bar" @=? stripPrefix "/foo/" "/foo/bar"+ Just "bar/baz" @=? stripPrefix "/foo/" "/foo/bar/baz"+ Just ".txt" @=? stripPrefix "/foo/bar" "/foo/bar.txt"+ Just ".gz" @=? stripPrefix "/foo/bar.txt" "/foo/bar.txt.gz"++ -- Test ignoring non-matching prefixes+ Nothing @=? stripPrefix "/foo" "/foo/bar"+ Nothing @=? stripPrefix "/foo/bar/baz" "/foo"+ Nothing @=? stripPrefix "/foo/baz/" "/foo/bar/qux"+ Nothing @=? stripPrefix "/foo/bar/baz" "/foo/bar/qux"++test_Collapse :: TestTree+test_Collapse = testCase "collapse" $ do+ -- This behavior differs from the old `system-filepath` package, but this+ -- behavior is more correct in the presence of symlinks+ "foo/../bar" @=? collapse "foo/../bar"++ "foo/bar" @=? collapse "foo/bar"+ "foo/bar" @=? collapse "foo/./bar"++test_SplitDirectories :: TestTree+test_SplitDirectories = testCase "splitDirectories" $ do+ [] @=? splitDirectories ""+ ["./"] @=? splitDirectories "."+ ["../"] @=? splitDirectories ".."+ ["foo/", "../"] @=? splitDirectories "foo/.."+ ["foo/", "./"] @=? splitDirectories "foo/."+ ["/"] @=? splitDirectories "/"+ ["/", "a"] @=? splitDirectories "/a"+ ["/", "ab/", "cd"] @=? splitDirectories "/ab/cd"+ ["/", "ab/", "cd/"] @=? splitDirectories "/ab/cd/"+ ["ab/", "cd"] @=? splitDirectories "ab/cd"+ ["ab/", "cd/"] @=? splitDirectories "ab/cd/"+ ["ab/", "cd.txt"] @=? splitDirectories "ab/cd.txt"+ ["ab/", "cd/", ".txt"] @=? splitDirectories "ab/cd/.txt"+ ["ab/", "./", "cd"] @=? splitDirectories "ab/./cd"++test_SplitExtension :: TestTree+test_SplitExtension = testCase "splitExtension" $ do+ ("", Nothing) @=? splitExtension ""+ ("foo", Nothing) @=? splitExtension "foo"+ ("foo", Just "") @=? splitExtension "foo."+ ("foo", Just "a") @=? splitExtension "foo.a"+ ("foo.a/", Nothing) @=? splitExtension "foo.a/"+ ("foo.a/bar", Nothing) @=? splitExtension "foo.a/bar"+ ("foo.a/bar", Just "b") @=? splitExtension "foo.a/bar.b"+ ("foo.a/bar.b", Just "c") @=? splitExtension "foo.a/bar.b.c"
turtle.cabal view
@@ -1,5 +1,5 @@ Name: turtle-Version: 1.5.25+Version: 1.6.0 Cabal-Version: >=1.10 Build-Type: Simple License: BSD3@@ -29,7 +29,7 @@ . * Formatting: Type-safe @printf@-style text formatting .- * Modern: Supports @text@ and @system-filepath@+ * Modern: Supports @text@ . Read "Turtle.Tutorial" for a detailed tutorial or "Turtle.Prelude" for a quick-start guide@@ -69,12 +69,11 @@ containers >= 0.5.0.0 && < 0.7 , directory >= 1.3.1.0 && < 1.4 , exceptions >= 0.4 && < 0.11,+ filepath >= 1.4.1.2 && < 1.5 , foldl >= 1.1 && < 1.5 , hostname < 1.1 , managed >= 1.0.3 && < 1.1 , process >= 1.0.1.1 && < 1.7 ,- system-filepath >= 0.3.1 && < 0.5 ,- system-fileio >= 0.2.1 && < 0.4 , stm < 2.6 , streaming-commons < 0.3 , temporary < 1.4 ,@@ -83,7 +82,7 @@ transformers >= 0.2.0.0 && < 0.7 , optparse-applicative >= 0.16 && < 0.18, optional-args >= 1.0 && < 2.0 ,- unix-compat >= 0.4 && < 0.6+ unix-compat >= 0.4 && < 0.7 if os(windows) Build-Depends: Win32 >= 2.12 else@@ -143,7 +142,20 @@ Build-Depends: base >= 4 && < 5, temporary,- system-filepath >= 0.4,+ filepath >= 0.4,+ turtle++test-suite system-filepath-tests+ Type: exitcode-stdio-1.0+ HS-Source-Dirs: test+ Main-Is: system-filepath.hs+ GHC-Options: -Wall -threaded+ Default-Language: Haskell2010+ Build-Depends:+ base,+ filepath,+ tasty >=1.4 && <1.5,+ tasty-hunit >=0.10 && <0.11, turtle benchmark bench