getopt-generics-0.13.0.3/docs/0000755000000000000000000000000012620534250014150 5ustar0000000000000000getopt-generics-0.13.0.3/src/0000755000000000000000000000000012700143112013777 5ustar0000000000000000getopt-generics-0.13.0.3/src/WithCli/0000755000000000000000000000000013253514110015346 5ustar0000000000000000getopt-generics-0.13.0.3/src/WithCli/Modifier/0000755000000000000000000000000012620533370017112 5ustar0000000000000000getopt-generics-0.13.0.3/src/WithCli/Pure/0000755000000000000000000000000012620533370016267 5ustar0000000000000000getopt-generics-0.13.0.3/test/0000755000000000000000000000000012726547313014212 5ustar0000000000000000getopt-generics-0.13.0.3/test/ModifiersSpec/0000755000000000000000000000000012620413255016734 5ustar0000000000000000getopt-generics-0.13.0.3/test/WithCli/0000755000000000000000000000000013253400315015537 5ustar0000000000000000getopt-generics-0.13.0.3/test/WithCli/Pure/0000755000000000000000000000000012620413255016456 5ustar0000000000000000getopt-generics-0.13.0.3/src/WithCli.hs0000644000000000000000000000653212755323645015731 0ustar0000000000000000{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} module WithCli ( withCli, WithCli(), HasArguments(argumentsParser), atomicArgumentsParser, Argument(argumentType, parseArgument), -- * Modifiers withCliModified, Modifier(..), -- * Useful Re-exports GHC.Generic, Typeable, Proxy(..), ) where import Data.Proxy import Data.Typeable import qualified GHC.Generics as GHC import System.Environment import WithCli.Argument import WithCli.HasArguments import WithCli.Modifier import WithCli.Parser import qualified WithCli.Pure.Internal import WithCli.Result -- | 'withCli' converts an IO operation into a program with a proper CLI. -- Retrieves command line arguments through 'withArgs'. -- @main@ (the given IO operation) can have arbitrarily many parameters -- provided all parameters have instances for 'HasArguments'. -- -- May throw the following exceptions: -- -- - @'ExitFailure' 1@ in case of invalid options. Error messages are written -- to @stderr@. -- - @'ExitSuccess'@ in case @--help@ is given. (@'ExitSuccess'@ behaves like -- a normal exception, except that -- if uncaught -- the process will exit -- with exit-code @0@.) Help output is written to @stdout@. -- -- Example: -- ### Start "docs/Simple.hs" "module Simple where\n\n" Haddock ### -- | -- > import WithCli -- > -- > main :: IO () -- > main = withCli run -- > -- > run :: String -> Int -> Bool -> IO () -- > run s i b = print (s, i, b) -- ### End ### -- | Using the above program in a shell: -- ### Start "docs/Simple.shell-protocol" "" Haddock ### -- | -- > $ program foo 42 true -- > ("foo",42,True) -- > $ program --help -- > program [OPTIONS] STRING INTEGER BOOL -- > -h --help show help and exit -- > $ program foo 42 bar -- > cannot parse as BOOL: bar -- > # exit-code 1 -- > $ program -- > missing argument of type STRING -- > missing argument of type INTEGER -- > missing argument of type BOOL -- > # exit-code 1 -- > $ program foo 42 yes bar -- > unknown argument: bar -- > # exit-code 1 -- ### End ### withCli :: WithCli main => main -> IO () withCli = withCliModified [] -- | This is a variant of 'withCli' that allows to tweak the generated -- command line interface by providing a list of 'Modifier's. withCliModified :: WithCli main => [Modifier] -> main -> IO () withCliModified mods main = do args <- getArgs modifiers <- handleResult (mkModifiers mods) run modifiers (return $ emptyParser ()) (\ () -> main) args -- | Everything that can be used as a @main@ function with 'withCli' needs to -- have an instance of 'WithCli'. You shouldn't need to implement your own -- instances. class WithCli main where run :: Modifiers -> Result (Parser Unnormalized a) -> (a -> main) -> [String] -> IO () instance WithCli (IO ()) where run modifiers mkParser mkMain args = do progName <- getProgName let result = WithCli.Pure.Internal.run progName modifiers mkParser mkMain args action <- handleResult result action instance (HasArguments a, WithCli rest) => WithCli (a -> rest) where run modifiers fa mkMain args = run modifiers (combine fa (argumentsParser modifiers Nothing)) (\ (a, r) -> mkMain a r) args getopt-generics-0.13.0.3/src/WithCli/Pure.hs0000644000000000000000000000232512620414125016621 0ustar0000000000000000 module WithCli.Pure ( withCliPure, WithCliPure(), Result(..), handleResult, HasArguments(argumentsParser), atomicArgumentsParser, Argument(argumentType, parseArgument), -- * Modifiers Modifier(..), -- * Useful Re-exports GHC.Generic, Typeable, Proxy(..), ) where import Data.Proxy import Data.Typeable import GHC.Generics as GHC import WithCli.Argument import WithCli.HasArguments import WithCli.Modifier import WithCli.Parser import WithCli.Pure.Internal import WithCli.Result -- | Pure variant of 'WithCli.withCliModified'. withCliPure :: WithCliPure function a => String -> [Modifier] -> [String] -> function -- ^ The @function@ parameter can be a -- function with arbitrary many parameters as long as they have an instance -- for 'HasArguments'. You can choose the return type of @function@ freely, -- 'withCliPure' will return it wrapped in 'Result' to account for parse -- errors, etc. (see 'Result'). -> Result a withCliPure progName modifiers args function = sanitize $ do modifiers <- mkModifiers modifiers run progName modifiers (return $ emptyParser ()) (\ () -> function) args getopt-generics-0.13.0.3/src/WithCli/Argument.hs0000644000000000000000000000461412755326065017511 0ustar0000000000000000{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-deprecated-flags #-} module WithCli.Argument where import Data.Orphans () import Prelude () import Prelude.Compat import Data.List import Data.Proxy import Text.Read -- | 'Argument' is a typeclass for things that can be parsed as atomic values from -- single command line arguments, e.g. strings (and filenames) and numbers. -- -- Occasionally you might want to declare your own instance for additional -- type safety and for providing a more informative command argument type. -- Here's an example: -- ### Start "docs/CustomOption.hs" "module CustomOption where\n\n" Haddock ### -- | -- > {-# LANGUAGE DeriveDataTypeable #-} -- > -- > import WithCli -- > -- > data File = File FilePath -- > deriving (Show, Typeable) -- > -- > instance Argument File where -- > argumentType Proxy = "custom-file-type" -- > parseArgument f = Just (File f) -- > -- > instance HasArguments File where -- > argumentsParser = atomicArgumentsParser -- > -- > main :: IO () -- > main = withCli run -- > -- > run :: File -> IO () -- > run = print -- ### End ### -- | And this is how the above program behaves: -- ### Start "docs/CustomOption.shell-protocol" "" Haddock ### -- | -- > $ program --help -- > program [OPTIONS] custom-file-type -- > -h --help show help and exit -- > $ program some/file -- > File "some/file" -- ### End ### class Argument a where argumentType :: Proxy a -> String parseArgument :: String -> Maybe a instance Argument String where argumentType Proxy = "STRING" parseArgument = Just instance Argument Int where argumentType _ = "INTEGER" parseArgument = readMaybe instance Argument Integer where argumentType _ = "INTEGER" parseArgument = readMaybe instance Argument Float where argumentType _ = "NUMBER" parseArgument = readFloat instance Argument Double where argumentType _ = "NUMBER" parseArgument = readFloat readFloat :: (RealFloat n, Read n) => String -> Maybe n readFloat s = case readMaybe s of Just n -> Just n Nothing | "." `isPrefixOf` s -> readMaybe ("0" ++ s) | otherwise -> Nothing getopt-generics-0.13.0.3/src/WithCli/Flag.hs0000644000000000000000000000327713253514110016564 0ustar0000000000000000{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE ViewPatterns #-} module WithCli.Flag where import Prelude () import Prelude.Compat import Data.List import Data.Maybe import System.Console.GetOpt data Flag a = Help | Version String | NoHelp a deriving (Functor) flagConcat :: Monoid a => [Flag a] -> Flag a flagConcat = foldl' flagAppend (NoHelp mempty) where flagAppend :: Monoid a => Flag a -> Flag a -> Flag a flagAppend a b = case (a, b) of (Help, _) -> Help (_, Help) -> Help (Version s, _) -> Version s (_, Version s) -> Version s (NoHelp a, NoHelp b) -> NoHelp (mappend a b) foldFlags :: [Flag a] -> Flag [a] foldFlags flags = flagConcat $ map (fmap pure) flags helpOption :: OptDescr (Flag a) helpOption = Option ['h'] ["help"] (NoArg Help) "show help and exit" versionOption :: String -> OptDescr (Flag a) versionOption version = Option ['v'] ["version"] (NoArg (Version version)) "show version and exit" usage :: String -> [(Bool, String)] -> [OptDescr ()] -> String usage progName fields options = usageInfo header options where header :: String header = unwords $ progName : "[OPTIONS]" : fromMaybe [] (formatFields fields) ++ [] formatFields :: [(Bool, String)] -> Maybe [String] formatFields [] = Nothing formatFields fields = Just $ let (map snd -> nonOptional, map snd -> optional) = span (not . fst) fields in nonOptional ++ [formatOptional optional] formatOptional :: [String] -> String formatOptional [] = "" formatOptional [a] = "[" ++ a ++ "]" formatOptional (a : r) = "[" ++ a ++ " " ++ formatOptional r ++ "]" getopt-generics-0.13.0.3/src/WithCli/HasArguments.hs0000644000000000000000000002517512755323645020336 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-deprecated-flags #-} module WithCli.HasArguments where import Data.Orphans () import Prelude () import Prelude.Compat import Data.Char import Data.List.Compat import Data.Proxy import Data.Traversable import qualified GHC.Generics as GHC import Generics.SOP as SOP import Generics.SOP.GGP as SOP import System.Console.GetOpt import Text.Read import WithCli.Argument import WithCli.Modifier import WithCli.Normalize import WithCli.Parser import WithCli.Result parseArgumentResult :: forall a . Argument a => Maybe String -> String -> Result a parseArgumentResult mMsg s = case parseArgument s of Just x -> return x Nothing -> parseError (argumentType (Proxy :: Proxy a)) mMsg s parseError :: String -> Maybe String -> String -> Result a parseError typ mMsg s = Errors $ "cannot parse as " ++ typ ++ maybe "" (\ msg -> " (" ++ msg ++ ")") mMsg ++ ": " ++ s -- | Everything that can be used as an argument to your @main@ function -- (see 'withCli') needs to have a 'HasArguments' instance. -- -- 'HasArguments' also allows to conjure up instances for record types -- to create more complex command line interfaces. Here's an example: -- ### Start "docs/RecordType.hs" "module RecordType where\n\n" Haddock ### -- | -- > {-# LANGUAGE DeriveAnyClass #-} -- > {-# LANGUAGE DeriveGeneric #-} -- > -- > import WithCli -- > -- > data Options -- > = Options { -- > port :: Int, -- > daemonize :: Bool, -- > config :: Maybe FilePath -- > } -- > deriving (Show, Generic, HasArguments) -- > -- > main :: IO () -- > main = withCli run -- > -- > run :: Options -> IO () -- > run = print -- ### End ### -- | In a shell this program behaves like this: -- ### Start "docs/RecordType.shell-protocol" "" Haddock ### -- | -- > $ program --port 8080 --config some/path -- > Options {port = 8080, daemonize = False, config = Just "some/path"} -- > $ program --port 8080 --daemonize -- > Options {port = 8080, daemonize = True, config = Nothing} -- > $ program --port foo -- > cannot parse as INTEGER: foo -- > # exit-code 1 -- > $ program -- > missing option: --port=INTEGER -- > # exit-code 1 -- > $ program --help -- > program [OPTIONS] -- > --port=INTEGER -- > --daemonize -- > --config=STRING (optional) -- > -h --help show help and exit -- ### End ### class HasArguments a where argumentsParser :: Modifiers -> Maybe String -> Result (Parser Unnormalized a) default argumentsParser :: (GHC.Generic a, GTo a, SOP.GDatatypeInfo a, All2 HasArguments (GCode a)) => Modifiers -> Maybe String -> Result (Parser Unnormalized a) argumentsParser = const . genericParser -- * atomic HasArguments instance HasArguments Int where argumentsParser = atomicArgumentsParser instance HasArguments Bool where argumentsParser = wrapForPositionalArguments "Bool" (const boolParser) instance HasArguments String where argumentsParser = atomicArgumentsParser instance HasArguments Float where argumentsParser = atomicArgumentsParser instance HasArguments Double where argumentsParser = atomicArgumentsParser instance (HasArguments a, HasArguments b) => HasArguments (a, b) instance (HasArguments a, HasArguments b, HasArguments c) => HasArguments (a, b, c) wrapForPositionalArguments :: String -> (Modifiers -> Maybe String -> Result a) -> (Modifiers -> Maybe String -> Result a) wrapForPositionalArguments typ wrapped modifiers (Just field) = if isPositionalArgumentsField modifiers field then Errors ("UseForPositionalArguments can only be used for fields of type [String] not " ++ typ) else wrapped modifiers (Just field) wrapForPositionalArguments _ wrapped modifiers Nothing = wrapped modifiers Nothing instance Argument a => HasArguments (Maybe a) where argumentsParser _ = maybeParser instance Argument a => HasArguments [a] where argumentsParser modifiers (Just field) = return $ if isPositionalArgumentsField modifiers field then positionalArgumentsParser else listParser (Just field) argumentsParser _ Nothing = return $ listParser Nothing -- | Useful for implementing your own instances of 'HasArguments' on top -- of a custom 'Argument' instance. atomicArgumentsParser :: forall a . Argument a => Modifiers -> Maybe String -> Result (Parser Unnormalized a) atomicArgumentsParser = wrapForPositionalArguments typ inner where typ = argumentType (Proxy :: Proxy a) inner modifiers mLong = return $ case mLong of Nothing -> withoutLongOption Just long -> withLongOption modifiers long withoutLongOption = Parser { parserDefault = Nothing, parserOptions = [], parserNonOptions = [NonOptionsParser typ False (\ (s : r) -> fmap ((, r) . const . Just) $ parseArgumentResult Nothing s)], parserConvert = \ case Just a -> return a Nothing -> Errors $ "missing argument of type " ++ typ } withLongOption modifiers long = Parser { parserDefault = Left (), parserOptions = pure $ Option [] [long] (fmap (fmap (const . Right)) $ ReqArg (parseArgumentResult Nothing) typ) "", parserNonOptions = [], parserConvert = \ case Right a -> return a Left () -> Errors $ "missing option: --" ++ normalize (applyModifiersLong modifiers long) ++ "=" ++ typ } listParser :: forall a . Argument a => Maybe String -> Parser Unnormalized [a] listParser mLong = case mLong of Nothing -> positionalArgumentsParser Just long -> Parser { parserDefault = [], parserOptions = pure $ Option [] [long] (ReqArg (\ s -> fmap (\ a -> (++ [a])) (parseArgumentResult (Just "multiple possible") s)) (argumentType (Proxy :: Proxy a) ++ " (multiple possible)")) "", parserNonOptions = [], parserConvert = return } positionalArgumentsParser :: forall a . Argument a => Parser Unnormalized [a] positionalArgumentsParser = Parser { parserDefault = [], parserOptions = [], parserNonOptions = [NonOptionsParser (argumentType (Proxy :: Proxy a)) True parse], parserConvert = return } where parse :: [String] -> Result ([a] -> [a], [String]) parse args = do mods <- forM args $ \ arg -> case parseArgument arg of Just a -> return (a :) Nothing -> parseError (argumentType (Proxy :: Proxy a)) Nothing arg return (foldl' (.) id mods, []) maybeParser :: forall a . Argument a => Maybe String -> Result (Parser Unnormalized (Maybe a)) maybeParser mLong = case mLong of Nothing -> return $ Parser { parserDefault = Nothing, parserOptions = [], parserNonOptions = let parse :: [String] -> Result (Maybe a -> Maybe a, [String]) parse (a : r) = do v <- parseArgumentResult (Just "optional") a return (const (Just v), r) parse [] = return (id, []) in [NonOptionsParser (argumentType (Proxy :: Proxy a)) True parse], parserConvert = return } Just long -> return $ Parser { parserDefault = Nothing, parserOptions = pure $ Option [] [long] (ReqArg (\ s -> fmap (\ a -> (const (Just a))) (parseArgumentResult (Just "optional") s)) (argumentType (Proxy :: Proxy a) ++ " (optional)")) "", parserNonOptions = [], parserConvert = return } boolParser :: Maybe String -> Result (Parser Unnormalized Bool) boolParser mLong = return $ case mLong of Nothing -> Parser { parserDefault = Nothing, parserOptions = [], parserNonOptions = pure $ (NonOptionsParser "BOOL" False (\ (s : r) -> (, r) <$> maybe (parseError "BOOL" Nothing s) (return . const . Just) (parseBool s))), parserConvert = \ case Just x -> return x Nothing -> Errors $ "missing argument of type BOOL" } Just long -> Parser { parserDefault = False, parserOptions = pure $ Option [] [long] (NoArg (return (const True))) "", parserNonOptions = [], parserConvert = return } parseBool :: String -> Maybe Bool parseBool s | map toLower s `elem` ["true", "yes", "on"] = Just True | map toLower s `elem` ["false", "no", "off"] = Just False | otherwise = case readMaybe s of Just (n :: Integer) -> Just (n > 0) Nothing -> Nothing -- * generic HasArguments genericParser :: forall a . (GHC.Generic a, GTo a, GDatatypeInfo a, All2 HasArguments (GCode a)) => Modifiers -> Result (Parser Unnormalized a) genericParser modifiers = fmap (fmap gto) $ case gdatatypeInfo (Proxy :: Proxy a) of ADT _ typeName (constructorInfo :* Nil) -> case constructorInfo of (Record _ fields) -> fmap (fmap (SOP . Z)) (fieldsParser modifiers fields) Constructor{} -> fmap (fmap (SOP . Z)) (noSelectorsParser modifiers shape) Infix{} -> err typeName "infix constructors" ADT _ typeName Nil -> err typeName "empty data types" ADT _ typeName (_ :* _ :* _) -> err typeName "sum types" Newtype _ _ (Record _ fields) -> fmap (fmap (SOP . Z)) (fieldsParser modifiers fields) Newtype _ typeName (Constructor _) -> err typeName "constructors without field labels" where err typeName message = Errors $ "getopt-generics doesn't support " ++ message ++ " (" ++ typeName ++ ")." fieldsParser :: All HasArguments xs => Modifiers -> NP FieldInfo xs -> Result (Parser Unnormalized (NP I xs)) fieldsParser modifiers = \ case Nil -> return $ emptyParser Nil FieldInfo fieldName :* rest -> fmap (fmap (\ (a, r) -> a :* r)) $ combine (fmap (fmap I) $ (argumentsParser modifiers (Just fieldName))) (fieldsParser modifiers rest) noSelectorsParser :: All HasArguments xs => Modifiers -> Shape xs -> Result (Parser Unnormalized (NP I xs)) noSelectorsParser modifiers = \ case ShapeNil -> return $ emptyParser Nil ShapeCons rest -> fmap (fmap (\ (a, r) -> a :* r)) $ combine (fmap (fmap I) $ (argumentsParser modifiers Nothing)) (noSelectorsParser modifiers rest) getopt-generics-0.13.0.3/src/WithCli/Modifier.hs0000644000000000000000000001156212620414110017441 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} module WithCli.Modifier ( Modifier(..), Modifiers, mkModifiers, isPositionalArgumentsField, getPositionalArgumentType, getVersion, applyModifiers, applyModifiersLong, -- exported for testing insertWith, ) where import Prelude () import Prelude.Compat import Control.Arrow import Control.Monad import Data.Char import Data.List (foldl') import Data.Maybe import System.Console.GetOpt import WithCli.Modifier.Types import WithCli.Normalize import WithCli.Parser import WithCli.Result -- | 'Modifier's can be used to customize the command line parser. data Modifier = AddShortOption String Char -- ^ @AddShortOption fieldName c@ adds the 'Char' @c@ as a short option for -- the field addressed by @fieldName@. | RenameOption String String -- ^ @RenameOption fieldName customName@ renames the option generated -- through the @fieldName@ by @customName@. | RenameOptions (String -> Maybe String) -- ^ @RenameOptions f@ renames all options with the given functions. In case -- the function returns @Nothing@ the original field name is used. -- -- Can be used together with 'Data.List.stripPrefix'. | UseForPositionalArguments String String -- ^ @UseForPositionalArguments fieldName argumentType@ fills the field -- addressed by @fieldName@ with the positional arguments (i.e. arguments -- that don't correspond to a flag). The field has to have type -- @['String']@. -- -- @argumentType@ is used as the type of the positional arguments in the -- help output. | AddOptionHelp String String -- ^ @AddOptionHelp fieldName helpText@ adds a help text for the option -- @fieldName@. | AddVersionFlag String -- ^ @AddVersionFlag version@ adds a @--version@ flag. mkModifiers :: [Modifier] -> Result Modifiers mkModifiers = foldM inner empty where empty :: Modifiers empty = Modifiers [] id Nothing [] Nothing inner :: Modifiers -> Modifier -> Result Modifiers inner (Modifiers shorts renaming args help version) modifier = case modifier of (AddShortOption option short) -> return $ Modifiers (insertWith (++) option [short] shorts) renaming args help version (RenameOption from to) -> let newRenaming :: String -> String newRenaming option = if from `matches` option then to else option in return $ Modifiers shorts (renaming . newRenaming) args help version (RenameOptions newRenaming) -> return $ Modifiers shorts (renaming `combineRenamings` newRenaming) args help version (UseForPositionalArguments option typ) -> case args of Nothing -> return $ Modifiers shorts renaming (Just (option, map toUpper typ)) help version Just _ -> Errors "UseForPositionalArguments can only be used once" (AddOptionHelp option helpText) -> return $ Modifiers shorts renaming args (insert option helpText help) version (AddVersionFlag v) -> return $ Modifiers shorts renaming args help (Just v) combineRenamings :: (a -> a) -> (a -> Maybe a) -> (a -> a) combineRenamings old new x = old (fromMaybe x (new x)) -- * list utils to replace Data.Map insertWith :: Eq a => (b -> b -> b) -> a -> b -> [(a, b)] -> [(a, b)] insertWith _ key value [] = [(key, value)] insertWith combine key value ((a, b) : r) = if a == key then (key, b `combine` value) : r else (a, b) : insertWith combine key value r insert :: Eq a => a -> b -> [(a, b)] -> [(a, b)] insert key value [] = [(key, value)] insert key value ((a, b) : r) = if a == key then (key, value) : r else (a, b) : insert key value r -- * transforming Parsers applyModifiers :: Modifiers -> Parser Unnormalized a -> Parser Unnormalized a applyModifiers modifiers = addShortOptions >>> renameOptions where addShortOptions = modParserOptions $ map $ \ option -> case filter (\ (needle, _) -> needle `elem` longs option) (shortOptions modifiers) of [] -> option (concat . map snd -> newShorts) -> foldl' (flip addShort) option newShorts renameOptions = modParserOptions $ map $ modLongs $ renaming modifiers applyModifiersLong :: Modifiers -> String -> String applyModifiersLong modifiers long = (renaming modifiers) long longs :: OptDescr a -> [String] longs (Option _ ls _ _) = ls addShort :: Char -> OptDescr a -> OptDescr a addShort short (Option shorts longs argDescrs help) = Option (shorts ++ [short]) longs argDescrs help modLongs :: (String -> String) -> OptDescr a -> OptDescr a modLongs f (Option shorts longs descrs help) = Option shorts (map f longs) descrs help getopt-generics-0.13.0.3/src/WithCli/Modifier/Types.hs0000644000000000000000000000117012620414100020536 0ustar0000000000000000 module WithCli.Modifier.Types where data Modifiers = Modifiers { shortOptions :: [(String, [Char])], renaming :: String -> String, positionalArgumentsField :: Maybe (String, String), _helpTexts :: [(String, String)], version :: Maybe String } getVersion :: Modifiers -> Maybe String getVersion modifiers = version modifiers isPositionalArgumentsField :: Modifiers -> String -> Bool isPositionalArgumentsField modifiers field = maybe False ((field ==) . fst) (positionalArgumentsField modifiers) getPositionalArgumentType :: Modifiers -> Maybe String getPositionalArgumentType = fmap snd . positionalArgumentsField getopt-generics-0.13.0.3/src/WithCli/Normalize.hs0000644000000000000000000000127412601754342017657 0ustar0000000000000000 module WithCli.Normalize ( normalize, matches, ) where import Data.Char matches :: String -> String -> Bool matches a b = normalize a == normalize b normalize :: String -> String normalize s = if all (not . isAllowedChar) s then s else slugify $ dropWhile (== '-') $ filter isAllowedChar $ map (\ c -> if c == '_' then '-' else c) $ s where slugify (a : r) | isUpper a = slugify (toLower a : r) slugify (a : b : r) | isUpper b = a : '-' : slugify (toLower b : r) | otherwise = a : slugify (b : r) slugify x = x isAllowedChar :: Char -> Bool isAllowedChar c = (isAscii c && isAlphaNum c) || (c `elem` "-_") getopt-generics-0.13.0.3/src/WithCli/Parser.hs0000644000000000000000000001201412620414075017142 0ustar0000000000000000{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} module WithCli.Parser where import Data.Orphans () import Prelude () import Prelude.Compat import Control.Arrow import Control.Monad import System.Console.GetOpt as Base import WithCli.Flag import WithCli.Modifier.Types import WithCli.Normalize import WithCli.Result data NonOptionsParser uninitialized = NonOptionsParser { nonOptionsType :: String, nonOptionsOptional :: Bool, nonOptionsParser :: [String] -> Result (uninitialized -> uninitialized, [String]) } combineNonOptionsParser :: [NonOptionsParser u] -> [NonOptionsParser v] -> [NonOptionsParser (u, v)] combineNonOptionsParser a b = map (modMod first) a ++ map (modMod second) b where modMod :: ((a -> a) -> (b -> b)) -> NonOptionsParser a -> NonOptionsParser b modMod f (NonOptionsParser field optional parser) = NonOptionsParser field optional (fmap (fmap (first f)) parser) data Parser phase a where Parser :: { parserDefault :: uninitialized, parserOptions :: [OptDescr (Result (uninitialized -> uninitialized))], parserNonOptions :: [NonOptionsParser uninitialized], parserConvert :: uninitialized -> Result a } -> Parser phase a instance Functor (Parser phase) where fmap f (Parser def options nonOptions convert) = Parser def options nonOptions (fmap f . convert) -- phases: data Unnormalized data Normalized emptyParser :: a -> Parser phase a emptyParser a = Parser { parserDefault = a, parserOptions = [], parserNonOptions = [], parserConvert = return } normalizeParser :: Parser Unnormalized a -> Parser Normalized a normalizeParser (Parser d options nonOptions convert) = Parser d (map (mapLongOptions normalize) options) nonOptions convert where mapLongOptions :: (String -> String) -> OptDescr a -> OptDescr a mapLongOptions f (Option shorts longs argDescr help) = Option shorts (map f longs) argDescr help modParserOptions :: (forall x . [OptDescr (Result x)] -> [OptDescr (Result x)]) -> Parser Unnormalized a -> Parser Unnormalized a modParserOptions f (Parser def options nonOptions convert) = Parser def (f options) nonOptions convert combine :: forall a b phase . Result (Parser phase a) -> Result (Parser phase b) -> Result (Parser phase (a, b)) combine a b = inner <$> a <*> b where inner :: Parser phase a -> Parser phase b -> Parser phase (a, b) inner (Parser defaultA optionsA nonOptionsA convertA) (Parser defaultB optionsB nonOptionsB convertB) = Parser { parserDefault = (defaultA, defaultB), parserOptions = map (fmap (fmap first)) optionsA ++ map (fmap (fmap second)) optionsB, parserNonOptions = combineNonOptionsParser nonOptionsA nonOptionsB, parserConvert = \ (u, v) -> (,) <$> (convertA u) <*> (convertB v) } fillInOptions :: [Result (u -> u)] -> u -> Result u fillInOptions [] u = return u fillInOptions (option : options) u = do f <- option fillInOptions options (f u) fillInNonOptions :: [[String] -> Result (u -> u, [String])] -> [String] -> u -> Result u fillInNonOptions (parser : parsers) nonOptions@(_ : _) u = do (p, rest) <- parser nonOptions fillInNonOptions parsers rest (p u) fillInNonOptions [] [] u = return u fillInNonOptions [] nonOptions _ = Errors $ unlines (map ("unknown argument: " ++) nonOptions) fillInNonOptions _ [] u = return u runParser :: String -> Modifiers -> Parser Normalized a -> [String] -> Result a runParser progName modifiers Parser{..} args = checkNonOptionParsers parserNonOptions |> let versionOptions = maybe [] (\ v -> pure $ versionOption (progName ++ " version " ++ v)) (getVersion modifiers) options = map (fmap NoHelp) parserOptions ++ [helpOption] ++ versionOptions (flags, nonOptions, errs) = Base.getOpt Base.Permute options args in case foldFlags flags of Help -> OutputAndExit $ let fields = case getPositionalArgumentType modifiers of Nothing -> map (\ p -> (nonOptionsOptional p, nonOptionsType p)) parserNonOptions Just typ -> [(True, typ)] in usage progName fields (map void options) Version msg -> OutputAndExit msg NoHelp innerFlags -> reportErrors errs *> (fillInOptions innerFlags parserDefault >>= fillInNonOptions (map nonOptionsParser parserNonOptions) nonOptions >>= parserConvert) where reportErrors :: [String] -> Result () reportErrors = \ case [] -> return () errs -> Errors $ unlines errs checkNonOptionParsers :: [NonOptionsParser a] -> Result () checkNonOptionParsers parsers = case dropWhile nonOptionsOptional $ dropWhile (not . nonOptionsOptional) parsers of [] -> return () (_ : _) -> Errors "cannot use Maybes for optional arguments before any non-optional arguments" getopt-generics-0.13.0.3/src/WithCli/Pure/Internal.hs0000644000000000000000000000242612620414115020376 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} module WithCli.Pure.Internal where import WithCli.HasArguments import WithCli.Modifier import WithCli.Parser import WithCli.Result class WithCliPure function output where run :: String -> Modifiers -> Result (Parser Unnormalized input) -> (input -> function) -> [String] -> Result output instance WithCliPure output output where run :: String -> Modifiers -> Result (Parser Unnormalized input) -> (input -> output) -> [String] -> Result output run progName modifiers mkParser function args = do mkParser >>= \ parser -> do input <- runParser progName modifiers (normalizeParser (applyModifiers modifiers parser)) args return $ function input instance (HasArguments input, WithCliPure function output) => WithCliPure (input -> function) output where run :: String -> Modifiers -> Result (Parser Unnormalized otherInput) -> (otherInput -> (input -> function)) -> [String] -> Result output run progName modifiers mkParser function args = do run progName modifiers (combine mkParser (argumentsParser modifiers Nothing)) (\ (otherInput, input) -> function otherInput input) args getopt-generics-0.13.0.3/src/WithCli/Result.hs0000644000000000000000000000532712620372205017173 0ustar0000000000000000{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE ImplicitParams #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ViewPatterns #-} module WithCli.Result ( Result(..), (|>), handleResult, sanitizeMessage, sanitize, ) where import Prelude () import Prelude.Compat import Control.Arrow import System.Exit import System.IO -- | Type to wrap results from 'WithCli.Pure.withCliPure'. data Result a = Success a -- ^ The CLI was used correctly and a value of type @a@ was -- successfully constructed. | Errors String -- ^ The CLI was used incorrectly. The 'Result' contains error messages. -- -- It can also happen that the data type you're trying to use isn't -- supported. See the -- for -- details. | OutputAndExit String -- ^ The CLI was used with @--help@. The 'Result' contains the help message. deriving (Show, Eq, Ord, Functor) instance Applicative Result where pure = Success OutputAndExit message <*> _ = OutputAndExit message _ <*> OutputAndExit message = OutputAndExit message Success f <*> Success x = Success (f x) Errors a <*> Errors b = Errors (a ++ "\n" ++ b) Errors err <*> Success _ = Errors err Success _ <*> Errors err = Errors err (|>) :: Result a -> Result b -> Result b a |> b = a >>= const b instance Monad Result where return = pure Success a >>= b = b a Errors errs >>= _ = Errors errs OutputAndExit message >>= _ = OutputAndExit message (>>) = (*>) -- | Handles an input of type @'Result' a@: -- -- - On @'Success' a@ it returns the value @a@. -- - On @'OutputAndExit' message@ it writes the message to 'stdout' and throws -- 'ExitSuccess'. -- - On @'Errors' errs@ it writes the error messages to 'stderr' and throws -- @'ExitFailure' 1@. -- -- This is used by 'WithCli.withCli' to handle parse results. handleResult :: Result a -> IO a handleResult result = case sanitize result of Success a -> return a OutputAndExit message -> do putStr message exitWith ExitSuccess Errors err -> do hPutStr stderr err exitWith $ ExitFailure 1 sanitize :: Result a -> Result a sanitize = \ case Success a -> Success a OutputAndExit message -> OutputAndExit $ sanitizeMessage message Errors messages -> Errors $ sanitizeMessage messages sanitizeMessage :: String -> String sanitizeMessage = lines >>> map stripTrailingSpaces >>> filter (not . null) >>> map (++ "\n") >>> concat stripTrailingSpaces :: String -> String stripTrailingSpaces = reverse . inner . dropWhile (`elem` [' ', '\n']) . reverse where inner s = case s of ('\n' : ' ' : r) -> inner ('\n' : r) (a : r) -> a : inner r [] -> [] getopt-generics-0.13.0.3/test/Spec.hs0000644000000000000000000000005412726547313015437 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} getopt-generics-0.13.0.3/test/DocsSpec.hs0000644000000000000000000000221412620533617016243 0ustar0000000000000000{-# LANGUAGE CPP #-} module DocsSpec where import Prelude () import Prelude.Compat import Control.Monad import System.FilePath import Test.Hspec import ShellProtocol import qualified Test01 import qualified CustomOption import qualified Simple #if MIN_VERSION_base(4,8,0) import qualified Test02 import qualified Test03 import qualified Test04 import qualified RecordType import qualified CustomOptionRecord #endif examples :: [(IO (), String)] examples = (Test01.main, "Test01") : (CustomOption.main, "CustomOption") : (Simple.main, "Simple") : #if MIN_VERSION_base(4,8,0) (Test02.main, "Test02") : (Test03.main, "Test03") : (Test04.main, "Test04") : (RecordType.main, "RecordType") : (CustomOptionRecord.main, "CustomOptionRecord") : #endif [] main :: IO () main = hspec spec spec :: Spec spec = do describe "shell protocols" $ do forM_ examples $ \ (program, name) -> it name $ do test program name test :: IO () -> String -> IO () test program name = do protocol <- readFile ("docs" name <.> "shell-protocol") testShellProtocol program protocol getopt-generics-0.13.0.3/test/ModifiersSpec.hs0000644000000000000000000000506112620402742017271 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} module ModifiersSpec where import Data.List import Test.Hspec import Util import WithCli.Pure import WithCli.Pure.RecordSpec spec :: Spec spec = do describe "AddShortOption" $ do it "allows modifiers for short options" $ do modsParse [AddShortOption "camelCase" 'x'] "-x foo" `shouldBe` Success (CamelCaseOptions "foo") it "allows modifiers in camelCase" $ do modsParse [AddShortOption "camelCase" 'x'] "-x foo" `shouldBe` Success (CamelCaseOptions "foo") let parse' :: String -> Result CamelCaseOptions parse' = modsParse [AddShortOption "camelCase" 'x'] it "includes the short option in the help" $ do let OutputAndExit output = parse' "--help" output `shouldContain` "-x STRING" describe "RenameOption" $ do it "allows to rename options" $ do modsParse [RenameOption "camelCase" "bla"] "--bla foo" `shouldBe` Success (CamelCaseOptions "foo") context "when shadowing earlier modifiers with later modifiers" $ do let parse' = modsParse [RenameOption "camelCase" "foo", RenameOption "camelCase" "bar"] it "uses the later renaming" $ do parse' "--bar foo" `shouldBe` Success (CamelCaseOptions "foo") it "disregards the earlier renaming" $ do let Errors errs = parse' "--foo foo" errs `shouldContain` "unrecognized option `--foo'\n" it "contains renamed options in error messages" $ do let Errors errs = modsParse [RenameOption "camelCase" "foo"] "" :: Result CamelCaseOptions -- _ <- error $ show errs show errs `shouldNotContain` "camelCase" show errs `shouldNotContain` "camel-case" show errs `shouldContain` "foo" it "" $ do modsParse [RenameOption "bar" "one", RenameOption "baz" "two"] "--one 1 --two foo" `shouldBe` Success (Foo (Just 1) "foo" False) describe "AddVersionFlag" $ do it "implements --version" $ do let OutputAndExit output = modsParse [AddVersionFlag "1.0.0"] "--version" :: Result Foo output `shouldBe` "prog-name version 1.0.0\n" it "--help takes precedence over --version" $ do let OutputAndExit output = modsParse [AddVersionFlag "1.0.0"] "--version --help" :: Result Foo output `shouldSatisfy` ("show help and exit" `isInfixOf`) it "--version shows up in help output" $ do let OutputAndExit output = modsParse [AddVersionFlag "1.0.0"] "--help" :: Result Foo output `shouldSatisfy` ("show version and exit" `isInfixOf`) getopt-generics-0.13.0.3/test/ModifiersSpec/RenameOptionsSpec.hs0000644000000000000000000000305712620400527022671 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} module ModifiersSpec.RenameOptionsSpec where import Data.Char import Data.List import Test.Hspec import Util import WithCli.Pure data Foo = Foo { foo :: Int, bar :: Int } deriving (Eq, Show, Generic) instance HasArguments Foo data CommonPrefixes = CP { prefixFoo :: Int, prefixBar :: Int, notPrefixBaz :: Int } deriving (Eq, Show, Generic) instance HasArguments CommonPrefixes spec :: Spec spec = do describe "RenameOptions" $ do it "allows to rename all flags" $ do modsParse [RenameOptions (Just . reverse)] "--oof 1 --rab 2" `shouldBe` Success (Foo 1 2) it "works on camelCase field names" $ do modsParse [RenameOptions (Just . map toLower)] "--prefixfoo 1 --prefixbar 2 --notprefixbaz 3" `shouldBe` Success (CP 1 2 3) it "missing options messages show renamed options" $ do let Errors errs = modsParse [RenameOptions (Just . map toLower)] "" :: Result CommonPrefixes lines errs `shouldSatisfy` ("missing option: --prefixfoo=INTEGER" `elem`) it "can be used to rename a single field" $ do let rename f = case f of "foo" -> Just "renamed" _ -> Nothing modsParse [RenameOptions rename] "--renamed 1 --bar 2" `shouldBe` Success (Foo 1 2) it "allows to strip a common prefix" $ do modsParse [RenameOptions (stripPrefix "prefix")] "--foo 1 --bar 2 --not-prefix-baz 3" `shouldBe` Success (CP 1 2 3) getopt-generics-0.13.0.3/test/ModifiersSpec/UseForPositionalArgumentsSpec.hs0000644000000000000000000000525712620400547025247 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ScopedTypeVariables #-} module ModifiersSpec.UseForPositionalArgumentsSpec where import Data.List import System.Environment import Test.Hspec import Util import WithCli import WithCli.Pure data WithPositionalArguments = WithPositionalArguments { positionalArguments :: [String], someFlag :: Bool } deriving (Generic, Show, Eq) instance HasArguments WithPositionalArguments data WithMultiplePositionalArguments = WithMultiplePositionalArguments { positionalArgumentsA :: [String], positionalArgumentsB :: [String], someOtherFlag :: Bool } deriving (Generic, Show, Eq) instance HasArguments WithMultiplePositionalArguments spec :: Spec spec = do it "allows positionalArguments" $ do modsParse [UseForPositionalArguments "positionalArguments" "type"] "foo bar --some-flag" `shouldBe` Success (WithPositionalArguments ["foo", "bar"] True) it "disallows to specify the option used for positional arguments" $ do modsParse [UseForPositionalArguments "positionalArguments" "type"] "--positional-arguments foo" `shouldBe` (Errors "unrecognized option `--positional-arguments'\n" :: Result WithPositionalArguments) it "complains about fields that don't have type [String]" $ do modsParse [UseForPositionalArguments "someFlag" "type"] "doesn't matter" `shouldBe` (Errors "UseForPositionalArguments can only be used for fields of type [String] not Bool\n" :: Result WithPositionalArguments) it "includes the type of positional arguments in the help output in upper-case" $ do let OutputAndExit output = modsParse [UseForPositionalArguments "positionalArguments" "foo"] "--help" :: Result WithPositionalArguments output `shouldSatisfy` ("prog-name [OPTIONS] [FOO]\n" `isPrefixOf`) it "complains about multiple PositionalArguments fields" $ do let modifiers = UseForPositionalArguments "positionalArgumentsA" "foo" : UseForPositionalArguments "positionalArgumentsB" "bar" : [] (modsParse modifiers [] :: Result WithMultiplePositionalArguments) `shouldBe` Errors "UseForPositionalArguments can only be used once\n" context "when used without selector" $ do it "automatically uses positional arguments for [Int]" $ do withArgs (words "1 2 3") $ withCli $ \ (xs :: [Int]) -> do xs `shouldBe` [1, 2, 3] it "automatically uses positional arguments for [String]" $ do withArgs (words "foo bar") $ withCli $ \ (xs :: [String]) -> do xs `shouldBe` (words "foo bar") getopt-generics-0.13.0.3/test/ShellProtocol.hs0000644000000000000000000000272712601754310017334 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} module ShellProtocol (testShellProtocol) where import Control.Exception import Control.Monad import Data.List import System.Environment import System.Exit import System.IO import System.IO.Silently import Test.Hspec testShellProtocol :: IO () -> String -> IO () testShellProtocol program shellProtocol = do let protocol = parseProtocol shellProtocol testProtocol program protocol data Protocol = Protocol { _args :: [String], _expected :: [String] } deriving (Show) parseProtocol :: String -> [Protocol] parseProtocol = inner . lines where inner :: [String] -> [Protocol] inner [] = [] inner ((words -> "$" : "program" : args) : rest) = let (expected, next) = span (not . ("$ " `isPrefixOf`)) rest in Protocol args expected : inner next inner lines = error ("parseProtocol: cannot parse: " ++ show lines) testProtocol :: IO () -> [Protocol] -> IO () testProtocol program protocol = do forM_ protocol $ \ (Protocol args expected) -> do output <- hCapture_ [stdout, stderr] $ handle (\ (e :: ExitCode) -> printExitCode e) $ withArgs args $ withProgName "program" $ program output `shouldBe` unlines expected printExitCode :: ExitCode -> IO () printExitCode e = case e of ExitFailure n -> hPutStrLn stderr ("# exit-code " ++ show n) ExitSuccess -> return () getopt-generics-0.13.0.3/test/Util.hs0000644000000000000000000000146212620414151015450 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} module Util where import Prelude () import Prelude.Compat import WithCli.Modifier import WithCli.Pure parse :: (HasArguments a) => String -> Result a parse = modsParse [] data Wrapped a = Wrap { unwrap :: a } modsParse :: forall a . (HasArguments a) => [Modifier] -> String -> Result a modsParse modifiers args = unwrap <$> withCliPure "prog-name" modifiers (words args) (Wrap :: a -> Wrapped a) unsafeModifiers :: [Modifier] -> Modifiers unsafeModifiers mods = case mkModifiers mods of Success x -> x Errors errs -> error ("unsafeModifiers: " ++ show errs) OutputAndExit msg -> error ("unsafeModifiers: " ++ show msg) getopt-generics-0.13.0.3/test/WithCli/ArgumentSpec.hs0000644000000000000000000000134112601754344020501 0ustar0000000000000000 module WithCli.ArgumentSpec where import Data.Proxy import Test.Hspec import WithCli.Argument spec :: Spec spec = do describe "Option.Double" $ do it "parses doubles" $ do parseArgument "1.2" `shouldBe` Just (1.2 :: Double) it "renders as NUMBER in help and error output" $ do argumentType (Proxy :: Proxy Double) `shouldBe` "NUMBER" it "parses doubles that start with a dot" $ do parseArgument ".4" `shouldBe` Just (0.4 :: Double) describe "Option.Float" $ do it "parses floats" $ do parseArgument "1.2" `shouldBe` Just (1.2 :: Float) it "renders as NUMBER in help and error output" $ do argumentType (Proxy :: Proxy Float) `shouldBe` "NUMBER" getopt-generics-0.13.0.3/test/WithCli/HasArgumentsSpec.hs0000644000000000000000000000200012601754344021311 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module WithCli.HasArgumentsSpec where import Control.Monad import Test.Hspec import Test.QuickCheck import WithCli.HasArguments spec :: Spec spec = do describe "parseBool" $ do forM_ ["true", "True", "tRue", "TRUE", "yes", "yEs", "on", "oN"] $ \ true -> it ("parses '" ++ true ++ "' as True") $ do parseBool true `shouldBe` Just True forM_ ["false", "False", "falSE", "FALSE", "no", "nO", "off", "ofF"] $ \ false -> it ("parses '" ++ false ++ "' as False") $ do parseBool false `shouldBe` Just False it "parses every positive integer as true" $ do property $ \ (n :: Int) -> n > 0 ==> parseBool (show n) `shouldBe` Just True it "parses every non-positive integer as false" $ do property $ \ (n :: Int) -> n <= 0 ==> parseBool (show n) `shouldBe` Just False it "doesn't parse 'foo'" $ do parseBool "foo" `shouldBe` (Nothing :: Maybe Bool) getopt-generics-0.13.0.3/test/WithCli/ModifierSpec.hs0000644000000000000000000000131412620414154020446 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} module WithCli.ModifierSpec where import Test.Hspec import Util import WithCli import WithCli.Modifier spec :: Spec spec = do describe "insertWith" $ do it "combines existing values with the given function" $ do insertWith (++) (1 :: Integer) "bar" [(1, "foo")] `shouldBe` [(1, "foobar")] describe "getVersion" $ do it "returns the version" $ do let modifiers = unsafeModifiers [AddVersionFlag "1.0.0"] getVersion modifiers `shouldBe` Just "1.0.0" data Foo = Foo { bar :: String } deriving (Generic) data Overlap = Overlap { foo :: String, fooo :: String } deriving (Generic) getopt-generics-0.13.0.3/test/WithCli/NormalizeSpec.hs0000644000000000000000000000365612601754342020670 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} module WithCli.NormalizeSpec where import Data.Char import Test.Hspec import Test.QuickCheck hiding (Success) import WithCli.Normalize isValidInputChar :: Char -> Bool isValidInputChar c = c `elem` ['A' .. 'Z'] ++ ['a' .. 'z'] ++ ['0' .. '9'] ++ "-_" isAllowedOutputChar :: Char -> Bool isAllowedOutputChar c = c `elem` ['a' .. 'z'] ++ ['0' .. '9'] ++ "-" upperCaseChar :: Gen Char upperCaseChar = elements ['A' .. 'Z'] spec :: Spec spec = do describe "normalize" $ do it "is idempotent" $ do property $ \ x -> do let once = normalize x twice = normalize once once `shouldBe` twice it "replaces underscores with dashes" $ do normalize "foo_bar" `shouldBe` "foo-bar" it "doesn't modify digits" $ do normalize "foo2bar" `shouldBe` "foo2bar" it "when there's one valid character it returns only dashes and lower case characters" $ do property $ \ x -> any isValidInputChar x ==> normalize x `shouldSatisfy` (\ s -> all isAllowedOutputChar s) it "when there are no valid characters it returns its input" $ do property $ forAll (listOf (arbitrary `suchThat` (not . isValidInputChar))) $ \ x -> normalize x `shouldBe` x it "replaces camelCase with dashes" $ do let isValidPrefixChar c = c `elem` ['A' .. 'Z'] ++ ['a' .. 'z'] property $ \ prefix suffix -> (any isValidPrefixChar prefix) ==> forAll upperCaseChar $ \ upper -> counterexample (prefix ++ [upper] ++ suffix) $ normalize (prefix ++ [upper] ++ suffix) `shouldBe` normalize prefix ++ "-" ++ normalize (toLower upper : suffix) describe "matches" $ do it "matches normalized strings" $ do property $ \ s -> normalize s `matches` s it "matches unnormalized strings" $ do property $ \ s -> s `matches` s getopt-generics-0.13.0.3/test/WithCli/ParserSpec.hs0000644000000000000000000000141312620323625020146 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} module WithCli.ParserSpec where import Prelude () import Prelude.Compat import Test.Hspec import WithCli.Parser import WithCli.Result import Util spec :: Spec spec = do describe "runParser" $ do it "works" $ do let fa :: Parser phase Int fa = Parser { parserDefault = Nothing, parserOptions = [], parserNonOptions = (NonOptionsParser "type" False (\ (s : r) -> (, r) <$> Success (const $ Just $ read s))) : [], parserConvert = \ (Just x) -> return x } let i = runParser "program" (unsafeModifiers []) fa ["42"] i `shouldBe` Success 42 getopt-generics-0.13.0.3/test/WithCli/Pure/RecordSpec.hs0000644000000000000000000001451412620400573021047 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ScopedTypeVariables #-} module WithCli.Pure.RecordSpec where import Prelude () import Prelude.Compat import Control.Exception import Data.Foldable (forM_) import Data.List (isPrefixOf, isSuffixOf) import System.Exit import System.IO import System.IO.Silently import Test.Hspec import Util import WithCli.Pure spec :: Spec spec = do part1 part2 part3 part4 part5 data Foo = Foo { bar :: Maybe Int, baz :: String, bool :: Bool } deriving (Generic, Show, Eq) instance HasArguments Foo data NotAllowed = NotAllowed1 | NotAllowed2 deriving (Generic, Show, Eq) instance HasArguments NotAllowed part1 :: Spec part1 = do describe "withCliPure (record types)" $ do it "allows optional arguments" $ do parse "--baz foo" `shouldBe` Success (Foo Nothing "foo" False) it "allows boolean flags" $ do parse "--bool --baz foo" `shouldBe` Success (Foo Nothing "foo" True) it "allows to overwrite String options" $ do parse "--baz one --baz two" `shouldBe` Success (Foo Nothing "two" False) context "with invalid arguments" $ do it "prints out an error" $ do let Errors messages = parse "--no-such-option" :: Result Foo messages `shouldBe` "unrecognized option `--no-such-option'\n" ++ "missing option: --baz=STRING\n" it "prints errors for missing options" $ do let Errors messages = parse [] :: Result Foo messages `shouldBe` "missing option: --baz=STRING\n" it "prints out an error for unparseable options" $ do let Errors messages = parse "--bar foo --baz huhu" :: Result Foo messages `shouldBe` "cannot parse as INTEGER (optional): foo\n" it "complains about unused positional arguments" $ do (parse "--baz foo unused" :: Result Foo) `shouldBe` Errors "unknown argument: unused\n" it "complains about invalid overwritten options" $ do let Errors messages = parse "--bar foo --baz huhu --bar 12" :: Result Foo messages `shouldBe` "cannot parse as INTEGER (optional): foo\n" context "--help" $ do it "implements --help" $ do let OutputAndExit output = parse "--help" :: Result Foo mapM_ (output `shouldContain`) $ "--bar=INTEGER" : "optional" : "--baz=STRING" : "--bool" : [] lines output `shouldSatisfy` (not . ("" `elem`)) it "contains help message about --help" $ do let OutputAndExit output = parse "--help" :: Result Foo output `shouldContain` "show help and exit" it "does not contain trailing spaces" $ do output <- hCapture_ [stdout] $ handle (\ ExitSuccess -> return ()) $ handleResult $ ((parse "--help" :: Result Foo) >> return ()) forM_ (lines output) $ \ line -> do line `shouldSatisfy` (not . (" " `isSuffixOf`)) it "complains when the options datatype is not allowed" $ do let Errors messages = parse "--help" :: Result NotAllowed messages `shouldSatisfy` ("getopt-generics doesn't support sum types" `isPrefixOf`) it "outputs a header including \"[OPTIONS]\"" $ do let OutputAndExit output = parse "--help" :: Result Foo output `shouldSatisfy` ("prog-name [OPTIONS]\n" `isPrefixOf`) data ListOptions = ListOptions { multiple :: [Int] } deriving (Generic, Show, Eq) instance HasArguments ListOptions part2 :: Spec part2 = do describe "parseArguments" $ do it "allows to interpret multiple uses of the same option as lists" $ do parse "--multiple 23 --multiple 42" `shouldBe` Success (ListOptions [23, 42]) it "complains about invalid list arguments" $ do let Errors errs = parse "--multiple foo --multiple 13" :: Result ListOptions errs `shouldBe` "cannot parse as INTEGER (multiple possible): foo\n" data CamelCaseOptions = CamelCaseOptions { camelCase :: String } deriving (Generic, Show, Eq) instance HasArguments CamelCaseOptions part3 :: Spec part3 = do describe "parseArguments" $ do it "turns camelCase selectors to lowercase and seperates with a dash" $ do parse "--camel-case foo" `shouldBe` Success (CamelCaseOptions "foo") it "help does not contain camelCase flags" $ do let OutputAndExit output :: Result CamelCaseOptions = parse "--help" output `shouldNotContain` "camelCase" output `shouldContain` "camel-case" it "error messages don't contain camelCase flags" $ do let Errors errs :: Result CamelCaseOptions = parse "--bla" show errs `shouldNotContain` "camelCase" show errs `shouldContain` "camel-case" data WithUnderscore = WithUnderscore { _withUnderscore :: String } deriving (Generic, Show, Eq) instance HasArguments WithUnderscore part4 :: Spec part4 = do describe "parseArguments" $ do it "ignores leading underscores in field names" $ do parse "--with-underscore foo" `shouldBe` Success (WithUnderscore "foo") data WithoutSelectors = WithoutSelectors String Bool Int deriving (Eq, Show, Generic) instance HasArguments WithoutSelectors part5 :: Spec part5 = do describe "parseArguments" $ do context "WithoutSelectors" $ do it "populates fields without selectors from positional arguments" $ do parse "foo true 23" `shouldBe` Success (WithoutSelectors "foo" True 23) it "has good help output for positional arguments" $ do let OutputAndExit output = parse "--help" :: Result WithoutSelectors output `shouldSatisfy` ("prog-name [OPTIONS] STRING BOOL INTEGER" `isPrefixOf`) it "has good error messages for missing positional arguments" $ do (parse "foo" :: Result WithoutSelectors) `shouldBe` Errors ("missing argument of type BOOL\n" ++ "missing argument of type INTEGER\n") it "complains about additional positional arguments" $ do (parse "foo true 5 bar" :: Result WithoutSelectors) `shouldBe` Errors "unknown argument: bar\n" it "allows to use tuples" $ do (parse "42 bar" :: Result (Int, String)) `shouldBe` Success (42, "bar") getopt-generics-0.13.0.3/test/WithCli/PureSpec.hs0000644000000000000000000000177512620323002017625 0ustar0000000000000000 module WithCli.PureSpec where import Test.Hspec import WithCli.Pure spec :: Spec spec = do describe "withCliPure" $ do it "works for no arguments" $ do let f :: String f = "foo" withCliPure "progName" [] [] f `shouldBe` Success "foo" withCliPure "progName" [] ["-h"] f `shouldBe` ((OutputAndExit $ unlines $ "progName [OPTIONS]" : " -h --help show help and exit" : []) :: Result String) it "works for one argument" $ do let f :: Int -> String f = show withCliPure "progName" [] ["42"] f `shouldBe` Success "42" withCliPure "progName" [] ["-h"] f `shouldBe` ((OutputAndExit $ unlines $ "progName [OPTIONS] INTEGER" : " -h --help show help and exit" : []) :: Result String) it "works for two arguments" $ do let f :: Int -> String -> (Int, String) f n s = (n, s) withCliPure "progName" [] ["42", "foo"] f `shouldBe` Success (42 :: Int, "foo") getopt-generics-0.13.0.3/test/WithCli/ResultSpec.hs0000644000000000000000000000355312620321770020176 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} module WithCli.ResultSpec where import Data.Char import Data.List import Safe import System.Exit import Test.Hspec import Test.QuickCheck hiding (Result(..)) import WithCli.Result spec :: Spec spec = do describe "Result" $ do context ">>" $ do it "collects errors" $ do (Errors "foo" >> Errors "bar" :: Result ()) `shouldBe` Errors "foo\nbar" describe "|>" $ do it "shortcuts directly without collecting other errors" $ do (Errors "foo" |> Errors "bar" :: Result ()) `shouldBe` Errors "foo" return () |> return () `shouldBe` return () describe "handleResult" $ do context "OutputAndExit" $ do it "throws ExitSuccess" $ do handleResult (OutputAndExit "foo") `shouldThrow` (== ExitSuccess) context "Errors" $ do it "throws an ExitFailure" $ do handleResult (Errors "foo") `shouldThrow` (== ExitFailure 1) describe "sanitizeMessage" $ do it "removes empty lines" $ do property $ \ (unlines -> s) -> do sanitizeMessage s `shouldNotContain` "\n\n" it "adds a newline at the end if missing" $ do property $ \ (unlines -> s) -> not (null (sanitizeMessage s)) ==> lastMay (sanitizeMessage s) `shouldBe` Just '\n' it "only strips spaces" $ do property $ \ (unlines -> s) -> do counterexample s $ do let expected = case s of "" -> "" x | lastMay x == Just '\n' -> x x -> x ++ "\n" filter (not . isSpace) (sanitizeMessage s) `shouldBe` filter (not . isSpace) expected it "removes trailing spaces" $ do property $ \ (unlines -> s) -> do sanitizeMessage s `shouldSatisfy` (not . (" \n" `isInfixOf`)) getopt-generics-0.13.0.3/test/WithCliSpec.hs0000644000000000000000000000717112620377051016723 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} module WithCliSpec where import System.Environment import System.Exit import System.IO import System.IO.Silently import Test.Hspec import WithCli data Foo = Foo { bar :: Maybe Int, baz :: String, bool :: Bool } deriving (Eq, Show, Generic) instance HasArguments Foo spec :: Spec spec = do describe "withCli" $ do context "no arguments" $ do it "executes the operation in case of no command line arguments" $ do let main :: IO () main = putStrLn "success" (capture_ $ withArgs [] $ withCli main) `shouldReturn` "success\n" it "produces nice error messages" $ do let main :: IO () main = putStrLn "success" output <- hCapture_ [stderr] (withArgs ["foo"] (withCli main) `shouldThrow` (== ExitFailure 1)) output `shouldBe` "unknown argument: foo\n" context "1 argument" $ do it "parses Ints" $ do let main :: Int -> IO () main n = putStrLn ("success: " ++ show n) (capture_ $ withArgs ["12"] $ withCli main) `shouldReturn` "success: 12\n" it "error parsing" $ do let main :: Int -> IO () main n = putStrLn ("error: " ++ show n) output <- hCapture_ [stderr] (withArgs (words "12 foo") (withCli main) `shouldThrow` (== ExitFailure 1)) output `shouldBe` "unknown argument: foo\n" context "record types" $ do it "parses command line arguments" $ do withArgs (words "--bar 4 --baz foo") $ withCli $ \ foo -> do foo `shouldBe` Foo (Just 4) "foo" False context "optional positional arguments with Maybe" $ do it "allows optional positional arguments" $ do let main :: Maybe Int -> IO () main = print (capture_ $ withCli main) `shouldReturn` "Nothing\n" (capture_ $ withArgs ["23"] $ withCli main) `shouldReturn` "Just 23\n" it "allows multiple optional positional arguments" $ do let main :: Maybe Int -> Maybe String -> IO () main i s = print (i, s) (capture_ $ withCli main) `shouldReturn` "(Nothing,Nothing)\n" (capture_ $ withArgs ["23"] $ withCli main) `shouldReturn` "(Just 23,Nothing)\n" (capture_ $ withArgs ["23", "foo"] $ withCli main) `shouldReturn` "(Just 23,Just \"foo\")\n" it "allows optional positional arguments after non-optional arguments" $ do let main :: Int -> Maybe String -> IO () main i s = print (i, s) (hCapture_ [stderr] $ withCli main `shouldThrow` (== ExitFailure 1)) `shouldReturn` "missing argument of type INTEGER\n" (capture_ $ withArgs ["23"] $ withCli main) `shouldReturn` "(23,Nothing)\n" (capture_ $ withArgs ["23", "foo"] $ withCli main) `shouldReturn` "(23,Just \"foo\")\n" it "disallows optional positional arguments before non-optional ones with a proper error message" $ do let main :: Maybe Int -> String -> IO () main = error "main" hCapture_ [stderr] (withCli main `shouldThrow` (== ExitFailure 1)) `shouldReturn` "cannot use Maybes for optional arguments before any non-optional arguments\n" it "shows optional arguments with nested square brackets in help output" $ do let main :: Int -> Maybe String -> Maybe String -> IO () main = error "main" output <- capture_ (withArgs ["-h"] (withCli main) `shouldThrow` (== ExitSuccess)) output `shouldContain` "[OPTIONS] INTEGER [STRING [STRING]]" getopt-generics-0.13.0.3/docs/CustomOption.hs0000644000000000000000000000060012601754344017152 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module CustomOption where import WithCli data File = File FilePath deriving (Show, Typeable) instance Argument File where argumentType Proxy = "custom-file-type" parseArgument f = Just (File f) instance HasArguments File where argumentsParser = atomicArgumentsParser main :: IO () main = withCli run run :: File -> IO () run = print getopt-generics-0.13.0.3/docs/CustomOptionRecord.hs0000644000000000000000000000104212617073407020313 0ustar0000000000000000{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} module CustomOptionRecord where import WithCli data File = File FilePath deriving (Show, Typeable) instance Argument File where argumentType Proxy = "custom-file-type" parseArgument f = Just (File f) data Options = Options { file :: File } deriving (Show, Generic, HasArguments) instance HasArguments File where argumentsParser = atomicArgumentsParser main :: IO () main = withCli run run :: Options -> IO () run = print getopt-generics-0.13.0.3/docs/RecordType.hs0000644000000000000000000000047512620533622016574 0ustar0000000000000000{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} module RecordType where import WithCli data Options = Options { port :: Int, daemonize :: Bool, config :: Maybe FilePath } deriving (Show, Generic, HasArguments) main :: IO () main = withCli run run :: Options -> IO () run = print getopt-generics-0.13.0.3/docs/Simple.hs0000644000000000000000000000021112601754344015736 0ustar0000000000000000module Simple where import WithCli main :: IO () main = withCli run run :: String -> Int -> Bool -> IO () run s i b = print (s, i, b) getopt-generics-0.13.0.3/docs/Test01.hs0000644000000000000000000000016612601754344015576 0ustar0000000000000000 module Test01 where import WithCli main :: IO () main = withCli run run :: Int -> Bool -> IO () run = curry print getopt-generics-0.13.0.3/docs/Test02.hs0000644000000000000000000000051712617073407015600 0ustar0000000000000000{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} module Test02 where import WithCli data Options = Options { port :: Int, daemonize :: Bool, config :: Maybe FilePath, args :: [String] } deriving (Show, Generic, HasArguments) main :: IO () main = withCli run run :: Options -> IO () run = print getopt-generics-0.13.0.3/docs/Test03.hs0000644000000000000000000000054712617073407015604 0ustar0000000000000000{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} module Test03 where import WithCli main :: IO () main = withCli run run :: (A, B) -> IO () run options = do print (options :: (A, B)) data A = A { aa :: String } deriving (Show, Generic, HasArguments) data B = B { bb :: String } deriving (Show, Generic, HasArguments) getopt-generics-0.13.0.3/docs/Test04.hs0000644000000000000000000000052612617073407015602 0ustar0000000000000000{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} module Test04 where import WithCli main :: IO () main = withCli run run :: A -> B -> IO () run a b = do print (a, b) data A = A { aa :: String } deriving (Show, Generic, HasArguments) data B = B { bb :: String } deriving (Show, Generic, HasArguments) getopt-generics-0.13.0.3/LICENSE0000644000000000000000000000302612506240557014235 0ustar0000000000000000Copyright (c) 2014, Zalora South East Asia Pte Ltd All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Zalora South East Asia Pte Ltd nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. getopt-generics-0.13.0.3/Setup.hs0000755000000000000000000000011012576262530014660 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain getopt-generics-0.13.0.3/getopt-generics.cabal0000644000000000000000000000602513372077534017322 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.31.0. -- -- see: https://github.com/sol/hpack -- -- hash: a8f8322b2416d58ac189c12c7f304a9e93419217f59a6b53375ab335009c9bc3 name: getopt-generics version: 0.13.0.3 synopsis: Create command line interfaces with ease description: Create command line interfaces with ease category: Console, System homepage: https://github.com/soenkehahn/getopt-generics#readme bug-reports: https://github.com/soenkehahn/getopt-generics/issues author: Linh Nguyen, Sönke Hahn maintainer: linh.nguyen@zalora.com, soenkehahn@gmail.com copyright: Zalora South East Asia Pte Ltd license: BSD3 license-file: LICENSE build-type: Simple extra-source-files: docs/CustomOption.hs docs/CustomOption.shell-protocol docs/CustomOptionRecord.hs docs/CustomOptionRecord.shell-protocol docs/RecordType.hs docs/RecordType.shell-protocol docs/Simple.hs docs/Simple.shell-protocol docs/Test01.hs docs/Test01.shell-protocol docs/Test02.hs docs/Test02.shell-protocol docs/Test03.hs docs/Test03.shell-protocol docs/Test04.hs docs/Test04.shell-protocol source-repository head type: git location: https://github.com/soenkehahn/getopt-generics library exposed-modules: WithCli WithCli.Pure other-modules: WithCli.Argument WithCli.Flag WithCli.HasArguments WithCli.Modifier WithCli.Modifier.Types WithCli.Normalize WithCli.Parser WithCli.Pure.Internal WithCli.Result Paths_getopt_generics hs-source-dirs: src ghc-options: -Wall -fno-warn-name-shadowing build-depends: base ==4.* , base-compat >=0.8 , base-orphans , generics-sop >=0.1 && <0.5 , tagged default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: WithCli WithCli.Argument WithCli.Flag WithCli.HasArguments WithCli.Modifier WithCli.Modifier.Types WithCli.Normalize WithCli.Parser WithCli.Pure WithCli.Pure.Internal WithCli.Result DocsSpec ModifiersSpec ModifiersSpec.RenameOptionsSpec ModifiersSpec.UseForPositionalArgumentsSpec ShellProtocol Util WithCli.ArgumentSpec WithCli.HasArgumentsSpec WithCli.ModifierSpec WithCli.NormalizeSpec WithCli.ParserSpec WithCli.Pure.RecordSpec WithCli.PureSpec WithCli.ResultSpec WithCliSpec CustomOption CustomOptionRecord RecordType Simple Test01 Test02 Test03 Test04 Paths_getopt_generics hs-source-dirs: src test docs ghc-options: -Wall -fno-warn-name-shadowing -threaded -O0 build-depends: QuickCheck , base ==4.* , base-compat >=0.8 , base-orphans , filepath , generics-sop >=0.1 && <0.5 , hspec >=2.1.8 , safe , silently , tagged default-language: Haskell2010 getopt-generics-0.13.0.3/docs/CustomOption.shell-protocol0000644000000000000000000000017212601754342021510 0ustar0000000000000000$ program --help program [OPTIONS] custom-file-type -h --help show help and exit $ program some/file File "some/file" getopt-generics-0.13.0.3/docs/CustomOptionRecord.shell-protocol0000644000000000000000000000026012601754307022646 0ustar0000000000000000$ program --file some/file Options {file = File "some/file"} $ program --help program [OPTIONS] --file=custom-file-type -h --help show help and exit getopt-generics-0.13.0.3/docs/RecordType.shell-protocol0000644000000000000000000000074112601754307021130 0ustar0000000000000000$ program --port 8080 --config some/path Options {port = 8080, daemonize = False, config = Just "some/path"} $ program --port 8080 --daemonize Options {port = 8080, daemonize = True, config = Nothing} $ program --port foo cannot parse as INTEGER: foo # exit-code 1 $ program missing option: --port=INTEGER # exit-code 1 $ program --help program [OPTIONS] --port=INTEGER --daemonize --config=STRING (optional) -h --help show help and exit getopt-generics-0.13.0.3/docs/Simple.shell-protocol0000644000000000000000000000055712601754307020306 0ustar0000000000000000$ program foo 42 true ("foo",42,True) $ program --help program [OPTIONS] STRING INTEGER BOOL -h --help show help and exit $ program foo 42 bar cannot parse as BOOL: bar # exit-code 1 $ program missing argument of type STRING missing argument of type INTEGER missing argument of type BOOL # exit-code 1 $ program foo 42 yes bar unknown argument: bar # exit-code 1 getopt-generics-0.13.0.3/docs/Test01.shell-protocol0000644000000000000000000000022012601754307020120 0ustar0000000000000000$ program 42 missing argument of type BOOL # exit-code 1 $ program missing argument of type INTEGER missing argument of type BOOL # exit-code 1 getopt-generics-0.13.0.3/docs/Test02.shell-protocol0000644000000000000000000000125512601754344020133 0ustar0000000000000000$ program --port 8080 --config some/path Options {port = 8080, daemonize = False, config = Just "some/path", args = []} $ program --port 8080 --config some/path --foo true unrecognized option `--foo' unknown argument: true # exit-code 1 $ program --port 8080 --daemonize --config some Options {port = 8080, daemonize = True, config = Just "some", args = []} $ program --port foo cannot parse as INTEGER: foo # exit-code 1 $ program missing option: --port=INTEGER # exit-code 1 $ program --help program [OPTIONS] --port=INTEGER --daemonize --config=STRING (optional) --args=STRING (multiple possible) -h --help show help and exit getopt-generics-0.13.0.3/docs/Test03.shell-protocol0000644000000000000000000000025112601754307020126 0ustar0000000000000000$ program --aa foo --bb bar (A {aa = "foo"},B {bb = "bar"}) $ program --help program [OPTIONS] --aa=STRING --bb=STRING -h --help show help and exit getopt-generics-0.13.0.3/docs/Test04.shell-protocol0000644000000000000000000000025112601754307020127 0ustar0000000000000000$ program --aa foo --bb bar (A {aa = "foo"},B {bb = "bar"}) $ program --help program [OPTIONS] --aa=STRING --bb=STRING -h --help show help and exit