docopt 0.6.0.2 → 0.7.0.0

raw patch · 10 files changed

+637/−145 lines, 10 filesdep +template-haskelldep +th-liftPVP ok

version bump matches the API change (PVP)

Dependencies added: template-haskell, th-lift

API changes (from Hackage documentation)

Files

• CHANGELOG.md +38/−0
• README.md +210/−0
• System/Console/Docopt.hs +42/−3
• System/Console/Docopt/NoTH.hs +38/−0
• System/Console/Docopt/OptParse.hs +44/−43
• System/Console/Docopt/Public.hs +139/−88
• System/Console/Docopt/QQ.hs +73/−0
• System/Console/Docopt/QQ/Instances.hs +19/−0
• System/Console/Docopt/Types.hs +12/−6
• docopt.cabal +22/−5

@@ -0,0 +1,38 @@+# 0.7.0.0++- Add usage parsing QuasiQuoters [#7]+  - Add `docopt` usage parsing QuasiQuoter+  - Add `docoptFile` usage parsing QuasiQuoter+  - Add `System.Docopt.NoTH` module+    - Add `parseUsage`+    - Add `parseUsageOrExit`+- New API organization [#10]+  - Remove `optionsWithUsage`+  - Remove `optionsWithUsageDebug`+  - Remove `optionsWithUsageFile`+  - Remove `optionsWithUsageFileDebug`+  - Add `Docopt` type to represent a parsed usage string+  - Add `usage`+  - Add `parseArgs`+  - Add `parseArgsOrExit`+  - Add `exitWithUsage`+  - Add `exitWithUsageMessage`+  - Monomorphize `getArg` from `Monad m` to `Maybe`+  - Add `getArgOrExitWith`+  - Deprecate `getAllArgsM`+  - Deprecate `notPresentM`+  - Deprecate `isPresentM`+  - Deprecate `getFirstArg`+- Add thorough haddock API documentation+  +### 0.6.0.2++- Make `argument` not require its named option wrapped in angle brackets. [#4, #5]++### 0.6.0.1++- Fix haddock docs.++# 0.6.0.0++First release! Tracks features of reference Python implementation at version `0.6`.

