turtle 1.4.6 → 1.5.0
raw patch · 7 files changed
+144/−91 lines, 7 filesdep +exceptionsdep ~Win32
Dependencies added: exceptions
Dependency ranges changed: Win32
Files
- CHANGELOG.md +8/−2
- src/Turtle/Bytes.hs +5/−8
- src/Turtle/Format.hs +10/−0
- src/Turtle/Options.hs +2/−2
- src/Turtle/Prelude.hs +37/−45
- src/Turtle/Shell.hs +79/−32
- turtle.cabal +3/−2
CHANGELOG.md view
@@ -1,6 +1,12 @@-1.4.6+1.5.0 -* Increase upper bound on `Win32`+* 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
src/Turtle/Bytes.hs view
@@ -40,7 +40,6 @@ 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)@@ -51,7 +50,7 @@ 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@@ -89,8 +88,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 +97,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@@ -591,8 +589,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 +599,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
src/Turtle/Format.hs view
@@ -46,6 +46,7 @@ , (%) , format , printf+ , eprintf , makeFormat -- * Parameters@@ -76,6 +77,7 @@ import Filesystem.Path.CurrentOS (FilePath, toText) import Numeric (showEFloat, showFFloat, showGFloat, showHex, showOct) import Prelude hiding ((.), id, FilePath)+import qualified System.IO as IO import Turtle.Line (Line) import qualified Data.Text.IO as Text@@ -112,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)
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
src/Turtle/Prelude.hs view
@@ -289,7 +289,7 @@ 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)@@ -678,6 +678,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@@ -785,8 +787,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 +797,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@@ -945,8 +946,7 @@ @\"..\"@ -} ls :: FilePath -> Shell FilePath-ls path = Shell (\(FoldM step begin done) -> do- x0 <- begin+ls path = Shell (\(FoldShell step begin done) -> do let path' = Filesystem.encodeString path canRead <- fmap Directory.readable@@ -966,8 +966,8 @@ 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@@ -981,8 +981,8 @@ 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@@ -1462,8 +1462,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 +1471,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 ()@@ -1642,17 +1641,15 @@ -- | 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 +1660,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 +1679,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 +1693,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 +1711,28 @@ 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 :: 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 +1740,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@@ -1969,7 +1963,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,9 +1972,7 @@ 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 @@ -2027,12 +2019,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 +2044,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: --
src/Turtle/Shell.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE RankNTypes, CPP #-}+{-# 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 +49,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,7 +60,11 @@ module Turtle.Shell ( -- * Shell Shell(..)+ , FoldShell(..)+ , _foldIO+ , _Shell , foldIO+ , foldShell , fold , sh , view@@ -72,6 +77,7 @@ 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)@@ -85,13 +91,54 @@ 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 } +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)@@ -107,34 +154,31 @@ 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 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,18 +186,22 @@ 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 ) +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))+ #if MIN_VERSION_base(4,9,0) instance Fail.MonadFail Shell where fail = Prelude.fail@@ -175,9 +223,8 @@ -- | 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 )
turtle.cabal view
@@ -1,5 +1,5 @@ Name: turtle-Version: 1.4.6+Version: 1.5.0 Cabal-Version: >=1.10 Build-Type: Simple License: BSD3@@ -56,6 +56,7 @@ clock >= 0.4.1.2 && < 0.8 , containers >= 0.5.0.0 && < 0.6 , directory >= 1.0.7 && < 1.4 ,+ exceptions >= 0.4 && < 0.9 , foldl >= 1.1 && < 1.4 , hostname < 1.1 , managed >= 1.0.3 && < 1.1 ,@@ -72,7 +73,7 @@ optional-args >= 1.0 && < 2.0 , unix-compat >= 0.4 && < 0.6 if os(windows)- Build-Depends: Win32 >= 2.2.0.1 && < 2.6+ Build-Depends: Win32 >= 2.2.0.1 && < 2.4 else Build-Depends: unix >= 2.5.1.0 && < 2.8 Exposed-Modules: