packages feed

shh 0.5.0.0 → 0.6.0.0

raw patch · 7 files changed

+255/−114 lines, 7 filesdep +bytestringdep +utf8-stringPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, utf8-string

API changes (from Hackage documentation)

+ Shh.Internal: instance Shh.Internal.ExecArg Data.ByteString.Lazy.Internal.ByteString
+ Shh.Internal: unlines :: [ByteString] -> ByteString
- Shh: (<<<) :: PipeResult io => Proc a -> String -> io a
+ Shh: (<<<) :: PipeResult io => Proc a -> ByteString -> io a
- Shh: (>>>) :: PipeResult io => String -> Proc a -> io a
+ Shh: (>>>) :: PipeResult io => ByteString -> Proc a -> io a
- Shh: Append :: FilePath -> Stream
+ Shh: Append :: ByteString -> Stream
- Shh: Failure :: String -> [String] -> Int -> Failure
+ Shh: Failure :: ByteString -> [ByteString] -> Int -> Failure
- Shh: Truncate :: FilePath -> Stream
+ Shh: Truncate :: ByteString -> Stream
- Shh: [failureArgs] :: Failure -> [String]
+ Shh: [failureArgs] :: Failure -> [ByteString]
- Shh: [failureProg] :: Failure -> String
+ Shh: [failureProg] :: Failure -> ByteString
- Shh: apply :: MonadIO io => Proc a -> String -> io String
+ Shh: apply :: MonadIO io => Proc a -> ByteString -> io ByteString
- Shh: asArg :: (ExecArg a, Show a) => a -> [String]
+ Shh: asArg :: (ExecArg a, Show a) => a -> [ByteString]
- Shh: asArgFromList :: (ExecArg a, Show a) => [a] -> [String]
+ Shh: asArgFromList :: (ExecArg a, Show a) => [a] -> [ByteString]
- Shh: capture :: PipeResult io => io String
+ Shh: capture :: PipeResult io => io ByteString
- Shh: captureLines :: PipeResult io => io [String]
+ Shh: captureLines :: PipeResult io => io [ByteString]
- Shh: captureSplit :: PipeResult io => String -> io [String]
+ Shh: captureSplit :: PipeResult io => ByteString -> io [ByteString]
- Shh: captureSplit0 :: PipeResult io => io [String]
+ Shh: captureSplit0 :: PipeResult io => io [ByteString]
- Shh: captureTrim :: PipeResult io => io String
+ Shh: captureTrim :: PipeResult io => io ByteString
- Shh: exe :: (Unit a, ExecArgs a) => String -> a
+ Shh: exe :: (Unit a, ExecArgs a, ExecArg str) => str -> a
- Shh: load :: ExecReference -> [String] -> Q [Dec]
+ Shh: load :: ExecReference -> [FilePath] -> Q [Dec]
- Shh: loadAnnotated :: ExecReference -> (String -> String) -> [String] -> Q [Dec]
+ Shh: loadAnnotated :: ExecReference -> (String -> String) -> [FilePath] -> Q [Dec]
- Shh: mkProc :: String -> [String] -> Proc ()
+ Shh: mkProc :: ByteString -> [ByteString] -> Proc ()
- Shh: mkProc' :: Bool -> String -> [String] -> Proc ()
+ Shh: mkProc' :: Bool -> ByteString -> [ByteString] -> Proc ()
- Shh: prefixLines :: PipeResult io => String -> io ()
+ Shh: prefixLines :: PipeResult io => ByteString -> io ()
- Shh: pureProc :: PipeResult io => (String -> String) -> io ()
+ Shh: pureProc :: PipeResult io => (ByteString -> ByteString) -> io ()
- Shh: readInput :: (NFData a, PipeResult io) => (String -> IO a) -> io a
+ Shh: readInput :: (NFData a, PipeResult io) => (ByteString -> IO a) -> io a
- Shh: readInputLines :: (NFData a, PipeResult io) => ([String] -> IO a) -> io a
+ Shh: readInputLines :: (NFData a, PipeResult io) => ([ByteString] -> IO a) -> io a
- Shh: readInputLinesP :: (NFData a, PipeResult io) => ([String] -> Proc a) -> io a
+ Shh: readInputLinesP :: (NFData a, PipeResult io) => ([ByteString] -> Proc a) -> io a
- Shh: readInputP :: (NFData a, PipeResult io) => (String -> Proc a) -> io a
+ Shh: readInputP :: (NFData a, PipeResult io) => (ByteString -> Proc a) -> io a
- Shh: readInputSplit :: (NFData a, PipeResult io) => String -> ([String] -> IO a) -> io a
+ Shh: readInputSplit :: (NFData a, PipeResult io) => ByteString -> ([ByteString] -> IO a) -> io a
- Shh: readInputSplit0 :: (NFData a, PipeResult io) => ([String] -> IO a) -> io a
+ Shh: readInputSplit0 :: (NFData a, PipeResult io) => ([ByteString] -> IO a) -> io a
- Shh: readInputSplit0P :: (NFData a, PipeResult io) => ([String] -> Proc a) -> io a
+ Shh: readInputSplit0P :: (NFData a, PipeResult io) => ([ByteString] -> Proc a) -> io a
- Shh: readInputSplitP :: (NFData a, PipeResult io) => String -> ([String] -> Proc a) -> io a
+ Shh: readInputSplitP :: (NFData a, PipeResult io) => ByteString -> ([ByteString] -> Proc a) -> io a
- Shh: readLines :: Proc () -> IO [String]
+ Shh: readLines :: Proc () -> IO [ByteString]
- Shh: readProc :: PipeResult io => Proc a -> io String
+ Shh: readProc :: PipeResult io => Proc a -> io ByteString
- Shh: readSplit0 :: Proc () -> IO [String]
+ Shh: readSplit0 :: Proc () -> IO [ByteString]
- Shh: readTrim :: (Functor io, PipeResult io) => Proc a -> io String
+ Shh: readTrim :: (Functor io, PipeResult io) => Proc a -> io ByteString
- Shh: readWords :: Proc () -> IO [String]
+ Shh: readWords :: Proc () -> IO [ByteString]
- Shh: readWriteProc :: MonadIO io => Proc a -> String -> io String
+ Shh: readWriteProc :: MonadIO io => Proc a -> ByteString -> io ByteString
- Shh: split0 :: String -> [String]
+ Shh: split0 :: ByteString -> [ByteString]
- Shh: trim :: String -> String
+ Shh: trim :: ByteString -> ByteString
- Shh: withRead :: (PipeResult f, NFData b) => Proc a -> (String -> IO b) -> f b
+ Shh: withRead :: (PipeResult f, NFData b) => Proc a -> (ByteString -> IO b) -> f b
- Shh: withReadLines :: (NFData b, PipeResult io) => Proc a -> ([String] -> IO b) -> io b
+ Shh: withReadLines :: (NFData b, PipeResult io) => Proc a -> ([ByteString] -> IO b) -> io b
- Shh: withReadSplit0 :: (NFData b, PipeResult io) => Proc a -> ([String] -> IO b) -> io b
+ Shh: withReadSplit0 :: (NFData b, PipeResult io) => Proc a -> ([ByteString] -> IO b) -> io b
- Shh: withReadWords :: (NFData b, PipeResult io) => Proc a -> ([String] -> IO b) -> io b
+ Shh: withReadWords :: (NFData b, PipeResult io) => Proc a -> ([ByteString] -> IO b) -> io b
- Shh: writeError :: PipeResult io => String -> io ()
+ Shh: writeError :: (ExecArg a, PipeResult io) => a -> io ()
- Shh: writeOutput :: PipeResult io => String -> io ()
+ Shh: writeOutput :: (ExecArg a, PipeResult io) => a -> io ()
- Shh: writeProc :: PipeResult io => Proc a -> String -> io a
+ Shh: writeProc :: PipeResult io => Proc a -> ByteString -> io a
- Shh: xargs1 :: (NFData a, Monoid a) => String -> (String -> Proc a) -> Proc a
+ Shh: xargs1 :: (NFData a, Monoid a) => ByteString -> (ByteString -> Proc a) -> Proc a
- Shh.Internal: (<<<) :: PipeResult io => Proc a -> String -> io a
+ Shh.Internal: (<<<) :: PipeResult io => Proc a -> ByteString -> io a
- Shh.Internal: (>>>) :: PipeResult io => String -> Proc a -> io a
+ Shh.Internal: (>>>) :: PipeResult io => ByteString -> Proc a -> io a
- Shh.Internal: Append :: FilePath -> Stream
+ Shh.Internal: Append :: ByteString -> Stream
- Shh.Internal: Failure :: String -> [String] -> Int -> Failure
+ Shh.Internal: Failure :: ByteString -> [ByteString] -> Int -> Failure
- Shh.Internal: Truncate :: FilePath -> Stream
+ Shh.Internal: Truncate :: ByteString -> Stream
- Shh.Internal: [failureArgs] :: Failure -> [String]
+ Shh.Internal: [failureArgs] :: Failure -> [ByteString]
- Shh.Internal: [failureProg] :: Failure -> String
+ Shh.Internal: [failureProg] :: Failure -> ByteString
- Shh.Internal: apply :: MonadIO io => Proc a -> String -> io String
+ Shh.Internal: apply :: MonadIO io => Proc a -> ByteString -> io ByteString
- Shh.Internal: asArg :: (ExecArg a, Show a) => a -> [String]
+ Shh.Internal: asArg :: (ExecArg a, Show a) => a -> [ByteString]
- Shh.Internal: asArgFromList :: (ExecArg a, Show a) => [a] -> [String]
+ Shh.Internal: asArgFromList :: (ExecArg a, Show a) => [a] -> [ByteString]
- Shh.Internal: capture :: PipeResult io => io String
+ Shh.Internal: capture :: PipeResult io => io ByteString
- Shh.Internal: captureLines :: PipeResult io => io [String]
+ Shh.Internal: captureLines :: PipeResult io => io [ByteString]
- Shh.Internal: captureSplit :: PipeResult io => String -> io [String]
+ Shh.Internal: captureSplit :: PipeResult io => ByteString -> io [ByteString]
- Shh.Internal: captureSplit0 :: PipeResult io => io [String]
+ Shh.Internal: captureSplit0 :: PipeResult io => io [ByteString]
- Shh.Internal: captureTrim :: PipeResult io => io String
+ Shh.Internal: captureTrim :: PipeResult io => io ByteString
- Shh.Internal: exe :: (Unit a, ExecArgs a) => String -> a
+ Shh.Internal: exe :: (Unit a, ExecArgs a, ExecArg str) => str -> a
- Shh.Internal: load :: ExecReference -> [String] -> Q [Dec]
+ Shh.Internal: load :: ExecReference -> [FilePath] -> Q [Dec]
- Shh.Internal: loadAnnotated :: ExecReference -> (String -> String) -> [String] -> Q [Dec]
+ Shh.Internal: loadAnnotated :: ExecReference -> (String -> String) -> [FilePath] -> Q [Dec]
- Shh.Internal: mkProc :: String -> [String] -> Proc ()
+ Shh.Internal: mkProc :: ByteString -> [ByteString] -> Proc ()
- Shh.Internal: mkProc' :: Bool -> String -> [String] -> Proc ()
+ Shh.Internal: mkProc' :: Bool -> ByteString -> [ByteString] -> Proc ()
- Shh.Internal: prefixLines :: PipeResult io => String -> io ()
+ Shh.Internal: prefixLines :: PipeResult io => ByteString -> io ()
- Shh.Internal: pureProc :: PipeResult io => (String -> String) -> io ()
+ Shh.Internal: pureProc :: PipeResult io => (ByteString -> ByteString) -> io ()
- Shh.Internal: readInput :: (NFData a, PipeResult io) => (String -> IO a) -> io a
+ Shh.Internal: readInput :: (NFData a, PipeResult io) => (ByteString -> IO a) -> io a
- Shh.Internal: readInputLines :: (NFData a, PipeResult io) => ([String] -> IO a) -> io a
+ Shh.Internal: readInputLines :: (NFData a, PipeResult io) => ([ByteString] -> IO a) -> io a
- Shh.Internal: readInputLinesP :: (NFData a, PipeResult io) => ([String] -> Proc a) -> io a
+ Shh.Internal: readInputLinesP :: (NFData a, PipeResult io) => ([ByteString] -> Proc a) -> io a
- Shh.Internal: readInputP :: (NFData a, PipeResult io) => (String -> Proc a) -> io a
+ Shh.Internal: readInputP :: (NFData a, PipeResult io) => (ByteString -> Proc a) -> io a
- Shh.Internal: readInputSplit :: (NFData a, PipeResult io) => String -> ([String] -> IO a) -> io a
+ Shh.Internal: readInputSplit :: (NFData a, PipeResult io) => ByteString -> ([ByteString] -> IO a) -> io a
- Shh.Internal: readInputSplit0 :: (NFData a, PipeResult io) => ([String] -> IO a) -> io a
+ Shh.Internal: readInputSplit0 :: (NFData a, PipeResult io) => ([ByteString] -> IO a) -> io a
- Shh.Internal: readInputSplit0P :: (NFData a, PipeResult io) => ([String] -> Proc a) -> io a
+ Shh.Internal: readInputSplit0P :: (NFData a, PipeResult io) => ([ByteString] -> Proc a) -> io a
- Shh.Internal: readInputSplitP :: (NFData a, PipeResult io) => String -> ([String] -> Proc a) -> io a
+ Shh.Internal: readInputSplitP :: (NFData a, PipeResult io) => ByteString -> ([ByteString] -> Proc a) -> io a
- Shh.Internal: readLines :: Proc () -> IO [String]
+ Shh.Internal: readLines :: Proc () -> IO [ByteString]
- Shh.Internal: readProc :: PipeResult io => Proc a -> io String
+ Shh.Internal: readProc :: PipeResult io => Proc a -> io ByteString
- Shh.Internal: readSplit0 :: Proc () -> IO [String]
+ Shh.Internal: readSplit0 :: Proc () -> IO [ByteString]
- Shh.Internal: readTrim :: (Functor io, PipeResult io) => Proc a -> io String
+ Shh.Internal: readTrim :: (Functor io, PipeResult io) => Proc a -> io ByteString
- Shh.Internal: readWords :: Proc () -> IO [String]
+ Shh.Internal: readWords :: Proc () -> IO [ByteString]
- Shh.Internal: readWriteProc :: MonadIO io => Proc a -> String -> io String
+ Shh.Internal: readWriteProc :: MonadIO io => Proc a -> ByteString -> io ByteString
- Shh.Internal: split :: String -> String -> [String]
+ Shh.Internal: split :: ByteString -> ByteString -> [ByteString]
- Shh.Internal: split0 :: String -> [String]
+ Shh.Internal: split0 :: ByteString -> [ByteString]
- Shh.Internal: toArgs :: ExecArgs a => [String] -> a
+ Shh.Internal: toArgs :: ExecArgs a => [ByteString] -> a
- Shh.Internal: trim :: String -> String
+ Shh.Internal: trim :: ByteString -> ByteString
- Shh.Internal: waitProc :: String -> [String] -> ProcessHandle -> IO ()
+ Shh.Internal: waitProc :: ByteString -> [ByteString] -> ProcessHandle -> IO ()
- Shh.Internal: withRead :: (PipeResult f, NFData b) => Proc a -> (String -> IO b) -> f b
+ Shh.Internal: withRead :: (PipeResult f, NFData b) => Proc a -> (ByteString -> IO b) -> f b
- Shh.Internal: withRead' :: (NFData b, PipeResult io) => (String -> a) -> Proc x -> (a -> IO b) -> io b
+ Shh.Internal: withRead' :: (NFData b, PipeResult io) => (ByteString -> a) -> Proc x -> (a -> IO b) -> io b
- Shh.Internal: withReadLines :: (NFData b, PipeResult io) => Proc a -> ([String] -> IO b) -> io b
+ Shh.Internal: withReadLines :: (NFData b, PipeResult io) => Proc a -> ([ByteString] -> IO b) -> io b
- Shh.Internal: withReadSplit :: (NFData b, PipeResult io) => String -> Proc a -> ([String] -> IO b) -> io b
+ Shh.Internal: withReadSplit :: (NFData b, PipeResult io) => ByteString -> Proc a -> ([ByteString] -> IO b) -> io b
- Shh.Internal: withReadSplit0 :: (NFData b, PipeResult io) => Proc a -> ([String] -> IO b) -> io b
+ Shh.Internal: withReadSplit0 :: (NFData b, PipeResult io) => Proc a -> ([ByteString] -> IO b) -> io b
- Shh.Internal: withReadWords :: (NFData b, PipeResult io) => Proc a -> ([String] -> IO b) -> io b
+ Shh.Internal: withReadWords :: (NFData b, PipeResult io) => Proc a -> ([ByteString] -> IO b) -> io b
- Shh.Internal: writeError :: PipeResult io => String -> io ()
+ Shh.Internal: writeError :: (ExecArg a, PipeResult io) => a -> io ()
- Shh.Internal: writeOutput :: PipeResult io => String -> io ()
+ Shh.Internal: writeOutput :: (ExecArg a, PipeResult io) => a -> io ()
- Shh.Internal: writeProc :: PipeResult io => Proc a -> String -> io a
+ Shh.Internal: writeProc :: PipeResult io => Proc a -> ByteString -> io a
- Shh.Internal: xargs1 :: (NFData a, Monoid a) => String -> (String -> Proc a) -> Proc a
+ Shh.Internal: xargs1 :: (NFData a, Monoid a) => ByteString -> (ByteString -> Proc a) -> Proc a