@@ -0,0 +1,210 @@+Docopt.hs+=========++A Haskell port of python's [docopt](http://docopt.org).++----------++## Want a command-line interface *without* building a parser?++How about writing your help text first, and getting a parser for free!++Save your help text to a file (i.e. `USAGE.txt`):++    Usage: +      myprog cat <file>+      myprog echo [--caps] <string>++    Options:+      -c, --caps    Caps-lock the echoed argument++Then, in your `Myprog.hs`:+    +```haskell+{-# LANGUAGE QuasiQuotes #-}+import Control.Monad (when)+import Data.Char (toUpper)+import System.Console.Docopt++patterns :: Docopt+patterns = [docoptFile|USAGE.txt|]++main = do+  args <- parseArgsOrExit patterns =<< getArgs++  when (args `isPresent` (command "cat")) $ do+    file <- args `getArgOrExit` (argument "file")+    putStr =<< readFile file++  when (args `isPresent` (command "echo")) $ do+    let charTransform = if args `isPresent` (longOption "caps")+                          then toUpper+                          else id+    string <- args `getArgOrExit` (argument "string")+    putStrLn $ map charTransform string+```++That's it! No Template Haskell, no unreadable syntax, no learning yet *another* finicky API. Write the usage patterns you support, and docopt builds the appropriate option parser for you (internally using [`parsec`](http://hackage.haskell.org/package/parsec)). If your user invokes your program correctly, you query for the arguments they provided. If the arguments provided do not match a supported usage pattern, you guessed it: docopt automatically prints the help text and exits!+++Installation+------------++    cabal sandbox init+    cabal install docopt++API Reference+-------------++See [the package on hackage](https://hackage.haskell.org/package/docopt)+++Help text format+================++Docopt only cares about 2 parts of your help text:+ +- **Usage patterns**, e.g.:++  ```+      Usage: +        my_program [-hs] [-o=<file>] [--quiet | --verbose] [<input>...]+  ```+  These begin with `Usage:` (case-insensitive), and end with a blank line. ++- **Option descriptions**, e.g.: ++  ```+      Options:+        -h --help    show this+        -s --sorted  sorted output+        -o=<file>    specify output file +                     [default: ./test.txt]+        --quiet      print less text+        --verbose    print more text+  ```++  Any line after the usage patterns that begins with a `-` is treated as an option description (though an option's default may be on a different line).++Usage Patterns+--------------++- #### `<argument>`++  Positional arguments. Constructed via `argument`, i.e. `argument "arg"` matches an `<arg>` element in the help text.++- #### `--flag` or `--option=<arg>`++  Options are typically optional (though this is up to you), and can be either boolean (present/absent), as in `--flag`, or expect a trailing argument, as in `--option=<arg>`. Arguments can be separated from the option name by an `=` or a single space, and can be in `<arg>` form or `ARG` form (though consistency of style is recommended, it is not enforced). ++  Short-style options, as in `-f` or `-f ARG`, are also allowed. Synonyms between different spellings of the same option (e.g. `-v` and `--verbose`) can be established in the option descriptions (see below). Short-style options can also be stacked, as in `-rfA`. When options are stacked, `-rfA` is effectively equivalent to `(-r | -f | -A)...` to the argument parser.++  You can match a long-style option `--flag` with `longOption "flag"`, and a short-style option `-f` with `shortOption 'f'` The same constructor is used whether the option expects an argument or not.++- #### `command`++  Anything not recognized as a positional argument or a short or long option is treated as a command (or subcommand, same thing to docopt). A command named `pull` can be matched with `command "pull"`. ++- #### `[]` (brackets) e.g. `command [--option]`++  Patterns inside brackets are **optional**.++- #### `()` (parens)++  Patterns inside parens are **required** (the same as patterns *not* in `()` are required). Parens are useful if you need to group some elements, either for use with `|` or `...`.++- #### `|` (pipe) e.g. `command [--quiet | --verbose]`++  A pipe `|` separates mutually elements in a group. A group could be elements inside `[]`, `()`, or the whole usage line. ++  ```+      Usage:+        myprog command [--opt1 | --opt2]  # valid+        myprog go (left | right)          # valid+        myprog -v | -h                    # valid+  ```++  When elements are separated by a pipe, the elements are tried from left to right until one succeeds. At least one of the elements are required unless in an eplicitly optional group surrounded by `[]`.++- #### `...` (ellipsis) e.g. `command <file>...`++  An ellipsis can trail any element or group to make it repeatable. Repeatable elements will be accumulated into a list of occurrences.++- #### `[options]` (case sensitive)++  The string `[options]` is a shortcut to match any options specified in your option descriptions.++- #### `[-]` and `[--]`++  Single hyphen `-` is used by convention to specify using `stdin` as input instead of reading a file. Double hyphen `--` is typically used to manually separate leading options from trailing positional arguments. Both of these are treated as `command`s, and so are perfectly legal in usage patterns. They are typically optional elements, but can be required if you drop the `[]`. ++Option descriptions+-------------------++Option descriptions establish:+- which short and long options are synonymous+- whether an option expects an argument or is a simple flag+- if an option's argument has a default value++**Rules**:++- Any line *after* the usage patterns whose first non-space character is a `-` is treated as an option description. (`Options:` prefix line not required).+      +  ```+      Options: --help       # invalid: line does not start with '-'+               --verbose    # good+  ```++- Options on the same line will be treated by the parser as synonyms (everywhere interchangeable). Synonymous options are separated by a space (with optional comma):++  ```+      Usage:+        myprog --help | --verbose++      Options: +        -h, --help      Print help text+        -v --verbose    Print help text twice +  ```++  Here, `myprog --help` and `myprog -h` will both work the same, as will `myprog --verbose` and `myprog -v`.++- If any synonymous options are specified in the description with an argument, the option parser will expect an argument for all synonyms. If not, all synonyms will be treated as flags.++  ```+      Usage:+        myprog analyze [--verbose] <file>++      Options:+        --verbose, -v LEVEL   The level of output verbosity.+  ```++  Here, in the arguments `myprog analyze --verbose ./file1.txt` would be invalid, because `-v` *and its synonyms* expect an argument, so `./file1.txt` is captured as the argument of `--verbose`, *not* as the positional argument `<file>`. Be careful!++  Options can be separated from arguments with a single space or a `=`, and arguments can have the form `<arg>` or `ARG`. Just be sure to separate synonyms and arguments from the beginning of the description by **at least 2 spaces**.++  ```+      --opt1 ARG1   Option 1.+      --opt2=<arg2> Option 2.        # BAD: use 2 spaces+      -a <arg3>     Option 3.+      -b=ARG4       Option 4. +  ```++- Options that expect arguments can be given a default value, in the form `[default: <default-val>]`. Default values do not need to be on the same line++  ```+      --host=NAME       Host to listen on. [default: localhost]+      --port=PORT       Port number [default: 8080]+      --directory=DIR   This option has an especially long description +                        explaining its meaning. [default: ./]+  ```++----------------+++#### Differences from reference python implementation:++  - does not automatically exclude from the `[options]` shortcut options that are already used elsewhere in the usage pattern (e.g. `usage: prog [options] -a` will try to parse `-a` twice).++  - does not automatically resolve partially-specified arguments, e.g. `--verb` does not match where `--verbose` is expected. This is planned to be deprecated in future versions of docopt, and will likely not be implemented in docopt.hs++  - is not insensitive to the ordering of adjacent options, e.g. `usage: prog -a -b` does not allow `prog -b -a` (reference implementation currently does).

@@ -1,7 +1,46 @@-module System.Console.Docopt -  ( -    module System.Console.Docopt.Public,+-- | Example:+--+-- @+-- {-\# LANGUAGE QuasiQuotes \#-}+-- module Main where+--+-- import Control.Monad (when)+-- import Data.Char (toUpper)+-- import System.Console.Docopt+--+-- patterns :: Docopt+-- patterns = [docopt|+-- docopt-sample version 0.1.0+--+-- Usage:+--   docopt-sample cat \<file\>+--   docopt-sample echo [--caps] \<string\>+--+-- Options:+--   -c, --caps    Caps-lock the echoed argument+-- |]+--+-- main :: IO ()+-- main = do+--   args <- parseArgsOrExit patterns+--+--   when (args \`isPresent\` (command \"cat\")) $ do+--     file <- args \`getArgOrExit\` (argument \"file\")+--     putStr =<< readFile file+--+--   when (args \`isPresent\` (command \"echo\")) $ do+--     let charTransform = if args \`isPresent\` (longOption \"caps\")+--                         then toUpper+--                         else id+--     string <- args \`getArgOrExit\` (argument \"string\")+--     putStrLn $ map charTransform string+-- @+module System.Console.Docopt+  (+    module System.Console.Docopt.QQ,+    module System.Console.Docopt.Public   )   where +import System.Console.Docopt.QQ import System.Console.Docopt.Public

@@ -0,0 +1,38 @@+module System.Console.Docopt.NoTH+  (+    -- * Usage parsers+      parseUsage+    , parseUsageOrExit++    , module System.Console.Docopt.Public+  )+  where++import Data.Map as M hiding (null)+import System.Exit++import System.Console.Docopt.Types+import System.Console.Docopt.Public+import System.Console.Docopt.ParseUtils+import System.Console.Docopt.UsageParse (pDocopt)+++-- | Parse docopt-formatted usage patterns.+--+--   For help with the docopt usage format, see+--   <https://github.com/docopt/docopt.hs/blob/master/README.md#help-text-format the readme on github>.+parseUsage :: String -> Either ParseError Docopt+parseUsage usg =+  case runParser pDocopt M.empty "Usage" usg of+    Left e       -> Left e+    Right optfmt -> Right (Docopt optfmt usg)++-- | Same as 'parseUsage', but 'exitWithUsage' on parse failure. E.g.+--+-- > let usageStr = "Usage:\n  prog [--option]\n"+-- > patterns <- parseUsageOrExit usageStr+parseUsageOrExit :: String -> IO Docopt+parseUsageOrExit usg = exitUnless $ parseUsage usg+  where+    exit message = putStrLn message >> exitFailure+    exitUnless = either (const $ exit usg) return

@@ -1,4 +1,4 @@-module System.Console.Docopt.OptParse +module System.Console.Docopt.OptParse   where  import Control.Monad (unless)@@ -10,20 +10,20 @@ import System.Console.Docopt.Types  --- | The meat and potatoes. +-- | The meat and potatoes. --   @delim@ is an obscure delimiter with which to intercalate the argv list, --   @fmt@ is the OptPattern together with metadata to tell the parser how to parse args.---   Together, these let @buildOptParser@ build a parsec parser that can be applied to an argv. +--   Together, these let @buildOptParser@ build a parsec parser that can be applied to an argv. buildOptParser :: String -> OptFormat -> CharParser OptParserState ()-buildOptParser delim fmt@(pattern, infomap) = -  +buildOptParser delim fmt@(pattern, infomap) =+   let -- Helpers       argDelim = (try $ string delim) <?> "space between arguments"-      +       makeParser p = buildOptParser delim (p, infomap)-      -      argDelimIfNotInShortOptStack = do -        st <- getState ++      argDelimIfNotInShortOptStack = do+        st <- getState         if not $ inShortOptStack st           then optional argDelim           else return ()@@ -41,20 +41,20 @@       updateSt_assertPresent opt = updateOptWith (\opt info _ -> assertPresent opt info) opt ""        updateSt_inShortOptStack = updateState . updateInShortOptStack-  +   in case pattern of   (Sequence pats) ->-      assertTopConsumesAll $ foldl (andThen) (return ()) ps +      assertTopConsumesAll $ foldl (andThen) (return ()) ps       where assertTopConsumesAll p = do               st <- getState               if inTopLevelSequence st-                then do +                then do                   updateState $ \st -> st {inTopLevelSequence = False}                   p <* eof-                else p +                else p             inner_pats = (\pat -> (pat, infomap)) `map` pats             ps = (buildOptParser delim) `map` inner_pats-            andThen = \p1 p2 -> do +            andThen = \p1 p2 -> do               p1               argDelimIfNotInShortOptStack               p2@@ -69,8 +69,8 @@                     argDelimIfNotInShortOptStack                     makeParser $ Unordered rest   (Optional pat) ->-        case pat of -          Unordered ps -> case ps of +        case pat of+          Unordered ps -> case ps of             p:[] -> makeParser $ Optional p             _  -> optional $ choice $ (parseThisThenRest ps) `map` ps                   where parseThisThenRest list pat = try $ do@@ -78,27 +78,27 @@                           let rest = list \\ [pat]                           argDelimIfNotInShortOptStack                           makeParser $ Optional $ Unordered rest-          _ -> optional $ try $ makeParser pat +          _ -> optional $ try $ makeParser pat   (Repeated pat) -> do-      case pat of +      case pat of         (Optional p) -> (try $ makeParser p) `sepBy` argDelimIfNotInShortOptStack         _            -> (try $ makeParser pat) `sepBy1` argDelimIfNotInShortOptStack       return ()-  (Atom pat) -> case pat of +  (Atom pat) -> case pat of       o@(ShortOption c) ->             do  st <- getState                 if inShortOptStack st then return () else char '-' >> return ()                 char c                 updateState $ updateInShortOptStack True-                val <- if expectsVal $ M.findWithDefault (fromSynList []) o infomap -                  then try $ do +                val <- if expectsVal $ M.findWithDefault (fromSynList []) o infomap+                  then try $ do                     optional $ string "=" <|> argDelim                     updateState $ updateInShortOptStack False                     manyTill1 anyChar (lookAhead_ argDelim <|> eof)                   else do                     stillInShortStack <- isNotFollowedBy argDelim-                    unless stillInShortStack $ -                      updateState $ updateInShortOptStack False +                    unless stillInShortStack $+                      updateState $ updateInShortOptStack False                     return ""                 updateState $ withEachSynonym o $                               \pa syn info -> saveOccurrence syn info val pa@@ -106,8 +106,8 @@       o@(LongOption name) ->             do string "--"                string name-               val <- if expectsVal $ M.findWithDefault (fromSynList []) o infomap -                 then do +               val <- if expectsVal $ M.findWithDefault (fromSynList []) o infomap+                 then do                    string "=" <|> argDelim                    --many (notFollowedBy (string delim) >> anyChar)                    manyTill1 anyChar (lookAhead_ argDelim <|> eof)@@ -122,7 +122,7 @@                 --synparsers = oneOf `map` synlists                 oneOfSyns = map (\ss -> OneOf (map Atom ss)) synlists                 unorderedSynParser = buildOptParser delim (Unordered oneOfSyns, infomap)-            in  unorderedSynParser +            in  unorderedSynParser                 <?> humanize o       o@(Argument name) ->             do val <- try $ many1 (notFollowedBy argDelim >> anyChar)@@ -154,7 +154,7 @@ saveOccurrence opt info newval argmap = M.alter updateCurrentVal opt argmap     where updateCurrentVal m_oldval = case m_oldval of             Nothing     -> (newval `updateFrom`) =<< (optInitialValue info opt)-            Just oldval -> newval `updateFrom` oldval +            Just oldval -> newval `updateFrom` oldval           updateFrom newval oldval = Just $ case oldval of             MultiValue vs -> MultiValue $ newval : vs             Value v       -> Value newval@@ -166,42 +166,42 @@ assertPresent :: Option -> OptionInfo -> Arguments -> Arguments assertPresent opt info argmap = saveOccurrence opt info "" argmap -withEachSynonym :: Option -> -                   (Arguments -> Option -> OptionInfo -> Arguments) -> -                   OptParserState -> +withEachSynonym :: Option ->+                   (Arguments -> Option -> OptionInfo -> Arguments) ->+                   OptParserState ->                    OptParserState-withEachSynonym opt savefn st = +withEachSynonym opt savefn st =   let infomap = optInfoMap st       args = parsedArgs st       syns = synonyms $ M.findWithDefault (fromSynList []) opt infomap       -- give the savefn each opt's info, as well-      foldsavefn = \args opt -> +      foldsavefn = \args opt ->                     let info = M.findWithDefault (fromSynList []) opt infomap-                    in savefn args opt info +                    in savefn args opt info   in st {parsedArgs = foldl foldsavefn args syns}   optInitialValue :: OptionInfo -> Option -> Maybe ArgValue-optInitialValue info opt = -  let repeatable = isRepeated info +optInitialValue info opt =+  let repeatable = isRepeated info   in case opt of     Command name  -> Just $ if repeatable then Counted 0 else NotPresent     Argument name -> Just $ if repeatable then MultiValue [] else NoValue     AnyOption     -> Nothing -- no storable value for [options] shortcut-    _             -> case expectsVal info of +    _             -> case expectsVal info of       True  -> Just $ if repeatable then MultiValue [] else NoValue       False -> Just $ if repeatable then Counted 0 else NotPresent  optDefaultValue :: OptionInfo -> Option -> Maybe ArgValue-optDefaultValue info opt = +optDefaultValue info opt =   let repeatable = isRepeated info-  in case opt of +  in case opt of     Command name  -> Just $ if repeatable then Counted 0 else NotPresent     Argument name -> Just $ if repeatable then MultiValue [] else NoValue     AnyOption     -> Nothing -- no storable value for [options] shortcut-    _               -> case expectsVal info of +    _               -> case expectsVal info of       True  -> case defaultVal info of-        Just dval -> Just $ if repeatable +        Just dval -> Just $ if repeatable                             then MultiValue $ reverse $ words dval                             else Value dval         Nothing   -> Just $ if repeatable then MultiValue [] else NoValue@@ -209,15 +209,16 @@   getArguments :: OptFormat -> [String] -> Either ParseError Arguments-getArguments optfmt argv = +getArguments optfmt argv =     let (pattern, infomap) = optfmt          -- delimiter used to flatten argv to parsable String-        delim = "«»" +        -- TODO: parse argv without a nasty intercalate hack+        delim = "«»"         argvString = delim `intercalate` argv          p = parsedArgs <$> (returnState $ buildOptParser delim optfmt)-        +         patAtoms = atoms pattern         infoKeys = (\\ [AnyOption]) $ M.keys infomap         allAtoms = nub $ patAtoms ++ infoKeys

@@ -1,63 +1,86 @@-module System.Console.Docopt.Public +module System.Console.Docopt.Public   (-    -- everything locally declared-    module System.Console.Docopt.Public,+    -- * Command line arguments parsers+      parseArgs+    , parseArgsOrExit -    -- public types-    Option(),-    Arguments(),+    -- *** Re-exported from Parsec+    , ParseError++    -- * Parsed usage string+    , Docopt ()+    , usage+    , exitWithUsage+    , exitWithUsageMessage++    -- * Argument lookup+    , Option()+    , Arguments()++    -- ** Query functions+    , isPresent+    , notPresent+    , getArg+    , getArgOrExitWith+    , getArgWithDefault+    , getAllArgs+    , getArgCount++    -- ** 'Option' constructors+    , command+    , argument+    , shortOption+    , longOption++    -- ** Deprecated+    , getAllArgsM+    , notPresentM+    , isPresentM+    , getFirstArg   )   where -import System.Environment (getArgs) import System.Exit  import Data.Map as M hiding (null)--import Control.Applicative--import System.Console.Docopt.ParseUtils+import Data.Maybe (fromMaybe) import System.Console.Docopt.Types-import System.Console.Docopt.UsageParse (pDocopt)-import System.Console.Docopt.OptParse (getArguments)+import System.Console.Docopt.ApplicativeParsec (ParseError)+import System.Console.Docopt.OptParse  --- * Public API---- ** Main option parsing entry points--optionsWithUsage :: String -> [String] -> IO Arguments-optionsWithUsage usage rawArgs = -    case runParser pDocopt M.empty "Usage" usage of-        Left err -> do putStrLn usage-                       exitFailure-        Right fmt -> case getArguments fmt rawArgs of-            Left err         -> do putStrLn usage-                                   exitFailure-            Right parsedArgs -> return parsedArgs+-- | Parse command line arguments.+parseArgs :: Docopt -> [String] -> Either ParseError Arguments+parseArgs parser = getArguments (optFormat parser) -optionsWithUsageDebug :: String -> [String] -> IO Arguments-optionsWithUsageDebug usage rawArgs =-    case runParser pDocopt M.empty "Usage" usage of-        Left err  -> fail $ show err-        Right fmt -> case getArguments fmt rawArgs of-            Left err         -> fail $ show err-            Right parsedArgs -> return parsedArgs+-- | Same as 'parseArgs', but 'exitWithUsage' on parse failure. E.g.+--+-- > args <- parseArgsOrExit patterns =<< getArgs+parseArgsOrExit :: Docopt -> [String] -> IO Arguments+parseArgsOrExit parser argv = either (const $ exitWithUsage parser) return $ parseArgs parser argv -optionsWithUsageFile :: FilePath -> IO Arguments-optionsWithUsageFile path = do usageStr <- readFile path-                               rawArgs <- getArgs-                               optionsWithUsage usageStr rawArgs+-- | Exit after printing usage text.+exitWithUsage :: Docopt -> IO a+exitWithUsage doc = do+  putStr $ usage doc+  exitFailure -optionsWithUsageFileDebug :: FilePath -> IO Arguments-optionsWithUsageFileDebug path = do usageStr <- readFile path-                                    rawArgs <- getArgs-                                    optionsWithUsageDebug usageStr rawArgs+-- | Exit after printing a custom message followed by usage text.+--   Intended for convenience when more context can be given about what went wrong.+exitWithUsageMessage :: Docopt -> String -> IO a+exitWithUsageMessage doc msg = do+  putStrLn msg+  putStrLn ""+  exitWithUsage doc --- ** Option lookup methods+-- Query functions+------------------ +-- | 'True' if an option was present at all in an invocation.+--+--   Useful with 'longOption's and 'shortOption's, and in conjunction with 'Control.Monad.when'. isPresent :: Arguments -> Option -> Bool-isPresent args opt = +isPresent args opt =   case opt `M.lookup` args of     Nothing  -> False     Just val -> case val of@@ -65,56 +88,53 @@       NotPresent -> False       _          -> True -isPresentM :: Monad m => Arguments -> Option -> m Bool-isPresentM args o = return $ isPresent args o- notPresent :: Arguments -> Option -> Bool-notPresent args o = not $ isPresent args o--notPresentM :: Monad m => Arguments -> Option -> m Bool-notPresentM args o = return $ not $ isPresent args o--getArg :: Monad m => Arguments -> Option -> m String-getArg args opt = -  let failure = fail $ "no argument given: " ++ show opt-  in  case opt `M.lookup` args of-        Nothing  -> failure-        Just val -> case val of-          MultiValue (v:vs) -> return v-          Value v           -> return v-          _                 -> failure          +notPresent = (not .) . isPresent -getFirstArg :: Monad m => Arguments -> Option -> m String-getFirstArg args opt = -  let failure = fail $ "no argument given: " ++ show opt-  in  case opt `M.lookup` args of-        Nothing  -> failure-        Just val -> case val of-          MultiValue vs -> if null vs then failure else return $ last vs-          Value v       -> return v-          _             -> failure          +-- | 'Just' the value of the argument supplied, or 'Nothing' if one was not given.+--+--   If the option's presence is required by your 'Docopt' usage text+--   (e.g. a positional argument), as in+--+-- > Usage:+-- >   prog <required>+--+--   then @getArg args (argument \'required\')@ is guaranteed to be a 'Just'.+getArg :: Arguments -> Option -> Maybe String+getArg args opt =+  case opt `M.lookup` args of+    Nothing  -> Nothing+    Just val -> case val of+      MultiValue (v:_) -> Just v+      Value v          -> Just v+      _                -> Nothing +-- | Same as 'getArg', but 'exitWithUsage' if 'Nothing'.+--+--   As in 'getArg', if your usage pattern required the option, 'getArgOrExitWith' will not exit.+getArgOrExitWith :: Docopt -> Arguments -> Option -> IO String+getArgOrExitWith doc args opt = exitUnless $ getArg args opt+  where exitUnless = maybe (exitWithUsageMessage doc $ "argument expected for: " ++ show opt) return +-- | Same as 'getArg', but eliminate 'Nothing' with a default argument. getArgWithDefault :: Arguments -> String -> Option -> String-getArgWithDefault args def opt = -  case args `getArg` opt of-    Just val -> val-    Nothing -> def+getArgWithDefault args def opt = fromMaybe def (args `getArg` opt) +-- | Returns all occurrences of a repeatable option, e.g. @\<file\>...@. getAllArgs :: Arguments -> Option -> [String]-getAllArgs args opt = +getAllArgs args opt =   case opt `M.lookup` args of-     Nothing  -> []-     Just val -> case val of-       MultiValue vs -> reverse vs-       Value v       -> [v] -       _             -> []--getAllArgsM :: Monad m => Arguments -> Option -> m [String]-getAllArgsM o e = return $ getAllArgs o e+    Nothing  -> []+    Just val -> case val of+      MultiValue vs -> reverse vs+      Value v       -> [v]+      _             -> [] +-- | Return the number of occurrences of an option in an invocation.+--+--   Useful with repeatable flags, e.g. @[ -v | -vv | -vvv]@. getArgCount :: Arguments -> Option -> Int-getArgCount args opt = +getArgCount args opt =   case opt `M.lookup` args of     Nothing -> 0     Just val -> case val of@@ -125,16 +145,47 @@       _             -> 0  --- ** Public Option constructor functions+-- Option constructors+---------------------- +-- | For @Usage: prog cmd@, ask for @command \"cmd\"@. command :: String -> Option-command s = Command s+command = Command +-- | For @Usage: prog \<file\>@, ask for @argument \"file\"@. argument :: String -> Option-argument s = Argument s+argument = Argument +-- | For @Usage: prog -h@, ask for @shortOption \'h\'@. shortOption :: Char -> Option-shortOption c = ShortOption c+shortOption = ShortOption +-- | For @Usage: prog --version@, ask for @shortOption \"version\"@. longOption :: String -> Option-longOption s = LongOption s+longOption = LongOption++-- Deprecated+-------------++{-# DEPRECATED getAllArgsM "Monadic query functions will soon be removed" #-}+getAllArgsM :: Monad m => Arguments -> Option -> m [String]+getAllArgsM o e = return $ getAllArgs o e++{-# DEPRECATED notPresentM "Monadic query functions will soon be removed" #-}+notPresentM :: Monad m => Arguments -> Option -> m Bool+notPresentM args o = return $ not $ isPresent args o++{-# DEPRECATED isPresentM "Monadic query functions will soon be removed" #-}+isPresentM :: Monad m => Arguments -> Option -> m Bool+isPresentM args o = return $ isPresent args o++{-# DEPRECATED getFirstArg "Use 'getAllArgs' instead" #-}+getFirstArg :: Monad m => Arguments -> Option -> m String+getFirstArg args opt =+  let failure = fail $ "no argument given: " ++ show opt+  in  case opt `M.lookup` args of+        Nothing  -> failure+        Just val -> case val of+          MultiValue vs -> if null vs then failure else return $ last vs+          Value v       -> return v+          _             -> failure

@@ -0,0 +1,73 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_HADDOCK prune #-}+module System.Console.Docopt.QQ+    (+    -- * QuasiQuoter usage parsers+      docopt+    , docoptFile+    ) where++import qualified Data.Map as M++import System.Console.Docopt.Types+import System.Console.Docopt.QQ.Instances ()+import System.Console.Docopt.ApplicativeParsec+import System.Console.Docopt.UsageParse++import Language.Haskell.TH+import Language.Haskell.TH.Quote++parseFmt :: FilePath -> String -> Either ParseError OptFormat+parseFmt = runParser pDocopt M.empty++docoptExp :: String -> Q Exp+docoptExp usg = do+  let mkDocopt fmt = Docopt { usage = usg, optFormat = fmt }+  loc <- loc_filename <$> location+  case mkDocopt <$> parseFmt loc usg of+    Left err     -> fail $ show err+    Right parser -> [| parser |]++-- | A 'QuasiQuoter' which parses a usage string and returns a+-- 'Docopt'.+--+-- Example usage:+--+-- @+-- patterns :: Docopt+-- patterns = [docopt|+-- docopt-sample version 0.1.0+--+-- Usage:+--   docopt-sample cat \<file\>+--   docopt-sample echo [--caps] \<string\>+--+-- Options:+--   -c, --caps    Caps-lock the echoed argument+-- |]+-- @+--+-- For help with the docopt usage format, see+-- <https://github.com/docopt/docopt.hs/blob/master/README.md#help-text-format the readme on github>.+docopt :: QuasiQuoter+docopt = QuasiQuoter { quoteExp  = docoptExp+                     , quoteDec  = unsupported "Declaration"+                     , quotePat  = unsupported "Pattern"+                     , quoteType = unsupported "Type"+                     }+    where unsupported = fail . (++ " context unsupported")++-- | Same as 'docopt', but parses the given file instead of a literal+-- string.+--+-- Example:+--+-- @+-- patterns :: Docopt+-- patterns = [docoptFile|USAGE|]+-- @+--+-- where @USAGE@ is the name of a file which contains the usage+-- string (relative to the directory from which ghc is invoked).+docoptFile :: QuasiQuoter+docoptFile = quoteFile docopt

@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK hide, prune #-}+module System.Console.Docopt.QQ.Instances where++import System.Console.Docopt.Types+import Language.Haskell.TH.Lift++import qualified Data.Map as M++instance (Lift k, Lift v) => Lift (M.Map k v) where+    lift m = [| M.fromList assoc |]+        where assoc = M.toList m++$(deriveLiftMany [ ''Option+                 , ''Pattern+                 , ''OptionInfo+                 , ''Docopt+                 ])

@@ -28,6 +28,7 @@ atoms (Repeated p)   = atoms p atoms (Atom a)       = [a] +-- | A named leaf node of the usage pattern tree data Option = LongOption Name             | ShortOption Char             | Command Name@@ -47,13 +48,13 @@  -- | Used when parsing through the available option descriptions. --   Holds a list of synonymous options, Maybe a default value (if specified),---   an expectsVal :: Bool that indicates whether this option is a flag (--flag) ---   or an option that needs an argument (--opt=arg), and isRepeated :: Bool +--   an expectsVal :: Bool that indicates whether this option is a flag (--flag)+--   or an option that needs an argument (--opt=arg), and isRepeated :: Bool --   that indicates whether this option is always single or needs to be accumulated-data OptionInfo = OptionInfo +data OptionInfo = OptionInfo                   { synonyms :: [Option]                   , defaultVal :: Maybe String-                  , expectsVal :: Bool +                  , expectsVal :: Bool                   , isRepeated :: Bool                   } deriving (Show, Eq) @@ -71,8 +72,8 @@ --   Used to build the actual command-line arg parser. type OptFormat = (OptPattern, OptInfoMap) --- | -data OptParserState = OptParserState +-- |+data OptParserState = OptParserState                       { optInfoMap :: OptInfoMap                       , parsedArgs :: Arguments                       , inShortOptStack :: Bool@@ -98,3 +99,8 @@ --   (in order of last to first, if multiple values encountered) type Arguments = Map Option ArgValue +-- | An abstract data type which represents Docopt usage patterns.+data Docopt = Docopt { optFormat :: OptFormat+                     -- | Retrieve the original usage string.+                     , usage :: String+                     }

@@ -1,5 +1,5 @@ name:                docopt-version:             0.6.0.2+version:             0.7.0.0 synopsis:            A command-line interface parser that will make you smile description:         Docopt parses command-line interface usage text that adheres to a familiar syntax, and from it builds a command-line argument parser that will ensure your program is invoked correctly with the available options specified in the usage text. This allows the developer to write a usage text and get an argument parser for free. @@ -7,9 +7,8 @@ license-file:        LICENSE.txt author:              Ryan Artecona maintainer:          ryanartecona@gmail.com-copyright:           (c) 2013 Ryan Artecona +copyright:           (c) 2013-2015 Ryan Artecona -stability:           Experimental category:            Console  build-type:          Simple@@ -18,9 +17,18 @@ homepage:            https://github.com/docopt/docopt.hs bug-reports:         https://github.com/docopt/docopt.hs/issues +extra-source-files:  README.md+                     CHANGELOG.md++flag template-haskell+  default:      True+  manual:       True+  description:+    Build with QuasiQuoter usage parsers, which requires Template Haskell+ library-  exposed-modules:    System.Console.Docopt- +  exposed-modules:    System.Console.Docopt.NoTH+   other-modules:      System.Console.Docopt.ApplicativeParsec                       System.Console.Docopt.ParseUtils                       System.Console.Docopt.Types@@ -31,6 +39,15 @@   build-depends:      base == 4.*,                       parsec == 3.1.*,                       containers++  ghc-options:        -Wall -fno-warn-unused-do-bind++  if impl(ghc >= 6.10) && flag(template-haskell)+    exposed-modules:  System.Console.Docopt+    other-modules:    System.Console.Docopt.QQ+                      System.Console.Docopt.QQ.Instances+    build-depends:    template-haskell >= 2.7 && < 3.0,+                      th-lift >= 0.7 && < 1.0  test-suite tests   type:               exitcode-stdio-1.0