1{-# LANGUAGE Arrows, CPP #-}
2module Examples.Cabal where
3
4import Options.Applicative
5import Options.Applicative.Arrows
6
7import Data.Monoid
8
9#if __GLASGOW_HASKELL__ <= 702
10(<>) :: Monoid a => a -> a -> a
11(<>) = mappend
12#endif
13
14data Args = Args CommonOpts Command
15  deriving Show
16
17data CommonOpts = CommonOpts
18  { optVerbosity :: Int }
19  deriving Show
20
21data Command
22  = Install ConfigureOpts InstallOpts
23  | Update
24  | Configure ConfigureOpts
25  | Build BuildOpts
26  deriving Show
27
28data InstallOpts = InstallOpts
29  { instReinstall :: Bool
30  , instForce :: Bool }
31  deriving Show
32
33data ConfigureOpts = ConfigureOpts
34  { configTests :: Bool
35  , configFlags :: [String] }
36  deriving Show
37
38data BuildOpts = BuildOpts
39  { buildDir :: FilePath }
40  deriving Show
41
42version :: Parser (a -> a)
43version = infoOption "0.0.0"
44  (  long "version"
45  <> help "Print version information" )
46
47parser :: Parser Args
48parser = runA $ proc () -> do
49  opts <- asA commonOpts -< ()
50  cmds <- (asA . hsubparser)
51            ( command "install"
52              (info installParser
53                    (progDesc "Installs a list of packages"))
54           <> command "update"
55              (info updateParser
56                    (progDesc "Updates list of known packages"))
57           <> command "configure"
58              (info configureParser
59                    (progDesc "Prepare to build the package"))
60           <> command "build"
61              (info buildParser
62                    (progDesc "Make this package ready for installation")) ) -< ()
63  A version >>> A helper -< Args opts cmds
64
65commonOpts :: Parser CommonOpts
66commonOpts = CommonOpts
67  <$> option auto
68      ( short 'v'
69     <> long "verbose"
70     <> metavar "LEVEL"
71     <> help "Set verbosity to LEVEL"
72     <> value 0 )
73
74installParser :: Parser Command
75installParser = runA $ proc () -> do
76  config <- asA configureOpts -< ()
77  inst <- asA installOpts -< ()
78  returnA -< Install config inst
79
80installOpts :: Parser InstallOpts
81installOpts = runA $ proc () -> do
82  reinst <- asA (switch (long "reinstall")) -< ()
83  force <- asA (switch (long "force-reinstall")) -< ()
84  returnA -< InstallOpts
85             { instReinstall = reinst
86             , instForce = force }
87
88updateParser :: Parser Command
89updateParser = pure Update
90
91configureParser :: Parser Command
92configureParser = runA $ proc () -> do
93  config <- asA configureOpts -< ()
94  returnA -< Configure config
95
96configureOpts :: Parser ConfigureOpts
97configureOpts = runA $ proc () -> do
98  tests <- (asA . switch)
99             ( long "enable-tests"
100            <> help "Enable compilation of test suites" ) -< ()
101  flags <- (asA . many . strOption)
102             ( short 'f'
103            <> long "flags"
104            <> metavar "FLAGS"
105            <> help "Enable the given flag" ) -< ()
106  returnA -< ConfigureOpts tests flags
107
108buildParser :: Parser Command
109buildParser = runA $ proc () -> do
110  opts <- asA buildOpts -< ()
111  returnA -< Build opts
112
113buildOpts :: Parser BuildOpts
114buildOpts = runA $ proc () -> do
115  bdir <- (asA . strOption)
116            ( long "builddir"
117           <> metavar "DIR"
118           <> value "dist" ) -< ()
119  returnA -< BuildOpts bdir
120
121pinfo :: ParserInfo Args
122pinfo = info parser
123  ( progDesc "An example modelled on cabal" )
124
125main :: IO ()
126main = do
127  r <- customExecParser (prefs helpShowGlobals) pinfo
128  print r
129