Skip to content

Commit d0d76aa

Browse files
soupisoupi
committed
Chapter 5.4 - Options parsing
1 parent 8ca58ae commit d0d76aa

File tree

4 files changed

+203
-44
lines changed

4 files changed

+203
-44
lines changed

‎app/Main.hs‎

Lines changed: 53 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,60 @@
11
-- app/Main.hs
22

3+
-- | Entry point for the hs-blog-gen program
4+
35
module Main where
46

57
import qualified HsBlog
8+
import OptParse
9+
10+
import System.Exit (exitFailure)
11+
import System.Directory (doesFileExist)
12+
import System.IO
613

714
main :: IO ()
8-
main = HsBlog.main
15+
main = do
16+
options <- parse
17+
case options of
18+
ConvertDir input output ->
19+
HsBlog.convertDirectory input output
20+
21+
ConvertSingle input output -> do
22+
(title, inputHandle) <-
23+
case input of
24+
Stdin ->
25+
pure ("", stdin)
26+
InputFile file ->
27+
(,) file <$> openFile file ReadMode
28+
29+
outputHandle <-
30+
case output of
31+
Stdout -> pure stdout
32+
OutputFile file -> do
33+
exists <- doesFileExist file
34+
shouldOpenFile <-
35+
if exists
36+
then confirm
37+
else pure True
38+
if shouldOpenFile
39+
then
40+
openFile file WriteMode
41+
else
42+
exitFailure
43+
44+
HsBlog.convertSingle title inputHandle outputHandle
45+
hClose inputHandle
46+
hClose outputHandle
47+
48+
------------------------------------------------
49+
-- * Utilities
50+
51+
-- | Confirm user action
52+
confirm :: IO Bool
53+
confirm =
54+
putStrLn "Are you sure? (y/n)" *>
55+
getLine >>= \answer ->
56+
case answer of
57+
"y" -> pure True
58+
"n" -> pure False
59+
_ -> putStrLn "Invalid response. use y or n" *>
60+
confirm

‎app/OptParse.hs‎

Lines changed: 137 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,137 @@
1+
-- app/OptParse.hs
2+
3+
-- | Command-line options parsing
4+
5+
module OptParse
6+
( Options(..)
7+
, SingleInput(..)
8+
, SingleOutput(..)
9+
, parse
10+
)
11+
where
12+
13+
import Data.Maybe (fromMaybe)
14+
import Options.Applicative
15+
16+
------------------------------------------------
17+
-- * Our command-line options model
18+
19+
-- | Model
20+
data Options
21+
= ConvertSingle SingleInput SingleOutput
22+
| ConvertDir FilePath FilePath
23+
deriving Show
24+
25+
-- | A single input source
26+
data SingleInput
27+
= Stdin
28+
| InputFile FilePath
29+
deriving Show
30+
31+
-- | A single output sink
32+
data SingleOutput
33+
= Stdout
34+
| OutputFile FilePath
35+
deriving Show
36+
37+
------------------------------------------------
38+
-- * Parser
39+
40+
-- | Parse command-line options
41+
parse :: IO Options
42+
parse = execParser opts
43+
44+
opts :: ParserInfo Options
45+
opts =
46+
info (pOptions <**> helper)
47+
( fullDesc
48+
<> header "hs-blog-gen - a static blog generator"
49+
<> progDesc "Convert markup files or directories to html"
50+
)
51+
52+
-- | Parser for all options
53+
pOptions :: Parser Options
54+
pOptions =
55+
subparser
56+
( command
57+
"convert"
58+
( info
59+
(helper <*> pConvertSingle)
60+
(progDesc "Convert a single markup source to html")
61+
)
62+
<> command
63+
"convert-dir"
64+
( info
65+
(helper <*> pConvertDir)
66+
(progDesc "Convert a directory of markup files to html")
67+
)
68+
)
69+
70+
------------------------------------------------
71+
-- * Single source to sink conversion parser
72+
73+
-- | Parser for single source to sink option
74+
pConvertSingle :: Parser Options
75+
pConvertSingle =
76+
ConvertSingle <$> pSingleInput <*> pSingleOutput
77+
78+
-- | Parser for single input source
79+
pSingleInput :: Parser SingleInput
80+
pSingleInput =
81+
fromMaybe Stdin <$> optional pInputFile
82+
83+
-- | Parser for single output sink
84+
pSingleOutput :: Parser SingleOutput
85+
pSingleOutput =
86+
fromMaybe Stdout <$> optional pOutputFile
87+
88+
-- | Input file parser
89+
pInputFile :: Parser SingleInput
90+
pInputFile = fmap InputFile parser
91+
where
92+
parser =
93+
strOption
94+
( long "input"
95+
<> short 'i'
96+
<> metavar "FILE"
97+
<> help "Input file"
98+
)
99+
100+
-- | Output file parser
101+
pOutputFile :: Parser SingleOutput
102+
pOutputFile = OutputFile <$> parser
103+
where
104+
parser =
105+
strOption
106+
( long "output"
107+
<> short 'o'
108+
<> metavar "FILE"
109+
<> help "Output file"
110+
)
111+
112+
------------------------------------------------
113+
-- * Directory conversion parser
114+
115+
pConvertDir :: Parser Options
116+
pConvertDir =
117+
ConvertDir <$> pInputDir <*> pOutputDir
118+
119+
-- | Parser for input directory
120+
pInputDir :: Parser FilePath
121+
pInputDir =
122+
strOption
123+
( long "input"
124+
<> short 'i'
125+
<> metavar "DIRECTORY"
126+
<> help "Input directory"
127+
)
128+
129+
-- | Parser for output directory
130+
pOutputDir :: Parser FilePath
131+
pOutputDir =
132+
strOption
133+
( long "output"
134+
<> short 'o'
135+
<> metavar "DIRECTORY"
136+
<> help "Output directory"
137+
)

