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
|
{-# LANGUAGE Arrows, CPP #-}
module Examples.Cabal where
import Options.Applicative
import Options.Applicative.Arrows
import Data.Monoid
#if __GLASGOW_HASKELL__ <= 702
(<>) :: Monoid a => a -> a -> a
(<>) = mappend
#endif
data Args = Args CommonOpts Command
deriving Show
data CommonOpts = CommonOpts
{ optVerbosity :: Int }
deriving Show
data Command
= Install ConfigureOpts InstallOpts
| Update
| Configure ConfigureOpts
| Build BuildOpts
deriving Show
data InstallOpts = InstallOpts
{ instReinstall :: Bool
, instForce :: Bool }
deriving Show
data ConfigureOpts = ConfigureOpts
{ configTests :: Bool
, configFlags :: [String] }
deriving Show
data BuildOpts = BuildOpts
{ buildDir :: FilePath }
deriving Show
parser :: Parser Args
parser = runA $ proc () -> do
opts <- asA commonOpts -< ()
cmds <- (asA . hsubparser)
( command "install"
(info installParser
(progDesc "Installs a list of packages"))
<> command "update"
(info updateParser
(progDesc "Updates list of known packages"))
<> command "configure"
(info configureParser
(progDesc "Prepare to build the package"))
<> command "build"
(info buildParser
(progDesc "Make this package ready for installation")) ) -< ()
A (simpleVersioner "0.0.0") >>> A helper -< Args opts cmds
commonOpts :: Parser CommonOpts
commonOpts = CommonOpts
<$> option auto
( short 'v'
<> long "verbose"
<> metavar "LEVEL"
<> help "Set verbosity to LEVEL"
<> value 0 )
installParser :: Parser Command
installParser = runA $ proc () -> do
config <- asA configureOpts -< ()
inst <- asA installOpts -< ()
returnA -< Install config inst
installOpts :: Parser InstallOpts
installOpts = runA $ proc () -> do
reinst <- asA (switch (long "reinstall")) -< ()
force <- asA (switch (long "force-reinstall")) -< ()
returnA -< InstallOpts
{ instReinstall = reinst
, instForce = force }
updateParser :: Parser Command
updateParser = pure Update
configureParser :: Parser Command
configureParser = runA $ proc () -> do
config <- asA configureOpts -< ()
returnA -< Configure config
configureOpts :: Parser ConfigureOpts
configureOpts = runA $ proc () -> do
tests <- (asA . switch)
( long "enable-tests"
<> help "Enable compilation of test suites" ) -< ()
flags <- (asA . many . strOption)
( short 'f'
<> long "flags"
<> metavar "FLAGS"
<> help "Enable the given flag" ) -< ()
returnA -< ConfigureOpts tests flags
buildParser :: Parser Command
buildParser = runA $ proc () -> do
opts <- asA buildOpts -< ()
returnA -< Build opts
buildOpts :: Parser BuildOpts
buildOpts = runA $ proc () -> do
bdir <- (asA . strOption)
( long "builddir"
<> metavar "DIR"
<> value "dist" ) -< ()
returnA -< BuildOpts bdir
pinfo :: ParserInfo Args
pinfo = info parser
( progDesc "An example modelled on cabal" )
main :: IO ()
main = do
r <- customExecParser (prefs helpShowGlobals) pinfo
print r
|
