Commit 96523829 authored by Jonas Oberschweiber's avatar Jonas Oberschweiber

CurryDoc!

parent 67befcf4
module OptParse where
module OptParse
( Arg
, Parser
, ParseSpec
, ArgProps
, OptProps
, Mod
, long
, short
, optional
, metavar
, help
, (<>)
, (<.>)
, (<|>)
, option
, arg
, rest
, flag
, command
, commands
, optParser
, printUsage
, renderUsage
, parse
) where
import Debug
import Char (isAscii)
......@@ -7,31 +32,48 @@ import qualified DetParse as P
import Pretty
import qualified Boxes as B
--- A command line argument. Used to represent a parsed command line.
---
--- @cons Flag - a flag, e.g. `-d` or `--enable-debug`
--- @cons Val - a simple value
--- @cons FlagWithValue - an option, e.g. `-v debug` or `--verbosity=debug`
data Arg = Flag String
| Val String
| FlagWithValue String String
--- A partial command line parser.
---
--- @cons OptP - parses an option with a value
--- @cons FlagP - parses a flag
--- @cons ArgP - parses a positional argument
--- @cons RestP - a parses that consumes the rest
--- @cons CmdP - a parser that branches out to command sub-parsers
data Parser a = OptP ArgProps OptProps (String -> a)
| FlagP ArgProps OptProps a
| ArgP ArgProps (String -> a)
| RestP ArgProps (String -> a)
| CmdP ArgProps [(String, ArgProps, a, ParseSpec a)]
--- A parser specification. A collection of parsers.
data ParseSpec a = ParseSpec [Parser a]
--- Properties that for all parser types.
data ArgProps = ArgProps
{ metavarName :: String
, helpText :: Maybe String
, argOptional :: Bool }
--- Properties for option/flag parsers.
data OptProps = OptProps
{ longName :: String
, shortName :: String }
--- Modifiers for argument and option properties.
data Mod = Mod
{ optMod :: OptProps -> OptProps
, argMod :: ArgProps -> ArgProps }
--- Get argument properties from a parser.
argProps :: Parser a -> ArgProps
argProps (OptP a _ _) = a
argProps (FlagP a _ _) = a
......@@ -39,69 +81,126 @@ argProps (ArgP a _) = a
argProps (RestP a _) = a
argProps (CmdP a _) = a
idm :: Mod
idm = Mod id id
--- Default argument properties.
defaultArgProps :: ArgProps
defaultArgProps = ArgProps "" Nothing False
--- Default option properties.
defaultOptProps :: OptProps
defaultOptProps = OptProps "" ""
--- Identity modifiers.
idm :: Mod
idm = Mod id id
--- Set the long name of an option.
long :: String -> Mod
long s = Mod (\o -> o { longName = s }) id
--- Set the short name of an option.
short :: String -> Mod
short s = Mod (\o -> o { shortName = s }) id
--- Set the optional flag of an argument.
optional :: Mod
optional = Mod id (\a -> a { argOptional = True })
--- Set the metavar of an argument. The metavar is used to print usage
--- information.
metavar :: String -> Mod
metavar s = Mod id (\a -> a { metavarName = s })
--- Set the help text of an argument. Used to print usage information.
help :: String -> Mod
help s = Mod id (\a -> a { helpText = Just s })
--- Combine two modifiers.
(<>) :: Mod -> Mod -> Mod
(Mod o1 a1) <> (Mod o2 a2) = Mod (o2 . o1) (a2 . a1)
strOption :: (String -> a) -> Mod -> [Parser a]
strOption f (Mod o a) = [OptP (a defaultArgProps) (o defaultOptProps) f]
--- Create an option.
---
--- @param f function that converts the parsed value into a parse result
--- @param m modifiers for this argument
option :: (String -> a) -> Mod -> [Parser a]
option f (Mod o a) = [OptP (a defaultArgProps) (o defaultOptProps) f]
--- Create a positional argument.
---
--- @param f function that converts the parsed value into a parse result
--- @param m modifiers for this argument
arg :: (String -> a) -> Mod -> [Parser a]
arg f (Mod _ a) = [ArgP (a defaultArgProps) f]
--- Create an argument that consumes the rest of the command line.
---
--- @param f function that converts the parsed value into a parse result
--- @param m modifiers for this argument
rest :: (String -> a) -> Mod -> [Parser a]
rest f (Mod _ a) = [RestP (a defaultArgProps) f]
--- Create a flag.
---
--- @param a result of the parser
--- @param m modifiers for this argument
flag :: a -> Mod -> [Parser a]
flag f (Mod o a) = [FlagP (a defaultArgProps) (o defaultOptProps) f]
infixl 4 <.>
infixl 5 <|>
--- Combine two arguments.
(<.>) :: [a] -> [a] -> [a]
(<.>) = (++)
--- Combine command sub parsers.
(<|>) :: [a] -> [a] -> [a]
(<|>) = (++)
--- Create a sub-parser for a command. Must be used with `commands`.
---
--- @param n the name of the command
--- @param m modifiers for this command
--- @param a the result of this parse
--- @param ps parsers for the rest of the command line for this command
command :: String -> Mod -> a -> [Parser a] -> [(String, ArgProps, a, ParseSpec a)]
command n (Mod _ a) d ps = [(n, a defaultArgProps, d, ParseSpec ps)]
argParse :: [Parser a] -> ParseSpec a
argParse = ParseSpec
--- Create a parse spec from a list of parsers.
optParser :: [Parser a] -> ParseSpec a
optParser = ParseSpec
--- Create a command parser.
---
--- @param m modifiers for this command
--- @param cs command sub-parsers, created by `command`
commands :: Mod -> [(String, ArgProps, a, ParseSpec a)] -> [Parser a]
commands (Mod _ a) cmds = [CmdP (a defaultArgProps) cmds]
margin :: Int
margin = 5
--- Print usage information for a command line parser specification.
---
--- @param p the name of the current program
--- @param c the maximum number of columns to use
--- @param p the parser specification
printUsage :: String -> Int -> ParseSpec a -> IO ()
printUsage prog w spec = B.printBox $ usageBox prog w spec
--- Render usage information to a string.
---
--- @param p the name of the current program
--- @param c the maximum number of columns to use
--- @param p the parser specification
renderUsage :: String -> Int -> ParseSpec a -> String
renderUsage prog w spec = B.render $ usageBox prog w spec
--- Create a box for usage information.
---
--- @param p the name of the current program
--- @param c the maximum number of columns to use
--- @param p the parser specification
usageBox :: String -> Int -> ParseSpec a -> B.Box
usageBox prog w (ParseSpec ps) = usageLine B./+/ optBox B./+/ argBox B./+/ cmdsBox
where
......@@ -119,12 +218,13 @@ usageBox prog w (ParseSpec ps) = usageLine B./+/ optBox B./+/ argBox B./+/ cmdsB
maxCmdsLen = foldl max 0 $ map cmdsLen cmds
cmdsBox = B.vcat B.left $ (map (cmdsRows maxCmdsLen w) cmds)
--- Render an argument for the usage line.
formatArgForUsage :: Parser a -> String
formatArgForUsage p = wrap $ metavarN p
formatArgForUsage p = wrap $ argMetavar p
where
wrap s = if isOptional p then "[" ++ s ++ "]" else s
metavarN = metavarName . argProps
--- Render detailed help for an option/flag.
optRow :: Parser a -> [String]
optRow (OptP a o _) = [sh ++ " " ++ lo ++ " " ++ metavarName a, hlp]
where
......@@ -144,6 +244,7 @@ optRow (ArgP _ _) = error "OptParse.optRow: called on ArgP"
optRow (RestP _ _) = error "OptParse.optRow: called on RestP"
optRow (CmdP _ _) = error "OptParse.optRow: called on CmdP"
--- Render detailed help for a positional argument.
argRow :: Parser a -> [String]
argRow (ArgP a _) = [metavarName a, hlp]
where
......@@ -159,6 +260,7 @@ argRow (OptP _ _ _) = error "OptParse.argRow: called on OptP"
argRow (FlagP _ _ _) = error "OptParse.argRow: called on FlagP"
argRow (CmdP _ _) = error "OptParse.argRow: called on CmdP"
--- Render detailed help for a command parser.
cmdsRows :: Int -> Int -> Parser a -> B.Box
cmdsRows max w (CmdP a cmds) = hdr B.// tbl
where
......@@ -173,6 +275,7 @@ cmdsRows _ _ (FlagP _ _ _) = error "OptParse.cmdsRows: called on FlagP"
cmdsRows _ _ (ArgP _ _) = error "OptParse.cmdsRows: called on ArgP"
cmdsRows _ _ (RestP _ _) = error "OptParse.cmdsRows: called on RestP"
--- Calculate maximum command length for a command parser.
cmdsLen :: Parser a -> Int
cmdsLen (CmdP _ cmds) = foldl max 0 $ map cmdsLen' cmds
where
......@@ -182,6 +285,7 @@ cmdsLen (OptP _ _ _) = 0
cmdsLen (FlagP _ _ _) = 0
cmdsLen (RestP _ _) = 0
--- Length of a positional argument name.
posnLen :: Parser a -> Int
posnLen (ArgP a _) = length (metavarName a)
posnLen (CmdP _ _) = 0
......@@ -193,6 +297,7 @@ optLen' :: ArgProps -> OptProps -> Int
optLen' a o = length (shortName o) + 2 + length (longName o) + 3 +
length (metavarName a) + 2
--- Length needed to represent a option/flag detailed help.
optLen :: Parser a -> Int
optLen (OptP a o _) = optLen' a o
optLen (FlagP a o _) = optLen' a o
......@@ -200,18 +305,29 @@ optLen (ArgP _ _) = 0
optLen (CmdP _ _) = 0
optLen (RestP _ _) = 0
--- Parses a command line via a parser spec.
---
--- @param l the command line
--- @param s the parser spec
--- @param p the name of the current program
parse :: String -> ParseSpec a -> String -> Either String [a]
parse argv spec prog = case P.parse pArgs argv of
Nothing -> Left $ parseError prog spec "Couldn't parse command line!"
Just as -> parseArgs as spec prog
extractStrings :: [Arg] -> String
extractStrings [] = []
extractStrings ((Val s):as) = s ++ " " ++ (extractStrings as)
extractStrings ((FlagWithValue n v):as) =
"--" ++ n ++ "=" ++ v ++ " " ++ (extractStrings as)
extractStrings ((Flag n):as) = "-" ++ n ++ " " ++ (extractStrings as)
--- Renders parsed parts of a command line back to a string.
renderCommandLine :: [Arg] -> String
renderCommandLine [] = []
renderCommandLine ((Val s):as) = s ++ " " ++ (renderCommandLine as)
renderCommandLine ((FlagWithValue n v):as) =
"--" ++ n ++ "=" ++ v ++ " " ++ (renderCommandLine as)
renderCommandLine ((Flag n):as) = "-" ++ n ++ " " ++ (renderCommandLine as)
--- Further parses a parsed command line using a parser spec.
---
--- @param as parsed command line
--- @param s parser spec
--- @param p name of the current program
parseArgs :: [Arg] -> ParseSpec a -> String -> Either String [a]
parseArgs args sp@(ParseSpec specs) prog = parse' args rst []
where
......@@ -219,7 +335,7 @@ parseArgs args sp@(ParseSpec specs) prog = parse' args rst []
rst = filter (not . isOpt) specs
parse' ((Val s):as) (p:ps) xs = case p of
ArgP _ f -> parse' as ps ((f s):xs)
RestP _ f -> parse' [] (p:ps) ((f $ extractStrings ((Val s):as)):xs)
RestP _ f -> parse' [] (p:ps) ((f $ renderCommandLine ((Val s):as)):xs)
CmdP _ cmds -> case findCommand s cmds of
Nothing -> Left $ parseError prog sp $ "Unknown command '" ++ s ++ "'."
Just (cmd, _, d, spec) -> case parseArgs as spec (prog ++ " " ++ cmd) of
......@@ -252,12 +368,19 @@ parseArgs args sp@(ParseSpec specs) prog = parse' args rst []
"Expected " ++ (argMetavar p) ++ ", but there are no arguments left."
parse' [] [] xs = Right xs
--- Renders a parse error.
---
--- @param p name of the current program
--- @param s parser spec
--- @param e error that occured
parseError :: String -> ParseSpec a -> String -> String
parseError prog spec err = renderUsage prog 80 spec ++ "\n" ++ err
--- Gets the metavar from a parser.
argMetavar :: Parser a -> String
argMetavar = metavarName . argProps
--- Does an option/flag match a name?
optMatches :: String -> Parser a -> Bool
optMatches _ (ArgP _ _) = False
optMatches _ (CmdP _ _) = False
......@@ -265,9 +388,11 @@ optMatches _ (RestP _ _) = False
optMatches n (OptP _ o _) = n == (longName o) || n == (shortName o)
optMatches n (FlagP _ o _) = n == (longName o) || n == (shortName o)
--- Is the argument optional?
isOptional :: Parser a -> Bool
isOptional = argOptional . argProps
--- Finds a command in a list of command specs.
findCommand :: String -> [(String, ArgProps, a, ParseSpec a)] -> Maybe (String, ArgProps, a, ParseSpec a)
findCommand s cmds = case cmd of
[] -> Nothing
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment