{-# LANGUAGE BlockArguments #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE QuasiQuotes #-} module Main (main) where import Conduit import Data.ByteString.Char8 qualified as B import Data.ByteString.Lazy.Char8 qualified as LB import Data.Text qualified as T import Data.Text.Lazy qualified as LT import Process.Shell import Test.Hspec main :: IO () main = hspec do describe "input" do it "capture stdin" do (`shouldBe` "stdin") =<< runConduitRes (yield "stdin\n" .| [sh|cat|]) (`shouldBe` "stdin") =<< runConduitRes (yield "stdin\n" .| [sh|cat|] .| foldC) describe "output" do it "capture stdout" do (`shouldBe` "stdout") . fst @String @() =<< [sh|echo stdout|] (`shouldBe` "stdout") . fst @String @String =<< runConduitRes [sh|echo stdout|] (`shouldBe` "stdout") . snd @String @String =<< runConduitRes ([sh|echo stdout|] .| partitionEithersC) -- TODO conduit it "capture stderr" do (`shouldBe` "stderr") . snd @() @String =<< [sh|>&2 echo stderr|] (`shouldBe` "stderr") . snd @() @String =<< runConduitRes [sh|>&2 echo stderr|] (`shouldBe` "stderr") . fst @String @String =<< runConduitRes ([sh|>&2 echo stderr|] .| partitionEithersC) it "capture stdout and stderr" do (`shouldBe` ("stdout", "stderr")) =<< [sh| echo stdout >&2 echo stderr |] (`shouldBe` ("stdout", "stderr")) =<< runConduitRes ( [sh| echo stdout >&2 echo stderr |] ) (`shouldBe` ("stderr", "stdout")) =<< runConduitRes ( [sh| echo stdout >&2 echo stderr |] .| partitionEithersC ) it "capture stdout and stderr interleaved" do (`shouldBe` "stdout\nstderr") =<< [sh| echo stdout >&2 echo stderr |] (`shouldBe` "stdout\nstderr") =<< runConduitRes ( [sh| echo stdout >&2 echo stderr |] ) (`shouldBe` "stdout\nstderr") =<< runConduitRes ( [sh| echo stdout >&2 echo stderr |] .| foldC ) it "preserve trailing newline" do (`shouldBe` "stdout\n") =<< [sh|echo stdout \|] (`shouldBe` "stdout\n") =<< runConduitRes [sh|echo stdout \|] (`shouldBe` "stdout\n") =<< runConduitRes ([sh|echo stdout \|] .| foldC) describe "arguments" do it "passes `Int`" do (`shouldBe` "1") =<< let x = 1 :: Int in [sh|echo '#{x}'|] it "passes `Text`" do (`shouldBe` "foobar") =<< let x = T.pack "foobar" in [sh|echo '#{x}'|] (`shouldBe` "foobar") =<< let x = LT.pack "foobar" in [sh|echo '#{x}'|] it "passes `ByteString`" do (`shouldBe` "foobar") =<< let x = B.pack "foobar" in [sh|echo '#{x}'|] (`shouldBe` "foobar") =<< let x = LB.pack "foobar" in [sh|echo '#{x}'|] it "interpolates monadic expressions" do (`shouldBe` "1") =<< let x = pure 1 :: IO Int in [sh|echo '#{{x}}'|] it "preserves argument order" do (`shouldBe` "1 2") =<< let x = "1"; y = "2" in [sh|echo '#{x}' '#{y}'|] describe "quoting" do it "preserves arguments" do (`shouldBe` "foo\\ bar") =<< let x = "foo bar" in [sh|printf %q '#{x}'|] it "preserves special characters" do (`shouldBe` "foo\\ bar") =<< let x = "$foo $bar" in [sh|foo=foo; bar=bar; ( printf %q #{x} )|] it "escapes special characters" do (`shouldBe` "\\$foo\\ \\$bar") =<< let x = "$foo $bar" in [sh|foo=foo; bar=bar; ( printf %q '#{x}' )|] it "preserves empty arguments" do (`shouldBe` "''") =<< let x = "" in [sh|printf %q #{x}|] (`shouldBe` "''") =<< let x = "" in [sh|printf %q '#{x}'|] describe "parsing" do it "parses shell quotes" do (`shouldBe` "foobar") =<< [sh|echo 'foobar'|] it "parses double cross" do (`shouldBe` "0") =<< [sh|echo $#|] partitionEithersC :: (Monad m, Monoid a, Monoid b) => ConduitT (Either a b) o m (a, b) partitionEithersC = foldlC (\(es, rs) x -> either (\e -> (e `mappend` es, rs)) (\r -> (es, r `mappend` rs)) x) (mempty, mempty)