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