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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
import Options.Applicative.Simple hiding(action)
import GHC.IO.Handle
import System.IO
import System.Environment
import Control.Exception
import Control.Monad
import System.Directory
import System.Exit
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Monoid ((<>))
shouldBe :: (Show a, Eq a) => a -> a -> IO ()
shouldBe actual expected
| expected == actual = return ()
| otherwise = do
putStrLn $ "expected: " ++ show expected
putStrLn $ "actual : " ++ show actual
exitFailure
catchReturn :: Exception e => IO e -> IO e
catchReturn io = io `catch` return
catchExitCode :: IO () -> IO ExitCode
catchExitCode action = catchReturn $ do
action
return ExitSuccess
data FakeHandles = FakeHandles
{ fakeIn :: Handle
, fakeOut :: Handle
, fakeErr :: Handle
, realIn :: Handle
, realOut :: Handle
, realErr :: Handle
}
openFile' :: FilePath -> IO Handle
openFile' path = do
removeIfExists path
openFile path ReadWriteMode
removeIfExists :: FilePath -> IO ()
removeIfExists path = do
exists <- doesFileExist path
when exists $ do
removeFile path
stdinFile :: FilePath
stdinFile = ".tmp.stdin"
stdoutFile :: FilePath
stdoutFile = ".tmp.stdout"
stderrFile :: FilePath
stderrFile = ".tmp.stderr"
beforeFH :: IO FakeHandles
beforeFH = do
realIn <- hDuplicate stdin
realOut <- hDuplicate stdout
realErr <- hDuplicate stderr
fakeIn <- openFile stdinFile ReadWriteMode
fakeOut <- openFile' stdoutFile
fakeErr <- openFile' stderrFile
hDuplicateTo fakeIn stdin
hDuplicateTo fakeOut stdout
hDuplicateTo fakeErr stderr
return FakeHandles{..}
afterFH :: FakeHandles -> IO ()
afterFH FakeHandles{..} = do
hDuplicateTo realIn stdin
hDuplicateTo realOut stdout
hDuplicateTo realErr stderr
hClose fakeIn
hClose fakeOut
hClose fakeErr
withFakeHandles :: IO a -> IO a
withFakeHandles = bracket beforeFH afterFH . const
withStdIn :: ByteString -> IO ()
-> IO (ByteString, ByteString, ExitCode)
withStdIn inBS action = do
BS.writeFile stdinFile inBS
withFakeHandles $ do
_ <- catchExitCode action
hFlush stdout
hFlush stderr
out <- BS.readFile stdoutFile
err <- BS.readFile stderrFile
removeIfExists stdinFile
removeIfExists stdoutFile
removeIfExists stderrFile
return (out, err, ExitSuccess)
main :: IO ()
main = do
(out, err, exitCode) <- withStdIn ""
$ withArgs ["--version"]
$ simpleProg
exitCode `shouldBe` ExitSuccess
err `shouldBe` ""
out `shouldBe` "version\n"
(out', err', exitCode') <- withStdIn ""
$ withArgs ["--summary"]
$ summaryProg
exitCode' `shouldBe` ExitSuccess
err' `shouldBe` ""
out' `shouldBe` "A program summary\n"
return ()
simpleProg :: IO ()
simpleProg = do
((), ()) <- simpleOptions "version" "header" "desc" (pure ()) empty
return ()
parserWithSummary :: Parser ()
parserWithSummary = summaryOption <*> pure () where
summaryOption = infoOption "A program summary"
$ long "summary"
<> help "Show program summary"
summaryProg :: IO ()
summaryProg = do
((), ()) <- simpleOptions "version" "header" "desc" parserWithSummary empty
return ()
|