Files

ChangeLog.md view
@@ -1,5 +1,16 @@ # Revision history for shh +## 0.6.0.0 -- 2019-06-26++This change doesn't remove any functions or majorly change any semantics,+but it will break everything. We now use ByteString instead of String as+the basis for interaction with the OS. This has the potential to improve+performance, but most importantly, helps with correctness.++* Switch to a ByteString interface, in the process fixing up a bunch of+  unicode issues.+* Encode String type arguments as utf8.+ ## 0.5.0.0 -- 2019-05-23  * Change how identifiers are encoded to avoid clashes in all scenarios
README.md view
@@ -199,4 +199,63 @@  ### Script Usage -TODO: Fill this in once the user experience is better.+#### Nix++Nixpkgs provides a `writeHaskellBin` function which is very convenient for+writing quick scripts for your Nix setup.++```nix+writers.writeHaskellBin "example" {libraries = [haskellPackages.shh];} ''+  {-# LANGUAGE TemplateHaskell #-}+  import Shh++  -- Load binaries from Nix packages. The dependencies will be captured+  -- in the closure.+  loadFromBins ["${git}", "${coreutils}", "${curl}"]++  main :: IO ()+  main = do+    cat "/a/file"+    cp "/a/file" "/b/file"+''+```++## Alternatives++There are quite a few players in the "shell programming for Haskell" field.++This table attempts to summarise some of the differences.++ * `Pipe Style` refers to how processes are joined together, "native" means+   that the mechanisms provided by the OS are used, while "via haskell" means+   that the data is read into the Haskell process, and then written into the+   subprocess.+ * `Via Shell` refers to whether subprocesses are launched directly or via+   a shell (which can provide a "native" piping solution at the cost of+   composability)+ * `Run in IO` refers to whether commands need to be prefixed with `run` or+   similar functions to actually execute them.+ * `TH Helper` refers to whether the use of TH to generate Haskell functions+   based on commands found at compile time is encouraged in the main library.+ * `Monadic Subshell` refers to the ability to join multiple processes together+   and feed them all from the same input and to the same output.+   `echo a | (cat; echo b) | wc -l` should report that 2 lines appeared.+++| Library | Pipe Style  | Via Shell | Run in IO | Threadsafe `cd` | TH Helper | Monadic Subshell | Redirect `stderr` |+|---------|-------------|-----------|-----------|-----------------|-----------|------------------|-------------------|+| Shh     | Native      | No        | Yes       | No              | Yes       | Yes              | Yes               |+| Shelly  | Via Haskell | Yes       | No        | Yes             | No        | No               | Yes               |+| Turtle  | Via Haskell | Optional  | No        | ?               | No        | No (Alternative) | Yes               |+| shell-conduit | Via Haskell | Optional | No   | ?               | Yes       | Yes              | No?               |+++### Errors++| Library | Exception on non-zero | Contains arguments | Contains `stderr` | Terminates pipeline |+|---------|-----------------------|--------------------|-------------------|---------------------|+| Shh     | Yes                   | Yes                | No                | Yes                 |+| Shelly  | Yes                   | Yes                | Yes               | Yes                 |+| Turtle  | Sometimes             | No                 | No                | ?                   |+| shell-conduit | Yes             | Yes                | No                | No                  |+
app/Example.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ExtendedDefaultRules #-}  module Main where
app/shh-app.hs view
@@ -4,6 +4,7 @@ import Control.DeepSeq (force) import Control.Exception import Control.Monad+import Data.ByteString.Lazy.Char8 (ByteString,pack) import Shh import System.IO import System.IO.Error@@ -82,14 +83,14 @@             setOwnerWritable True $             emptyPermissions         doIfMissing "init.ghci" $ do-            catchFailure (exe wrapper "ghc-pkg" "latest" "shh") >>= \case+            catchFailure (exe (pack wrapper) "ghc-pkg" "latest" "shh") >>= \case                 Left _ -> do                     putStrLn "Please make the shh and shh-extras packages available in the shh"                     putStrLn "environment (install it globally or modify the wrapper, see docs)."                     putStrLn "Aborting"                     exitFailure                 Right _ -> writeFile "init.ghci" defaultInitGhci-            catchFailure (exe wrapper "ghc-pkg" "latest" "shh-extras") >>= \case+            catchFailure (exe (pack wrapper) "ghc-pkg" "latest" "shh-extras") >>= \case                 Left _ -> do                     putStrLn "## WARNING ##########################################################"                     putStrLn "# You do not have the shh-extras library installed, and so we are"@@ -112,7 +113,7 @@             putStrLn "Rebuilding Shell.hs..."             writeFile "paths" cp             -- Use absolute path of Shell.hs so that GHCi doesn't recompile.-            exe wrapper "ghc" "-c" "-dynamic" (shhDir <> "/Shell.hs")+            exe (pack wrapper) "ghc" "-c" "-dynamic" (shhDir <> "/Shell.hs")      executeFile wrapper False ["ghci", "-ghci-script", shhDir <> "/init.ghci", shhDir <> "/Shell.hs"] Nothing 
shh.cabal view
@@ -1,5 +1,5 @@ name:                shh-version:             0.5.0.0+version:             0.6.0.0 synopsis:            Simple shell scripting from Haskell description:         Provides a shell scripting environment for Haskell. It                      helps you use external binaries, and allows you to@@ -25,6 +25,7 @@   build-depends:     base             >= 4.9 && < 4.13,     async            >= 2.2.1 && < 2.3,+    bytestring,     deepseq          >= 1.4.3 && < 1.5,     directory        >= 1.3.1 && < 1.4,     filepath         >= 1.4.2 && < 1.5,@@ -33,7 +34,8 @@     split            >= 0.2.3 && < 0.3,     template-haskell >= 2.13.0 && < 2.15,     containers       >= 0.5.11 && < 0.7,-    unix             >= 2.7.2 && < 2.8+    unix             >= 2.7.2 && < 2.8,+    utf8-string   hs-source-dirs:      src   default-language:    Haskell2010   ghc-options: -Wall@@ -44,6 +46,7 @@   build-depends:     base >=4.9,     temporary,+    bytestring,     deepseq,     directory,     shh,@@ -68,12 +71,14 @@   build-depends:     base >=4.9,     async,+    bytestring,     directory,     doctest,     tasty,     tasty-quickcheck,     tasty-hunit,-    shh+    shh,+    utf8-string   hs-source-dirs: test   main-is: Test.hs   type: exitcode-stdio-1.0
src/Shh/Internal.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE DataKinds #-}@@ -14,12 +15,19 @@ -- | See documentation for "Shh". module Shh.Internal where +import Prelude hiding (lines, unlines)+ import Control.Concurrent.MVar import Control.Concurrent.Async import Control.DeepSeq (force,NFData) import Control.Exception as C import Control.Monad import Control.Monad.IO.Class+import Data.ByteString.Lazy (ByteString, hGetContents)+import qualified Data.ByteString.Lazy as BS+import Data.ByteString.Lazy.Builder.ASCII+import Data.ByteString.Lazy.UTF8 (toString, fromString, lines)+import qualified Data.ByteString.Lazy.Char8 as BC8 import Data.Char (isLower, isSpace, isAlphaNum, ord) import Data.List (dropWhileEnd, intercalate) import Data.List.Split (endBy, splitOn)@@ -30,7 +38,7 @@ import GHC.IO.Device as IODevice hiding (read) import GHC.IO.Encoding import GHC.IO.Exception (IOErrorType(ResourceVanished))-import GHC.IO.Handle+import GHC.IO.Handle hiding (hGetContents) import GHC.IO.Handle.Internals import GHC.IO.Handle.Types import GHC.IO.Handle.Types (Handle(..))@@ -39,7 +47,7 @@ import System.Environment (getEnv, setEnv) import System.Exit (ExitCode(..)) import System.FilePath (takeFileName, (</>))-import System.IO+import System.IO (IOMode(..), withFile, withBinaryFile, stderr, stdout, stdin) import System.IO.Error import System.Posix.Signals import System.Process@@ -47,6 +55,7 @@  -- $setup -- For doc-tests. Not sure I can use TH in doc tests.+-- >>> :seti -XOverloadedStrings -- >>> import Data.Monoid -- >>> let cat = exe "cat" -- >>> let echo = exe "echo"@@ -74,8 +83,8 @@ -- The only exception to this is when a process is terminated -- by @SIGPIPE@ in a pipeline, in which case we ignore it. data Failure = Failure-    { failureProg :: String-    , failureArgs :: [String]+    { failureProg :: ByteString+    , failureArgs :: [ByteString]     , failureCode :: Int     } deriving (Eq, Ord) @@ -83,7 +92,7 @@     show f = concat $         [ "Command `"         ]-        ++ [intercalate " " (failureProg f : map show (failureArgs f))]+        ++ [intercalate " " (BC8.unpack (failureProg f) : map show (failureArgs f))]         ++         [ "` failed [exit "         , show (failureCode f)@@ -99,7 +108,7 @@     -- | Use this to send the output of on process into the input of another.     -- This is just like a shells `|` operator.     ---    -- The result is polymorphic in it's output, and can result in either+    -- The result is polymorphic in its output, and can result in either     -- another `Proc a` or an `IO a` depending on the context in which it is     -- used.     --@@ -164,7 +173,7 @@ -- | Create a pipe, and close both ends on exception. The first argument -- is the read end, the second is the write end. ----- >>> withPipe $ \r w -> hPutStrLn w "test" >> hClose w >> hGetLine r+-- >>> withPipe $ \r w -> hPutStr w "test" >> hClose w >> hGetLine r -- "test" withPipe :: (Handle -> Handle -> IO a) -> IO a withPipe k =@@ -193,16 +202,16 @@     p &> StdOut = p     (Proc f) &> StdErr = Proc $ \i _ e pl pw -> f i e e pl pw     (Proc f) &> (Truncate path) = Proc $ \i _ e pl pw ->-        withBinaryFile path WriteMode $ \h -> f i h e pl pw+        withBinaryFile (BC8.unpack path) WriteMode $ \h -> f i h e pl pw     (Proc f) &> (Append path) = Proc $ \i _ e pl pw ->-        withBinaryFile path AppendMode $ \h -> f i h e pl pw+        withBinaryFile (BC8.unpack path) AppendMode $ \h -> f i h e pl pw      p &!> StdErr = p     (Proc f) &!> StdOut = Proc $ \i o _ pl pw -> f i o o pl pw     (Proc f) &!> (Truncate path) = Proc $ \i o _ pl pw ->-        withBinaryFile path WriteMode $ \h -> f i o h pl pw+        withBinaryFile (BC8.unpack path) WriteMode $ \h -> f i o h pl pw     (Proc f) &!> (Append path) = Proc $ \i o _ pl pw ->-        withBinaryFile path AppendMode $ \h -> f i o h pl pw+        withBinaryFile (BC8.unpack path) AppendMode $ \h -> f i o h pl pw      nativeProc f = Proc $ \i o e pl pw -> handle handler $ do         pl@@ -228,66 +237,77 @@                 | ioeGetErrorType e == ResourceVanished = pure (throw e)                 | otherwise = throwIO e --- | Simple @`Proc`@ that writes a `String` to it's @stdout@. This behaves--- very much like the standard @echo@ utility, except that there is no--- restriction as to what can be in the string argument.+-- | Simple @`Proc`@ that writes its argument to its @stdout@. This behaves+-- very much like the standard @printf@ utility, except that there is no+-- restriction as to what can be in the argument. --+-- NB: @String@ arguments are encoded as UTF8, while @ByteString@ is passed+-- through. Be aware if you are using @OverloadedStrings@ that you will get+-- wrong results if using unicode in your string literal and it inferes+-- anything other than @String@.+-- -- >>> writeOutput "Hello" -- Hello-writeOutput :: PipeResult io => String -> io ()+writeOutput :: (ExecArg a, PipeResult io) => a -> io () writeOutput s = nativeProc $ \_ o _ -> do-    hPutStr o s+    mapM_ (BS.hPutStr o) (asArg s) --- | Simple @`Proc`@ that writes a `String` to it's @stderr@.+-- | Simple @`Proc`@ that writes its argument to its @stderr@. -- See also @`writeOutput`@.+-- -- >>> writeError "Hello" &> devNull -- Hello-writeError :: PipeResult io => String -> io ()+writeError :: (ExecArg a, PipeResult io) => a -> io () writeError s = nativeProc $ \_ _ e -> do-    hPutStr e s+   mapM_ (BS.hPutStr e) (asArg s) --- | Simple @`Proc`@ that reads it's input, and can react to it with an IO--- action. Does not write anything to it's output. See also @`capture`@.+-- | Simple @`Proc`@ that reads its input, and can react to it with an IO+-- action. Does not write anything to its output. See also @`capture`@. ----- @`readInput`@ uses lazy IO to read it's stdin, and works with infinite+-- @`readInput`@ uses lazy IO to read its stdin, and works with infinite -- inputs. -- -- >>> yes |> readInput (pure . unlines . take 3 . lines) -- "y\ny\ny\n"-readInput :: (NFData a, PipeResult io) => (String -> IO a) -> io a+readInput :: (NFData a, PipeResult io) => (ByteString -> IO a) -> io a readInput f = nativeProc $ \i _ _ -> do     hGetContents i >>= f +-- | Join a list of @ByteString@s with newline characters, terminating it+-- with a newline.+unlines :: [ByteString] -> ByteString+unlines = toLazyByteString . mconcat . map (\l -> lazyByteString l <> char7 '\n')+ -- | Like @`readInput`@, but @`split`@s the string. -- -- >>> yes |> readInputSplit "\n" (pure . take 3) -- ["y","y","y"]-readInputSplit :: (NFData a, PipeResult io) => String -> ([String] -> IO a) -> io a+readInputSplit :: (NFData a, PipeResult io) => ByteString -> ([ByteString] -> IO a) -> io a readInputSplit s f = readInput (f . split s)  -- | Like @`readInput`@, but @`split`@s the string on the 0 byte. -- -- >>> writeOutput "1\0\&2\0" |> readInputSplit0 pure -- ["1","2"]-readInputSplit0 :: (NFData a, PipeResult io) => ([String] -> IO a) -> io a+readInputSplit0 :: (NFData a, PipeResult io) => ([ByteString] -> IO a) -> io a readInputSplit0 = readInputSplit "\0"  -- | Like @`readInput`@, but @`split`@s the string on new lines. -- -- >>> writeOutput "a\nb\n" |> readInputLines pure -- ["a","b"]-readInputLines :: (NFData a, PipeResult io) => ([String] -> IO a) -> io a+readInputLines :: (NFData a, PipeResult io) => ([ByteString] -> IO a) -> io a readInputLines = readInputSplit "\n"  -- | Creates a pure @`Proc`@ that simple transforms the @stdin@ and writes -- it to @stdout@. The input can be infinite. ----- >>> yes |> pureProc (take 4) |> capture+-- >>> yes |> pureProc (BS.take 4) |> capture -- "y\ny\n"-pureProc :: PipeResult io => (String -> String) -> io ()+pureProc :: PipeResult io => (ByteString -> ByteString) -> io () pureProc f = nativeProc $ \i o _ -> do     s <- hGetContents i-    hPutStr o (f s)+    BS.hPutStr o (f s)  -- | Captures the stdout of a process and prefixes all the lines with -- the given string.@@ -295,28 +315,29 @@ -- >>> some_command |> prefixLines "stdout: " |!> prefixLines "stderr: " &> StdErr -- stdout: this is stdout -- stderr: this is stderr-prefixLines :: PipeResult io => String -> io ()-prefixLines s = pureProc $ unlines . map (s ++) . lines+prefixLines :: PipeResult io => ByteString -> io ()+prefixLines s = pureProc $ \inp -> toLazyByteString $+    mconcat $ map (\l -> lazyByteString s <> lazyByteString l <> char7 '\n') (lines inp) --- | Provide the stdin of a `Proc` from a `String`+-- | Provide the stdin of a `Proc` from a `ByteString` -- -- Same as @`writeOutput` s |> p@-writeProc :: PipeResult io => Proc a -> String -> io a+writeProc :: PipeResult io => Proc a -> ByteString -> io a writeProc p s = writeOutput s |> p --- | Run a process and capture it's output lazily. Once the continuation+-- | Run a process and capture its output lazily. Once the continuation -- is completed, the handles are closed. However, the process is run -- until it naturally terminates in order to capture the correct exit -- code. Most utilities behave correctly with this (e.g. @cat@ will -- terminate if you close the handle). -- -- Same as @p |> readInput f@-withRead :: (PipeResult f, NFData b) => Proc a -> (String -> IO b) -> f b+withRead :: (PipeResult f, NFData b) => Proc a -> (ByteString -> IO b) -> f b withRead p f = p |> readInput f  -- | Type used to represent destinations for redirects. @`Truncate` file@ -- is like @> file@ in a shell, and @`Append` file@ is like @>> file@.-data Stream = StdOut | StdErr | Truncate FilePath | Append FilePath+data Stream = StdOut | StdErr | Truncate ByteString | Append ByteString  -- | Shortcut for @`Truncate` "\/dev\/null"@ -- @@ -387,10 +408,13 @@ -- | Create a `Proc` from a command and a list of arguments. -- The boolean represents whether we should delegate control-c -- or not. Most uses of @`mkProc'`@ in Shh do not delegate control-c.-mkProc' :: Bool -> String -> [String] -> Proc ()+mkProc' :: Bool -> ByteString -> [ByteString] -> Proc () mkProc' delegate cmd args = Proc $ \i o e pl pw -> do+    let+        cmd' = BC8.unpack cmd+        args' = BC8.unpack <$> args     bracket-        (createProcess_ cmd (proc cmd args)+        (createProcess_ cmd' (proc cmd' args')             { std_in = UseHandle i             , std_out = UseHandle o             , std_err = UseHandle e@@ -405,23 +429,23 @@  -- | Create a `Proc` from a command and a list of arguments. Does not delegate -- control-c handling.-mkProc :: String -> [String] -> Proc ()+mkProc :: ByteString -> [ByteString] -> Proc () mkProc = mkProc' False  -- | Read the stdout of a `Proc`. This captures stdout, so further piping will -- not see anything on the input. ----- This is strict, so the whole output is read into a `String`. See `withRead`+-- This is strict, so the whole output is read into a `ByteString`. See `withRead` -- for a lazy version that can be used for streaming.-readProc :: PipeResult io => Proc a -> io String+readProc :: PipeResult io => Proc a -> io ByteString readProc p = withRead p pure --- | A special `Proc` which captures it's stdin and presents it as a `String`+-- | A special `Proc` which captures its stdin and presents it as a `ByteString` -- to Haskell. -- -- >>> printf "Hello" |> md5sum |> capture -- "8b1a9953c4611296a827abf8c47804d7  -\n"-capture :: PipeResult io => io String+capture :: PipeResult io => io ByteString capture = readInput pure  -- | Like @'capture'@, except that it @'trim'@s leading and trailing white@@ -429,69 +453,69 @@ -- -- >>> printf "Hello" |> md5sum |> captureTrim -- "8b1a9953c4611296a827abf8c47804d7  -"-captureTrim :: PipeResult io => io String+captureTrim :: PipeResult io => io ByteString captureTrim = readInput (pure . trim)  -- | Like @'capture'@, but splits the input using the provided separator. -- -- NB: This is strict. If you want a streaming version, use `readInput`-captureSplit :: PipeResult io => String -> io [String]-captureSplit s = readInput (pure . endBy s)+captureSplit :: PipeResult io => ByteString -> io [ByteString]+captureSplit s = readInput (pure . fmap fromString . endBy (toString s) . toString)  -- | Same as @'captureSplit' "\0"@.-captureSplit0 :: PipeResult io => io [String]+captureSplit0 :: PipeResult io => io [ByteString] captureSplit0 = captureSplit "\0"  -- | Same as @'captureSplit' "\n"@.-captureLines :: PipeResult io => io [String]+captureLines :: PipeResult io => io [ByteString] captureLines = captureSplit "\n"  -- | Apply a transformation function to the string before the IO action.-withRead' :: (NFData b, PipeResult io) => (String -> a) -> Proc x -> (a -> IO b) -> io b+withRead' :: (NFData b, PipeResult io) => (ByteString -> a) -> Proc x -> (a -> IO b) -> io b withRead' f p io = withRead p (io . f)  -- | Like @'withRead'@ except it splits the string with the provided separator.-withReadSplit :: (NFData b, PipeResult io) => String -> Proc a -> ([String] -> IO b) -> io b+withReadSplit :: (NFData b, PipeResult io) => ByteString -> Proc a -> ([ByteString] -> IO b) -> io b withReadSplit = withRead' . split  -- | Like @'withRead'@ except it splits the string with @'split0'@ first.-withReadSplit0 :: (NFData b, PipeResult io) => Proc a -> ([String] -> IO b) -> io b+withReadSplit0 :: (NFData b, PipeResult io) => Proc a -> ([ByteString] -> IO b) -> io b withReadSplit0 = withRead' split0  -- | Like @'withRead'@ except it splits the string with @'lines'@ first. -- -- NB: Please consider using @'withReadSplit0'@ where you can.-withReadLines :: (NFData b, PipeResult io) => Proc a -> ([String] -> IO b) -> io b+withReadLines :: (NFData b, PipeResult io) => Proc a -> ([ByteString] -> IO b) -> io b withReadLines = withRead' lines  -- | Like @'withRead'@ except it splits the string with @'words'@ first.-withReadWords :: (NFData b, PipeResult io) => Proc a -> ([String] -> IO b) -> io b-withReadWords = withRead' words+withReadWords :: (NFData b, PipeResult io) => Proc a -> ([ByteString] -> IO b) -> io b+withReadWords = withRead' (map fromString . words . toString)  -- | Read and write to a `Proc`. Same as -- @readProc proc <<< input@-readWriteProc :: MonadIO io => Proc a -> String -> io String+readWriteProc :: MonadIO io => Proc a -> ByteString -> io ByteString readWriteProc p input = liftIO $ readProc p <<< input --- | Some as `readWriteProc`. Apply a `Proc` to a `String`.+-- | Some as `readWriteProc`. Apply a `Proc` to a `ByteString`. -- -- >> apply md5sum "Hello" -- "8b1a9953c4611296a827abf8c47804d7  -\n"-apply :: MonadIO io => Proc a -> String -> io String+apply :: MonadIO io => Proc a -> ByteString -> io ByteString apply = readWriteProc  -- | Flipped, infix version of `writeProc`-(>>>) :: PipeResult io => String -> Proc a -> io a+(>>>) :: PipeResult io => ByteString -> Proc a -> io a (>>>) = flip writeProc   -- | Infix version of `writeProc`-(<<<) :: PipeResult io => Proc a -> String -> io a+(<<<) :: PipeResult io => Proc a -> ByteString -> io a (<<<) = writeProc  -- | Wait on a given `ProcessHandle`, and throw an exception of--- type `Failure` if it's exit code is non-zero (ignoring SIGPIPE)-waitProc :: String -> [String] -> ProcessHandle -> IO ()+-- type `Failure` if its exit code is non-zero (ignoring SIGPIPE)+waitProc :: ByteString -> [ByteString] -> ProcessHandle -> IO () waitProc cmd arg ph = waitForProcess ph >>= \case     ExitFailure c         | fromIntegral c == negate sigPIPE -> pure ()@@ -499,8 +523,8 @@     ExitSuccess -> pure ()  -- | Trim leading and tailing whitespace.-trim :: String -> String-trim = dropWhileEnd isSpace . dropWhile isSpace+trim :: ByteString -> ByteString+trim = fromString . dropWhileEnd isSpace . dropWhile isSpace . toString  -- | Allow us to catch `Failure` exceptions in `IO` and `Proc` class ProcFailure m where@@ -535,36 +559,41 @@         getCode (Left  f) = failureCode f  -- | Like `readProc`, but trim leading and tailing whitespace.-readTrim :: (Functor io, PipeResult io) => Proc a -> io String+readTrim :: (Functor io, PipeResult io) => Proc a -> io ByteString readTrim = fmap trim . readProc  -- | A class for things that can be converted to arguments on the command -- line. The default implementation is to use `show`. class ExecArg a where-    asArg :: a -> [String]-    default asArg :: Show a => a -> [String]-    asArg a = [show a]+    asArg :: a -> [ByteString]+    default asArg :: Show a => a -> [ByteString]+    asArg a = [fromString $ show a]      -- God, I hate that String is [Char]...-    asArgFromList :: [a] -> [String]-    default asArgFromList :: Show a => [a] -> [String]+    asArgFromList :: [a] -> [ByteString]+    default asArgFromList :: Show a => [a] -> [ByteString]     asArgFromList = concatMap asArg +-- | The @Char@ and @String@ instances encodes as UTF8 instance ExecArg Char where-    asArg s = [[s]]-    asArgFromList s = [s]+    asArg s = [fromString [s]]+    asArgFromList s = [fromString s] +-- | The @[Char]@/@String@ instance encodes as UTF8 instance ExecArg a => ExecArg [a] where     asArg = asArgFromList     asArgFromList = concatMap asArg +instance ExecArg ByteString where+    asArg s = [s]+ instance ExecArg Int instance ExecArg Integer instance ExecArg Word  -- | A class for building up a command class ExecArgs a where-    toArgs :: [String] -> a+    toArgs :: [ByteString] -> a  instance ExecArgs (Proc ()) where     toArgs (cmd:args) = mkProc cmd args@@ -617,8 +646,8 @@ -- > exe "ls" "-l" -- -- See also `loadExe` and `loadEnv`.-exe :: (Unit a, ExecArgs a) => String -> a-exe s = toArgs [s]+exe :: (Unit a, ExecArgs a, ExecArg str) => str -> a+exe s = toArgs (asArg s)  -- | Create a function for the executable named loadExe :: ExecReference -> String -> Q [Dec]@@ -670,6 +699,18 @@ -- Justification for changing @-@ to @_@ is that @-@ appears far more commonly -- in executable names than @_@ does, and so we give it the more ergonomic -- encoding.+--+-- >>> encodeIdentifier "nix-shell"+-- "nix_shell"+--+-- >>> encodeIdentifier "R"+-- "_R"+--+-- >>> encodeIdentifier "x86_64-unknown-linux-gnu-gcc"+-- "x86'_64_unknown_linux_gnu_gcc"+--+-- >>> encodeIdentifier "release.sh"+-- "release''sh" encodeIdentifier :: String -> String encodeIdentifier ident =     let@@ -712,11 +753,11 @@ -- and creating a function @missingExecutables@ to do a runtime check for their -- availability. Uses the @'encodeIdentifier'@ function to create function -- names.-load :: ExecReference -> [String] -> Q [Dec]+load :: ExecReference -> [FilePath] -> Q [Dec] load ref = loadAnnotated ref encodeIdentifier  -- | Same as `load`, but allows you to modify the function names.-loadAnnotated :: ExecReference -> (String -> String) -> [String] -> Q [Dec]+loadAnnotated :: ExecReference -> (String -> String) -> [FilePath] -> Q [Dec] loadAnnotated ref f bins = do     let pairs = zip (map f bins) bins     ds <- fmap join $ mapM (uncurry (loadExeAs ref)) pairs@@ -746,8 +787,8 @@ -- -- >>> split "\n" "a\nb" -- ["a","b"]-split :: String -> String -> [String]-split = endBy+split :: ByteString -> ByteString -> [ByteString]+split s str = fmap fromString $ endBy (toString s) (toString str)  -- | Load executables from the given directories loadFromDirs :: [FilePath] -> Q [Dec]@@ -756,7 +797,6 @@ -- | Load executables from the given directories appended with @"/bin"@. -- -- Useful for use with Nix.---  loadFromBins :: [FilePath] -> Q [Dec] loadFromBins = loadFromDirs . fmap (</> "bin") @@ -771,29 +811,29 @@  -- | Function that splits '\0' separated list of strings. Useful in conjunction -- with @find . "-print0"@.-split0 :: String -> [String]-split0 = endBy "\0"+split0 :: ByteString -> [ByteString]+split0 = split "\0"  -- | A convenience function for reading in a @"\\NUL"@ separated list of -- strings. This is commonly used when dealing with paths. -- -- > readSplit0 $ find "-print0"-readSplit0 :: Proc () -> IO [String]+readSplit0 :: Proc () -> IO [ByteString] readSplit0 p = withReadSplit0 p pure  -- | A convenience function for reading the output lines of a `Proc`. -- -- Note: Please consider using @'readSplit0'@ instead if you can.-readLines :: Proc () -> IO [String]+readLines :: Proc () -> IO [ByteString] readLines p = withReadLines p pure  -- | Read output into a list of words-readWords :: Proc () -> IO [String]+readWords :: Proc () -> IO [ByteString] readWords p = withReadWords p pure  -- | Like `readProc`, but attempts to `Prelude.read` the result. readAuto :: Read a => Proc () -> IO a-readAuto p = read <$> readProc p+readAuto p = read . toString <$> readProc p  -- | Mimics the shell builtin "cd". cd' :: FilePath -> IO ()@@ -804,7 +844,10 @@  -- | Helper class for variable number of arguments to @cd@ builtin. class Cd a where-    -- | Mimics the shell builtin "cd"+    -- | Mimics the shell builtin "cd". Be careful using this function+    -- in a program, as it doesn't play well with multiple threads. Best+    -- to just use it in an interactive shell or for very simple+    -- transliterations of shell scripts.     cd :: a  instance (io ~ IO ()) => Cd io where@@ -830,28 +873,28 @@ -- -- >>> yes |> head "-n" 5 |> xargs1 "\n" (const $ pure $ Sum 1) -- Sum {getSum = 5}-xargs1 :: (NFData a, Monoid a) => String -> (String -> Proc a) -> Proc a+xargs1 :: (NFData a, Monoid a) => ByteString -> (ByteString -> Proc a) -> Proc a xargs1 n f = readInputSplitP n (fmap mconcat . mapM f) --- | Simple @`Proc`@ that reads it's input and can react to the output by--- calling other @`Proc`@'s which can write something to it's stdout.--- The internal @`Proc`@ is given @/dev/null@ as it's input.-readInputP :: (NFData a, PipeResult io) => (String -> Proc a) -> io a+-- | Simple @`Proc`@ that reads its input and can react to the output by+-- calling other @`Proc`@'s which can write something to its stdout.+-- The internal @`Proc`@ is given @/dev/null@ as its input.+readInputP :: (NFData a, PipeResult io) => (ByteString -> Proc a) -> io a readInputP f = nativeProc $ \i o e -> do     s <- hGetContents i     withNullInput $ \i' ->         liftIO $ runProc' i' o e (f s)  -- | Like @`readInputP`@, but splits the input.-readInputSplitP :: (NFData a, PipeResult io) => String -> ([String] -> Proc a) -> io a+readInputSplitP :: (NFData a, PipeResult io) => ByteString -> ([ByteString] -> Proc a) -> io a readInputSplitP s f = readInputP (f . split s)  -- | Like @`readInputP`@, but splits the input on 0 bytes.-readInputSplit0P :: (NFData a, PipeResult io) => ([String] -> Proc a) -> io a+readInputSplit0P :: (NFData a, PipeResult io) => ([ByteString] -> Proc a) -> io a readInputSplit0P = readInputSplitP "\0"  -- | Like @`readInputP`@, but splits the input on new lines.-readInputLinesP :: (NFData a, PipeResult io) => ([String] -> Proc a) -> io a+readInputLinesP :: (NFData a, PipeResult io) => ([ByteString] -> Proc a) -> io a readInputLinesP = readInputSplitP "\n"  -- | Create a null file handle.
test/Test.hs view
@@ -1,9 +1,14 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ExtendedDefaultRules #-} module Main where  import System.Directory import Shh+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as BS+import Data.ByteString.Lazy.UTF8 (toString, fromString)+import qualified Data.ByteString.Lazy.Char8 as C8 import Test.DocTest import Test.Tasty import Test.Tasty.HUnit@@ -16,7 +21,7 @@ import System.IO  load SearchPath-    ["wc", "head", "tr", "echo", "cat", "true", "false", "mktemp", "sleep"+    [ "wc", "head", "tr", "echo", "cat", "true", "false", "mktemp", "sleep"     , "rm", "printf", "xargs", "find"     ] @@ -33,9 +38,13 @@ tests :: TestTree tests = localOption (Timeout 4000000 "4s") $ testGroup "Tests" [unitTests, properties] -bytesToString :: [Word8] -> String-bytesToString = map (chr . fromIntegral)+bytesToString :: [Word8] -> ByteString+bytesToString = BS.pack +instance Arbitrary ByteString where+    arbitrary = bytesToString <$> arbitrary+    shrink = fmap BS.pack . shrink . BS.unpack+ properties :: TestTree properties = testGroup "Properties"     [ testProperty "trim = trim . trim" $ \l -> trim l == trim (trim l)@@ -51,9 +60,9 @@             s' = bytesToString s         k <- readProc $ s' >>> pureProc id         pure $ s' === k-    , testProperty "pureProc (map toUpper)" $ \(ASCIIString s) -> ioProperty $ do-        k <- readProc $ s >>> pureProc (map toUpper)-        pure $ map toUpper s === k+    , testProperty "pureProc (map toUpper)" $ \s -> ioProperty $ do+        k <- readProc $ s >>> pureProc (C8.map toUpper)+        pure $ C8.map toUpper s === k     , testProperty "pureProc . const === writeOutput" $ \s -> ioProperty $ do         let             s' = bytesToString s@@ -61,17 +70,23 @@         b <- pureProc (const s') |> capture         pure $ a === b     , testProperty "writeOutput s |> capture >>= writeOutput |> capture === s"-        $ \(ASCIIString s) -> ioProperty $ do+        $ \s -> ioProperty $ do             r <- writeOutput s |> capture >>= writeOutput |> capture             pure $ r === s     , testProperty "pureProc id === readInputP (\\s -> writeOutput s)"-        $ \(ASCIIString s) -> ioProperty $ do+        $ \s -> ioProperty $ do             a <- writeOutput s |> pureProc id |> capture             b <- writeOutput s |> readInputP (\s -> writeOutput s) |> capture             pure $ a === b+    , testProperty "string round trip" $ \s -> ioProperty $ do+        r <- writeOutput (s :: String) |> capture+        pure $ s == toString r+    , testProperty "bytestring round trip" $ \s -> ioProperty $ do+        r <- writeOutput (s :: ByteString) |> capture+        pure $ s == r     ] -withTmp :: (FilePath -> IO a) -> IO a+withTmp :: (ByteString -> IO a) -> IO a withTmp = bracket (readTrim mktemp) rm  unitTests :: TestTree@@ -102,7 +117,7 @@         r @?= "test\n"     , testCase "Lazy read" $ replicateM_ 100 $ do         withRead (cat "/dev/zero") $ \s -> do-            take 6 s @?= "\0\0\0\0\0\0"+            BS.take 6 s @?= "\0\0\0\0\0\0"     , testCase "Multiple outputs" $ do         l <- readProc $ (echo (1 :: Int) >> echo (2 :: Int)) |> cat         l @?= "1\n2\n"@@ -135,7 +150,7 @@         Left r <- catchFailure $ readProc $ echo "test" |> true |> false "dummy"         r @?= Shh.Failure "false" ["dummy"] 1     , testCase "Lazy read checks code" $ replicateM_ 30 $ do-        Left r <- catchFailure $ withRead (cat "/dev/urandom" |> false "dummy") $ pure . take 3+        Left r <- catchFailure $ withRead (cat "/dev/urandom" |> false "dummy") $ pure . BS.take 3         r @?= Shh.Failure "false" ["dummy"] 1     , testCase "Identifier odd chars" $ encodeIdentifier "1@3.-" @?= "_1'40'3''_"     , testCase "Identifier make lower" $ encodeIdentifier "T.est" @?= "_T''est"@@ -196,6 +211,12 @@         a @?= b     , testCase "complex example with intermediate handles (>BUFSIZ)" $ do         let c = 20000000-        s <- readTrim $ cat "/dev/urandom" |> readInputP (\s -> writeOutput (map toUpper s) |> cat) |> Main.head "-c" c |> wc "-c"-        show c @?= s+        s <- readTrim $ cat "/dev/urandom" |> readInputP (\s -> writeOutput (C8.map toUpper s) |> cat) |> Main.head "-c" c |> wc "-c"+        show c @?= toString s+    , testCase "subshells" $ do+      s <- readProc $ echo "ac" |> (cat >> echo "bc") |> tr "-d" "c"+      s @?= "a\nb\n"+    , testCase "unicode" $ do+        s <- writeOutput "üか" |> cat |> capture+        toString s @?= "üか"     ]