diff --git a/src/Turtle/Format.hs b/src/Turtle/Format.hs --- a/src/Turtle/Format.hs +++ b/src/Turtle/Format.hs @@ -45,6 +45,7 @@ Format , (%) , format + , printf , makeFormat -- * Parameters @@ -58,6 +59,7 @@ , g , s , fp + , utc -- * Utilities , repr @@ -67,11 +69,14 @@ import Data.Monoid ((<>)) import Data.String (IsString(..)) 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 qualified Data.Text.IO as Text + -- | A `Format` string newtype Format a b = Format { (>>-) :: (Text -> a) -> b } @@ -96,6 +101,14 @@ format :: Format Text r -> r format fmt = fmt >>- id +{-| Print a `Format` string to standard output (without a trailing newline) + +>>> printf ("Hello, "%s%"!\n") "world" +Hello, world! +-} +printf :: Format (IO ()) r -> r +printf fmt = fmt >>- Text.putStr + -- | Create your own format specifier makeFormat :: (a -> Text) -> Format r (a -> r) makeFormat k = Format (\return_ -> \a -> return_ (k a)) @@ -183,6 +196,10 @@ -- | `Format` a `Filesystem.Path.CurrentOS.FilePath` into `Text` fp :: Format r (FilePath -> r) fp = makeFormat (\fpath -> either id id (toText fpath)) + +-- | `Format` a `UTCTime` into `Text` +utc :: Format r (UTCTime -> r) +utc = w {-| Convert a `Show`able value to `Text` diff --git a/src/Turtle/Prelude.hs b/src/Turtle/Prelude.hs --- a/src/Turtle/Prelude.hs +++ b/src/Turtle/Prelude.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} @@ -106,6 +107,8 @@ -- * IO proc , shell + , procs + , shells , procStrict , shellStrict , echo @@ -217,6 +220,10 @@ , mebibytes , gibibytes , tebibytes + + -- * Exceptions + , ProcFailed(..) + , ShellFailed(..) ) where import Control.Applicative @@ -226,7 +233,7 @@ import Control.Concurrent.MVar (newMVar, modifyMVar_) import qualified Control.Concurrent.STM as STM import qualified Control.Concurrent.STM.TQueue as TQueue -import Control.Exception (bracket, finally, mask_, throwIO) +import Control.Exception (Exception, bracket, finally, mask_, throwIO) import Control.Foldl (Fold, FoldM(..), genericLength, handles, list, premap) import qualified Control.Foldl.Text import Control.Monad (liftM, msum, when, unless) @@ -241,6 +248,7 @@ import Data.Traversable import qualified Data.Text as Text import qualified Data.Text.IO as Text +import Data.Typeable (Typeable) import qualified Filesystem import Filesystem.Path.CurrentOS (FilePath, ()) import qualified Filesystem.Path.CurrentOS as Filesystem @@ -308,6 +316,56 @@ -> io ExitCode -- ^ Exit code shell cmdLine = system (Process.shell (unpack cmdLine)) + +data ProcFailed = ProcFailed + { procCommand :: Text + , procArguments :: [Text] + , procExitCode :: ExitCode + } deriving (Show, Typeable) + +instance Exception ProcFailed + +{-| This function is identical to `proc` except this throws `ProcFailed` for + non-zero exit codes +-} +procs + :: MonadIO io + => Text + -- ^ Command + -> [Text] + -- ^ Arguments + -> Shell Text + -- ^ Lines of standard input + -> io () +procs cmd args s = do + exitCode <- proc cmd args s + case exitCode of + ExitSuccess -> return () + _ -> liftIO (throwIO (ProcFailed cmd args exitCode)) + +data ShellFailed = ShellFailed + { shellCommandLine :: Text + , shellExitCode :: ExitCode + } deriving (Show, Typeable) + +instance Exception ShellFailed + +{-| This function is identical to `shell` except this throws `ShellFailed` for + non-zero exit codes +-} +shells + :: MonadIO io + => Text + -- ^ Command line + -> Shell Text + -- ^ Lines of standard input + -> io () + -- ^ Exit code +shells cmdline s = do + exitCode <- shell cmdline s + case exitCode of + ExitSuccess -> return () + _ -> liftIO (throwIO (ShellFailed cmdline exitCode)) {-| Run a command using @execvp@, retrieving the exit code and stdout as a non-lazy blob of Text diff --git a/src/Turtle/Tutorial.hs b/src/Turtle/Tutorial.hs --- a/src/Turtle/Tutorial.hs +++ b/src/Turtle/Tutorial.hs @@ -778,6 +778,10 @@ -- Most of the commands in this library do not actually invoke an external -- shell or program. Instead, they indirectly wrap other Haskell libraries that -- bind to C code. +-- +-- Also, some people prefer that subprocess runners throw exceptions instead of +-- returning an `ExitCode`. `procs` and `shells` are the exception-throwing +-- variations on `proc` and `shell`. -- $format -- @@ -1698,15 +1702,34 @@ -- /Question:/ My program prints some extra output every time it starts. How do -- I remove it? -- --- /Answer:/ Compile your program and run the executable instead of interpreting-- the program. +-- /Answer:/ Compile your program and run the executable instead of interpreting +-- the program. -- +-- /Question:/ How do I transform a @(`Pattern` a)@ into a @(`Pattern` [a])@? +-- +-- /Answer:/ Use `many` or `some` (both are from "Control.Applicative" and +-- re-exported by "Turtle") +-- +-- /Question:/ Why are `star` \/ `plus` not the same as `many` \/ `some`? +-- +-- /Answer:/ Because @[Char]@ is a `String`, which is not the same thing as +-- `Text`. `String` is deprecated in favor of `Text` in modern Haskell code, +-- primarily for performance reasons and also because `Text` provides better +-- support for Unicode. +-- +-- /Question:/ Some Haskell libraries still use `String`. How do I convert +-- back and forth between `String` and `Text`? +-- +-- /Answer:/ Use @"Data.Text".`Data.Text.pack`@ and +-- @"Data.Text".`Data.Text.unpack`@ +-- -- /Question:/ What's the easiest way to fail with a descriptive error message -- if a subprocess command like `proc`/`shell` returns a non-zero exit code? -- code? -- --- /Answer:/ Use @(`proc` cmd args input `.||.` `die` "Descriptive error message")@ --- or @(`shell` cmdline input `.||.` `die` "Descriptive error message")@, very --- similar to Bash and Perl. +-- /Answer:/ Use @(`procs` cmd args input)@ or +-- @(`proc` cmd args input `.||.` `die` "Descriptive error message")@ (or +-- `shell` / `shells`, respectively) -- -- /Question:/ How do I close a resource that I acquired? -- diff --git a/turtle.cabal b/turtle.cabal --- a/turtle.cabal +++ b/turtle.cabal @@ -1,5 +1,5 @@ Name: turtle -Version: 1.2.4 +Version: 1.2.5 Cabal-Version: >=1.10 Build-Type: Simple License: BSD3 @@ -47,7 +47,7 @@ HS-Source-Dirs: src Build-Depends: base >= 4.5 && < 5 , - async >= 2.0.0.0 && < 2.1, + async >= 2.0.0.0 && < 2.2, clock >= 0.4.1.2 && < 0.7, directory >= 1.0.7 && < 1.3, foldl >= 1.1 && < 1.2,