{-# LANGUAGE DataKinds #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.LambdaOptions.Example.Example_6_SubOptions (
main,
) where
import Data.Proxy ( Proxy(Proxy) )
import qualified System.Environment as Env
import qualified Text.LambdaOptions as L
data SourceControlOption
= Help
| CloneHelp
| CloneRepository String String
| CloneBinary
deriving (Show)
data TopOption
= Option SourceControlOption
| DelegateClone [String]
topOptions :: L.Options TopOption
topOptions = do
L.addOption
(L.kw "help"
`L.text` "Display this help text.")
$ Option Help
L.addOption
(L.kw "help"
`L.argText` "clone"
`L.text` "Display help text for the 'clone' options.")
$ \(Proxy :: Proxy "clone") -> Option CloneHelp
L.addOption
(L.kw "clone"
`L.argText` "ARGS+"
`L.text` "See 'help clone' for more details.")
$ \(L.List subArgs) -> DelegateClone subArgs
cloneOptions :: L.Options SourceControlOption
cloneOptions = do
L.addOption
(L.kw ()
`L.argText` "REPO DIR?"
`L.text` "Clones REPO into DIR.")
$ \repo mDir -> CloneRepository repo $ maybe "." id mDir
L.addOption
(L.kw "--binary"
`L.text` "Optimize clone for repos with large binary data.")
$ CloneBinary
parseTopOptions :: [String] -> Either String [SourceControlOption]
parseTopOptions args = case L.runOptions topOptions args of
Left e -> Left $ unlines
[ L.prettyOptionsError e
, L.getHelpDescription topOptions
]
Right options -> case options of
[option] -> case option of
DelegateClone args' -> parseCloneOptions args'
Option opt -> Right [opt]
_ -> Right [Help]
parseCloneOptions :: [String] -> Either String [SourceControlOption]
parseCloneOptions subArgs = case L.runOptions cloneOptions subArgs of
Left e -> Left $ unlines
[ L.prettyOptionsError e
{ L.parseFailedArgs = "clone" : subArgs
, L.parseFailedBeginArgsIndex = 1 + L.parseFailedBeginArgsIndex e
, L.parseFailedEndArgsIndex = 1 + L.parseFailedEndArgsIndex e
}
, L.getHelpDescription cloneOptions
]
Right options -> Right $ case options of
[] -> [CloneHelp]
_ -> options
main :: IO ()
main = do
args <- Env.getArgs
case parseTopOptions args of
Left errorMessage -> putStrLn errorMessage
Right commands -> flip mapM_ commands $ \command ->
case command of
Help -> putStrLn $ L.getHelpDescription topOptions
CloneHelp -> putStrLn $ L.getHelpDescription cloneOptions
_ -> putStrLn $ "Executing " ++ show command