{-# LANGUAGE CPP #-}

module System.Console.Docopt.Public
  (
    -- * Command line arguments parsers
      parseArgs
    , parseArgsOrExit

    -- *** 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.Exit

#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail)
#endif

import Data.Map as M hiding (null)
import Data.Maybe (fromMaybe)
import System.Console.Docopt.Types
import System.Console.Docopt.ApplicativeParsec (ParseError)
import System.Console.Docopt.OptParse


-- | Parse command line arguments.
parseArgs :: Docopt -> [String] -> Either ParseError Arguments
parseArgs :: Docopt -> [String] -> Either ParseError Arguments
parseArgs Docopt
parser = OptFormat -> [String] -> Either ParseError Arguments
getArguments (Docopt -> OptFormat
optFormat Docopt
parser)

-- | Same as 'parseArgs', but 'exitWithUsage' on parse failure. E.g.
--
-- > args <- parseArgsOrExit patterns =<< getArgs
parseArgsOrExit :: Docopt -> [String] -> IO Arguments
parseArgsOrExit :: Docopt -> [String] -> IO Arguments
parseArgsOrExit Docopt
parser [String]
argv = (ParseError -> IO Arguments)
-> (Arguments -> IO Arguments)
-> Either ParseError Arguments
-> IO Arguments
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO Arguments -> ParseError -> IO Arguments
forall a b. a -> b -> a
const (IO Arguments -> ParseError -> IO Arguments)
-> IO Arguments -> ParseError -> IO Arguments
forall a b. (a -> b) -> a -> b
$ Docopt -> IO Arguments
forall a. Docopt -> IO a
exitWithUsage Docopt
parser) Arguments -> IO Arguments
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError Arguments -> IO Arguments)
-> Either ParseError Arguments -> IO Arguments
forall a b. (a -> b) -> a -> b
$ Docopt -> [String] -> Either ParseError Arguments
parseArgs Docopt
parser [String]
argv

-- | Exit after printing usage text.
exitWithUsage :: Docopt -> IO a
exitWithUsage :: forall a. Docopt -> IO a
exitWithUsage Docopt
doc = do
  String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Docopt -> String
usage Docopt
doc
  IO a
forall a. IO a
exitFailure

-- | 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 :: forall a. Docopt -> String -> IO a
exitWithUsageMessage Docopt
doc String
msg = do
  String -> IO ()
putStrLn String
msg
  String -> IO ()
putStrLn String
""
  Docopt -> IO a
forall a. Docopt -> IO a
exitWithUsage Docopt
doc

-- 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 :: Arguments -> Option -> Bool
isPresent Arguments
args Option
opt =
  case Option
opt Option -> Arguments -> Maybe ArgValue
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Arguments
args of
    Maybe ArgValue
Nothing  -> Bool
False
    Just ArgValue
val -> case ArgValue
val of
      ArgValue
NoValue       -> Bool
False
      ArgValue
NotPresent    -> Bool
False
      Counted Int
0     -> Bool
False
      MultiValue [] -> Bool
False
      ArgValue
_             -> Bool
True

notPresent :: Arguments -> Option -> Bool
notPresent :: Arguments -> Option -> Bool
notPresent = (Bool -> Bool
not (Bool -> Bool) -> (Option -> Bool) -> Option -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Option -> Bool) -> Option -> Bool)
-> (Arguments -> Option -> Bool) -> Arguments -> Option -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments -> Option -> Bool
isPresent

-- | '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 :: Arguments -> Option -> Maybe String
getArg Arguments
args Option
opt =
  case Option
opt Option -> Arguments -> Maybe ArgValue
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Arguments
args of
    Maybe ArgValue
Nothing  -> Maybe String
forall a. Maybe a
Nothing
    Just ArgValue
val -> case ArgValue
val of
      MultiValue (String
v:[String]
_) -> String -> Maybe String
forall a. a -> Maybe a
Just String
v
      Value String
v          -> String -> Maybe String
forall a. a -> Maybe a
Just String
v
      ArgValue
_                -> Maybe String
forall a. Maybe a
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 :: Docopt -> Arguments -> Option -> IO String
getArgOrExitWith Docopt
doc Arguments
args Option
opt = Maybe String -> IO String
forall {a}. Maybe a -> IO a
exitUnless (Maybe String -> IO String) -> Maybe String -> IO String
forall a b. (a -> b) -> a -> b
$ Arguments -> Option -> Maybe String
getArg Arguments
args Option
opt
  where exitUnless :: Maybe a -> IO a
