turtle 1.5.14 → 1.6.2
raw patch · 14 files changed
Files
- CHANGELOG.md +133/−0
- LICENSE +2/−2
- bench/Main.hs +1/−1
- src/Turtle.hs +19/−17
- src/Turtle/Bytes.hs +145/−2
- src/Turtle/Format.hs +4/−5
- src/Turtle/Internal.hs +236/−3
- src/Turtle/Options.hs +43/−5
- src/Turtle/Prelude.hs +313/−137
- src/Turtle/Shell.hs +32/−13
- src/Turtle/Tutorial.hs +44/−15
- test/cptree.hs +2/−2
- test/system-filepath.hs +226/−0
- turtle.cabal +68/−31
CHANGELOG.md view
@@ -1,3 +1,136 @@+1.6.2++* 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
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@@ -120,9 +117,23 @@ import Control.Monad.IO.Class (MonadIO(..)) import Data.Monoid (Monoid(..), (<>)) import Data.String (IsString(..))-import Filesystem.Path.CurrentOS+import Control.Monad.Managed (Managed, managed, runManaged, with)+import Control.Foldl (Fold(..), FoldM(..))+import Data.Text (Text)+import Data.Time (NominalDiffTime, UTCTime)+import System.FilePath ( FilePath- , root+ , dropExtension+ , hasExtension+ , isAbsolute+ , isRelative+ , (</>)+ , (<.>)+ )+import System.IO (Handle)+import System.Exit (ExitCode(..))+import Turtle.Internal+ ( root , directory , parent , filename@@ -130,27 +141,18 @@ , basename , absolute , relative- , (</>) , commonPrefix , stripPrefix , collapse , splitDirectories , extension- , hasExtension- , (<.>)- , dropExtension , splitExtension+ , splitExtensions , toText , fromText , encodeString , decodeString )-import Control.Monad.Managed (Managed, managed, runManaged, with)-import Control.Foldl (Fold(..), FoldM(..))-import Data.Text (Text)-import Data.Time (NominalDiffTime, UTCTime)-import System.IO (Handle)-import System.Exit (ExitCode(..)) import Prelude hiding (FilePath) #if __GLASGOW_HASKELL__ >= 710
src/Turtle/Bytes.hs view
@@ -16,6 +16,12 @@ , append , stderr , strict+ , compress+ , decompress+ , WindowBits(..)+ , Zlib.defaultWindowBits+ , fromUTF8+ , toUTF8 -- * Subprocess management , proc@@ -43,9 +49,10 @@ 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)@@ -61,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@@ -657,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,7 +42,7 @@ module Turtle.Format ( -- * Format- Format+ Format (..) , (%) , format , printf@@ -74,9 +74,8 @@ import Data.Text (Text, pack) import Data.Time (UTCTime) import Data.Word-import Filesystem.Path.CurrentOS (FilePath, toText) import Numeric (showEFloat, showFFloat, showGFloat, showHex, showOct)-import Prelude hiding ((.), id, FilePath)+import Prelude hiding ((.), id) import qualified System.IO as IO import Turtle.Line (Line) @@ -215,9 +214,9 @@ l :: Format r (Line -> r) l = makeFormat Turtle.Line.lineToText --- | `Format` a `Filesystem.Path.CurrentOS.FilePath` into `Text`+-- | `Format` a `FilePath` into `Text` fp :: Format r (FilePath -> r)-fp = makeFormat (\fpath -> either id id (toText fpath))+fp = makeFormat pack -- | `Format` a `UTCTime` into `Text` utc :: Format r (UTCTime -> r)
src/Turtle/Internal.hs view
@@ -1,11 +1,17 @@-module Turtle.Internal- ( ignoreSIGPIPE- ) where+module Turtle.Internal where +import Control.Applicative ((<|>)) import Control.Exception (handle, throwIO)+import Data.Text (Text) import Foreign.C.Error (Errno(..), ePIPE) import GHC.IO.Exception (IOErrorType(..), IOException(..))+import System.FilePath ((</>)) +import qualified Data.List as List+import qualified Data.Text as Text+import qualified Data.Text.IO as Text.IO+import qualified System.FilePath as FilePath+ ignoreSIGPIPE :: IO () -> IO () ignoreSIGPIPE = handle (\e -> case e of IOError@@ -14,3 +20,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/Options.hs view
@@ -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/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,14 @@ , cd , pwd , home+ , readlink , realpath , mv , mkdir , mktree , cp , cptree+ , cptreeL #if !defined(mingw32_HOST_OS) , symlink #endif@@ -187,6 +191,7 @@ , inplacePrefix , inplaceSuffix , inplaceEntire+ , update , find , findtree , yes@@ -206,6 +211,7 @@ , sort , sortOn , sortBy+ , toLines -- * Folds , countChars@@ -248,7 +254,7 @@ -- * File size , du- , Size+ , Size(B, KB, MB, GB, TB, KiB, MiB, GiB, TiB) , sz , bytes , kilobytes@@ -300,7 +306,7 @@ 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@@ -308,6 +314,8 @@ #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@@ -318,9 +326,6 @@ import qualified Data.Text as Text import qualified Data.Text.IO as Text import Data.Typeable (Typeable)-import qualified Filesystem-import Filesystem.Path.CurrentOS (FilePath, (</>))-import qualified Filesystem.Path.CurrentOS as Filesystem import GHC.IO.Exception (IOErrorType(UnsupportedOperation)) import Network.HostName (getHostName) import System.Clock (Clock(..), TimeSpec(..), getTime)@@ -334,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@@ -354,12 +360,12 @@ 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, (%), fp)-import Turtle.Internal (ignoreSIGPIPE)+import qualified Turtle.Internal as Internal import Turtle.Line {-| Run a command using @execvp@, retrieving the exit code@@ -559,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@@ -570,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) )@@ -608,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 ->@@ -651,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 ->@@ -735,12 +741,12 @@ mvar <- liftIO (newMVar False) let close handle = do modifyMVar_ mvar (\finalized -> do- unless finalized (ignoreSIGPIPE (hClose handle))+ unless finalized (Internal.ignoreSIGPIPE (hClose handle)) return True ) (hIn, hOut, ph) <- using (managed (bracket open (\(hIn, _, ph) -> close hIn >> Process.terminateProcess ph))) let feedIn :: (forall a. IO a -> IO a) -> IO ()- feedIn restore = restore (ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn+ feedIn restore = restore (Internal.ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn a <- using (managed (\k ->@@ -776,12 +782,12 @@ mvar <- liftIO (newMVar False) let close handle = do modifyMVar_ mvar (\finalized -> do- unless finalized (ignoreSIGPIPE (hClose handle))+ unless finalized (Internal.ignoreSIGPIPE (hClose handle)) return True ) (hIn, hOut, hErr, ph) <- using (managed (bracket open (\(hIn, _, _, ph) -> close hIn >> Process.terminateProcess ph))) let feedIn :: (forall a. IO a -> IO a) -> IO ()- feedIn restore = restore (ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn+ feedIn restore = restore (Internal.ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn queue <- liftIO TQueue.newTQueueIO let forwardOut :: (forall a. IO a -> IO a) -> IO ()@@ -889,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)) @@ -912,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.@@ -933,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@@ -956,7 +974,7 @@ -} ls :: FilePath -> Shell FilePath ls path = Shell (\(FoldShell step begin done) -> do- let path' = Filesystem.encodeString path+ let path' = path canRead <- fmap Directory.readable (Directory.getPermissions (deslash path'))@@ -964,13 +982,12 @@ 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@@ -981,12 +998,11 @@ if canRead then bracket (openDirStream path') closeDirStream (\dirp -> do let loop x = do- file' <- readDirStream dirp- case file' of+ file <- readDirStream dirp+ case file of "" -> done x _ -> do- let file = Filesystem.decodeString file'- x' <- if (file' /= "." && file' /= "..")+ x' <- if (file /= "." && file /= "..") then step x (path </> file) else return x loop $! x'@@ -1062,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@@ -1074,18 +1090,18 @@ Fails if the directory is present -} mkdir :: MonadIO io => FilePath -> io ()-mkdir path = liftIO (Filesystem.createDirectory False path)+mkdir path = liftIO (Directory.createDirectory path) {-| Create a directory tree (equivalent to @mkdir -p@) Does not fail if the directory is present -} mktree :: MonadIO io => FilePath -> io ()-mktree path = liftIO (Filesystem.createTree path)+mktree path = liftIO (Directory.createDirectoryIfMissing True path) -- | Copy a file cp :: MonadIO io => FilePath -> FilePath -> io ()-cp oldPath newPath = liftIO (Filesystem.copyFile oldPath newPath)+cp oldPath newPath = liftIO (Directory.copyFile oldPath newPath) #if !defined(mingw32_HOST_OS) -- | Create a symlink from one @FilePath@ to another@@ -1105,7 +1121,7 @@ isNotSymbolicLink :: MonadIO io => FilePath -> io Bool isNotSymbolicLink = fmap (not . PosixCompat.isSymbolicLink) . lstat --- | Copy a directory tree+-- | Copy a directory tree and preserve symbolic links cptree :: MonadIO io => FilePath -> FilePath -> io () cptree oldTree newTree = sh (do oldPath <- lsif isNotSymbolicLink oldTree@@ -1114,7 +1130,7 @@ -- a directory and fails to strip it as a prefix from `/tmp/foo`. Adding -- `(</> "")` to the end of the path makes clear that the path is a -- directory- Just suffix <- return (Filesystem.stripPrefix (oldTree </> "") oldPath)+ Just suffix <- return (Internal.stripPrefix (oldTree <> [ FilePath.pathSeparator ]) oldPath) let newPath = newTree </> suffix @@ -1124,26 +1140,38 @@ if PosixCompat.isSymbolicLink fileStatus then do- oldTarget <- liftIO (PosixCompat.readSymbolicLink (Filesystem.encodeString oldPath))+ oldTarget <- liftIO (PosixCompat.readSymbolicLink oldPath) - mktree (Filesystem.directory newPath)+ mktree (FilePath.takeDirectory newPath) - liftIO (PosixCompat.createSymbolicLink oldTarget (Filesystem.encodeString newPath))+ liftIO (PosixCompat.createSymbolicLink oldTarget newPath) else if isFile then do- mktree (Filesystem.directory newPath)+ mktree (FilePath.takeDirectory newPath) cp oldPath newPath else do 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 (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@) @@ -1167,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@@ -1192,7 +1220,7 @@ #ifdef mingw32_HOST_OS then do handle <- Win32.createFile- (Filesystem.encodeString file)+ file Win32.gENERIC_WRITE Win32.fILE_SHARE_NONE Nothing@@ -1201,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.@@ -1221,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@@ -1275,7 +1303,7 @@ -> io Permissions -- ^ Updated permissions chmod modifyPermissions path = liftIO (do- let path' = deslash (Filesystem.encodeString path)+ let path' = deslash path permissions <- Directory.getPermissions path' let permissions' = fromSystemDirectoryPermissions permissions let permissions'' = modifyPermissions permissions'@@ -1287,21 +1315,21 @@ -- | Get a file or directory's user permissions getmod :: MonadIO io => FilePath -> io Permissions getmod path = liftIO (do- let path' = deslash (Filesystem.encodeString path)+ let path' = deslash path permissions <- Directory.getPermissions path' return (fromSystemDirectoryPermissions permissions)) -- | Set a file or directory's user permissions setmod :: MonadIO io => Permissions -> FilePath -> io () setmod permissions path = liftIO (do- let path' = deslash (Filesystem.encodeString path)+ let path' = deslash path Directory.setPermissions path' (toSystemDirectoryPermissions permissions) ) -- | Copy a file or directory's permissions (analogous to @chmod --reference@) copymod :: MonadIO io => FilePath -> FilePath -> io () copymod sourcePath targetPath = liftIO (do- let sourcePath' = deslash (Filesystem.encodeString sourcePath)- targetPath' = deslash (Filesystem.encodeString targetPath)+ let sourcePath' = deslash sourcePath+ targetPath' = deslash targetPath Directory.copyPermissions sourcePath' targetPath' ) -- | @+r@@@ -1389,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'@@ -1462,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 @@ -1484,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 @@ -1502,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)@@ -1578,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@@ -1616,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"@@ -1631,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@@ -1706,8 +1733,11 @@ findtree :: Pattern a -> Shell FilePath -> Shell FilePath findtree pat files = do path <- files- Right txt <- return (Filesystem.toText path)++ let txt = Text.pack path+ _:_ <- return (match pat txt)+ return path {- | Check if a file was last modified after a given@@ -1819,7 +1849,11 @@ loop $! x' 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 (\(FoldShell step begin done) -> do ref <- newIORef 0 -- I feel so dirty@@ -1891,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@@ -1900,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@@ -1912,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@@ -1957,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@) @@ -2024,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@@ -2044,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@@ -2166,3 +2306,39 @@ -- [(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,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE RankNTypes #-}@@ -74,6 +75,7 @@ , select , liftIO , using+ , fromIO ) where import Control.Applicative@@ -81,9 +83,7 @@ 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)@@ -103,21 +103,23 @@ -- | A @(Shell a)@ is a protected stream of @a@'s with side effects 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'+translate (FoldM step begin done) = FoldShell step' Nothing' done' where- step' Nothing a = do+ step' Nothing' a = do x <- begin x' <- step x a- return (Just x')- step' (Just x) a = do+ return $! Just' x'+ step' (Just' x) a = do x' <- step x a- return (Just x')+ return $! Just' x' - done' Nothing = do+ done' Nothing' = do x <- begin done x- done' (Just x) = do+ done' (Just' x) = do done x -- | Use a @`FoldM` `IO`@ to reduce the stream of @a@'s produced by a `Shell`@@ -182,7 +184,9 @@ 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 (\(FoldShell _ begin done) -> done begin)@@ -213,10 +217,8 @@ instance MonadCatch Shell where m `catch` k = Shell (\f-> _foldShell m f `catch` (\e -> _foldShell (k e) f)) -#if MIN_VERSION_base(4,9,0) instance Fail.MonadFail Shell where- fail = Prelude.fail-#endif+ fail _ = mzero #if __GLASGOW_HASKELL__ >= 804 instance Monoid a => Semigroup (Shell a) where@@ -244,3 +246,20 @@ x' <- step x a k $! x' 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
@@ -116,6 +116,9 @@ -- * Conclusion -- $conclusion + -- * Nix scripts+ -- $nix+ -- * FAQ -- $faq ) where@@ -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"@@ -1106,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" --@@ -1161,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\"] -- @ --@@ -1251,9 +1254,9 @@ -- > .X0-lock -- > pulse-PKdhtXMmr18n -- > pulse-xHYcZ3zmN3Fv--- > tracker-gabriel+-- > tracker-gabriella -- > pulse-PYi1hSlWgNj2--- > orbit-gabriel+-- > orbit-gabriella -- > ssh-vREYGbWGpiCa -- > .ICE-unix --@@ -1490,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@@ -1790,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:@@ -1853,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.5.14+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.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,42 +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 ,+ -- 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.11,- clock >= 0.4.1.2 && < 0.8 ,+ bytestring >= 0.9.1.8 && < 0.12,+ clock >= 0.4.1.2 && < 0.9 , containers >= 0.5.0.0 && < 0.7 ,- directory >= 1.0.7 && < 1.4 ,+ 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.6 ,+ streaming-commons < 0.3 , temporary < 1.4 ,- text < 1.3 ,- time < 1.9 ,- transformers >= 0.2.0.0 && < 0.6 ,- optparse-applicative >= 0.13 && < 0.15,+ 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.9+ 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,@@ -99,7 +126,7 @@ Default-Language: Haskell2010 Build-Depends: base >= 4 && < 5 ,- doctest >= 0.7 && < 0.17+ doctest >= 0.7 test-suite regression-broken-pipe Type: exitcode-stdio-1.0@@ -130,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@@ -140,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.6