‎hs-blog.cabal‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,6 @@ library
3131
hs-source-dirs: src
3232
build-depends:
3333
base
34-
, directory
3534
exposed-modules:
3635
HsBlog
3736
HsBlog.Convert
@@ -44,8 +43,12 @@ executable hs-blog-gen
4443
import: common-settings
4544
hs-source-dirs: app
4645
main-is: Main.hs
46+
other-modules:
47+
OptParse
4748
build-depends:
4849
base
50+
, directory
51+
, optparse-applicative
4952
, hs-blog
5053
ghc-options:
5154
-O

‎src/HsBlog.hs‎

Lines changed: 9 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,8 @@
11
-- src/HsBlog.hs
22

33
module HsBlog
4-
( main
4+
( convertSingle
5+
, convertDirectory
56
, process
67
)
78
where
@@ -10,49 +11,15 @@ import qualified HsBlog.Markup as Markup
1011
import qualified HsBlog.Html as Html
1112
import HsBlog.Convert (convert)
1213

13-
import System.Directory (doesFileExist)
14-
import System.Environment (getArgs)
14+
import System.IO
1515

16-
main :: IO ()
17-
main = do
18-
args <- getArgs
19-
case args of
20-
-- No program arguments: reading from stdin and writing to stdout
21-
[] -> do
22-
content <- getContents
23-
putStrLn (process "Empty title" content)
16+
convertSingle :: Html.Title -> Handle -> Handle -> IO ()
17+
convertSingle title input output = do
18+
content <- hGetContents input
19+
hPutStrLn output (process title content)
2420

25-
-- With input and output file paths as program arguments
26-
[input, output] -> do
27-
content <- readFile input
28-
exists <- doesFileExist output
29-
let
30-
writeResult = writeFile output (process input content)
31-
if exists
32-
then whenIO confirm writeResult
33-
else writeResult
34-
35-
-- Any other kind of program arguments
36-
_ ->
37-
putStrLn "Usage: runghc Main.hs [-- <input-file> <output-file>]"
21+
convertDirectory :: FilePath -> FilePath -> IO ()
22+
convertDirectory = error "Not implemented"
3823

3924
process :: Html.Title -> String -> String
4025
process title = Html.render . convert title . Markup.parse
41-
42-
confirm :: IO Bool
43-
confirm = do
44-
putStrLn "Are you sure? (y/n)"
45-
answer <- getLine
46-
case answer of
47-
"y" -> pure True
48-
"n" -> pure False
49-
_ -> do
50-
putStrLn "Invalid response. use y or n"
51-
confirm
52-
53-
whenIO :: IO Bool -> IO () -> IO ()
54-
whenIO cond action = do
55-
result <- cond
56-
if result
57-
then action
58-
else pure ()

0 commit comments

Comments
 (0)