exitUnless = IO a -> (a -> IO a) -> Maybe a -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Docopt -> String -> IO a
forall a. Docopt -> String -> IO a
exitWithUsageMessage Docopt
doc (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
"argument expected for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Option -> String
forall a. Show a => a -> String
show Option
opt) a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Same as 'getArg', but eliminate 'Nothing' with a default argument.
getArgWithDefault :: Arguments -> String -> Option -> String
getArgWithDefault :: Arguments -> String -> Option -> String
getArgWithDefault Arguments
args String
def Option
opt = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
def (Arguments
args Arguments -> Option -> Maybe String
`getArg` Option
opt)

-- | Returns all occurrences of a repeatable option, e.g. @\<file\>...@.
getAllArgs :: Arguments -> Option -> [String]
getAllArgs :: Arguments -> Option -> [String]
getAllArgs Arguments
args Option
opt =
  case Option
opt Option -> Arguments -> Maybe ArgValue
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Arguments
args of
    Maybe ArgValue
Nothing  -> []
    Just ArgValue
val -> case ArgValue
val of
      MultiValue [String]
vs -> [String] -> [String]
forall a. [a] -> [a]
reverse [String]
vs
      Value String
v       -> [String
v]
      ArgValue
_             -> []

-- | 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 :: Arguments -> Option -> Int
getArgCount Arguments
args Option
opt =
  case Option
opt Option -> Arguments -> Maybe ArgValue
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Arguments
args of
    Maybe ArgValue
Nothing -> Int
0
    Just ArgValue
val -> case ArgValue
val of
      Counted Int
i     -> Int
i
      MultiValue [String]
vs -> [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
vs
      Value String
_       -> Int
1
      ArgValue
Present       -> Int
1
      ArgValue
_             -> Int
0


-- Option constructors
----------------------

-- | For @Usage: prog cmd@, ask for @command \"cmd\"@.
--
--   For @Usage: prog -@ or @Usage: prog [-]@, ask for @command \"-\"@. Same for @--@.
command :: String -> Option
command :: String -> Option
command = String -> Option
Command

-- | For @Usage: prog \<file\>@, ask for @argument \"file\"@.
--
--   __Note:__ A @Usage: prog --output=\<file\>@ is /not/ matched by @argument \"file\"@. See 'longOption'.
argument :: String -> Option
argument :: String -> Option
argument = String -> Option
Argument

-- | For @Usage: prog -h@, ask for @shortOption \'h\'@.
--
--   For @Usage: prog -o=\<file\>@, ask for @shortOption \'o\'@.
shortOption :: Char -> Option
shortOption :: Char -> Option
shortOption = Char -> Option
ShortOption

-- | For @Usage: prog --version@, ask for @longOption \"version\"@.
--
--   For @Usage: prog --output=\<file\>@, ask for @longOption \"output\"@.
longOption :: String -> Option
longOption :: String -> Option
longOption = String -> Option
LongOption

-- Deprecated
-------------

{-# DEPRECATED getAllArgsM "Monadic query functions will soon be removed" #-}
getAllArgsM :: Monad m => Arguments -> Option -> m [String]
getAllArgsM :: forall (m :: * -> *). Monad m => Arguments -> Option -> m [String]
getAllArgsM Arguments
o Option
e = [String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ Arguments -> Option -> [String]
getAllArgs Arguments
o Option
e

{-# DEPRECATED notPresentM "Monadic query functions will soon be removed" #-}
notPresentM :: Monad m => Arguments -> Option -> m Bool
notPresentM :: forall (m :: * -> *). Monad m => Arguments -> Option -> m Bool
notPresentM Arguments
args Option
o = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Arguments -> Option -> Bool
isPresent Arguments
args Option
o

{-# DEPRECATED isPresentM "Monadic query functions will soon be removed" #-}
isPresentM :: Monad m => Arguments -> Option -> m Bool
isPresentM :: forall (m :: * -> *). Monad m => Arguments -> Option -> m Bool
isPresentM Arguments
args Option
o = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Arguments -> Option -> Bool
isPresent Arguments
args Option
o

{-# DEPRECATED getFirstArg "Use 'getAllArgs' instead" #-}
getFirstArg :: MonadFail m => Arguments -> Option -> m String
getFirstArg :: forall (m :: * -> *).
MonadFail m =>
Arguments -> Option -> m String
getFirstArg Arguments
args Option
opt =
  let failure :: m a
failure = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"no argument given: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Option -> String
forall a. Show a => a -> String
show Option
opt
  in  case Option
opt Option -> Arguments -> Maybe ArgValue
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Arguments
args of
        Maybe ArgValue
Nothing  -> m String
forall {a}. m a
failure
        Just ArgValue
val -> case ArgValue
val of
          MultiValue [String]
vs -> if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
vs then m String
forall {a}. m a
failure else String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. HasCallStack => [a] -> a
last [String]
vs
          Value String
v       -> String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
v
          ArgValue
_             -> m String
forall {a}. m a
failure