1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-}
import Data.Data (Data, Typeable)
import FileLocation
import Control.Exception.Base (SomeException, Exception(..))
import Prelude hiding (catch)
import Control.Exception.Lifted (catch)
import Control.Monad (unless)
import System.Environment (getArgs)
import System.Process (readProcessWithExitCode)
data AException = AException String
deriving (Show, Typeable)
instance Exception AException
main = do
args <- getArgs
case args of
[] -> do
(_, stdout, stderr) <- readProcessWithExitCode "dist/build/test/test" ["foo"] ""
shelltest <- readFile "test/file-location.shelltest"
let (stdout', stderr') = parseShellTest shelltest
unless (unlines (lines stdout) == stdout') $ do
putStrLn "Invalid stdout:"
putStr stdout
error "Failure"
unless (unlines (lines stderr) == stderr') $ do
putStrLn "Invalid stderr:"
putStr stderr
error "Failure"
putStrLn "Success"
_ -> main2
parseShellTest :: String -> (String, String)
parseShellTest orig =
(unlines stdout, unlines stderr)
where
ls1 = lines orig
ls2 = drop 1 $ dropWhile (/= ">>>") ls1
(stdout, ls3) = break (== ">>>2") ls2
stderr = takeWhile (/= ">>>= 1") $ drop 1 ls3
main2 :: IO ()
main2 = do
let _ = debugMsgIf "Not Visble" id False
let x = debugMsgIf "debugMsgIf" (\xs -> head xs == 1) [1,2,3]
putStrLn . show $ $(dbgMsg "Msg TH") $ debugMsg "Msg plain" $ $(dbg) $ debug $ $(trc "trc") x
ltraceM "traceM" x
debugM x
($thrwIO AException) `catch` \e -> putStrLn ("Caught " ++ show (e :: AException))
($(thrwsIO "doh!") AException) `catch` \e -> putStrLn ("Caught " ++ show (e :: AException))
($fromJst Nothing) `catch` \e -> putStrLn ("Caught " ++ show (e :: SomeException))
($fromRht (Left "Lefty")) `catch` \e -> putStrLn ("Caught " ++ show (e :: SomeException))
$undef `catch` \e -> putStrLn ("Caught " ++ show (e :: SomeException))
$reThrow (error "foo") `catch` \e -> print ("Rethrow", e :: SomeException)
$(err "Oh no!")
|
