{-# LANGUAGE FlexibleInstances, OverloadedStrings, RankNTypes #-}
module Main where
import Codec.Binary.UTF8.String (encode)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.ListLike as ListLike (ListLike(..))
import Data.Maybe (mapMaybe)
import Data.Monoid (Monoid(..))
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Prelude hiding (length, concat)
import GHC.IO.Exception
import System.Exit
import System.Posix.Files (getFileStatus, fileMode, setFileMode, unionFileModes, ownerExecuteMode, groupExecuteMode, otherExecuteMode)
import System.Process (proc)
import System.Process.Chunks (Chunk(..), readProcessChunks, canonicalChunks)
import System.Process.Lazy ()
import System.Process.ListLike (readProcessWithExitCode, readCreateProcessWithExitCode, readCreateProcess, ListLikePlus(..))
import System.Process.Strict ()
import Test.HUnit hiding (path)
fromString :: String -> B.ByteString
fromString = fromList . encode
lazyFromString :: String -> L.ByteString
lazyFromString = L.fromChunks . (: []) . fromString
instance Monoid Test where
mempty = TestList []
mappend (TestList a) (TestList b) = TestList (a ++ b)
mappend (TestList a) b = TestList (a ++ [b])
mappend a (TestList b) = TestList ([a] ++ b)
mappend a b = TestList [a, b]
testInstances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test
testInstances mkTest = mappend (testCharInstances mkTest) (testWord8Instances mkTest)
testStrictInstances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test
testStrictInstances mkTest = mappend (testStrictCharInstances mkTest) (testStrictWord8Instances mkTest)
testLazyInstances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test
testLazyInstances mkTest = mappend (testLazyCharInstances mkTest) (testLazyWord8Instances mkTest)
testCharInstances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test
testCharInstances mkTest = mappend (testLazyCharInstances mkTest) (testStrictCharInstances mkTest)
testLazyCharInstances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test
testLazyCharInstances mkTest =
TestList [ TestLabel "Lazy Text" $ mkTest LT.empty
, TestLabel "String" $ mkTest ("" :: String) ]
testStrictCharInstances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test
testStrictCharInstances mkTest =
TestList [ TestLabel "Strict Text" $ mkTest T.empty ]
testWord8Instances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test
testWord8Instances mkTest = mappend (testLazyWord8Instances mkTest) (testStrictWord8Instances mkTest)
testLazyWord8Instances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test
testLazyWord8Instances mkTest =
TestList [ TestLabel "Lazy ByteString" $ mkTest L.empty ]
testStrictWord8Instances :: (forall a c. (Show a, ListLikePlus a c) => a -> Test) -> Test
testStrictWord8Instances mkTest =
TestList [ TestLabel "Strict ByteString" $ mkTest B.empty ]
main :: IO ()
main =
do chmod "Tests/Test1.hs"
chmod "Tests/Test2.hs"
chmod "Tests/Test4.hs"
(c,st) <- runTestText putTextToShowS test1 -- (TestList (versionTests ++ sourcesListTests ++ dependencyTests ++ changesTests))
putStrLn (st "")
case (failures c) + (errors c) of
0 -> return ()
_ -> exitFailure
chmod :: FilePath -> IO ()
chmod path =
getFileStatus "Tests/Test1.hs" >>= \ status ->
setFileMode path (foldr unionFileModes (fileMode status) [ownerExecuteMode, groupExecuteMode, otherExecuteMode])
test1 :: Test
test1 =
TestLabel "test1"
(TestList
[ TestLabel "[Output]" $
TestList
[ testCharInstances
(\ i -> TestCase (do b <- readProcessChunks (proc "cat" ["Tests/text"]) i
assertEqual
"UTF8"
["ProcessHandle <processhandle>",
-- For Text, assuming your locale is set to utf8, the result is unicode.
"Stdout \"Signed: Baishi laoren \\30333\\30707\\32769\\20154, painted in the artist\\8217s 87th year.\\n\"",
"Result ExitSuccess"] (ListLike.map show (canonicalChunks b))))
, testWord8Instances
(\ i -> TestCase (do b <- readProcessChunks (proc "cat" ["Tests/text"]) i
assertEqual
"UTF8"
["ProcessHandle <processhandle>",
-- For ByteString we get utf8 encoded text
"Stdout \"Signed: Baishi laoren \\231\\153\\189\\231\\159\\179\\232\\128\\129\\228\\186\\186, painted in the artist\\226\\128\\153s 87th year.\\n\"",
"Result ExitSuccess"] (ListLike.map show (canonicalChunks b))))
, testInstances
(\ i -> TestCase (do b <- readProcessChunks (proc "Tests/Test1.hs" []) i
assertEqual
"[Chunk]"
["ProcessHandle <processhandle>",
"Stderr \"This is an error message.\\n\"",
"Result (ExitFailure 123)"]
(ListLike.map show (canonicalChunks b))))
]
-- This gets "hGetContents: invalid argument (invalid byte sequence)" if we don't call
-- binary on the file handles in readProcessInterleaved.
, TestLabel "JPG" $
TestList
[ {- TestCase (do b <- readProcessChunks (proc "cat" ["Tests/houseisclean.jpg"]) B.empty >>=
return . mapMaybe (\ x -> case x of
Stdout s -> Just (length' s)
Stderr s -> Just (length' s)
_ -> Nothing)
assertEqual "ByteString Chunk Size"
[68668,0]
b
-- If we could read a jpg file into a string the chunks would look something like this:
-- [2048,2048,2048,1952,2048,2048,2048,1952,2048,2048,2048,1952,2048,2048,2048,1952,2048,2048,2048,1952,2048,2048,2048,1952,2048,2048,2048,1952,2048,2048,2048,1952,2048,1852]
)
, -}
testLazyWord8Instances
( \ i -> TestCase (do b <- readProcessChunks (proc "cat" ["Tests/houseisclean.jpg"]) i >>=
return . mapMaybe (\ x -> case x of
Stdout s -> Just (length s)
Stderr s -> Just (length s)
_ -> Nothing)
assertEqual "Chunk Size" [32752,32752,3164] b))
, testStrictWord8Instances
( \ i -> TestCase (do b <- readProcessChunks (proc "cat" ["Tests/houseisclean.jpg"]) i >>=
return . mapMaybe (\ x -> case x of
Stdout s -> Just (length s)
Stderr s -> Just (length s)
_ -> Nothing)
assertEqual "Chunk Size" [68668,0] b))
{- -- We don't seem to get an InvalidArgument exception back.
, TestCase (do b <- tryIOError (readProcessChunks (proc "cat" ["Tests/houseisclean.jpg"]) "") >>= return . either Left (Right . show)
assertEqual "String decoding exception" (Left (IOError { ioe_handle = Nothing
, ioe_type = InvalidArgument
, ioe_location = "recoverDecode"
, ioe_description = "invalid byte sequence"
, ioe_errno = Nothing
, ioe_filename = Nothing })) b)
Related to https://ghc.haskell.org/trac/ghc/ticket/9236. Try this:
import System.IO
import System.IO.Error
main = do
h <- openFile "Tests/houseisclean.jpg" ReadMode
r <- try (hGetContents h) >>= either exn str
hClose h
where
exn (e :: IOError) = putStrLn ("exn=" ++ show (ioe_handle e, ioe_type e, ioe_location e, ioe_description e, ioe_errno e, ioe_filename e))
str s = putStrLn ("s=" ++ show s)
The exception gets thrown and caught after the string result starts
being printed. You can see the open quote.
-}
]
{-
, TestLabel "ByteString" $
TestCase (do b <- readProcessWithExitCode "Tests/Test1.hs" [] B.empty
assertEqual "ByteString" (ExitFailure 123, fromString "", fromString "This is an error message.\n") b)
-}
, TestLabel "Lazy" $
TestCase (do l <- readProcessWithExitCode "Tests/Test1.hs" [] L.empty
assertEqual "Lazy ByteString" (ExitFailure 123, lazyFromString "", lazyFromString "This is an error message.\n") l)
{-
, TestLabel "Text" $
TestCase (do t <- readProcessWithExitCode "Tests/Test1.hs" [] T.empty
assertEqual "Text" (ExitFailure 123, T.pack "", T.pack "This is an error message.\n") t)
-}
, TestLabel "LazyText" $
TestCase (do lt <- readProcessWithExitCode "Tests/Test1.hs" [] LT.empty
assertEqual "LazyText" (ExitFailure 123, LT.pack "", LT.pack "This is an error message.\n") lt)
{-
, TestLabel "String" $
TestCase (do s <- readProcessWithExitCode "Tests/Test1.hs" [] ""
assertEqual "String" (ExitFailure 123, "", "This is an error message.\n") s)
-}
, TestLabel "pnmfile" $
TestCase (do out <- L.readFile "Tests/penguin.jpg" >>=
readCreateProcess (proc "djpeg" []) >>=
readCreateProcess (proc "pnmfile" [])
assertEqual "pnmfile" (lazyFromString "stdin:\tPPM raw, 96 by 96 maxval 255\n") out)
, TestLabel "pnmfile2" $
TestCase (do jpg <- L.readFile "Tests/penguin.jpg"
(code1, pnm, err1) <- readCreateProcessWithExitCode (proc "djpeg" []) jpg
out2 <- readCreateProcess (proc "pnmfile" []) pnm
assertEqual "pnmfile2" (ExitSuccess, empty, 2192, 27661, lazyFromString "stdin:\tPPM raw, 96 by 96 maxval 255\n") (code1, err1, length jpg, length pnm, out2))
, TestLabel "file closed 1" $
TestCase (do result <- readCreateProcessWithExitCode (proc "Tests/Test4.hs" []) (lazyFromString "a" :: L.ByteString)
assertEqual "file closed 1" (ExitSuccess, (lazyFromString "a"), (lazyFromString "Read one character: 'a'\n")) result)
, TestLabel "file closed 2" $
TestCase (do result <- readCreateProcessWithExitCode (proc "Tests/Test4.hs" []) (lazyFromString "" :: L.ByteString)
assertEqual "file closed 2" (ExitFailure 1, empty, (lazyFromString "Test4.hs: <stdin>: hGetChar: end of file\n")) result)
, TestLabel "file closed 3" $
TestCase (do result <- readCreateProcessWithExitCode (proc "Tests/Test4.hs" []) ("abcde" :: LT.Text)
assertEqual "file closed 3" (ExitSuccess, "a", "Read one character: 'a'\n") result)
, TestLabel "file closed 4" $
TestCase (do result <- readCreateProcessWithExitCode (proc "Tests/Test4.hs" []) ("abcde" :: LT.Text)
assertEqual "file closed 4" (ExitSuccess, "a", "Read one character: 'a'\n") result)
])