turtle 1.3.1 → 1.3.2
raw patch · 11 files changed
+150/−33 lines, 11 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.md +6/−0
- LICENSE +1/−1
- src/Turtle/Bytes.hs +25/−7
- src/Turtle/Format.hs +15/−5
- src/Turtle/Line.hs +5/−5
- src/Turtle/Options.hs +16/−3
- src/Turtle/Prelude.hs +23/−9
- src/Turtle/Tutorial.hs +30/−0
- test/Main.hs +5/−1
- test/RegressionMaskingException.hs +12/−0
- turtle.cabal +12/−2
CHANGELOG.md view
@@ -1,3 +1,9 @@+1.3.2++* Fix bugs in subprocess management+* Generalize type of `repr` to return any type that implements `IsString`+* Add `optLine`, `argLine`, and `l` utilities to simplify working with `Line`s+ 1.3.1 * `find` no longer follows symlinks
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015 Gabriel Gonzalez+Copyright (c) 2017 Gabriel Gonzalez All rights reserved. Redistribution and use in source and binary forms, with or without modification,
src/Turtle/Bytes.hs view
@@ -349,7 +349,9 @@ feedIn restore = restore (ignoreSIGPIPE (outhandle hIn s)) `Exception.finally` close hIn- Exception.mask_ (Async.withAsyncWithUnmask feedIn (\a -> Process.waitForProcess ph <* halt a) )+ Exception.mask (\restore ->+ Async.withAsync (feedIn restore) (\a ->+ restore (Process.waitForProcess ph) <* halt a ) ) handle (Nothing , ph) = do Process.waitForProcess ph @@ -390,7 +392,9 @@ `Exception.finally` close hIn Async.concurrently- (Exception.mask_ (Async.withAsyncWithUnmask feedIn (\a -> liftIO (Process.waitForProcess ph) <* halt a)))+ (Exception.mask (\restore ->+ Async.withAsync (feedIn restore) (\a ->+ restore (Process.waitForProcess ph) <* halt a ) )) (Data.ByteString.hGetContents hOut) ) ) systemStrictWithErr@@ -428,7 +432,9 @@ `Exception.finally` close hIn runConcurrently $ (,,)- <$> Concurrently (Exception.mask_ (Async.withAsyncWithUnmask feedIn (\a -> liftIO (Process.waitForProcess ph) <* halt a)))+ <$> Concurrently (Exception.mask (\restore ->+ Async.withAsync (feedIn restore) (\a ->+ restore (Process.waitForProcess ph) <* halt a ) )) <*> Concurrently (Data.ByteString.hGetContents hOut) <*> Concurrently (Data.ByteString.hGetContents hErr) ) ) @@ -499,7 +505,10 @@ liftIO (Data.ByteString.hPut hIn bytes) ) ) `Exception.finally` close hIn - a <- using (Managed.managed (Exception.mask_ . Async.withAsyncWithUnmask feedIn))+ a <- using+ (Managed.managed (\k ->+ Exception.mask (\restore ->+ Async.withAsync (feedIn restore) k ) )) inhandle hOut <|> (liftIO (Process.waitForProcess ph *> halt a) *> empty) streamWithErr@@ -563,9 +572,18 @@ x1 <- loop x0 (0 :: Int) done x1 ) - a <- using (Managed.managed (Exception.mask_ . Async.withAsyncWithUnmask feedIn ))- b <- using (Managed.managed (Exception.mask_ . Async.withAsyncWithUnmask forwardOut))- c <- using (Managed.managed (Exception.mask_ . Async.withAsyncWithUnmask forwardErr))+ a <- using+ (Managed.managed (\k ->+ Exception.mask (\restore ->+ Async.withAsync (feedIn restore) k ) ))+ b <- using+ (Managed.managed (\k ->+ Exception.mask (\restore ->+ Async.withAsync (forwardOut restore) k ) ))+ c <- using+ (Managed.managed (\k ->+ Exception.mask (\restore ->+ Async.withAsync (forwardErr restore) k ) )) let l `also` r = do _ <- l <|> (r *> STM.retry) _ <- r
src/Turtle/Format.hs view
@@ -58,6 +58,7 @@ , e , g , s+ , l , fp , utc @@ -75,8 +76,10 @@ import Filesystem.Path.CurrentOS (FilePath, toText) import Numeric (showEFloat, showFFloat, showGFloat, showHex, showOct) import Prelude hiding ((.), id, FilePath)+import Turtle.Line (Line) import qualified Data.Text.IO as Text+import qualified Turtle.Line -- | A `Format` string newtype Format a b = Format { (>>-) :: (Text -> a) -> b }@@ -194,6 +197,14 @@ s :: Format r (Text -> r) s = makeFormat id +{-| `Format` that inserts a `Line`++>>> format l "ABC"+"ABC"+-}+l :: Format r (Line -> r)+l = makeFormat Turtle.Line.lineToText+ -- | `Format` a `Filesystem.Path.CurrentOS.FilePath` into `Text` fp :: Format r (FilePath -> r) fp = makeFormat (\fpath -> either id id (toText fpath))@@ -202,12 +213,11 @@ utc :: Format r (UTCTime -> r) utc = w -{-| Convert a `Show`able value to `Text`-- Short-hand for @(format w)@+{-| Convert a `Show`able value to any type that implements `IsString` (such as+ `Text`) >>> repr (1,2) "(1,2)" -}-repr :: Show a => a -> Text-repr = format w+repr :: (Show a, IsString text) => a -> text+repr = fromString . show
src/Turtle/Line.hs view
@@ -36,8 +36,8 @@ -- When debugging, it might be useful to look for implicit invocations of -- `fromString` for `Line`: ----- >>> sh (do { line <- "Hello\nWorld"; echo line })--- *** Exception: NewlineForbidden+-- > >>> sh (do { line <- "Hello\nWorld"; echo line })+-- > *** Exception: NewlineForbidden -- -- In the above example, `echo` expects its argument to be a `Line`, thus -- @line :: `Line`@. Since we bind @line@ in `Shell`, the string literal@@ -47,9 +47,9 @@ -- -- To fix the problem, use `textToLines`: ----- >>> sh (do { line <- select (textToLines "Hello\nWorld"); echo line })--- Hello--- World+-- > >>> sh (do { line <- select (textToLines "Hello\nWorld"); echo line })+-- > Hello+-- > World data NewlineForbidden = NewlineForbidden deriving (Show, Typeable)
src/Turtle/Options.hs view
@@ -49,6 +49,7 @@ -- * Flag-based option parsers , switch , optText+ , optLine , optInt , optInteger , optDouble@@ -58,6 +59,7 @@ -- * Positional argument parsers , argText+ , argLine , argInt , argInteger , argDouble@@ -77,17 +79,20 @@ import Data.String (IsString) import Text.Read (readMaybe) import Data.Text (Text)-import qualified Data.Text as Text import Data.Optional import Control.Applicative import Control.Monad.IO.Class import Filesystem.Path.CurrentOS (FilePath, fromText) import Options.Applicative (Parser)-import qualified Options.Applicative as Opts-import qualified Options.Applicative.Types as Opts import Prelude hiding (FilePath) import Text.PrettyPrint.ANSI.Leijen (Doc, displayS, renderCompact)+import Turtle.Line (Line) +import qualified Data.Text as Text+import qualified Options.Applicative as Opts+import qualified Options.Applicative.Types as Opts+import qualified Turtle.Line+ -- | Parse the given options from the command line options :: MonadIO io => Description -> Parser a -> io a options desc parser = liftIO@@ -186,6 +191,10 @@ optText :: ArgName -> ShortName -> Optional HelpMessage -> Parser Text optText = opt Just +-- | Parse a `Line` value as a flag-based option+optLine :: ArgName -> ShortName -> Optional HelpMessage -> Parser Line+optLine = opt Turtle.Line.textToLine+ -- | 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)@@ -221,6 +230,10 @@ -- | Parse a `Text` as a positional argument argText :: ArgName -> Optional HelpMessage -> Parser Text argText = arg Just++-- | Parse a `Line` as a positional argument+argLine :: ArgName -> Optional HelpMessage -> Parser Line+argLine = arg Turtle.Line.textToLine -- | Parse a `FilePath` as a positional argument argPath :: ArgName -> Optional HelpMessage -> Parser FilePath
src/Turtle/Prelude.hs view
@@ -260,13 +260,13 @@ import Control.Applicative import Control.Concurrent (threadDelay) import Control.Concurrent.Async- (Async, withAsync, withAsyncWithUnmask, waitSTM, concurrently,+ (Async, withAsync, waitSTM, concurrently, Concurrently(..)) import qualified Control.Concurrent.Async import Control.Concurrent.MVar (newMVar, modifyMVar_) 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.Exception (Exception, bracket, bracket_, finally, mask, throwIO) import Control.Foldl (Fold, FoldM(..), genericLength, handles, list, premap) import qualified Control.Foldl import qualified Control.Foldl.Text@@ -536,7 +536,9 @@ let feedIn :: (forall a. IO a -> IO a) -> IO () feedIn restore = restore (ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn- mask_ (withAsyncWithUnmask feedIn (\a -> Process.waitForProcess ph <* halt a) )+ mask (\restore ->+ withAsync (feedIn restore) (\a ->+ restore (Process.waitForProcess ph) `finally` halt a) ) handle (Nothing , ph) = do Process.waitForProcess ph @@ -575,7 +577,9 @@ restore (ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn concurrently- (mask_ (withAsyncWithUnmask feedIn (\a -> liftIO (Process.waitForProcess ph) <* halt a)))+ (mask (\restore ->+ withAsync (feedIn restore) (\a ->+ restore (liftIO (Process.waitForProcess ph)) `finally` halt a ) )) (Text.hGetContents hOut) ) ) systemStrictWithErr@@ -611,7 +615,9 @@ restore (ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn runConcurrently $ (,,)- <$> Concurrently (mask_ (withAsyncWithUnmask feedIn (\a -> liftIO (Process.waitForProcess ph) <* halt a)))+ <$> Concurrently (mask (\restore ->+ withAsync (feedIn restore) (\a ->+ restore (liftIO (Process.waitForProcess ph)) `finally` halt a ) )) <*> Concurrently (Text.hGetContents hOut) <*> Concurrently (Text.hGetContents hErr) ) ) @@ -676,7 +682,9 @@ let feedIn :: (forall a. IO a -> IO a) -> IO () feedIn restore = restore (outhandle hIn s) `finally` close hIn - a <- using (managed (mask_ . withAsyncWithUnmask feedIn))+ a <- using+ (managed (\k ->+ mask (\restore -> withAsync (feedIn restore) (restore . k)))) inhandle hOut <|> (liftIO (Process.waitForProcess ph *> halt a) *> empty) streamWithErr@@ -736,9 +744,15 @@ x1 <- loop x0 (0 :: Int) done x1 ) - a <- using (managed (mask_ . withAsyncWithUnmask feedIn ))- b <- using (managed (mask_ . withAsyncWithUnmask forwardOut))- c <- using (managed (mask_ . withAsyncWithUnmask forwardErr))+ a <- using+ (managed (\k ->+ mask (\restore -> withAsync (feedIn restore) (restore . k)) ))+ b <- using+ (managed (\k ->+ mask (\restore -> withAsync (forwardOut restore) (restore . k)) ))+ c <- using+ (managed (\k ->+ mask (\restore -> withAsync (forwardErr restore) (restore . k)) )) let l `also` r = do _ <- l <|> (r *> STM.retry) _ <- r
src/Turtle/Tutorial.hs view
@@ -1074,6 +1074,36 @@ -- > FilePath "/tmp/orbit-gabriel" -- > FilePath "/tmp/ssh-vREYGbWGpiCa" -- > FilePath "/tmp/.ICE-unix"+--+-- You can filter streams using @"Control.Monad".`Control.Monad.mfilter`@, like+-- this:+--+-- >>> view (select [1..10])+-- 1+-- 2+-- 3+-- 4+-- 5+-- 6+-- 7+-- 8+-- 9+-- 10+-- >>> view (mfilter even (select [1..10]))+-- 2+-- 4+-- 6+-- 8+-- 10+--+-- This works because `Control.Monad.mfilter`'s implementation is equivalent to:+--+-- > mfilter predicate stream = do+-- > element <- stream+-- > if predicate element then return element else empty+--+-- In other words, `Control.Monad.mfilter` loops over each @element@ of the+-- @stream@ and only `return`s the element if the @predicate@ is `True` -- $folds --
test/Main.hs view
@@ -3,4 +3,8 @@ import Test.DocTest main :: IO ()-main = doctest ["src/Turtle/Pattern.hs", "src/Turtle/Format.hs"]+main = doctest+ [ "src/Turtle/Pattern.hs"+ , "src/Turtle/Format.hs"+ , "src/Turtle/Line.hs"+ ]
+ test/RegressionMaskingException.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE OverloadedStrings #-}++import Turtle++import qualified System.Timeout++-- This test fails by hanging+main :: IO ()+main = runManaged (do+ _ <- fork (shells "while true; do sleep 1; done" empty)+ sleep 1+ return () )
turtle.cabal view
@@ -1,5 +1,5 @@ Name: turtle-Version: 1.3.1+Version: 1.3.2 Cabal-Version: >=1.10 Build-Type: Simple License: BSD3@@ -105,7 +105,17 @@ GHC-Options: -Wall -threaded Default-Language: Haskell2010 Build-Depends:- base >= 4 && < 5 ,+ base >= 4 && < 5,+ turtle++test-suite regression-masking-exception+ Type: exitcode-stdio-1.0+ HS-Source-Dirs: test+ Main-Is: RegressionMaskingException.hs+ GHC-Options: -Wall -threaded+ Default-Language: Haskell2010+ Build-Depends:+ base >= 4 && < 5, turtle benchmark bench