turtle 1.4.6 → 1.6.2
raw patch · 16 files changed
Files
- CHANGELOG.md +214/−2
- LICENSE +2/−2
- bench/Main.hs +1/−1
- src/Turtle.hs +51/−17
- src/Turtle/Bytes.hs +156/−16
- src/Turtle/Format.hs +14/−5
- src/Turtle/Internal.hs +236/−3
- src/Turtle/Line.hs +5/−0
- src/Turtle/Options.hs +45/−7
- src/Turtle/Pattern.hs +13/−3
- src/Turtle/Prelude.hs +450/−187
- src/Turtle/Shell.hs +119/−37
- src/Turtle/Tutorial.hs +95/−38
- test/cptree.hs +2/−2
- test/system-filepath.hs +226/−0
- turtle.cabal +74/−36
CHANGELOG.md view
@@ -1,6 +1,218 @@-1.4.6+1.6.2 -* Increase upper bound on `Win32`+* Build against latest `ansi-wl-pprint` and `optparse-applicative` [[#445]](https://github.com/Gabriella439/turtle/pull/445) / [[#446]](https://github.com/Gabriella439/turtle/pull/446) / [[#447]](https://github.com/Gabriella439/turtle/pull/447)++1.6.1++* BUG FIX: Fix `turtle` to build on Windows+* BUG FIX: `stripPrefix` and `commonPrefix` now correctly handle files with+ extensions+ * For example, before this fix `stripPrefix "./" "./foo.bar"` would+ return `Just "foo/.bar"`++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++1.5.24++* Expose `Format` constructor++1.5.23++* Add `fromIO` utility+* Build against GHC 9.0 / 9.2++1.5.22++* Add new `update` utility+* Improve documentation for `limit`++1.5.21++* Build against `optparse-applicative-0.16.0.0`++1.5.20++* Build against `doctest-0.17`+* Only depend on `semigroups` for GHC < 8.0++1.5.19++* Add pattern synonyms for `Size`++1.5.18++* Fix space leak++1.5.17++* Add `optionsExt`: Extended version of `options` with header, footer,+ porgram-description and version information in `--help` flag+* Add `readlink`++1.5.16++* Add `cptreeL`++1.5.15++* Add `toLines`+* Add `Turtle.Bytes.{fromUTF8,toUTF8}`+* Add `Turtle.Bytes.{compress,decompress}`+* Always expose a `MonadFail` instance, relying on the `fail` package+ where needed. Related GHC 8.8 preparedness.++1.5.14++* Fix `cptree` to copy symlinks instead of descending into them+ * See: https://github.com/Gabriel439/Haskell-Turtle-Library/pull/344+* Build against newer versions of `Win32` package++1.5.13++* Fix `chmod` bug+ * See: https://github.com/Gabriel439/Haskell-Turtle-Library/pull/337+* Add `reduce` and re-export `(<&>)`+ * See: https://github.com/Gabriel439/Haskell-Turtle-Library/pull/332++1.5.12++* Increase upper bound on `containers`++1.5.11++* Don't forward broken pipe exceptions when using `inproc`+ * See: https://github.com/Gabriel439/Haskell-Turtle-Library/pull/321+* Increase upper bound on `stm`+ * See: https://github.com/Gabriel439/Haskell-Turtle-Library/pull/321+* Tutorial improvements:+ * See: https://github.com/Gabriel439/Haskell-Turtle-Library/pull/322++1.5.10++* Increase upper bound on `doctest` and `criterion`++1.5.9++* Add `symlink`++1.5.8++* Bug fix: `invert` no longer rejects inputs where a prefix matches the inverted+ pattern+ * See: https://github.com/Gabriel439/Haskell-Turtle-Library/pull/297+* Add lsdepth, findtree, cmin, and cmax+* Increase upper bound on `temporary` and `foldl`++1.5.7++* Increase upper bound on `doctest`++1.5.6++* Increase upper bound on `exceptions`++1.5.5++* Increase upper bound on `criterion`++1.5.4++* Increase upper bound on `exceptions`++1.5.3++* Increase upper bound on `doctest`++1.5.2++* Increase upper bound on `async`++1.5.1++* GHC 8.4 support+* Re-export `encodeString`/`decodeString`+* Update tutorial to use `stack script`+* Increase upper bounds on dependencies++1.5.0++* BREAKING CHANGE: Add `MonadCatch` instance for `Shell`+ * This requires a breaking change to the internal implementation of `Shell`+ * Most breaking changes can be fixed by replacing the `Shell` constructor+ with the newly added `_Shell` utility for ease of migration+ * If you don't use the `Shell` constructor then this change likely does not+ affect you+* Add `eprintf` 1.4.5
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2017 Gabriel Gonzalez+Copyright (c) 2017 Gabriella Gonzalez All rights reserved. Redistribution and use in source and binary forms, with or without modification,@@ -8,7 +8,7 @@ * 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 Gabriel Gonzalez nor the names of other contributors+ * Neither the name of Gabriella Gonzalez nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission.
bench/Main.hs view
@@ -2,7 +2,7 @@ module Main where import qualified Data.Text as Text-import Criterion.Main+import Test.Tasty.Bench import Turtle boundedNaive :: Int -> Int -> Pattern a -> Pattern [a]
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@@ -87,6 +84,7 @@ , ExitCode(..) , IsString(..) , (&)+ , (<&>) ) where import Turtle.Format@@ -119,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@@ -129,25 +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@@ -160,4 +165,33 @@ -- application operator '$', which allows '&' to be nested in '$'. (&) :: a -> (a -> b) -> b x & f = f x+#endif++#if __GLASGOW_HASKELL__ >= 821+import Data.Functor ((<&>))+#else+-- | Flipped version of '<$>'.+--+-- @+-- ('<&>') = 'flip' 'fmap'+-- @+--+-- @since 4.11.0.0+--+-- ==== __Examples__+-- Apply @(+1)@ to a list, a 'Data.Maybe.Just' and a 'Data.Either.Right':+--+-- >>> Just 2 <&> (+1)+-- Just 3+--+-- >>> [1,2,3] <&> (+1)+-- [2,3,4]+--+-- >>> Right 3 <&> (+1)+-- Right 4+--+(<&>) :: Functor f => f a -> (a -> b) -> f b+as <&> f = f <$> as++infixl 1 <&> #endif
src/Turtle/Bytes.hs view
@@ -16,6 +16,12 @@ , append , stderr , strict+ , compress+ , decompress+ , WindowBits(..)+ , Zlib.defaultWindowBits+ , fromUTF8+ , toUTF8 -- * Subprocess management , proc@@ -40,18 +46,18 @@ import Control.Applicative import Control.Concurrent.Async (Async, Concurrently(..))-import Control.Foldl (FoldM(..)) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Managed (MonadManaged(..)) import Data.ByteString (ByteString)+import Data.Monoid+import Data.Streaming.Zlib (Inflate, Popper, PopperRes(..), WindowBits(..)) import Data.Text (Text)-import Filesystem.Path (FilePath)-import Prelude hiding (FilePath)+import Data.Text.Encoding (Decoding(..)) import System.Exit (ExitCode(..)) import System.IO (Handle) import Turtle.Internal (ignoreSIGPIPE) import Turtle.Prelude (ProcFailed(..), ShellFailed(..))-import Turtle.Shell (Shell(..), fold, sh)+import Turtle.Shell (Shell(..), FoldShell(..), fold, sh) import qualified Control.Concurrent.Async as Async import qualified Control.Concurrent.STM as STM@@ -62,7 +68,10 @@ import qualified Control.Monad import qualified Control.Monad.Managed as Managed import qualified Data.ByteString+import qualified Data.Streaming.Zlib as Zlib import qualified Data.Text+import qualified Data.Text.Encoding as Encoding+import qualified Data.Text.Encoding.Error as Encoding.Error import qualified Foreign import qualified System.IO import qualified System.Process as Process@@ -89,8 +98,7 @@ The chunks are not necessarily aligned to line boundaries -} inhandle :: Handle -> Shell ByteString-inhandle handle = Shell (\(FoldM step begin done) -> do- x0 <- begin+inhandle handle = Shell (\(FoldShell step begin done) -> do let loop x = do eof <- System.IO.hIsEOF handle if eof@@ -99,7 +107,7 @@ bytes <- Data.ByteString.hGetSome handle defaultChunkSize x' <- step x bytes loop $! x'- loop $! x0 )+ loop $! begin ) where -- Copied from `Data.ByteString.Lazy.Internal` defaultChunkSize :: Int@@ -521,15 +529,15 @@ mvar <- liftIO (MVar.newMVar False) let close handle = do MVar.modifyMVar_ mvar (\finalized -> do- Control.Monad.unless finalized (System.IO.hClose handle)+ Control.Monad.unless finalized (ignoreSIGPIPE (System.IO.hClose handle)) return True ) (hIn, hOut, ph) <- using (Managed.managed (Exception.bracket open (\(hIn, _, ph) -> close hIn >> Process.terminateProcess ph))) let feedIn :: (forall a. IO a -> IO a) -> IO () feedIn restore =- restore (sh (do+ restore (ignoreSIGPIPE (sh (do bytes <- s- liftIO (Data.ByteString.hPut hIn bytes) ) )+ liftIO (Data.ByteString.hPut hIn bytes) ) ) ) `Exception.finally` close hIn a <- using@@ -567,15 +575,15 @@ mvar <- liftIO (MVar.newMVar False) let close handle = do MVar.modifyMVar_ mvar (\finalized -> do- Control.Monad.unless finalized (System.IO.hClose handle)+ Control.Monad.unless finalized (ignoreSIGPIPE (System.IO.hClose handle)) return True ) (hIn, hOut, hErr, ph) <- using (Managed.managed (Exception.bracket open (\(hIn, _, _, ph) -> close hIn >> Process.terminateProcess ph))) let feedIn :: (forall a. IO a -> IO a) -> IO () feedIn restore =- restore (sh (do+ restore (ignoreSIGPIPE (sh (do bytes <- s- liftIO (Data.ByteString.hPut hIn bytes) ) )+ liftIO (Data.ByteString.hPut hIn bytes) ) ) ) `Exception.finally` close hIn queue <- liftIO TQueue.newTQueueIO@@ -591,8 +599,7 @@ bytes <- inhandle hErr liftIO (STM.atomically (TQueue.writeTQueue queue (Just (Left bytes)))) )) `Exception.finally` STM.atomically (TQueue.writeTQueue queue Nothing)- let drain = Shell (\(FoldM step begin done) -> do- x0 <- begin+ let drain = Shell (\(FoldShell step begin done) -> do let loop x numNothing | numNothing < 2 = do m <- STM.atomically (TQueue.readTQueue queue)@@ -602,7 +609,7 @@ x' <- step x e loop x' numNothing | otherwise = return x- x1 <- loop x0 (0 :: Int)+ x1 <- loop begin (0 :: Int) done x1 ) a <- using@@ -660,3 +667,136 @@ -> Shell (Either ByteString ByteString) -- ^ Chunks of either output (`Right`) or error (`Left`) inshellWithErr cmd = streamWithErr (Process.shell (Data.Text.unpack cmd))++-- | Internal utility used by both `compress` and `decompress`+fromPopper :: Popper -> Shell ByteString+fromPopper popper = loop+ where+ loop = do+ result <- liftIO popper++ case result of+ PRDone ->+ empty+ PRNext compressedByteString ->+ return compressedByteString <|> loop+ PRError exception ->+ liftIO (Exception.throwIO exception)++{-| Compress a stream using @zlib@++ Note that this can decompress streams that are the concatenation of+ multiple compressed streams (just like @gzip@)++>>> let compressed = select [ "ABC", "DEF" ] & compress 0 defaultWindowBits+>>> compressed & decompress defaultWindowBits & view+"ABCDEF"+>>> (compressed <|> compressed) & decompress defaultWindowBits & view+"ABCDEF"+"ABCDEF"+-}+compress+ :: Int+ -- ^ Compression level+ -> WindowBits+ -- ^+ -> Shell ByteString+ -- ^+ -> Shell ByteString+compress compressionLevel windowBits bytestrings = do+ deflate <- liftIO (Zlib.initDeflate compressionLevel windowBits)++ let loop = do+ bytestring <- bytestrings++ popper <- liftIO (Zlib.feedDeflate deflate bytestring)++ fromPopper popper++ let wrapUp = do+ let popper = liftIO (Zlib.finishDeflate deflate)++ fromPopper popper++ loop <|> wrapUp++data DecompressionState = Uninitialized | Decompressing Inflate++-- | Decompress a stream using @zlib@ (just like the @gzip@ command)+decompress :: WindowBits -> Shell ByteString -> Shell ByteString+decompress windowBits (Shell k) = Shell k'+ where+ k' (FoldShell step begin done) = k (FoldShell step' begin' done')+ where+ begin' = (begin, Uninitialized)++ step' (x0, Uninitialized) compressedByteString = do+ inflate <- Zlib.initInflate windowBits++ step' (x0, Decompressing inflate) compressedByteString+ step' (x0, Decompressing inflate) compressedByteString = do+ popper <- Zlib.feedInflate inflate compressedByteString++ let loop x = do+ result <- popper++ case result of+ PRDone -> do+ compressedByteString' <- Zlib.getUnusedInflate inflate++ if Data.ByteString.null compressedByteString'+ then return (x, Decompressing inflate)+ else do+ decompressedByteString <- Zlib.finishInflate inflate++ x' <- step x decompressedByteString++ step' (x', Uninitialized) compressedByteString'+ PRNext decompressedByteString -> do+ x' <- step x decompressedByteString++ loop x'+ PRError exception -> do+ Exception.throwIO exception++ loop x0++ done' (x0, Uninitialized) = do+ done x0+ done' (x0, Decompressing inflate) = do+ decompressedByteString <- Zlib.finishInflate inflate++ x0' <- step x0 decompressedByteString++ done' (x0', Uninitialized)++{-| Decode a stream of bytes as UTF8 `Text`++ NOTE: This function will throw a pure exception (i.e. an `error`) if UTF8+ decoding fails (mainly due to limitations in the @text@ package's stream+ decoding API)+-}+toUTF8 :: Shell ByteString -> Shell Text+toUTF8 (Shell k) = Shell k'+ where+ k' (FoldShell step begin done) =+ k (FoldShell step' begin' done')+ where+ begin' =+ (mempty, Encoding.streamDecodeUtf8With Encoding.Error.strictDecode, begin)++ step' (prefix, decoder, x) suffix = do+ let bytes = prefix <> suffix++ let Some text prefix' decoder' = decoder bytes ++ x' <- step x text++ return (prefix', decoder', x')++ done' (_, _, x) = do+ done x++-- | Encode a stream of bytes as UTF8 `Text`+fromUTF8 :: Shell Text -> Shell ByteString+fromUTF8 = fmap Encoding.encodeUtf8
src/Turtle/Format.hs view
@@ -42,10 +42,11 @@ module Turtle.Format ( -- * Format- Format+ Format (..) , (%) , format , printf+ , eprintf , makeFormat -- * Parameters@@ -73,9 +74,9 @@ 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) import qualified Data.Text.IO as Text@@ -113,6 +114,14 @@ printf :: MonadIO io => Format (io ()) r -> r printf fmt = fmt >>- (liftIO . Text.putStr) +{-| Print a `Format` string to standard err (without a trailing newline)++>>> eprintf ("Hello, "%s%"!\n") "world"+Hello, world!+-}+eprintf :: MonadIO io => Format (io ()) r -> r+eprintf fmt = fmt >>- (liftIO . Text.hPutStr IO.stderr)+ -- | Create your own format specifier makeFormat :: (a -> Text) -> Format r (a -> r) makeFormat k = Format (\return_ -> \a -> return_ (k a))@@ -205,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,230 @@ | 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+ | leftComponents == rightComponents =+ FilePath.joinPath leftComponents+ ++ mconcat (longestPrefix leftExtensions rightExtensions)+ | otherwise =+ FilePath.joinPath (longestPrefix leftComponents rightComponents)+ where+ (leftComponents, leftExtensions) = splitExt (splitDirectories left)++ (rightComponents, rightExtensions) = 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+ componentSuffix <- List.stripPrefix prefixComponents pathComponents++ if null componentSuffix+ then do+ prefixSuffix <- List.stripPrefix prefixExtensions pathExtensions++ return (mconcat prefixSuffix)+ else do+ return (FilePath.joinPath componentSuffix ++ mconcat pathExtensions)+ where+ (prefixComponents, prefixExtensions) = splitExt (splitDirectories prefix)++ (pathComponents, pathExtensions) = splitExt (splitDirectories path)++-- Internal helper function for `stripPrefix` and `commonPrefix`+splitExt :: [FilePath] -> ([FilePath], [String])+splitExt [ component ] = ([ base ], map ("." ++) exts)+ where+ (base, exts) = splitExtensions component+splitExt [ ] =+ ([ ], [ ])+splitExt (component : components) = (component : base, exts)+ where+ (base, exts) = 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/Line.hs view
@@ -62,6 +62,11 @@ newtype Line = Line Text deriving (Eq, Ord, Show, Monoid) +#if __GLASGOW_HASKELL__ >= 804+instance Semigroup Line where+ (<>) = mappend+#endif+ instance IsString Line where fromString = fromMaybe (throw NewlineForbidden) . textToLine . fromString
src/Turtle/Options.hs view
@@ -17,8 +17,8 @@ -- > -- > main = do -- > (name, age) <- options "Greeting script" parser--- > echo (format ("Hello there, "%s) name)--- > echo (format ("You are "%d%" years old") age)+-- > echo (repr (format ("Hello there, "%s) name))+-- > echo (repr (format ("You are "%d%" years old") age)) -- -- > $ ./options --name John --age 42 -- > Hello there, John@@ -71,6 +71,7 @@ , subcommand , subcommandGroup , options+ , optionsExt ) where @@ -82,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) @@ -107,6 +106,30 @@ prefs = Opts.showHelpOnError #endif +{-| Parse the given options from the command line and add additional information++ Extended version of @options@ with program version header and footer information+-}+optionsExt :: MonadIO io => Header -> Footer -> Description -> Version -> Parser a -> io a+optionsExt header footer desc version parser = liftIO+ $ Opts.customExecParser (Opts.prefs prefs)+ $ Opts.info (Opts.helper <*> versionOption <*> parser)+ (Opts.headerDoc (Just (getHeader header)) <>+ Opts.footerDoc (Just (getFooter footer)) <>+ Opts.progDescDoc (Just (getDescription desc)))+ where+ versionOption =+ Opts.infoOption+ (Text.unpack version)+ (Opts.long "version" <> Opts.help "Show version")+ prefs :: Opts.PrefsMod+#if MIN_VERSION_optparse_applicative(0,13,0)+ prefs = Opts.showHelpOnError <> Opts.showHelpOnEmpty+#else+ prefs = Opts.showHelpOnError+#endif++ {-| The name of a command-line argument This is used to infer the long name and metavariable for the command line@@ -135,6 +158,21 @@ newtype Description = Description { getDescription :: Doc } deriving (IsString) +{-| Header of the program++ This description will appear in the header of the @--help@ output+-}+newtype Header = Header { getHeader :: Doc }+ deriving (IsString)+{-| Footer of the program++ This description will appear in the footer of the @--help@ output+-}+newtype Footer = Fotter { getFooter :: Doc }+ deriving (IsString)++-- | Program Version+type Version = Text {-| A helpful message explaining what a flag does This will appear in the @--help@ output@@ -197,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@@ -237,14 +275,14 @@ -- | 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 s <- Opts.readerAsk case f (Text.pack s) of Just a -> return a- Nothing -> Opts.readerAbort Opts.ShowHelpText+ Nothing -> Opts.readerAbort (Opts.ShowHelpText Nothing) {-| Create a sub-command that parses `CommandName` and then parses the rest of the command-line arguments
src/Turtle/Pattern.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-}@@ -123,6 +124,11 @@ newtype Pattern a = Pattern { runPattern :: StateT Text [] a } deriving (Functor, Applicative, Monad, Alternative, MonadPlus) +#if __GLASGOW_HASKELL__ >= 804+instance Monoid a => Semigroup (Pattern a) where+ (<>) = mappend+#endif+ instance Monoid a => Monoid (Pattern a) where mempty = pure mempty mappend = liftA2 mappend@@ -438,11 +444,15 @@ [] >>> match (invert "A") "B" [()]+>>> match (invert "A") "AA"+[()] -} invert :: Pattern a -> Pattern ()-invert p = Pattern (StateT (\str -> case runStateT (runPattern p) str of- [] -> [((), "")]- _ -> [] ))+invert p = Pattern (StateT f)+ where+ f str = case match p str of+ [] -> [((), "")]+ _ -> [] {-| Match a `Char`, but return `Text`
src/Turtle/Prelude.hs view
@@ -4,6 +4,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-} -- | This module provides a large suite of utilities that resemble Unix -- utilities.@@ -109,8 +111,8 @@ echo , err , readline- , Filesystem.readTextFile- , Filesystem.writeTextFile+ , Internal.readTextFile+ , Internal.writeTextFile , arguments #if __GLASGOW_HASKELL__ >= 710 , export@@ -121,12 +123,18 @@ , cd , pwd , home+ , readlink , realpath , mv , mkdir , mktree , cp , cptree+ , cptreeL+#if !defined(mingw32_HOST_OS)+ , symlink+#endif+ , isNotSymbolicLink , rm , rmdir , rmtree@@ -170,6 +178,7 @@ , ls , lsif , lstree+ , lsdepth , cat , grep , grepText@@ -182,7 +191,9 @@ , inplacePrefix , inplaceSuffix , inplaceEntire+ , update , find+ , findtree , yes , nl , paste@@ -200,6 +211,7 @@ , sort , sortOn , sortBy+ , toLines -- * Folds , countChars@@ -242,7 +254,7 @@ -- * File size , du- , Size+ , Size(B, KB, MB, GB, TB, KiB, MiB, GiB, TiB) , sz , bytes , kilobytes@@ -269,6 +281,8 @@ , PosixCompat.isDirectory , PosixCompat.isSymbolicLink , PosixCompat.isSocket+ , cmin+ , cmax -- * Headers , WithHeader(..)@@ -289,10 +303,10 @@ import qualified Control.Concurrent.STM as STM import qualified Control.Concurrent.STM.TQueue as TQueue import Control.Exception (Exception, bracket, bracket_, finally, mask, throwIO)-import Control.Foldl (Fold(..), FoldM(..), genericLength, handles, list, premap)+import Control.Foldl (Fold(..), genericLength, handles, list, premap) import qualified Control.Foldl import qualified Control.Foldl.Text-import Control.Monad (guard, liftM, msum, when, unless, (>=>), mfilter)+import Control.Monad (foldM, guard, liftM, msum, when, unless, (>=>), mfilter) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Managed (MonadManaged(..), managed, managed_, runManaged) #ifdef mingw32_HOST_OS@@ -300,19 +314,18 @@ #endif import Data.IORef (newIORef, readIORef, writeIORef) import qualified Data.List as List+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NonEmpty import Data.Monoid ((<>)) import Data.Ord (comparing) import qualified Data.Set as Set import Data.Text (Text, pack, unpack) import Data.Time (NominalDiffTime, UTCTime, getCurrentTime)-import Data.Time.Clock.POSIX (POSIXTime)+import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime) import Data.Traversable 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)@@ -326,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@@ -344,13 +358,14 @@ readDirStream, closeDirStream, touchFile )+import System.Posix.Files (createSymbolicLink) #endif-import Prelude hiding (FilePath)+import Prelude hiding (lines) import Turtle.Pattern (Pattern, anyChar, chars, match, selfless, sepBy) import Turtle.Shell-import Turtle.Format (Format, format, makeFormat, d, w, (%))-import Turtle.Internal (ignoreSIGPIPE)+import Turtle.Format (Format, format, makeFormat, d, w, (%), fp)+import qualified Turtle.Internal as Internal import Turtle.Line {-| Run a command using @execvp@, retrieving the exit code@@ -550,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@@ -561,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) )@@ -599,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 ->@@ -642,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 ->@@ -678,6 +693,8 @@ injection if you template the command line with untrusted input The command inherits @stderr@ for the current process++ Throws an `ExitCode` exception if the command returns a non-zero exit code -} inshell :: Text@@ -724,12 +741,12 @@ mvar <- liftIO (newMVar False) let close handle = do modifyMVar_ mvar (\finalized -> do- unless finalized (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 (outhandle hIn s) `finally` close hIn+ feedIn restore = restore (Internal.ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn a <- using (managed (\k ->@@ -765,12 +782,12 @@ mvar <- liftIO (newMVar False) let close handle = do modifyMVar_ mvar (\finalized -> do- unless finalized (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 (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 ()@@ -785,8 +802,7 @@ line <- inhandle hErr liftIO (STM.atomically (TQueue.writeTQueue queue (Just (Left line)))) )) `finally` STM.atomically (TQueue.writeTQueue queue Nothing)- let drain = Shell (\(FoldM step begin done) -> do- x0 <- begin+ let drain = Shell (\(FoldShell step begin done) -> do let loop x numNothing | numNothing < 2 = do m <- STM.atomically (TQueue.readTQueue queue)@@ -796,7 +812,7 @@ x' <- step x e loop x' numNothing | otherwise = return x- x1 <- loop x0 (0 :: Int)+ x1 <- loop begin (0 :: Int) done x1 ) a <- using@@ -879,7 +895,11 @@ arguments = liftIO (fmap (map pack) getArgs) #if __GLASGOW_HASKELL__ >= 710--- | Set or modify an environment variable+{-| Set or modify an environment variable++ Note: This will change the current environment for all of your program's+ threads since this modifies the global state of the process+-} export :: MonadIO io => Text -> Text -> io () export key val = liftIO (setEnv (unpack key) (unpack val)) @@ -902,9 +922,13 @@ where toTexts (key, val) = (pack key, pack val) --- | Change the current directory+{-| Change the current directory++ Note: This will change the current directory for all of your program's+ 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.@@ -923,15 +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 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@@ -945,9 +973,8 @@ @\"..\"@ -} ls :: FilePath -> Shell FilePath-ls path = Shell (\(FoldM step begin done) -> do- x0 <- begin- let path' = Filesystem.encodeString path+ls path = Shell (\(FoldShell step begin done) -> do+ let path' = path canRead <- fmap Directory.readable (Directory.getPermissions (deslash path'))@@ -955,34 +982,32 @@ reparse <- fmap reparsePoint (Win32.getFileAttributes path') if (canRead && not reparse) then bracket- (Win32.findFirstFile (Filesystem.encodeString (path </> "*")))+ (Win32.findFirstFile (path </> "*")) (\(h, _) -> Win32.findClose h) (\(h, fdat) -> do let loop x = do- file' <- Win32.getFindDataFileName fdat- let file = Filesystem.decodeString file'- x' <- if (file' /= "." && file' /= "..")+ file <- Win32.getFindDataFileName fdat+ x' <- if (file /= "." && file /= "..") then step x (path </> file) else return x more <- Win32.findNextFile h fdat if more then loop $! x' else done x'- loop $! x0 )- else done x0 )+ loop $! begin )+ else done begin ) #else 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'- loop $! x0 )- else done x0 )+ loop $! begin )+ else done begin ) #endif {-| This is used to remove the trailing slash from a path, because@@ -1005,6 +1030,29 @@ then return child <|> lstree child else return child ++{- | Stream the recursive descendents of a given directory+ between a given minimum and maximum depth+-}+lsdepth :: Int -> Int -> FilePath -> Shell FilePath+lsdepth mn mx path =+ lsdepthHelper 1 mn mx path+ where+ lsdepthHelper :: Int -> Int -> Int -> FilePath -> Shell FilePath+ lsdepthHelper depth l u p = + if depth > u+ then empty+ else do+ child <- ls p+ isDir <- testdir child+ if isDir+ then if depth >= l+ then return child <|> lsdepthHelper (depth + 1) l u child+ else lsdepthHelper (depth + 1) l u child+ else if depth >= l+ then return child+ else empty+ {-| Stream all recursive descendents of the given directory This skips any directories that fail the supplied predicate@@ -1030,11 +1078,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@@ -1042,41 +1090,88 @@ 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) --- | Copy a directory tree+#if !defined(mingw32_HOST_OS)+-- | Create a symlink from one @FilePath@ to another+symlink :: MonadIO io => FilePath -> FilePath -> io ()+symlink a b = liftIO $ createSymbolicLink (fp2fp a) (fp2fp b)+ where+ fp2fp = unpack . format fp + +#endif++{-| Returns `True` if the given `FilePath` is not a symbolic link++ This comes in handy in conjunction with `lsif`:++ > lsif isNotSymbolicLink+-}+isNotSymbolicLink :: MonadIO io => FilePath -> io Bool+isNotSymbolicLink = fmap (not . PosixCompat.isSymbolicLink) . lstat++-- | Copy a directory tree and preserve symbolic links cptree :: MonadIO io => FilePath -> FilePath -> io () cptree oldTree newTree = sh (do- oldPath <- lstree oldTree+ oldPath <- lsif isNotSymbolicLink oldTree+ -- The `system-filepath` library treats a path like "/tmp" as a file and not -- 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 <> [ FilePath.pathSeparator ]) oldPath)+ let newPath = newTree </> suffix+ isFile <- testfile oldPath++ fileStatus <- lstat oldPath++ if PosixCompat.isSymbolicLink fileStatus+ then do+ oldTarget <- liftIO (PosixCompat.readSymbolicLink oldPath)++ mktree (FilePath.takeDirectory newPath)++ liftIO (PosixCompat.createSymbolicLink oldTarget newPath)+ else if isFile+ then do+ mktree (FilePath.takeDirectory newPath)++ cp oldPath newPath+ else do+ mktree newPath )++-- | Copy a directory tree and dereference symbolic links+cptreeL :: MonadIO io => FilePath -> FilePath -> io ()+cptreeL oldTree newTree = sh (do+ oldPath <- lstree oldTree+ 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@) @@ -1100,11 +1195,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@@ -1125,7 +1220,7 @@ #ifdef mingw32_HOST_OS then do handle <- Win32.createFile- (Filesystem.encodeString file)+ file Win32.gENERIC_WRITE Win32.fILE_SHARE_NONE Nothing@@ -1134,15 +1229,15 @@ Nothing (creationTime, _, _) <- Win32.getFileTime handle systemTime <- Win32.getSystemTimeAsFileTime- Win32.setFileTime handle creationTime systemTime systemTime+ 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.@@ -1154,26 +1249,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@@ -1208,33 +1303,33 @@ -> 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' changed = permissions' /= permissions''- let permissions''' = toSystemDirectoryPermissions permissions'+ let permissions''' = toSystemDirectoryPermissions permissions'' when changed (Directory.setPermissions path' permissions''')- return permissions' )+ return permissions'' ) -- | 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@@@ -1322,7 +1417,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'@@ -1395,10 +1490,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 @@ -1417,11 +1510,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 @@ -1435,12 +1527,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)@@ -1462,8 +1553,7 @@ -- | Read lines of `Text` from a `Handle` inhandle :: Handle -> Shell Line-inhandle handle = Shell (\(FoldM step begin done) -> do- x0 <- begin+inhandle handle = Shell (\(FoldShell step begin done) -> do let loop x = do eof <- IO.hIsEOF handle if eof@@ -1472,7 +1562,7 @@ txt <- Text.hGetLine handle x' <- step x (unsafeTextToLine txt) loop $! x'- loop $! x0 )+ loop $! begin ) -- | Stream lines of `Text` to standard output stdout :: MonadIO io => Shell Line -> io ()@@ -1512,22 +1602,22 @@ -- | 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 cat = msum grepWith :: (b -> Text) -> Pattern a -> Shell b -> Shell b-grepWith f pattern = mfilter (not . null . match pattern . f)+grepWith f pattern' = mfilter (not . null . match pattern' . f) -- | Keep all lines that match the given `Pattern` grep :: Pattern a -> Shell Line -> Shell Line@@ -1550,12 +1640,12 @@ necessarily incomplete. -} sed :: Pattern Text -> Shell Line -> Shell Line-sed pattern s = do- when (matchesEmpty pattern) (die message)- let pattern' = fmap Text.concat- (many (pattern <|> fmap Text.singleton anyChar))+sed pattern' s = do+ when (matchesEmpty pattern') (die message)+ let pattern'' = fmap Text.concat+ (many (pattern' <|> fmap Text.singleton anyChar)) line <- s- txt':_ <- return (match pattern' (lineToText line))+ txt':_ <- return (match pattern'' (lineToText line)) select (textToLines txt') where message = "sed: the given pattern matches the empty string"@@ -1565,70 +1655,73 @@ line -} sedPrefix :: Pattern Text -> Shell Line -> Shell Line-sedPrefix pattern s = do+sedPrefix pattern' s = do line <- s- txt':_ <- return (match ((pattern <> chars) <|> chars) (lineToText line))+ txt':_ <- return (match ((pattern' <> chars) <|> chars) (lineToText line)) select (textToLines txt') -- | Like `sed`, but the provided substitution must match the end of the line sedSuffix :: Pattern Text -> Shell Line -> Shell Line-sedSuffix pattern s = do+sedSuffix pattern' s = do line <- s- txt':_ <- return (match ((chars <> pattern) <|> chars) (lineToText line))+ txt':_ <- return (match ((chars <> pattern') <|> chars) (lineToText line)) select (textToLines txt') -- | Like `sed`, but the provided substitution must match the entire line sedEntire :: Pattern Text -> Shell Line -> Shell Line-sedEntire pattern s = do+sedEntire pattern' s = do line <- s- txt':_ <- return (match (pattern <|> chars)(lineToText line))+ txt':_ <- return (match (pattern' <|> chars)(lineToText line)) select (textToLines txt') -- | 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 ()-inplace = inplaceWith sed+inplace = update . sed -- | Like `sedPrefix`, but operates in place on a `FilePath` inplacePrefix :: MonadIO io => Pattern Text -> FilePath -> io ()-inplacePrefix = inplaceWith sedPrefix+inplacePrefix = update . sedPrefix -- | Like `sedSuffix`, but operates in place on a `FilePath` inplaceSuffix :: MonadIO io => Pattern Text -> FilePath -> io ()-inplaceSuffix = inplaceWith sedSuffix+inplaceSuffix = update . sedSuffix -- | Like `sedEntire`, but operates in place on a `FilePath` inplaceEntire :: MonadIO io => Pattern Text -> FilePath -> io ()-inplaceEntire = inplaceWith sedEntire+inplaceEntire = update . sedEntire -inplaceWith- :: MonadIO io- => (Pattern Text -> Shell Line -> Shell Line)- -> Pattern Text- -> FilePath- -> io ()-inplaceWith sed_ pattern file = liftIO (runManaged (do- here <- pwd+{-| Update a file in place using a `Shell` transformation++ For example, this is used to implement the @inplace*@ family of utilities+-}+update :: MonadIO io => (Shell Line -> Shell Line) -> FilePath -> io ()+update f file = liftIO (runManaged (do+ here <- pwd+ (tmpfile, handle) <- mktemp here "turtle"- outhandle handle (sed_ pattern (input file))++ outhandle handle (f (input file))+ liftIO (hClose handle)+ copymod file tmpfile+ mv tmpfile file )) -- | Search a directory recursively for all files matching the given `Pattern` find :: Pattern a -> FilePath -> Shell FilePath-find pattern dir = do+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@@ -1636,23 +1729,52 @@ file_stat <- lstat file return (not (PosixCompat.isSymbolicLink file_stat)) +-- | Filter a shell of FilePaths according to a given pattern+findtree :: Pattern a -> Shell FilePath -> Shell FilePath+findtree pat files = do+ path <- files++ let txt = Text.pack path++ _:_ <- return (match pat txt)++ return path++{- | Check if a file was last modified after a given+ timestamp+-} +cmin :: MonadIO io => UTCTime -> FilePath -> io Bool+cmin t file = do+ status <- lstat file+ return (adapt status)+ where+ adapt x = posixSecondsToUTCTime (modificationTime x) > t++{- | Check if a file was last modified before a given+ timestamp+-} +cmax :: MonadIO io => UTCTime -> FilePath -> io Bool+cmax t file = do+ status <- lstat file+ return (adapt status)+ where+ adapt x = posixSecondsToUTCTime (modificationTime x) < t+ -- | A Stream of @\"y\"@s yes :: Shell Line yes = fmap (\_ -> "y") endless -- | Number each element of a `Shell` (starting at 0) nl :: Num n => Shell a -> Shell (n, a)-nl s = Shell _foldIO'+nl s = Shell _foldShell' where- _foldIO' (FoldM step begin done) = _foldIO s (FoldM step' begin' done')+ _foldShell' (FoldShell step begin done) = _foldShell s (FoldShell step' begin' done') where step' (x, n) a = do x' <- step x (n, a) let n' = n + 1 n' `seq` return (x', n')- begin' = do- x0 <- begin- return (x0, 0)+ begin' = (begin, 0) done' (x, _) = done x data ZipState a b = Empty | HasA a | HasAB a b | Done@@ -1663,14 +1785,12 @@ truncated -} paste :: Shell a -> Shell b -> Shell (a, b)-paste sA sB = Shell _foldIOAB+paste sA sB = Shell _foldShellAB where- _foldIOAB (FoldM stepAB beginAB doneAB) = do- x0 <- beginAB-+ _foldShellAB (FoldShell stepAB beginAB doneAB) = do tvar <- STM.atomically (STM.newTVar Empty) - let begin = return ()+ let begin = () let stepA () a = STM.atomically (do x <- STM.readTVar tvar@@ -1684,7 +1804,7 @@ Empty -> STM.writeTVar tvar Done Done -> return () _ -> STM.retry )- let foldA = FoldM stepA begin doneA+ let foldA = FoldShell stepA begin doneA let stepB () b = STM.atomically (do x <- STM.readTVar tvar@@ -1698,10 +1818,10 @@ HasA _ -> STM.writeTVar tvar Done Done -> return () _ -> STM.retry )- let foldB = FoldM stepB begin doneB+ let foldB = FoldShell stepB begin doneB - withAsync (foldIO sA foldA) (\asyncA -> do- withAsync (foldIO sB foldB) (\asyncB -> do+ withAsync (_foldShell sA foldA) (\asyncA -> do+ withAsync (_foldShell sB foldB) (\asyncB -> do let loop x = do y <- STM.atomically (do z <- STM.readTVar tvar@@ -1716,29 +1836,32 @@ Just ab -> do x' <- stepAB x ab loop $! x'- x' <- loop $! x0+ x' <- loop $! beginAB wait asyncA wait asyncB doneAB x' ) ) -- | A `Shell` that endlessly emits @()@ endless :: Shell ()-endless = Shell (\(FoldM step begin _) -> do- x0 <- begin+endless = Shell (\(FoldShell step begin _) -> do let loop x = do x' <- step x () loop $! x'- loop $! x0 )+ loop $! begin ) --- | Limit a `Shell` to a fixed number of values+{-| Limit a `Shell` to a fixed number of values++ NOTE: This is not lazy and will still consume the entire input stream.+ There is no way to implement a lazy version of this utility.+-} limit :: Int -> Shell a -> Shell a-limit n s = Shell (\(FoldM step begin done) -> do+limit n s = Shell (\(FoldShell step begin done) -> do ref <- newIORef 0 -- I feel so dirty let step' x a = do n' <- readIORef ref writeIORef ref (n' + 1) if n' < n then step x a else return x- foldIO s (FoldM step' begin done) )+ _foldShell s (FoldShell step' begin done) ) {-| Limit a `Shell` to values that satisfy the predicate @@ -1746,14 +1869,14 @@ predicate -} limitWhile :: (a -> Bool) -> Shell a -> Shell a-limitWhile predicate s = Shell (\(FoldM step begin done) -> do+limitWhile predicate s = Shell (\(FoldShell step begin done) -> do ref <- newIORef True let step' x a = do b <- readIORef ref let b' = b && predicate a writeIORef ref b' if b' then step x a else return x- foldIO s (FoldM step' begin done) )+ _foldShell s (FoldShell step' begin done) ) {-| Cache a `Shell`'s output so that repeated runs of the script will reuse the result of previous runs. You must supply a `FilePath` where the cached@@ -1802,7 +1925,7 @@ -- | Split a line into chunks delimited by the given `Pattern` cut :: Pattern a -> Text -> [Text]-cut pattern txt = head (match (selfless chars `sepBy` pattern) txt)+cut pattern' txt = head (match (selfless chars `sepBy` pattern') txt) -- This `head` should be safe ... in theory -- | Get the current time@@ -1811,7 +1934,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@@ -1823,9 +1946,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@@ -1868,41 +1991,147 @@ then format (d%"."%d%" GB") remainingGigabytes remainingMegabytes else format (d%"."%d%" TB") numTerabytes remainingGigabytes ) +{-| Construct a 'Size' from an integer in bytes++>>> format sz (B 42)+"42 B"+-}+pattern B :: Integral n => n -> Size+pattern B { bytes } <- (fromInteger . _bytes -> bytes)+ where+ B = fromIntegral+{-# COMPLETE B #-}++{-| Construct a 'Size' from an integer in kilobytes++>>> format sz (KB 42)+"42.0 KB"+>>> let B n = KB 1 in n+1000+-}+pattern KB :: Integral n => n -> Size+pattern KB { kilobytes } <- (\(B x) -> x `div` 1000 -> kilobytes)+ where+ KB = B . (* 1000)+{-# COMPLETE KB #-}++{-| Construct a 'Size' from an integer in megabytes++>>> format sz (MB 42)+"42.0 MB"+>>> let KB n = MB 1 in n+1000+-}+pattern MB :: Integral n => n -> Size+pattern MB { megabytes } <- (\(KB x) -> x `div` 1000 -> megabytes)+ where+ MB = KB . (* 1000)+{-# COMPLETE MB #-}++{-| Construct a 'Size' from an integer in gigabytes++>>> format sz (GB 42)+"42.0 GB"+>>> let MB n = GB 1 in n+1000+-}+pattern GB :: Integral n => n -> Size+pattern GB { gigabytes } <- (\(MB x) -> x `div` 1000 -> gigabytes)+ where+ GB = MB . (* 1000)+{-# COMPLETE GB #-}++{-| Construct a 'Size' from an integer in terabytes++>>> format sz (TB 42)+"42.0 TB"+>>> let GB n = TB 1 in n+1000+-}+pattern TB :: Integral n => n -> Size+pattern TB { terabytes } <- (\(GB x) -> x `div` 1000 -> terabytes)+ where+ TB = GB . (* 1000)+{-# COMPLETE TB #-}++{-| Construct a 'Size' from an integer in kibibytes++>>> format sz (KiB 42)+"43.8 KB"+>>> let B n = KiB 1 in n+1024+-}+pattern KiB :: Integral n => n -> Size+pattern KiB { kibibytes } <- (\(B x) -> x `div` 1024 -> kibibytes)+ where+ KiB = B . (* 1024)+{-# COMPLETE KiB #-}++{-| Construct a 'Size' from an integer in mebibytes++>>> format sz (MiB 42)+"44.40 MB"+>>> let KiB n = MiB 1 in n+1024+-}+pattern MiB :: Integral n => n -> Size+pattern MiB { mebibytes } <- (\(KiB x) -> x `div` 1024 -> mebibytes)+ where+ MiB = KiB . (* 1024)+{-# COMPLETE MiB #-}++{-| Construct a 'Size' from an integer in gibibytes++>>> format sz (GiB 42)+"45.97 GB"+>>> let MiB n = GiB 1 in n+1024+-}+pattern GiB :: Integral n => n -> Size+pattern GiB { gibibytes } <- (\(MiB x) -> x `div` 1024 -> gibibytes)+ where+ GiB = MiB . (* 1024)+{-# COMPLETE GiB #-}++{-| Construct a 'Size' from an integer in tebibytes++>>> format sz (TiB 42)+"46.179 TB"+>>> let GiB n = TiB 1 in n+1024+-}+pattern TiB :: Integral n => n -> Size+pattern TiB { tebibytes } <- (\(GiB x) -> x `div` 1024 -> tebibytes)+ where+ TiB = GiB . (* 1024)+{-# COMPLETE TiB #-}+ -- | Extract a size in bytes bytes :: Integral n => Size -> n-bytes = fromInteger . _bytes -- | @1 kilobyte = 1000 bytes@ kilobytes :: Integral n => Size -> n-kilobytes = (`div` 1000) . bytes -- | @1 megabyte = 1000 kilobytes@ megabytes :: Integral n => Size -> n-megabytes = (`div` 1000) . kilobytes -- | @1 gigabyte = 1000 megabytes@ gigabytes :: Integral n => Size -> n-gigabytes = (`div` 1000) . megabytes -- | @1 terabyte = 1000 gigabytes@ terabytes :: Integral n => Size -> n-terabytes = (`div` 1000) . gigabytes -- | @1 kibibyte = 1024 bytes@ kibibytes :: Integral n => Size -> n-kibibytes = (`div` 1024) . bytes -- | @1 mebibyte = 1024 kibibytes@ mebibytes :: Integral n => Size -> n-mebibytes = (`div` 1024) . kibibytes -- | @1 gibibyte = 1024 mebibytes@ gibibytes :: Integral n => Size -> n-gibibytes = (`div` 1024) . mebibytes -- | @1 tebibyte = 1024 gibibytes@ tebibytes :: Integral n => Size -> n-tebibytes = (`div` 1024) . gibibytes {-| Count the number of characters in the stream (like @wc -c@) @@ -1935,7 +2164,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@@ -1955,7 +2184,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@@ -1969,7 +2198,7 @@ header :: Shell a -> Shell (WithHeader a) header (Shell k) = Shell k' where- k' (FoldM step begin done) = k (FoldM step' begin' done')+ k' (FoldShell step begin done) = k (FoldShell step' begin' done') where step' (Pair x Nothing ) a = do x' <- step x (Header a)@@ -1978,17 +2207,15 @@ x' <- step x (Row a b) return (Pair x' (Just a)) - begin' = do- x <- begin- return (Pair x Nothing)+ begin' = Pair begin Nothing done' (Pair x _) = done x --- | Returns the result of a 'Shell' that outputs a single--- line:+-- | Returns the result of a 'Shell' that outputs a single line.+-- Note that if no lines / more than 1 line is produced by the Shell, this function will `die` with an error message. -- -- > main = do--- > Just directory <- single (inshell "pwd" empty)+-- > directory <- single (inshell "pwd" empty) -- > print directory single :: MonadIO io => Shell a -> io a single s = do@@ -2027,12 +2254,12 @@ -- 1 -- 3 uniqBy :: (a -> a -> Bool) -> Shell a -> Shell a-uniqBy cmp s = Shell $ \(FoldM step begin done) -> do+uniqBy cmp s = Shell $ \(FoldShell step begin done) -> do let step' (x, Just a') a | cmp a a' = return (x, Just a) step' (x, _) a = (, Just a) <$> step x a- begin' = (, Nothing) <$> begin+ begin' = (begin, Nothing) done' (x, _) = done x- foldIO s (FoldM step' begin' done')+ foldShell s (FoldShell step' begin' done') -- | Return a new `Shell` that discards duplicates from the input `Shell`: --@@ -2052,12 +2279,12 @@ -- 3 -- 4 nubOn :: Ord b => (a -> b) -> Shell a -> Shell a-nubOn f s = Shell $ \(FoldM step begin done) -> do+nubOn f s = Shell $ \(FoldShell step begin done) -> do let step' (x, bs) a | Set.member (f a) bs = return (x, bs) | otherwise = (, Set.insert (f a) bs) <$> step x a- begin' = (, Set.empty) <$> begin+ begin' = (begin, Set.empty) done' (x, _) = done x- foldIO s (FoldM step' begin' done')+ foldShell s (FoldShell step' begin' done') -- | Return a list of the sorted elements of the given `Shell`, keeping duplicates: --@@ -2073,9 +2300,45 @@ sortOn :: (Functor io, MonadIO io, Ord b) => (a -> b) -> Shell a -> io [a] sortOn f = sortBy (comparing f) --- | Return a list of the elements of the given `Shell`, sortesd by the given function and keeping duplicates:+-- | Return a list of the elements of the given `Shell`, sorted by the given function and keeping duplicates: -- -- >>> sortBy (comparing fst) (select [(1,'a'),(4,'b'),(2,'c'),(3,'d'),(3,'e'),(7,'f')]) -- [(1,'a'),(2,'c'),(3,'d'),(3,'e'),(4,'b'),(7,'f')] sortBy :: (Functor io, MonadIO io) => (a -> a -> Ordering) -> Shell a -> io [a] sortBy f s = List.sortBy f <$> fold s list++{-| Group an arbitrary stream of `Text` into newline-delimited `Line`s++>>> stdout (toLines ("ABC" <|> "DEF" <|> "GHI")+ABCDEFGHI+>>> stdout (toLines empty) -- Note that this always emits at least 1 `Line`++>>> stdout (toLines ("ABC\nDEF" <|> "" <|> "GHI\nJKL"))+ABC+DEFGHI+JKL+-}+toLines :: Shell Text -> Shell Line+toLines (Shell k) = Shell k'+ where+ k' (FoldShell step begin done) =+ k (FoldShell step' begin' done')+ where+ step' (Pair x prefix) text = do+ let suffix :| lines = Turtle.Line.textToLines text++ let line = prefix <> suffix++ let lines' = line :| lines++ x' <- foldM step x (NonEmpty.init lines')++ let prefix' = NonEmpty.last lines'++ return (Pair x' prefix')++ begin' = (Pair begin "")++ done' (Pair x prefix) = do+ x' <- step x prefix+ done x'
src/Turtle/Shell.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE RankNTypes, CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -fno-warn-missing-methods #-} {-| You can think of `Shell` as @[]@ + `IO` + `Managed`. In fact, you can embed@@ -47,9 +50,8 @@ `Shell` you build must satisfy this law: > -- For every shell `s`:-> _foldIO s (FoldM step begin done) = do-> x <- begin-> x' <- _foldIO s (FoldM step (return x) return)+> _foldShell s (FoldShell step begin done) = do+> x' <- _foldShell s (FoldShell step begin return) > done x' ... which is a fancy way of saying that your `Shell` must call @\'begin\'@@@ -59,8 +61,13 @@ module Turtle.Shell ( -- * Shell Shell(..)+ , FoldShell(..)+ , _foldIO+ , _Shell , foldIO+ , foldShell , fold+ , reduce , sh , view @@ -68,15 +75,15 @@ , select , liftIO , using+ , fromIO ) where import Control.Applicative import Control.Monad (MonadPlus(..), ap)+import Control.Monad.Catch (MonadThrow(..), MonadCatch(..)) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Managed (MonadManaged(..), with)-#if MIN_VERSION_base(4,9,0) import qualified Control.Monad.Fail as Fail-#endif import Control.Foldl (Fold(..), FoldM(..)) import qualified Control.Foldl as Foldl import Data.Foldable (Foldable)@@ -85,17 +92,70 @@ import Data.String (IsString(..)) import Prelude -- Fix redundant import warnings +{-| This is similar to @`Control.Foldl.FoldM` `IO`@ except that the @begin@+ field is pure++ This small difference is necessary to implement a well-behaved `MonadCatch`+ instance for `Shell`+-}+data FoldShell a b = forall x . FoldShell (x -> a -> IO x) x (x -> IO b)+ -- | A @(Shell a)@ is a protected stream of @a@'s with side effects-newtype Shell a = Shell { _foldIO :: forall r . FoldM IO a r -> IO r }+newtype Shell a = Shell { _foldShell:: forall r . FoldShell a r -> IO r } +data Maybe' a = Just' !a | Nothing'++translate :: FoldM IO a b -> FoldShell a b+translate (FoldM step begin done) = FoldShell step' Nothing' done'+ where+ step' Nothing' a = do+ x <- begin+ x' <- step x a+ return $! Just' x'+ step' (Just' x) a = do+ x' <- step x a+ return $! Just' x'++ done' Nothing' = do+ x <- begin+ done x+ done' (Just' x) = do+ done x+ -- | Use a @`FoldM` `IO`@ to reduce the stream of @a@'s produced by a `Shell` foldIO :: MonadIO io => Shell a -> FoldM IO a r -> io r foldIO s f = liftIO (_foldIO s f) +{-| Provided for backwards compatibility with versions of @turtle-1.4.*@ and+ older+-}+_foldIO :: Shell a -> FoldM IO a r -> IO r+_foldIO s foldM = _foldShell s (translate foldM)++-- | Provided for ease of migration from versions of @turtle-1.4.*@ and older+_Shell :: (forall r . FoldM IO a r -> IO r) -> Shell a+_Shell f = Shell (f . adapt)+ where+ adapt (FoldShell step begin done) = FoldM step (return begin) done++-- | Use a `FoldShell` to reduce the stream of @a@'s produced by a `Shell`+foldShell :: MonadIO io => Shell a -> FoldShell a b -> io b+foldShell s f = liftIO (_foldShell s f)+ -- | Use a `Fold` to reduce the stream of @a@'s produced by a `Shell` fold :: MonadIO io => Shell a -> Fold a b -> io b fold s f = foldIO s (Foldl.generalize f) +-- | Flipped version of 'fold'. Useful for reducing a stream of data+--+-- ==== __Example__+-- Sum a `Shell` of numbers:+--+-- >>> select [1, 2, 3] & reduce Fold.sum+-- 6+reduce :: MonadIO io => Fold a b -> Shell a -> io b+reduce = flip fold+ -- | Run a `Shell` to completion, discarding any unused values sh :: MonadIO io => Shell a -> io () sh s = fold s (pure ())@@ -107,34 +167,33 @@ liftIO (print x) ) instance Functor Shell where- fmap f s = Shell (\(FoldM step begin done) ->+ fmap f s = Shell (\(FoldShell step begin done) -> let step' x a = step x (f a)- in _foldIO s (FoldM step' begin done) )+ in _foldShell s (FoldShell step' begin done) ) instance Applicative Shell where pure = return (<*>) = ap instance Monad Shell where- return a = Shell (\(FoldM step begin done) -> do- x <- begin- x' <- step x a- done x' )+ return a = Shell (\(FoldShell step begin done) -> do+ x <- step begin a+ done x ) - m >>= f = Shell (\(FoldM step0 begin0 done0) -> do- let step1 x a = _foldIO (f a) (FoldM step0 (return x) return)- _foldIO m (FoldM step1 begin0 done0) )+ m >>= f = Shell (\(FoldShell step0 begin0 done0) -> do+ let step1 x a = _foldShell (f a) (FoldShell step0 x return)+ _foldShell m (FoldShell step1 begin0 done0) ) - fail _ = mzero+#if!(MIN_VERSION_base(4,13,0))+ fail = Fail.fail+#endif instance Alternative Shell where- empty = Shell (\(FoldM _ begin done) -> do- x <- begin- done x )+ empty = Shell (\(FoldShell _ begin done) -> done begin) - s1 <|> s2 = Shell (\(FoldM step begin done) -> do- x <- _foldIO s1 (FoldM step begin return)- _foldIO s2 (FoldM step (return x) done) )+ s1 <|> s2 = Shell (\(FoldShell step begin done) -> do+ x <- _foldShell s1 (FoldShell step begin return)+ _foldShell s2 (FoldShell step x done) ) instance MonadPlus Shell where mzero = empty@@ -142,21 +201,28 @@ mplus = (<|>) instance MonadIO Shell where- liftIO io = Shell (\(FoldM step begin done) -> do- x <- begin- a <- io- x' <- step x a- done x' )+ liftIO io = Shell (\(FoldShell step begin done) -> do+ a <- io+ x <- step begin a+ done x ) instance MonadManaged Shell where- using resource = Shell (\(FoldM step begin done) -> do- x <- begin- x' <- with resource (step x)- done x' )+ using resource = Shell (\(FoldShell step begin done) -> do+ x <- with resource (step begin)+ done x ) -#if MIN_VERSION_base(4,9,0)+instance MonadThrow Shell where+ throwM e = Shell (\_ -> throwM e)++instance MonadCatch Shell where+ m `catch` k = Shell (\f-> _foldShell m f `catch` (\e -> _foldShell (k e) f))+ instance Fail.MonadFail Shell where- fail = Prelude.fail+ fail _ = mzero++#if __GLASGOW_HASKELL__ >= 804+instance Monoid a => Semigroup (Shell a) where+ (<>) = mappend #endif instance Monoid a => Monoid (Shell a) where@@ -175,9 +241,25 @@ -- | Convert a list to a `Shell` that emits each element of the list select :: Foldable f => f a -> Shell a-select as = Shell (\(FoldM step begin done) -> do- x0 <- begin+select as = Shell (\(FoldShell step begin done) -> do let step' a k x = do x' <- step x a k $! x'- Data.Foldable.foldr step' done as $! x0 )+ Data.Foldable.foldr step' done as $! begin )++-- | Convert an `IO` action that returns a `Maybe` into a `Shell`+fromIO :: IO (Maybe a) -> Shell a+fromIO io =+ Shell+ (\(FoldShell step begin done) -> do+ let loop x = do+ m <- io+ case m of+ Just a -> do+ x' <- step x a+ loop x'+ Nothing -> do+ done x++ loop begin+ )
src/Turtle/Tutorial.hs view
@@ -47,7 +47,7 @@ can install a Haskell compiler if one is not already present. If you are curious about how these two lines work, they are described here: - <https://github.com/commercialhaskell/stack/blob/master/doc/GUIDE.md#ghcrunghc>+ <https://github.com/commercialhaskell/stack/blob/master/doc/GUIDE.md#script-interpreter> If you want to make a Windows script independently executable outside of a Git Bash environment, you can either (A) compile the script into an@@ -116,6 +116,9 @@ -- * Conclusion -- $conclusion + -- * Nix scripts+ -- $nix+ -- * FAQ -- $faq ) where@@ -129,7 +132,7 @@ -- -- @ -- #!\/usr\/bin\/env stack--- \-\- stack \-\-install-ghc runghc \-\-package turtle+-- \-\- stack \-\-resolver lts-10.2 script -- \ -- -- #!\/bin\/bash -- {-\# LANGUAGE OverloadedStrings \#-} --@@ -194,7 +197,7 @@ -- difference: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > -- #!/bin/bash -- > {-# LANGUAGE OverloadedStrings #-} --@@ -211,7 +214,7 @@ -- program this way instead: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > {-# LANGUAGE OverloadedStrings #-} -- > @@ -227,7 +230,7 @@ -- permits definitions. If you were to insert a statement at the top-level: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > {-# LANGUAGE OverloadedStrings #-} -- > @@ -244,7 +247,7 @@ -- command: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > -- #!/bin/bash -- > {-# LANGUAGE OverloadedStrings #-} --@@ -270,7 +273,7 @@ -- -- @ -- #!\/usr\/bin\/env stack--- \-\- stack \-\-install-ghc runghc \-\-package turtle+-- \-\- stack \-\-resolver lts-10.2 script -- \ -- -- #!\/bin\/bash -- import Turtle --@@ -298,7 +301,7 @@ -- within a larger subroutine: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > -- #!/bin/bash -- > import Turtle --@@ -360,7 +363,7 @@ -- following script to find out what happens if we choose `echo` instead: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > import Turtle -- > @@ -567,7 +570,7 @@ -- Let's illustrate this by adding types to our original script: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > import Turtle -- > @@ -605,7 +608,7 @@ -- can define unadorned `Line` values at the top-level, as we saw previously: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > {-# LANGUAGE OverloadedStrings #-} -- > @@ -625,7 +628,7 @@ -- Let's test this out by providing an incorrect type for @\'str\'@: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > {-# LANGUAGE OverloadedStrings #-} -- > @@ -677,7 +680,7 @@ -- a string: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > {-# LANGUAGE OverloadedStrings #-} -- > @@ -713,7 +716,7 @@ -- -- @ -- #!\/usr\/bin\/env stack--- \-\- stack \-\-install-ghc runghc \-\-package turtle+-- \-\- stack \-\-resolver lts-10.2 script -- \ -- -- #!\/bin\/bash -- {-\# LANGUAGE OverloadedStrings \#-} --@@ -758,7 +761,7 @@ -- -- @ -- #!\/usr\/bin\/env stack--- \-\- stack \-\-install-ghc runghc \-\-package turtle+-- \-\- stack \-\-resolver lts-10.2 script -- -- {-\# LANGUAGE OverloadedStrings \#-} -- @@ -879,9 +882,9 @@ -- > FilePath "/tmp/.X0-lock" -- > FilePath "/tmp/pulse-PKdhtXMmr18n" -- > FilePath "/tmp/pulse-xHYcZ3zmN3Fv"--- > FilePath "/tmp/tracker-gabriel"+-- > FilePath "/tmp/tracker-gabriella" -- > FilePath "/tmp/pulse-PYi1hSlWgNj2"--- > FilePath "/tmp/orbit-gabriel"+-- > FilePath "/tmp/orbit-gabriella" -- > FilePath "/tmp/ssh-vREYGbWGpiCa" -- > FilePath "/tmp/.ICE-unix --@@ -988,9 +991,9 @@ -- > FilePath "/tmp/.X0-lock" -- > FilePath "/tmp/pulse-PKdhtXMmr18n" -- > FilePath "/tmp/pulse-xHYcZ3zmN3Fv"--- > FilePath "/tmp/tracker-gabriel"+-- > FilePath "/tmp/tracker-gabriella" -- > FilePath "/tmp/pulse-PYi1hSlWgNj2"--- > FilePath "/tmp/orbit-gabriel"+-- > FilePath "/tmp/orbit-gabriella" -- > FilePath "/tmp/ssh-vREYGbWGpiCa" -- > FilePath "/tmp/.ICE-unix" -- > FilePath "/usr/lib"@@ -1031,7 +1034,7 @@ -- We can use `select` to implement loops within a `Shell`: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > -- #!/bin/bash -- > {-# LANGUAGE OverloadedStrings #-} --@@ -1053,6 +1056,34 @@ -- > (2,3) -- > (2,4) --+-- This is because `Shell` behaves like a list comprehension, running each+-- following command once for each element in the stream. This implies that+-- an `Shell` stream that produces 0 elements will short-circuit and prevent+-- subsequent commands from being run.+--+-- > -- This stream emits 0 elements but still has side effects+-- > inner :: Shell a+-- > inner = do+-- > x <- select [1, 2]+-- > y <- select [3, 4]+-- > liftIO (print (x, y))+-- > empty+-- > +-- > outer :: Shell ()+-- > outer = do+-- > inner+-- > liftIO (echo "This step will never run")+--+-- If you want to run a `Shell` stream just for its side effects, wrap the+-- `Shell` with `sh`. This ensures that you don't alter the surrounding+-- `Shell`'s control flow by unintentionally running subsequent commands zero+-- times or multiple times:+--+-- > outer :: Shell ()+-- > outer = do+-- > sh inner+-- > liftIO (echo "Now this step will exactly once")+-- -- This uses the `sh` utility instead of `view`. The only difference is that -- `sh` doesn't print any values (since `print` is doing that already): --@@ -1078,9 +1109,9 @@ -- > FilePath "/tmp/.X0-lock" -- > FilePath "/tmp/pulse-PKdhtXMmr18n" -- > FilePath "/tmp/pulse-xHYcZ3zmN3Fv"--- > FilePath "/tmp/tracker-gabriel"+-- > FilePath "/tmp/tracker-gabriella" -- > FilePath "/tmp/pulse-PYi1hSlWgNj2"--- > FilePath "/tmp/orbit-gabriel"+-- > FilePath "/tmp/orbit-gabriella" -- > FilePath "/tmp/ssh-vREYGbWGpiCa" -- > FilePath "/tmp/.ICE-unix" --@@ -1133,8 +1164,8 @@ -- @ -- Prelude Turtle Fold> `fold` (ls \"\/tmp\") Fold.list -- [FilePath \"\/tmp\/.X11-unix\",FilePath \"\/tmp\/.X0-lock\",FilePath \"\/tmp\/pulse-PKd--- htXMmr18n\",FilePath \"\/tmp\/pulse-xHYcZ3zmN3Fv\",FilePath \"\/tmp\/tracker-gabriel--- \",FilePath \"\/tmp\/pulse-PYi1hSlWgNj2\",FilePath \"\/tmp\/orbit-gabriel\",FilePath +-- htXMmr18n\",FilePath \"\/tmp\/pulse-xHYcZ3zmN3Fv\",FilePath \"\/tmp\/tracker-gabriella+-- \",FilePath \"\/tmp\/pulse-PYi1hSlWgNj2\",FilePath \"\/tmp\/orbit-gabriella\",FilePath -- \"\/tmp\/ssh-vREYGbWGpiCa\",FilePath \"\/tmp\/.ICE-unix\"] -- @ --@@ -1178,7 +1209,7 @@ -- to standard output: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > -- #!/bin/bash -- > {-# LANGUAGE OverloadedStrings #-} --@@ -1223,9 +1254,9 @@ -- > .X0-lock -- > pulse-PKdhtXMmr18n -- > pulse-xHYcZ3zmN3Fv--- > tracker-gabriel+-- > tracker-gabriella -- > pulse-PYi1hSlWgNj2--- > orbit-gabriel+-- > orbit-gabriella -- > ssh-vREYGbWGpiCa -- > .ICE-unix --@@ -1419,7 +1450,7 @@ -- a `Shell`: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > {-# LANGUAGE OverloadedStrings #-} -- > @@ -1445,7 +1476,7 @@ -- file and directory are still cleaned up correctly: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > {-# LANGUAGE OverloadedStrings #-} -- > @@ -1462,10 +1493,10 @@ -- $monadio ----- If you are sick of having type `liftIO` everywhere, you can omit it. This--- is because all subroutines in @turtle@ are overloaded using the `MonadIO`--- type class, like our original `pwd` command where we first encountered the--- the `MonadIO` type:+-- If you are sick of having to type `liftIO` everywhere, you can omit it.+-- This is because all subroutines in @turtle@ are overloaded using the+-- `MonadIO` type class, like our original `pwd` command where we first+-- encountered the the `MonadIO` type: -- -- @ -- Prelude Turtle> :type pwd@@ -1509,7 +1540,7 @@ -- to: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > {-# LANGUAGE OverloadedStrings #-} -- > @@ -1536,7 +1567,7 @@ -- positional arguments for the source and destination file, you can write: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > -- cp.hs -- >@@ -1601,7 +1632,7 @@ -- -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > {-# LANGUAGE OverloadedStrings #-} -- > @@ -1650,7 +1681,7 @@ -- as short-hands for the flags: -- -- > #!/usr/bin/env stack--- > -- stack --install-ghc runghc --package turtle+-- > -- stack --resolver lts-10.2 script -- > -- > {-# LANGUAGE OverloadedStrings #-} -- > @@ -1762,12 +1793,37 @@ -- If you have more questions or need help learning the library, ask a question -- on Stack Overflow under the @haskell-turtle@ tag. For bugs or feature -- requests, create an issue on Github at--- <https://github.com/Gabriel439/Haskell-Turtle-Library/issues>+-- <https://github.com/Gabriella439/turtle/issues> -- -- This library provides an extended suite of Unix-like utilities, but would -- still benefit from adding more utilities for better parity with the Unix -- ecosystem. Pull requests to add new utilities are highly welcome! +-- $nix+--+-- You can also turn `turtle` scripts into runnable scripts using Nix, like+-- this:+--+-- > #! /usr/bin/env nix-shell+-- > #! nix-shell -i runghc --packages "ghc.withPackages (x: [ x.turtle ])"+-- > +-- > {-# LANGUAGE OverloadedStrings #-}+-- > +-- > import Turtle+-- > +-- > main = echo "Hello, world!"+--+-- ... or create an auto-reloading script like this:+--+-- > #! /usr/bin/env nix-shell+-- > #! nix-shell -i "ghcid -T main" --packages ghcid "ghc.withPackages (x: [ x.turtle ])"+-- > +-- > {-# LANGUAGE OverloadedStrings #-}+-- > +-- > import Turtle+-- > +-- > main = echo "Hello, world!"+ -- $faq -- -- These are the most frequently asked questions from new users:@@ -1825,3 +1881,4 @@ -- like this: -- -- > Turtle.system (System.Process.proc "/bin/sh" []) empty+
test/cptree.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} import Turtle-import Filesystem.Path.CurrentOS () import System.IO.Temp (withSystemTempDirectory)+import qualified Control.Monad.Fail as Fail import Control.Monad (unless) check :: String -> Bool-> IO ()-check errorMessage successs = unless successs $ fail errorMessage+check errorMessage successs = unless successs $ Fail.fail errorMessage main :: IO () main = withSystemTempDirectory "tempDir" (runTest . fromString)
+ test/system-filepath.hs view
@@ -0,0 +1,226 @@+{-# 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 ""+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+ "c:\\" @=? root "c:\\"+ "c:\\" @=? root "c:\\foo"+#else+ "/" @=? root "/"+ "/" @=? root "/foo"+#endif+ "" @=? 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 "../."++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+ "c:\\" @=? parent "c:\\"+#else+ "/" @=? parent "/"+#endif+ "./" @=? 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"+#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"]+ "foo/a.b" @=? commonPrefix ["foo/a.b.c", "foo/a.b.d"]+ "" @=? commonPrefix ["foo/", "bar/"]++test_StripPrefix :: TestTree+test_StripPrefix = testCase "stripPrefix" $ do+ Just "" @=? stripPrefix "" ""+ Just "/" @=? stripPrefix "" "/"+ Just "" @=? stripPrefix "/" "/"+ Just "foo" @=? stripPrefix "/" "/foo"+ Just "foo" @=? stripPrefix "./" "./foo"+ Just "foo.ext" @=? stripPrefix "./" "./foo.ext"+ 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+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+ "foo\\..\\bar" @=? collapse "foo/../bar"+ "foo\\bar" @=? collapse "foo/bar"+ "foo\\bar" @=? collapse "foo/./bar"+#else+ "foo/../bar" @=? collapse "foo/../bar"+ "foo/bar" @=? collapse "foo/bar"+ "foo/bar" @=? collapse "foo/./bar"+#endif++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,14 +1,13 @@ Name: turtle-Version: 1.4.6+Version: 1.6.2 Cabal-Version: >=1.10 Build-Type: Simple License: BSD3 License-File: LICENSE-Copyright: 2015 Gabriel Gonzalez-Author: Gabriel Gonzalez-Maintainer: Gabriel439@gmail.com-Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1-Bug-Reports: https://github.com/Gabriel439/Haskell-Turtle-Library/issues+Copyright: 2015 Gabriella Gonzalez+Author: Gabriella Gonzalez+Maintainer: GenuineGabriella@gmail.com+Bug-Reports: https://github.com/Gabriella439/turtle/issues Synopsis: Shell programming, Haskell-style Description: @turtle@ is a reimplementation of the Unix command line environment in Haskell so that you can use Haskell as both a shell and a scripting@@ -30,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@@ -40,41 +39,70 @@ then you should also check out the @Shelly@ library which provides similar functionality. Category: System++Tested-With:+ GHC == 9.6.1+ GHC == 9.4.4+ GHC == 9.2.7+ GHC == 9.0.2+ GHC == 8.10.7+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4+ GHC == 8.2.2+ GHC == 8.0.2+ Extra-Source-Files: CHANGELOG.md+ Source-Repository head Type: git- Location: https://github.com/Gabriel439/Haskell-Turtle-Library+ Location: https://github.com/Gabriella439/turtle +Flag new-deps+ Description: Use new versions of ansi-wl-pprint and optparse-applicative+ Manual: False+ Default: True+ Library HS-Source-Dirs: src Build-Depends:- base >= 4.6 && < 5 ,- ansi-wl-pprint >= 0.6 && < 0.7 ,- async >= 2.0.0.0 && < 2.2 ,- bytestring >= 0.9.1.8 && < 0.11,- clock >= 0.4.1.2 && < 0.8 ,- containers >= 0.5.0.0 && < 0.6 ,- directory >= 1.0.7 && < 1.4 ,- foldl >= 1.1 && < 1.4 ,+ -- 2021-09-07: Turtle.Prelude uses GHC-8.0 features, so base >= 4.9+ base >= 4.9 && < 5 ,+ async >= 2.0.0.0 && < 2.3 ,+ bytestring >= 0.9.1.8 && < 0.12,+ clock >= 0.4.1.2 && < 0.9 ,+ 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 ,- semigroups >= 0.5.0 && < 0.19,- system-filepath >= 0.3.1 && < 0.5 ,- system-fileio >= 0.2.1 && < 0.4 ,- stm < 2.5 ,- temporary < 1.3 ,- text < 1.3 ,- time < 1.9 ,- transformers >= 0.2.0.0 && < 0.6 ,- optparse-applicative >= 0.13 && < 0.15,+ stm < 2.6 ,+ streaming-commons < 0.3 ,+ temporary < 1.4 ,+ text >= 1.0.0 && < 2.1 ,+ time < 1.13,+ transformers >= 0.2.0.0 && < 0.7 , optional-args >= 1.0 && < 2.0 ,- unix-compat >= 0.4 && < 0.6+ unix-compat >= 0.4 && < 0.8 if os(windows)- Build-Depends: Win32 >= 2.2.0.1 && < 2.6+ Build-Depends: Win32 >= 2.12 else- Build-Depends: unix >= 2.5.1.0 && < 2.8+ Build-Depends: unix >= 2.5.1.0 && < 2.9++ -- A possible Cabal issue makes it try an old version of ansi-wl-pprint+ -- even though a newer would work.+ -- See discussion in https://github.com/Gabriella439/turtle/pull/446+ if flag(new-deps)+ Build-Depends: ansi-wl-pprint >= 1.0 && < 1.1 ,+ optparse-applicative >= 0.18 && < 0.19+ else+ Build-Depends: ansi-wl-pprint >= 0.6 && < 1.0 ,+ optparse-applicative >= 0.16 && < 0.18+ Exposed-Modules: Turtle, Turtle.Bytes,@@ -98,7 +126,7 @@ Default-Language: Haskell2010 Build-Depends: base >= 4 && < 5 ,- doctest >= 0.7 && < 0.14+ doctest >= 0.7 test-suite regression-broken-pipe Type: exitcode-stdio-1.0@@ -129,9 +157,22 @@ 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 Type: exitcode-stdio-1.0 HS-Source-Dirs: bench@@ -139,10 +180,7 @@ GHC-Options: -O2 -Wall -threaded Default-Language: Haskell2010 Build-Depends:- base >= 4 && < 5 ,- text < 1.3,+ base >= 4 && < 5 ,+ tasty-bench >= 0.3.1 ,+ text < 1.3, turtle- if impl(ghc < 7.8)- Build-Depends: criterion >= 0.4 && < 1.1.4.0- else- Build-Depends: criterion >= 0.4 && < 1.3