packages feed

argparser (empty) → 0.3.1

raw patch · 19 files changed

+1870/−0 lines, 19 filesdep +HTFdep +HUnitdep +argparsersetup-changed

Dependencies added: HTF, HUnit, argparser, base, containers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2011-2013 Simon Bergot.
+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 Simon Bergot nor the names of any
+    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
+HOLDER 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain
+ argparser.cabal view
@@ -0,0 +1,55 @@+name:           argparser
+version:        0.3.1
+cabal-version:  >=1.8
+build-type:     Simple
+author:         Simon Bergot <simon.bergot@gmail.com>
+stability:      unstable
+maintainer:     Simon Bergot <simon.bergot@gmail.com>
+license:        BSD3
+category:       Console
+synopsis:       Command line parsing framework for console applications
+description:    Provides a combinator library for defining a command line parser.
+license-file:   LICENSE
+
+library 
+  build-depends:    
+                   base >= 4.0 && < 5,
+                   containers
+  hs-source-dirs:   src
+  ghc-options:      -Wall
+  exposed-modules:  
+                    System.Console.ArgParser,
+                    System.Console.ArgParser.ArgsProcess,
+                    System.Console.ArgParser.BaseType,
+                    System.Console.ArgParser.Format,
+                    System.Console.ArgParser.Params,
+                    System.Console.ArgParser.Parser,
+                    System.Console.ArgParser.QuickParams,
+                    System.Console.ArgParser.Run,
+                    System.Console.ArgParser.SubParser
+
+source-repository head
+  type:      git
+  location:  https://github.com/sbergot/EasyConsole
+
+test-suite TestsHTF
+  type:            exitcode-stdio-1.0
+  main-is:         TestsHTF.hs
+  ghc-options:     -Wall -rtsopts
+  build-depends:   
+                  base >= 4,
+                  HTF > 0.9,
+                  containers,
+                  HUnit,
+                  argparser
+  other-modules:   
+                   System.Console.ArgParser.ArgsProcessTest,
+                   System.Console.ArgParser.FormatTest,
+                   System.Console.ArgParser.ParserTest,
+                   System.Console.ArgParser.QuickParamsTest,
+                   System.Console.ArgParser.SubParserTest,
+                   System.Console.ArgParser.TestHelpers
+  hs-source-dirs:  
+                  tests,
+                  src
+
+ src/System/Console/ArgParser.hs view
@@ -0,0 +1,240 @@+{- |
+Module      :  $Header$
+Copyright   :  (c) Simon Bergot
+License     :  BSD3
+
+Maintainer  :  simon.bergot@gmail.com
+Stability   :  unstable
+Portability :  portable
+
+Simple command line parsing library. This library provides a small combinator
+dsl to specify a parser for a datatype. Running the parser will automatically
+consume and convert command line arguments. Default special action such as
+help/usage are automatically built from the parser specification.
+
+Here is a quick example. First, we need a datatype:
+
+@
+data MyTest = MyTest Int Int
+  deriving (Show) -- we will print the values
+@
+
+Then, we define a parser:
+
+@
+myTestParser :: ParserSpec MyTest
+myTestParser = MyTest
+  \`parsedBy\` reqPos \"pos1\"
+  \`andBy\` optPos 0 \"pos2\"
+@
+
+we proceed to build an interface and run it:
+
+@
+main = do
+  interface <- mkApp myTestParser
+  runApp interface print
+@
+
+Building this app will produce an executable `foo` which will behave like this:
+
+@
+$ foo 1 2
+MyTest 1 2
+$ foo 3
+MyTest 3 0
+$ foo -h
+foo
+usage : foo pos1 [pos2] [-h] [--version]
+
+mandatory arguments:
+ pos1
+
+optional arguments:
+ pos2
+ -h, --help                    show this help message and exit
+ --version                     print the program version and exit
+@
+
+
+-}
+module System.Console.ArgParser (
+  -- * Creating a parser
+  -- ** Basics
+    parsedBy
+  , andBy
+  , mkApp
+  , mkDefaultApp
+  -- ** Adding descriptions
+  -- $description
+  , Descr (Descr)
+  , setAppDescr
+  , setAppEpilog
+  -- ** Sub commands
+  -- $subparser
+  , mkSubParser
+  -- * Running a parser
+  , runApp
+  , parseArgs
+  -- * Creating parameters
+  -- $parameters
+  -- ** Parameters without args
+  , boolFlag
+  -- ** Parameters with one arg
+  -- *** Flags
+  , reqFlag
+  , optFlag
+  -- *** Positional
+  , reqPos
+  , optPos
+  -- ** Parameters with multiple args
+  -- *** Flags
+  , reqFlagArgs
+  , optFlagArgs
+  -- *** Positionnal
+  , posArgs
+  -- * Common types
+  , module System.Console.ArgParser.BaseType
+  ) where
+import           System.Console.ArgParser.BaseType
+import           System.Console.ArgParser.Params      (Descr (Descr))
+import           System.Console.ArgParser.Parser      (andBy, parsedBy)
+import           System.Console.ArgParser.QuickParams
+import           System.Console.ArgParser.Run         (mkApp, mkDefaultApp,
+                                                       parseArgs, runApp,
+                                                       setAppDescr,
+                                                       setAppEpilog)
+import           System.Console.ArgParser.SubParser   (mkSubParser)
+
+
+-- TODO copy the first example from the python argparse doc
+
+{- $subparser
+
+You can also split different parsers of the same type into sub-commands with 'mkSubParser':
+
+@
+data MyTest =
+  MyCons1 Int Int |
+  MyCons2 Int
+  deriving (Eq, Show)
+
+myTestParser :: IO (CmdLnInterface MyTest)
+myTestParser = mkSubParser
+  [ (\"A\", mkDefaultApp
+    (MyCons1 \`parsedBy\` reqPos \"pos1\" \`andBy\` reqPos \"pos2\") \"A\")
+  , (\"B\", mkDefaultApp
+    (MyCons2 \`parsedBy\` reqPos \"pos1\") \"B\")
+  ]
+
+
+main = do
+  interface <- myTestParser
+  runApp interface print
+@
+
+Running this script will yield:
+
+@
+$ hscmd A 1 2
+MyCons1 1 2
+$ hscmd B 3
+MyCons2 3
+$ hscmd -h
+hscmd
+usage : hscmd {A,B} [-h] [--version]
+
+commands arguments:
+ {A,B}
+ A
+ B
+
+optional arguments:
+ -h, --help                    show this help message and exit
+ --version                     print the program version and exit
+
+$ hscmd A -h
+hscmd A
+usage : hscmd A pos1 pos2 [-h] [--version]
+
+mandatory arguments:
+ pos1
+ pos2
+
+optional arguments:
+ -h, --help                    show this help message and exit
+ --version                     print the program version and exit
+ @
+
+-}
+
+{- $description
+
+You can add descriptions for individual arguments and for the application:
+
+@
+import System.Console.ArgParser
+import Control.Applicative
+
+data MyTest = MyTest Int Int
+  deriving (Show) -- we will print the values
+
+myTestParser :: ParserSpec MyTest
+myTestParser = MyTest
+  \`parsedBy\` reqPos \"pos1\" \`Descr\` \"description for the first argument\"
+  \`andBy\` optPos 0 \"pos2\" \`Descr\` \"description for the second argument\"
+
+myTestInterface :: IO (CmdLnInterface MyTest)
+myTestInterface =
+  (\`setAppDescr\` \"top description\")
+  \<$\> (\`setAppEpilog\` \"bottom description\")
+  \<$\> mkApp myTestParser
+
+main = do
+  interface <- myTestInterface
+  runApp interface print
+@
+
+The new help will look like:
+
+@
+foo
+usage : foo pos1 [pos2] [-h] [--version]
+top description
+
+mandatory arguments:
+ pos1                          description for the first argument
+
+optional arguments:
+ pos2                          description for the second
+                               argument
+ -h, --help                    show this help message and exit
+ --version                     print the program version and exit
+
+
+bottom description
+@
+
+-}
+
+{- $parameters
+
+Values provided to 'parsedBy' and 'andBy' should be created with
+the following functions. Those are shortcuts based on data types defined in
+"System.Console.ArgParser.Params". The types are inferred. argparser will use
+'read' to convert the arguments to haskell values, except for strings
+which will be passed unmodified.
+
+Flags can be passed in long form (@--foo@) or short form (@-f@)
+You may also provide a prefix form such as @--fo@.
+
+Mandatory parameters will fail if the argument is absent or invalid.
+Optional parameters only fail if the argument is invalid (ie @foo@ passed
+as @Int@)
+
+Note that single arg parameters need exactly one arg, and that multiple args
+parameters can have any number of args (0 included).
+
+Those functions are all defined in "System.Console.ArgParser.QuickParams".
+
+-}
+ src/System/Console/ArgParser/ArgsProcess.hs view
@@ -0,0 +1,55 @@+{- |
+Module      :  $Header$
+Copyright   :  (c) Simon Bergot
+License     :  BSD3
+
+Maintainer  :  simon.bergot@gmail.com
+Stability   :  unstable
+Portability :  portable
+
+Preprocess args from a list of words to a pair containing positional args/flag arguments.
+-}
+
+module System.Console.ArgParser.ArgsProcess (preprocess) where
+
+import           Data.List
+import qualified Data.Map                          as M
+import           System.Console.ArgParser.BaseType
+
+-- | Separate positional arguments from flag arguments
+preprocess :: Args -> NiceArgs
+preprocess args = (pos, flagArgs) where
+  (pos, rest) =  collectPos $ tokenize args
+  flagArgs :: Flags
+  flagArgs = M.fromListWith (flip (++)) $ unfoldr parseFlag rest
+
+data TokenType = Flag | Pos
+data Token = Token TokenType Arg
+
+
+isPos :: Token -> Bool
+isPos (Token tokenType _) = case tokenType of
+  Pos -> True
+  _   -> False
+
+getWord :: Token -> Arg
+getWord (Token _ word) = word
+
+tokenize :: Args -> [Token]
+tokenize = concatMap arg2token where
+  arg2token :: Arg -> [Token]
+  arg2token arg = case arg of
+    '-':'-':word -> [Token Flag word]
+    '-':word     ->  map (Token Flag . (:[]) ) word
+    word         -> [Token Pos word]
+
+collectPos :: [Token] -> (Args, [Token])
+collectPos tokens = (pos, rest) where
+  (posargs, rest) = span isPos tokens
+  pos = map getWord posargs
+
+parseFlag :: [Token] -> Maybe ((Arg, Args), [Token])
+parseFlag tokens = case tokens of
+  Token Flag word : othertokens -> Just ((word, args), rest)
+    where (args, rest) = collectPos othertokens
+  _ -> Nothing
+ src/System/Console/ArgParser/BaseType.hs view
@@ -0,0 +1,103 @@+{- |
+Module      :  $Header$
+Copyright   :  (c) Simon Bergot
+License     :  BSD3
+
+Maintainer  :  simon.bergot@gmail.com
+Stability   :  unstable
+Portability :  portable
+
+Base types shared by several EasyConsole modules.
+-}
+
+module System.Console.ArgParser.BaseType where
+
+import           Control.Applicative     ((<*>), Applicative, pure)
+import qualified Data.Map as M (Map)
+
+-- | Simple command line arg
+type Arg   = String
+-- | List of args provided
+type Args  = [Arg]
+-- | Flag collection with corresponding args
+type Flags = M.Map Arg Args
+-- | Structured args to be parsed.
+--   Pair of (positionnal arguments, flag arguments)
+type NiceArgs = (Args, Flags)
+-- | Type representing the result of the parse.
+--   Right val in case of success or
+--   Left msg if there was an error.
+type ParseResult a = Either String a
+
+-- | Data structure describing a parameter
+data ParamDescr = ParamDescr
+  { argUsageFmt :: String -> String -- ^ Short description of the parameter format
+  , argCategory :: String -- ^ Category of parameter (optional/mandatory)
+  , argFormat   :: String -> String -- ^ Format of the parameter to provide
+  , argDescr    :: String -- ^ Description of the parameter
+  , argMetaVar  :: String -- ^ Description of the parameter in the usage
+  }
+
+-- | Returns a short description of the input format
+--   of a parameter.
+argUsage :: ParamDescr -> String
+argUsage d = argUsageFmt d $ argMetaVar d
+
+-- | Returns a long description of the input format
+--   of a parameter.
+getArgFormat :: ParamDescr -> String
+getArgFormat d = argFormat d $ argMetaVar d
+
+-- | A parser actual function
+data Parser a = Parser (NiceArgs -> (ParseResult a, NiceArgs))
+
+-- | Represent a full parameter spec
+data ParserSpec a = ParserSpec
+  { getParserParams :: [ParamDescr]
+  , getParserFun    :: Parser a
+  }
+
+instance Functor ParserSpec where
+  fmap f p = p {getParserFun = fmap f $ getParserFun p}
+
+instance Applicative ParserSpec where
+  pure val = ParserSpec [] $ pure val
+  ParserSpec d1 p1 <*> ParserSpec d2 p2 =
+    ParserSpec (d1 ++ d2) (p1 <*> p2)
+
+-- | A special action with more possibilities.
+--   The full arg list will be provided,
+--   with the command line spec itself.
+type SpecialAction a =
+  CmdLnInterface a
+  -> NiceArgs
+  -> ParseResult a
+
+-- | A special parser allowing to
+--   perform standard actions.
+--   Used for version/help/subparsers.
+type SpecialFlag a = (ParserSpec Bool, SpecialAction a)
+
+-- | A command line application, with a parser and a description
+data CmdLnInterface a = CmdLnInterface
+  { cmdArgParser  :: ParserSpec a    -- ^ The argument parser
+  , specialFlags  :: [SpecialFlag a] -- ^ The special flags
+  , getAppName    :: String          -- ^ The application name.
+                                     --   Usally the binary name.
+  , getAppVersion :: Maybe String    -- ^ Optional application version
+  , getAppDescr   :: Maybe String    -- ^ Optional description
+  , getAppEpilog  :: Maybe String    -- ^ Optional epilog
+  }
+
+instance Functor Parser where
+  fmap f (Parser g) = Parser (\args ->
+    let (res, newargs) = g args
+    in (fmap f res, newargs))
+
+instance Applicative Parser where
+  pure val = Parser parser where
+    parser args = (Right val, args)
+  (Parser f) <*> (Parser g) = Parser (\args ->
+    let (h, newargs) = f args
+        (res, lastargs) = g newargs
+    in (h <*> res, lastargs))
+ src/System/Console/ArgParser/Format.hs view
@@ -0,0 +1,115 @@+{- |
+Module      :  $Header$
+Copyright   :  (c) Simon Bergot
+License     :  BSD3
+
+Maintainer  :  simon.bergot@gmail.com
+Stability   :  unstable
+Portability :  portable
+
+Module containing helpers to print information
+about a parser.
+-}
+
+module System.Console.ArgParser.Format (
+  -- * Print information about the parser
+    showCmdLineAppUsage
+  , showCmdLineVersion
+    -- * Help formatting
+  , CmdLineFormat (..)
+  , defaultFormat
+  ) where
+
+import           Control.Applicative
+import           Data.Char                         (isSpace)
+import           Data.List                         (intercalate, unfoldr)
+import qualified Data.Map                          as M
+import           Data.Maybe
+import           System.Console.ArgParser.BaseType
+
+-- | Specification of the help layout
+data CmdLineFormat = CmdLineFormat
+  { maxKeyWidth    :: Int
+  , keyIndentWidth :: Int
+  , maxDescrWidth  :: Int
+  }
+
+-- | Default specification for the help layout
+defaultFormat :: CmdLineFormat
+defaultFormat = CmdLineFormat 30 1 35
+
+-- | Prints the application name and version
+showCmdLineVersion :: CmdLnInterface a -> String
+showCmdLineVersion app =  appName ++ appVersion where
+  appName = getAppName app
+  appVersion = fromMaybe "" $ getAppVersion app
+
+-- | Prints a long usage such as
+--
+-- @
+--   foo bar [bay]
+-- @
+showCmdLineAppUsage :: CmdLineFormat -> CmdLnInterface a -> String
+showCmdLineAppUsage fmt app = (++ "\n\n") . trim $ intercalate "\n"
+  [ showCmdLineVersion app
+  , appUsage
+  , appDescr
+  , appParams
+  , appEpilog
+  ]
+ where
+  _reflow = reflow $ maxDescrWidth fmt
+  appDescr = fromMaybe "" ((++ "\n") . _reflow 0 <$> getAppDescr app)
+  appEpilog = fromMaybe "" (_reflow 0 <$> getAppEpilog app)
+  paramdescrs = userDescr ++ specialDescr
+  userDescr = getParserParams $ cmdArgParser app
+  specialDescr = concatMap (getParserParams . fst) $ specialFlags app
+  appParams = formatParamDescrs fmt paramdescrs
+  appUsage = "usage : " ++ getAppName app ++ " " ++ usage
+  usage = unwords $ filter (not . null) $ map argUsage paramdescrs
+
+groupByKey :: Ord k => (a -> k) -> [a] -> [(k, [a])]
+groupByKey getkey xs = M.toList $ M.fromListWith (flip (++))
+  $ map (\x -> (getkey x, [x])) xs
+
+formatParamDescrs :: CmdLineFormat -> [ParamDescr] -> String
+formatParamDescrs fmt paramdescrs = unlines $ map showCategory categories where
+  categories :: [(String, [ParamDescr])]
+  categories = groupByKey argCategory paramdescrs
+  showCategory :: (String, [ParamDescr]) -> String
+  showCategory (cat, descrs) =
+    cat ++ ":\n" ++ formattedargs where
+     formattedargs = unlines $ map (showargformat fmt) descrs
+
+trim :: String -> String
+trim = f . f
+   where f = reverse . dropWhile isSpace
+
+showargformat :: CmdLineFormat -> ParamDescr -> String
+showargformat fmt descr =
+  keyindent ++ trim (formattedkey ++ sep ++ descrtext) where
+    keyindent = replicate (keyIndentWidth fmt) ' '
+    formattedkey = getArgFormat descr
+    _maxkeywidth = maxKeyWidth fmt
+    padding =  _maxkeywidth - length formattedkey
+    sep = if padding > 0
+      then replicate padding ' '
+      else "\n" ++ keyindent ++ replicate _maxkeywidth ' '
+    indent = maxKeyWidth fmt + keyIndentWidth fmt
+    descrtext = reflow (maxDescrWidth fmt) indent $ argDescr descr
+
+reflow :: Int -> Int -> String -> String
+reflow width indent text = intercalate ('\n' : replicate indent ' ') _lines where
+  -- one space is appended to each line so we drop one char
+  _lines = map (drop 1) $ unfoldr takeOneLine $ words text
+  takeOneLine :: [String] -> Maybe (String, [String])
+  takeOneLine = loop 0 ""
+  loop currWidth accum rest = case rest of
+    [] -> case accum of
+      [] -> Nothing
+      _  -> Just (accum, rest)
+    word:_words -> let
+      newWidth = currWidth + 1 + length word
+      in if newWidth > width
+        then Just (accum, rest)
+        else loop newWidth (accum ++ ' ':word)  _words
+ src/System/Console/ArgParser/Params.hs view
@@ -0,0 +1,263 @@+{- |
+Module      :  $Header$
+Copyright   :  (c) Simon Bergot
+License     :  BSD3
+
+Maintainer  :  simon.bergot@gmail.com
+Stability   :  unstable
+Portability :  portable
+
+Parameters are basic building blocks of a command line parser.
+-}
+
+module System.Console.ArgParser.Params (
+  -- * Standard constructors
+  -- ** Constructor
+   StdArgParam (..)
+  -- ** Misc types
+  , ArgSrc (..)
+  , FlagFormat (..)
+  , ArgParser (..)
+  , Optionality (..)
+  , Key
+  -- * Special constructors
+  , FlagParam (..)
+  , Descr (..)
+  , MetaVar (..)
+  ) where
+
+import           Data.Char                         (toUpper)
+import           Data.List
+import qualified Data.Map                          as M
+import           Data.Maybe
+import           System.Console.ArgParser.BaseType
+import           System.Console.ArgParser.Parser
+
+-- | identifier used to specify the name of a flag
+--   or a positional argument.
+type Key = String
+
+-- | Specify the format of a flag
+data FlagFormat =
+  -- | Possible short format ie @-f@ or @--foo@ 
+  Short |
+  -- | Only long format ie @--foo@
+  Long
+
+deleteMany :: [String] -> Flags -> Flags
+deleteMany keys flags = foldl (flip M.delete) flags keys
+
+type FlagParser = String -> Flags -> (Maybe Args, Flags)
+
+takeFlag :: FlagParser
+takeFlag key flags = (args, rest) where
+  args = case mapMaybe lookupflag prefixes of
+    [] -> Nothing
+    grpargs -> Just $ concat grpargs
+  lookupflag _key = M.lookup _key flags
+  rest = deleteMany prefixes flags
+  prefixes = drop 1 $ inits key
+
+takeLongFlag :: FlagParser
+takeLongFlag key flags = (args, rest) where
+  args = M.lookup key flags
+  rest = M.delete key flags
+  
+takeValidFlag :: FlagFormat -> FlagParser
+takeValidFlag fmt = case fmt of
+  Short -> takeFlag
+  Long  -> takeLongFlag
+
+-- | A simple command line flag.
+--   The parsing function will be passed True
+--   if the flag is present, if the flag is provided to
+--   the command line, and False otherwise.
+--   For a key @foo@, the flag can either be @--foo@ or @-f@
+data FlagParam a =
+  FlagParam FlagFormat Key (Bool -> a)
+
+fullFlagformat :: FlagFormat -> String -> String
+fullFlagformat fmt key = case fmt of
+  Short -> shortfmt ++ ", " ++ longfmt
+  Long  -> longfmt
+ where
+  shortfmt = shortflagformat key
+  longfmt = longflagformat key
+
+longflagformat :: String -> String
+longflagformat = ("--" ++)
+
+shortflagformat :: String -> String
+shortflagformat key = '-' : first where
+  first = take 1 key
+
+shortestFlagFmt :: FlagFormat -> String -> String
+shortestFlagFmt fmt = case fmt of
+  Short -> shortflagformat
+  Long  -> longflagformat
+
+instance ParamSpec FlagParam where
+  getParser (FlagParam fmt key parse) = Parser rawparse where
+    rawparse (pos, flags) = case args of
+      Just [] -> (Right $ parse True, (pos, rest))
+      Just _  -> (Left "unexpected parameter(s)", (pos, rest))
+      Nothing -> (Right $ parse False, (pos, rest))
+     where
+      (args, rest) = takeValidFlag fmt key flags
+  getParamDescr (FlagParam fmt key _) = [ParamDescr
+    (const $ "[" ++ shortestFlagFmt fmt key ++ "]")
+    "optional arguments"
+    (const $ fullFlagformat fmt key)
+    ""
+    (map toUpper key)]
+
+infixl 2 `Descr`
+
+-- | Allows the user to provide a description for a particular parameter.
+--   Can be used as an infix operator:
+--
+-- > myparam `Descr` "this is my description"
+data Descr spec a = Descr
+  { getdvalue    :: spec a
+  , getuserdescr :: String
+  }
+
+instance ParamSpec spec => ParamSpec (Descr spec) where
+  getParser = getParser . getdvalue
+  getParamDescr (Descr inner descr) =
+    map (\d -> d { argDescr = descr }) (getParamDescr inner)
+
+infixl 2 `MetaVar`
+
+-- | Allows the user to provide a description for a particular parameter.
+--   Can be used as an infix operator:
+--
+-- > myparam `Descr` "this is my description"
+data MetaVar spec a = MetaVar
+  { getmvvalue  :: spec a
+  , getusermvar :: String
+  }
+
+instance ParamSpec spec => ParamSpec (MetaVar spec) where
+  getParser = getParser . getmvvalue
+  getParamDescr (MetaVar inner metavar) =
+    map (\d -> d { argMetaVar = metavar }) (getParamDescr inner)
+
+-- | Defines the source of a parameter: either positional or flag.
+data ArgSrc = Flag | Pos
+
+-- | Defines whether a parameter is mandatory or optional.
+--   When a parameter is marked as Optional, a default value must
+--   be provided.
+data Optionality a = Mandatory | Optional a
+
+-- | Defines the number of args consumed by a standard parameter
+data ArgParser a =
+  -- | Uses exactly one arg
+  SingleArgParser (Arg -> ParseResult a) |
+  -- | Uses any number of args
+  MulipleArgParser (Args -> ParseResult a)
+
+runFlagParse
+  :: ArgParser a
+  -> Args
+  -> ParseResult a
+runFlagParse parser args = case parser of
+  SingleArgParser f -> case args of
+    []    -> Left "missing arg"
+    [val] -> f val
+    _     -> Left "too many args"
+  MulipleArgParser f -> f args
+
+runPosParse
+  :: ArgParser a
+  -> Args
+  -> (ParseResult a, Args)
+runPosParse parser args = case parser of
+  SingleArgParser f -> case args of
+    []       -> (Left "missing arg", [])
+    val:rest -> (f val, rest)
+  MulipleArgParser f -> (f args, [])
+
+getValFormat :: ArgParser a -> String -> String
+getValFormat parser metavar = case parser of
+  SingleArgParser _  -> metavar
+  MulipleArgParser _ -> "[" ++ metavar ++ "...]"
+
+-- | Defines a parameter consuming arguments on the command line.
+--   The source defines whether the arguments are positional:
+--
+-- > myprog posarg1 posarg2 ...
+--
+--   ... or are taken from a flag:
+--
+-- > myprog --myflag flagarg1 flagarg2 ...
+--
+--   short form:
+--
+-- > myprog -m flagarg1 flagarg2 ...
+--
+--   One can provide two signatures of parsing function using the 'ArgParser type':
+--
+--   * 'SingleArgParser' means that the parameter expect exactly one arg
+--
+--   * 'MulipleArgParser' means that the parameter expect any number of args
+data StdArgParam a =
+  StdArgParam (Optionality a) ArgSrc Key (ArgParser a)
+
+instance ParamSpec StdArgParam where
+  getParser (StdArgParam opt src key parse) = Parser rawparse where
+    rawparse = choosesrc flagparse posparse src
+
+    flagparse (pos, flags) = (logkey key res, (pos, rest)) where
+      (margs, rest) = takeFlag key flags
+      res = case margs of
+        Nothing -> defaultOrError "missing flag"
+        Just args -> runFlagParse parse args
+
+    posparse (pos, flags) = case (pos, parse) of
+      ([], SingleArgParser _) ->
+        (logkey key $ defaultOrError "missing arg", (pos, flags))
+      (args, _) -> let (res, rest) = runPosParse parse args
+              in  (res, (rest, flags))
+
+    defaultOrError = missing opt
+
+  getParamDescr (StdArgParam opt src key parser) =
+    [ParamDescr
+      (wrap opt . usage) (category opt) format "" _metavar]
+   where
+    getflagformat flagfmt = choosesrc
+      ((++ "  ") . flagfmt)
+      (const "")
+    getinputfmt flagfmt metavar = flag ++ value where
+      flag = getflagformat flagfmt src key
+      value =  getValFormat parser metavar
+    usage = getinputfmt shortflagformat
+    format = case src of
+      Flag -> getinputfmt (fullFlagformat Short)
+      Pos  -> id
+    wrap Mandatory msg = msg
+    wrap _         msg = "[" ++ msg ++ "]"
+    _metavar = choosesrc (map toUpper key) key src
+
+
+choosesrc :: a -> a -> ArgSrc -> a
+choosesrc flag pos src = case src of
+  Flag -> flag
+  Pos  -> pos
+
+missing :: Optionality a -> String -> ParseResult a
+missing opt msg = case opt of
+  Mandatory    -> Left msg
+  Optional val -> Right val
+
+category :: Optionality a -> String
+category opt = case opt of
+  Mandatory -> "mandatory arguments"
+  _         -> "optional arguments"
+
+logkey :: String -> ParseResult a -> ParseResult a
+logkey key result = case result of
+  Left err -> Left $ "fail to parse '" ++ key ++ "' : " ++ err
+  val      -> val
+ src/System/Console/ArgParser/Parser.hs view
@@ -0,0 +1,68 @@+{- |
+Module      :  $Header$
+Copyright   :  (c) Simon Bergot
+License     :  BSD3
+
+Maintainer  :  simon.bergot@gmail.com
+Stability   :  unstable
+Portability :  portable
+
+Functions used to specify a parser for command line arguments.
+-}
+
+module System.Console.ArgParser.Parser
+  ( ParamSpec (..)
+  , liftParam
+  , parsedBy
+  , andBy
+  , subParser
+  ) where
+
+import           Control.Applicative
+import           System.Console.ArgParser.BaseType
+
+-- | interface allowing to define a basic block of a command line parser
+class ParamSpec spec where
+  getParser :: spec res -> Parser res
+  getParamDescr :: spec res -> [ParamDescr]
+
+-- | Converts any 'ParamSpec' to a 'ParserSpec'
+liftParam :: ParamSpec spec => spec res -> ParserSpec res
+liftParam param = ParserSpec
+  (getParamDescr param)
+  $ getParser param
+
+instance ParamSpec ParserSpec where
+  getParser = getParserFun
+  getParamDescr = getParserParams
+
+infixl 1 `andBy`
+-- | Build a parser from a parser and a 'ParamSpec'
+--
+-- > MyApp `parsedBy` myparamspec `andBy` myotherparamspec
+andBy
+  :: ParamSpec spec
+  => ParserSpec (a -> b)
+  -> spec a
+  -> ParserSpec b
+andBy parser param = parser <*> liftParam param
+
+infixl 1 `parsedBy`
+-- | Build a parser from a type constructor and a 'ParamSpec'
+--
+-- > MyApp `parsedBy` myparamspec
+parsedBy
+  :: ParamSpec spec
+  => (a -> b)
+  -> spec a
+  -> ParserSpec b
+parsedBy constr firstarg = constr <$> liftParam firstarg
+
+infixr 3 `subParser`
+-- | This is 'parsedBy' with a different fixity.
+subParser
+  :: ParamSpec spec
+  => (a -> b)
+  -> spec a
+  -> ParserSpec b
+subParser = parsedBy
+ src/System/Console/ArgParser/QuickParams.hs view
@@ -0,0 +1,187 @@+{- |
+Module      :  $Header$
+Copyright   :  (c) Simon Bergot
+License     :  BSD3
+
+Maintainer  :  simon.bergot@gmail.com
+Stability   :  unstable
+Portability :  portable
+
+Collection of functions which are basically shortcuts
+of "System.Console.EasyConsole.Params" versions. If you
+cannot find a parameter fitting your needs, you should check this
+module.
+
+Values provided to 'parsedBy' and 'andBy' should be created with
+the following functions. The types are inferred. ArgParser will use
+@readMaybe@ to convert the arguments to haskell values, except for strings
+which will be passed unmodified.
+
+Flags can be passed in long form (@--foo@) or short form (@-f@)
+You may also provide a prefix form such as @--fo@.
+
+Mandatory parameters will fail if the argument is absent or invalid.
+Optional parameters only fail if the argument is invalid (ie @foo@ passed
+as @Int@)
+
+Note that single arg parameters need exactly one arg, and that multiple args
+parameters can have any number of args (0 included).
+
+-}
+
+module System.Console.ArgParser.QuickParams (
+  -- * Parameters without args
+    boolFlag
+  -- * Parameters with one arg
+  -- ** Flags
+  , reqFlag
+  , optFlag
+  -- ** Positional
+  , reqPos
+  , optPos
+  -- * Parameters with multiple args
+  -- ** Flags
+  , reqFlagArgs
+  , optFlagArgs
+  -- ** Positionnal
+  , posArgs
+  -- ** RawRead class
+  , RawRead
+  ) where
+
+import           Data.Either                       (partitionEithers)
+import           Data.List                       (unfoldr)
+import           Control.Applicative
+import           System.Console.ArgParser.BaseType
+import           System.Console.ArgParser.Params
+
+-- | Same function as Text.Read.readMaybe. It is 
+--   redefined here for compatibility purpose
+readMaybe :: (Read a) => String -> Maybe a
+readMaybe s = case reads s of
+              [(x, "")] -> Just x
+              _ -> Nothing
+
+-- | A typeclass used to define a way a converting
+--   string to specific types. It is similar to read.
+--   The main difference is that strings are parsed
+--   without quotes.
+--
+-- > rawRead "foo" :: Maybe String == Just "foo"
+class RawRead a where
+  rawParse :: String -> Maybe (a, String)
+
+instance RawRead Char where
+  rawParse s = case s of
+    [] -> Nothing
+    c:s' -> Just (c, s')
+
+instance RawRead a => RawRead [a] where
+  rawParse s = Just (unfoldr rawParse s, [])
+
+instance RawRead Float where
+  rawParse = defaultRawParse
+
+instance RawRead Int where
+  rawParse = defaultRawParse
+
+defaultRawParse :: Read t => String -> Maybe (t, String)
+defaultRawParse s = (\val -> (val , [])) <$> readMaybe s
+
+rawRead :: RawRead a => String -> Maybe a
+rawRead s = fst <$> rawParse s
+
+readArg
+  :: RawRead a
+  => Key
+  -> Arg
+  -> ParseResult a
+readArg key arg = case rawRead arg of
+  Just val -> Right val
+  Nothing -> Left $ "Could not parse parameter " ++ key ++ "."
+    ++ "Unable to convert " ++ arg
+
+
+-- | A simple command line flag.
+--   The parsing function will return True
+--   if the flag is present, if the flag is provided to
+--   the command line, and False otherwise.
+--   For a key @foo@, the flag can either be @--foo@ or @-f@
+boolFlag
+  :: Key            -- ^ flag key
+  -> FlagParam Bool
+boolFlag key = FlagParam Short key id
+
+-- | A mandatory positional argument parameter
+reqPos
+  :: RawRead a
+  => Key         -- ^ Param name
+  -> StdArgParam a
+reqPos key = StdArgParam Mandatory Pos key (SingleArgParser $ readArg key)
+
+-- | An optional positional argument parameter
+optPos
+  :: RawRead a
+  => a                  -- ^ Default value
+  -> Key                -- ^ Param name
+  -> StdArgParam a
+optPos val key = StdArgParam (Optional val) Pos key (SingleArgParser $ readArg key)
+
+-- | A mandatory flag argument parameter
+reqFlag
+  :: RawRead a
+  => Key         -- ^ Flag name
+  -> StdArgParam a
+reqFlag key = StdArgParam Mandatory Flag key (SingleArgParser $ readArg key)
+
+-- | An optional flag argument parameter
+optFlag
+  :: RawRead a
+  => a                  -- ^ Default value
+  -> Key                -- ^ Flag name
+  -> StdArgParam a
+optFlag val key = StdArgParam (Optional val) Flag key (SingleArgParser $ readArg key)
+
+readArgs
+  :: RawRead a
+  => Key
+  -> b
+  -> (b -> a -> b)
+  -> Args
+  -> ParseResult b
+readArgs key initval accum args = case errors of
+  [] -> Right $ foldl accum initval values
+  _  -> Left $ unlines errors
+ where
+  (errors, values) = partitionEithers $ map (readArg key) args
+
+-- | A parameter consuming all the remaining positional parameters
+posArgs
+  :: RawRead a
+  => Key                -- ^ Param name
+  -> b                  -- ^ Initial value
+  -> (b -> a -> b)      -- ^ Accumulation function
+  -> StdArgParam b
+posArgs key initval accum = StdArgParam
+  Mandatory Pos key (MulipleArgParser $ readArgs key initval accum)
+
+-- | A mandatory flag argument parameter taking multiple arguments
+reqFlagArgs
+  :: RawRead a
+  => Key                -- ^ Flag name
+  -> b                  -- ^ Initial value
+  -> (b -> a -> b)      -- ^ Accumulation function
+  -> StdArgParam b
+reqFlagArgs key initval accum = StdArgParam
+  Mandatory Flag key (MulipleArgParser $ readArgs key initval accum)
+
+-- | An optional flag argument parameter taking multiple arguments
+optFlagArgs
+  :: RawRead a
+  => b                  -- ^ Default value
+  -> Key                -- ^ Flag name
+  -> b                  -- ^ Initial value
+  -> (b -> a -> b)      -- ^ Accumulation function
+  -> StdArgParam b
+optFlagArgs val key initval accum = StdArgParam
+  (Optional val) Flag key (MulipleArgParser $ readArgs key initval accum)
+ src/System/Console/ArgParser/Run.hs view
@@ -0,0 +1,120 @@+{- |
+Module      :  $Header$
+Copyright   :  (c) Simon Bergot
+License     :  BSD3
+
+Maintainer  :  simon.bergot@gmail.com
+Stability   :  unstable
+Portability :  portable
+
+Functions used to build and run command line applications.
+-}
+
+module System.Console.ArgParser.Run (
+  -- * Running a parser
+    runApp
+  , parseArgs
+  , parseNiceArgs
+  -- * Building a parser
+  , mkApp
+  , mkDefaultApp
+  , defaultSpecialFlags
+  , setAppDescr
+  , setAppEpilog
+  , setAppName
+  ) where
+
+import           Control.Monad
+import           Data.Maybe
+import           System.Console.ArgParser.ArgsProcess
+import           System.Console.ArgParser.BaseType
+import           System.Console.ArgParser.Format
+import           System.Console.ArgParser.Params
+import           System.Console.ArgParser.Parser
+import           System.Environment
+
+runParser :: Parser a -> NiceArgs -> ParseResult a
+runParser (Parser parse) args = fst $ parse args
+
+-- | Runs a command line application with the
+--   user provided arguments. If the parsing succeeds,
+--   run the application. Print the returned message otherwise
+runApp
+  :: CmdLnInterface a -- ^ Command line spec
+  -> (a -> IO ()) -- ^ Process to run if the parsing success
+  -> IO ()
+runApp appspec appfun = do
+  args <- getArgs
+  either putStrLn appfun $ parseArgs args appspec
+
+-- | Parse the arguments with the parser
+--   provided to the function.
+parseArgs
+  :: Args     -- ^ Arguments to parse
+  -> CmdLnInterface a -- ^ Command line spec
+  -> ParseResult a
+parseArgs args = parseNiceArgs niceargs
+ where
+  niceargs = preprocess args
+
+-- | Parse the arguments with the parser
+--   provided to the function.
+parseNiceArgs
+  :: NiceArgs     -- ^ Arguments to parse
+  -> CmdLnInterface a -- ^ Command line spec
+  -> ParseResult a
+parseNiceArgs niceargs appspec = fromMaybe normalprocess specialprocess
+ where
+  parser = getParserFun $ cmdArgParser appspec
+  normalprocess = runParser parser niceargs
+  specialprocess = runSpecialFlags appspec niceargs
+
+runSpecialFlags :: CmdLnInterface a -> NiceArgs -> Maybe (ParseResult a)
+runSpecialFlags app args = loop $ specialFlags app where
+  loop flags = case flags of
+    []                   -> Nothing
+    (parse, action):rest -> runSpecialAction parse action rest
+  runSpecialAction parse action other = case specialParseResult of
+    Right True -> Just $ action app args
+    _          -> loop other
+   where
+    specialParseResult = runParser (getParserFun parse) args
+
+-- | default version and help special actions
+defaultSpecialFlags :: [SpecialFlag a]
+defaultSpecialFlags =
+  [ ( flagparser Short "help" "show this help message and exit"
+    , showParser $ showCmdLineAppUsage defaultFormat
+    )
+  , ( flagparser Long "version" "print the program version and exit"
+    , showParser showCmdLineVersion
+    )
+  ] where
+  flagparser fmt key descr = liftParam $ FlagParam fmt key id `Descr` descr
+  -- ignore args and show the result
+  showParser action = const . Left . action
+
+-- | Build an application with no version/description
+--   and with a name equal to the file name.
+mkApp
+  :: ParserSpec a
+  -> IO (CmdLnInterface a)
+mkApp spec = liftM (mkDefaultApp spec) getProgName
+
+-- | Build an application with no version/description
+--   and with a name equal to the provided String.
+mkDefaultApp :: ParserSpec a -> String -> CmdLnInterface a
+mkDefaultApp spec progName = CmdLnInterface
+    spec defaultSpecialFlags progName Nothing Nothing Nothing
+
+-- | Set the description of an interface
+setAppDescr :: CmdLnInterface a -> String -> CmdLnInterface a
+setAppDescr app descr = app {getAppDescr = Just descr }
+
+-- | Set the description of an interface
+setAppEpilog :: CmdLnInterface a -> String -> CmdLnInterface a
+setAppEpilog app descr = app {getAppEpilog = Just descr }
+
+-- | Set the name of an interface
+setAppName :: CmdLnInterface a -> String -> CmdLnInterface a
+setAppName app descr = app {getAppName = descr }
+ src/System/Console/ArgParser/SubParser.hs view
@@ -0,0 +1,84 @@+{- |
+Module      :  $Header$
+Copyright   :  (c) Simon Bergot
+License     :  BSD3
+
+Maintainer  :  simon.bergot@gmail.com
+Stability   :  unstable
+Portability :  portable
+
+Subparsers allows the creation of complex command line
+applications organized around commands.
+-}
+
+module System.Console.ArgParser.SubParser (
+    mkSubParser
+  , mkSubParserWithName
+  ) where
+
+import qualified Data.List                         as L
+import qualified Data.Map                          as M
+import           Data.Maybe
+import           System.Console.ArgParser.BaseType
+import           System.Console.ArgParser.Parser
+import           System.Console.ArgParser.Run
+import           System.Environment
+
+-- | Create a parser composed of a list of subparsers.
+--
+--   Each subparser is associated with a command which the user
+--   must type to activate.
+mkSubParser :: [(Arg, CmdLnInterface a)] -> IO (CmdLnInterface a)
+mkSubParser parsers = do
+  name <- getProgName
+  return $ mkSubParserWithName name parsers
+
+-- | Same that "mkSubParser" but allows a custom name
+mkSubParserWithName :: String -> [(Arg, CmdLnInterface a)] -> CmdLnInterface a
+mkSubParserWithName name parsers = CmdLnInterface
+  parser cmdSpecialFlags name Nothing Nothing Nothing
+ where
+  parser = liftParam EmptyParam
+  cmdSpecialFlags = command:defaultSpecialFlags
+  command = mkSpecialFlag name parsers
+
+mkSpecialFlag :: String -> [(Arg, CmdLnInterface a)] -> SpecialFlag a
+mkSpecialFlag topname subapps = (parser, action) where
+  parser = liftParam $ CommandParam cmdMap id
+  action _ (posargs, flagargs) =
+    case listToMaybe posargs >>= flip M.lookup cmdMap of
+      Nothing     -> error "impossible"
+      Just subapp -> parseNiceArgs
+        (drop 1 posargs, flagargs)
+        (subapp `setAppName` (topname ++ " " ++ getAppName subapp))
+  cmdMap = M.fromList subapps
+
+data EmptyParam a = EmptyParam
+
+instance ParamSpec EmptyParam where
+  getParser _ = Parser $ \args -> (Left "command not found", args)
+  getParamDescr _ = []
+
+data CommandParam appT resT = CommandParam 
+  (M.Map String (CmdLnInterface appT))
+  (Bool -> resT)
+
+instance ParamSpec (CommandParam resT) where
+  getParser (CommandParam cmdMap convert) = Parser cmdParser where
+    cmdParser (pos, flags) = case pos of
+      []    -> (Left "No command provided", (pos, flags))
+      arg:_ -> (Right $ convert isMatch, ([], M.empty)) where
+        isMatch = arg `M.member` cmdMap
+
+  getParamDescr (CommandParam cmdMap _) = summary:commands where
+    cmds = M.elems cmdMap
+    names = map getAppName cmds
+    descrs = map (fromMaybe "" . getAppDescr) cmds
+    summaryUsage = const $ "{" ++ L.intercalate "," names ++ "}"
+    summary = ParamDescr
+      summaryUsage "commands arguments" summaryUsage "" ""
+    singleCmdDescr name descr = ParamDescr
+      (const "") "commands arguments" (const name) descr ""
+    commands = zipWith singleCmdDescr names descrs
+
+
+ tests/System/Console/ArgParser/ArgsProcessTest.hs view
@@ -0,0 +1,51 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}
+module System.Console.ArgParser.ArgsProcessTest where
+
+import           Data.Map                               as M
+import           System.Console.ArgParser.ArgsProcess
+import           Test.Framework
+import qualified Test.HUnit as H
+
+{-# ANN module "HLint: ignore Use camelCase" #-}
+
+test_empty :: H.Assertion
+test_empty = assertEqual ([], M.empty) $ preprocess []
+
+test_pos :: H.Assertion
+test_pos = assertEqual (["1", "2", "3"], M.empty) $ preprocess ["1", "2", "3"]
+
+test_single_flag :: H.Assertion
+test_single_flag =
+  assertEqual ([], M.fromList [("f", ["1", "2", "3"])]) $
+  preprocess ["-f", "1", "2", "3"]
+
+test_single_flag_long_form :: H.Assertion
+test_single_flag_long_form =
+  assertEqual ([], M.fromList [("foo", ["1", "2", "3"])]) $
+  preprocess ["--foo", "1", "2", "3"]
+
+test_multiple_flag :: H.Assertion
+test_multiple_flag =
+  assertEqual ([], M.fromList
+    [ ("f", ["1", "2", "3"])
+    , ("b", ["7", "8"])
+    ]) $
+  preprocess ["-f", "1", "2", "3", "-b", "7", "8"]
+
+test_multiple_flag_short_form :: H.Assertion
+test_multiple_flag_short_form =
+  assertEqual ([], M.fromList
+    [ ("f", [])
+    , ("b", ["7", "8"])
+    ]) $
+  preprocess ["-fb", "7", "8"]
+
+test_mix :: H.Assertion
+test_mix =
+  assertEqual (["bar"], M.fromList [("b", ["7", "8"])]) $
+  preprocess ["bar", "-b", "7", "8"]
+
+test_repeatFlag :: H.Assertion
+test_repeatFlag =
+  assertEqual ([], M.fromList [("b", ["7", "8", "11", "12"])]) $
+  preprocess ["-b", "7", "-b", "8", "-b", "11", "12"]
+ tests/System/Console/ArgParser/FormatTest.hs view
@@ -0,0 +1,188 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}
+module System.Console.ArgParser.FormatTest where
+import System.Console.ArgParser.Format
+
+import System.Console.ArgParser.BaseType
+import System.Console.ArgParser.Parser
+import System.Console.ArgParser.Params
+import System.Console.ArgParser.Run
+import System.Console.ArgParser.SubParser
+import System.Console.ArgParser.QuickParams
+
+import Test.Framework
+import qualified Test.HUnit as H
+
+{-# ANN module "HLint: ignore Use camelCase" #-}
+
+single :: [a] -> a
+single xs = case xs of
+  [x] -> x
+  _   -> error "single on non-single list"
+  
+paramDescr
+  :: ParamSpec spec
+  => spec a
+  -> ParamDescr
+paramDescr = single . getParamDescr  
+
+showUsage
+  :: ParamSpec spec
+  => spec a
+  -> String
+showUsage = argUsage . paramDescr
+
+showArgFmt
+  :: ParamSpec spec
+  => spec a
+  -> String
+showArgFmt = getArgFormat . paramDescr
+
+checkFmt
+  :: ParamSpec spec
+  => spec a
+  -> String
+  -> String
+  -> H.Assertion
+checkFmt param shortUsage longUsage = do
+  assertEqual shortUsage $ showUsage param
+  assertEqual longUsage $ showArgFmt param
+
+test_boolFlagUsage :: H.Assertion
+test_boolFlagUsage = checkFmt (boolFlag "foo")
+  "[-f]"
+  "-f, --foo"
+
+test_reqFlagUsage :: H.Assertion
+test_reqFlagUsage = checkFmt (reqFlag "foo" :: StdArgParam Int)
+  "-f  FOO"
+  "-f, --foo  FOO"
+
+test_reqPosUsage :: H.Assertion
+test_reqPosUsage = checkFmt (reqPos "foo" :: StdArgParam Int)
+  "foo"
+  "foo"
+
+test_optFlagUsage :: H.Assertion
+test_optFlagUsage = checkFmt (optFlag 0 "foo" :: StdArgParam Int)
+  "[-f  FOO]"
+  "-f, --foo  FOO"
+
+test_optPosUsage :: H.Assertion
+test_optPosUsage = checkFmt (optPos 0 "foo" :: StdArgParam Int)
+  "[foo]"
+  "foo"
+
+test_reqFlagArgsUsage :: H.Assertion
+test_reqFlagArgsUsage = checkFmt (reqFlagArgs "foo" 0 (+) :: StdArgParam Int)
+  "-f  [FOO...]"
+  "-f, --foo  [FOO...]"
+
+test_optFlagArgsUsage :: H.Assertion
+test_optFlagArgsUsage = checkFmt (optFlagArgs 0 "foo" 0 (+) :: StdArgParam Int)
+  "[-f  [FOO...]]"
+  "-f, --foo  [FOO...]"
+
+test_posArgsUsage :: H.Assertion
+test_posArgsUsage = checkFmt (posArgs "foo" 0 (+) :: StdArgParam Int)
+  "[foo...]"
+  "foo"
+
+data MyTest = MyTest Int Int
+  deriving (Eq, Show)
+
+myTestParser :: CmdLnInterface MyTest
+myTestParser = mkDefaultApp (MyTest
+  `parsedBy` reqPos "foo"
+  `andBy` reqPos "bar")
+  "test"
+
+test_basicFormat :: H.Assertion
+test_basicFormat = assertEqual
+  ( unlines
+  [ "test"
+  , "usage : test foo bar [-h] [--version]"
+  , ""
+  , "mandatory arguments:"
+  , " foo"
+  , " bar"
+  , ""
+  , "optional arguments:"
+  , " -h, --help                    show this help message and exit"
+  , " --version                     print the program version and exit"
+  , ""
+  ])
+  $ showCmdLineAppUsage defaultFormat myTestParser
+
+data MyDescrTest = MyDescrTest Int Int Int Int
+  deriving (Eq, Show)
+
+myDescrTestParser :: CmdLnInterface MyDescrTest
+myDescrTestParser = mkDefaultApp (MyDescrTest
+  `parsedBy` reqPos "foo" `Descr` "the foo description"
+  `andBy` reqPos "bar" `Descr` "the bar description"
+  `andBy` reqPos "baz"
+    `Descr` "the baz description wich can be very very very very very very long"
+  `andBy` reqPos "bazazazazazazazazazazazazazazazazazazazazaz"
+    `Descr` "the bazaz description")
+  "test" `setAppDescr` "application description"
+ `setAppEpilog` "application epilog"
+
+test_DescrFormat :: H.Assertion
+test_DescrFormat = assertEqual
+  ( unlines
+  [ "test"
+  , "usage : test foo bar baz" ++
+      " bazazazazazazazazazazazazazazazazazazazazaz" ++
+      " [-h] [--version]"
+  , "application description"
+  , ""
+  , "mandatory arguments:"
+  , " foo                           the foo description"
+  , " bar                           the bar description"
+  , " baz                           the baz description wich can be"
+  , "                               very very very very very very long"
+  , " bazazazazazazazazazazazazazazazazazazazazaz"
+  , "                               the bazaz description"
+  , ""
+  , "optional arguments:"
+  , " -h, --help                    show this help message and exit"
+  , " --version                     print the program version and exit"
+  , ""
+  , ""
+  , "application epilog"
+  , ""
+  ])
+  $ showCmdLineAppUsage defaultFormat myDescrTestParser
+
+data MySubTest =
+  MyCons1 Int Int |
+  MyCons2 Int
+  deriving (Eq, Show)
+
+mySubTestParser :: CmdLnInterface MySubTest
+mySubTestParser = mkSubParserWithName "subparser"
+  [ ("A", mkDefaultApp
+      (MyCons1 `parsedBy` reqPos "pos1" `andBy` reqPos "pos2")
+        "A" `setAppDescr` "A sub description")
+  , ("B", mkDefaultApp
+      (MyCons2 `parsedBy` reqPos "pos1")
+        "B" `setAppDescr` "B sub description") 
+  ]
+
+test_subparserFormat :: H.Assertion
+test_subparserFormat = assertEqual
+  ( unlines
+  [ "subparser"
+  , "usage : subparser {A,B} [-h] [--version]"
+  , ""
+  , "commands arguments:"
+  , " {A,B}"
+  , " A                             A sub description"
+  , " B                             B sub description"
+  , ""
+  , "optional arguments:"
+  , " -h, --help                    show this help message and exit"
+  , " --version                     print the program version and exit"
+  , ""
+  ])
+  $ showCmdLineAppUsage defaultFormat mySubTestParser
+ tests/System/Console/ArgParser/ParserTest.hs view
@@ -0,0 +1,62 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}
+module System.Console.ArgParser.ParserTest where
+import System.Console.ArgParser.Parser
+
+import System.Console.ArgParser.BaseType
+import System.Console.ArgParser.QuickParams
+import System.Console.ArgParser.TestHelpers
+
+import Test.Framework
+
+{-# ANN module "HLint: ignore Use camelCase" #-}
+
+data MyTest = MyTest Int Int
+  deriving (Eq, Show)
+
+myTestParser :: ParserSpec MyTest
+myTestParser = MyTest
+  `parsedBy` reqPos "pos1"
+  `andBy` reqPos "pos2"
+
+prop_parse
+  :: Positive Int
+  -> Positive Int
+  -> Bool
+prop_parse (Positive i) (Positive j) =
+  Right (MyTest i j) == specRun myTestParser [show i, show j]
+
+data MySuperTest = MySuperTest Int Int Int MyTest Int Int
+  deriving (Eq, Show)
+
+mySuperParser :: ParserSpec MySuperTest
+mySuperParser = MySuperTest
+ `parsedBy` reqPos "pos1"
+ `andBy` reqPos "pos2"
+ `andBy` reqPos "pos3"
+ `andBy` (MyTest
+   `subParser` reqPos "pos4"
+   `andBy` reqPos "pos5")
+ `andBy` reqPos "pos6"
+ `andBy` reqPos "pos7"
+
+prop_superParse
+  :: Positive Int
+  -> Positive Int
+  -> Positive Int
+  -> Positive Int
+  -> Positive Int
+  -> Positive Int
+  -> Positive Int
+  -> Bool
+prop_superParse
+  (Positive i1)
+  (Positive i2)
+  (Positive i3)
+  (Positive i4)
+  (Positive i5)
+  (Positive i6)
+  (Positive i7) =
+  Right expected == result where
+    expected = MySuperTest i1 i2 i3 (MyTest i4 i5) i6 i7 
+    result = specRun mySuperParser $ map show
+      [ i1, i2, i3, i4, i5, i6, i7]
+ tests/System/Console/ArgParser/QuickParamsTest.hs view
@@ -0,0 +1,122 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}
+module System.Console.ArgParser.QuickParamsTest where
+import System.Console.ArgParser.QuickParams
+import System.Console.ArgParser.BaseType
+
+import System.Console.ArgParser.TestHelpers
+import Test.Framework
+import qualified Test.HUnit as H
+
+{-# ANN module "HLint: ignore Use camelCase" #-}
+
+test_boolFlag :: H.Assertion
+test_boolFlag = behavior (paramRun (boolFlag "test"))
+  [ (willSucceed True  ,["--test"])
+  , (willSucceed True  ,["--te"])
+  , (willSucceed True  ,["-t"])
+  , (willSucceed False ,[])
+  , (willFail          ,["-t", "arg"])
+  ]
+
+intReqParser :: [String] -> ParseResult Int
+intReqParser = paramRun $ reqPos "test"
+
+prop_reqPosSuccess :: Positive Int -> Bool
+prop_reqPosSuccess = getIntSuccessProp intReqParser (\i -> [show i])
+
+strReqParser :: [String] -> ParseResult String
+strReqParser = paramRun $ reqPos "test"
+
+prop_strReqPosSuccess :: String -> Property
+prop_strReqPosSuccess = getStrSuccessProp strReqParser
+
+floatReqParser :: [String] -> ParseResult Float
+floatReqParser = paramRun $ reqPos "test"
+
+prop_floatReqPosSuccess :: Positive Float -> Bool
+prop_floatReqPosSuccess = getIntSuccessProp floatReqParser (\i -> [show i])
+ 
+test_reqPosFailure :: H.Assertion
+test_reqPosFailure = behavior intReqParser
+  [ (willFail, ["--test"])
+  , (willFail, ["foo"])
+  , (willFail, [])
+  ]
+
+intOptParser :: [String] -> ParseResult Int
+intOptParser = paramRun $ optPos 0 "test"
+
+prop_optPosSuccess :: Positive Int -> Bool
+prop_optPosSuccess = getIntSuccessProp intOptParser (\i -> [show i])
+ 
+test_optPosFailure :: H.Assertion
+test_optPosFailure = behavior intOptParser
+  [ (willFail, ["foo"])
+  , (willSucceed 0, [])
+  ]
+
+intReqFlagParser :: [String] -> ParseResult Int
+intReqFlagParser = paramRun $ reqFlag "test"
+
+prop_reqFlagSuccess :: Positive Int -> Bool
+prop_reqFlagSuccess = getIntSuccessProp intReqFlagParser (\i -> ["-t", show i])
+ 
+test_reqFlagFailure :: H.Assertion
+test_reqFlagFailure = behavior intReqFlagParser
+  [ (willFail, ["--test"])
+  , (willFail, ["--test", "foo"])
+  , (willFail, [])
+  ]
+intOptFlagParser :: [String] -> ParseResult Int
+intOptFlagParser = paramRun $ optFlag 0 "test"
+
+prop_optFlagSuccess :: Positive Int -> Bool
+prop_optFlagSuccess = getIntSuccessProp intOptFlagParser (\i -> ["-t", show i])
+ 
+test_optFlagFailure :: H.Assertion
+test_optFlagFailure = behavior intOptFlagParser
+  [ (willFail, ["--test"])
+  , (willFail, ["--test", "foo"])
+  , (willSucceed 0, [])
+  ]
+
+intOptArgsParser :: [String] -> ParseResult Int
+intOptArgsParser = paramRun $ posArgs "test" 0 (+)
+
+prop_optPosArgsSuccess :: NonEmptyList (Positive Int) -> Bool
+prop_optPosArgsSuccess = getIntSumSuccessProp intOptArgsParser []
+ 
+test_optPosArgsFailure :: H.Assertion
+test_optPosArgsFailure = behavior intOptArgsParser
+  [ (willFail, ["foo"])
+  , (willSucceed 0, [])
+  ]
+
+intReqFlagArgsParser :: [String] -> ParseResult Int
+intReqFlagArgsParser = paramRun $ reqFlagArgs "test" 0 (+)
+
+prop_reqFlagArgsSuccess :: NonEmptyList (Positive Int) -> Bool
+prop_reqFlagArgsSuccess =
+  getIntSumSuccessProp intReqFlagArgsParser ["-t"]
+ 
+test_reqFlagArgsFailure :: H.Assertion
+test_reqFlagArgsFailure = behavior intReqFlagArgsParser
+  [ (willFail, ["--test", "foo"])
+  , (willFail, [])
+  , (willSucceed 0, ["--test"])
+  ]
+
+intOptFlagArgsParser :: [String] -> ParseResult Int
+intOptFlagArgsParser = paramRun $ optFlagArgs 1 "test" 0 (+) 
+
+prop_optFlagArgsSuccess :: NonEmptyList (Positive Int) -> Bool
+prop_optFlagArgsSuccess =
+  getIntSumSuccessProp intOptFlagArgsParser ["-t"]
+ 
+test_optFlagArgsFailure :: H.Assertion
+test_optFlagArgsFailure = behavior intOptFlagArgsParser
+  [ (willFail, ["--test", "foo"])
+  , (willSucceed 0, ["--test"])
+  , (willSucceed 1, [])
+  , (willSucceed 3, ["-t", "1", "-t", "2"])
+  ]
+ tests/System/Console/ArgParser/SubParserTest.hs view
@@ -0,0 +1,34 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}
+module System.Console.ArgParser.SubParserTest where
+import System.Console.ArgParser.SubParser
+
+import System.Console.ArgParser.BaseType
+import System.Console.ArgParser.QuickParams
+import System.Console.ArgParser.Run
+import System.Console.ArgParser.Parser
+import System.Console.ArgParser.TestHelpers
+
+import Test.Framework
+import qualified Test.HUnit as H
+
+{-# ANN module "HLint: ignore Use camelCase" #-}
+
+data MyTest =
+  MyCons1 Int Int |
+  MyCons2 Int
+  deriving (Eq, Show)
+
+myTestParser :: CmdLnInterface MyTest
+myTestParser = mkSubParserWithName "subparser"
+  [ ("A", mkDefaultApp
+    (MyCons1 `parsedBy` reqPos "pos1" `andBy` reqPos "pos2") "A")
+  , ("B", mkDefaultApp
+    (MyCons2 `parsedBy` reqPos "pos1") "B") 
+  ]
+
+test_subparser :: H.Assertion
+test_subparser = behavior (`parseArgs` myTestParser)
+  [ (willSucceed (MyCons1 1 2), ["A", "1", "2"])
+  , (willSucceed (MyCons2 3), ["B", "3"])
+  , (willFail, ["3"])
+  ]
+ tests/System/Console/ArgParser/TestHelpers.hs view
@@ -0,0 +1,77 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}
+module System.Console.ArgParser.TestHelpers where
+
+import System.Console.ArgParser.BaseType
+import System.Console.ArgParser.Parser
+import System.Console.ArgParser.Run
+
+import Test.Framework
+import qualified Test.HUnit as H
+
+
+paramRun
+  :: ParamSpec spec
+  => spec a
+  -> [String]
+  -> ParseResult a
+paramRun param args = parseArgs args $
+  mkDefaultApp (liftParam param) ""
+
+
+specRun
+  :: ParserSpec a
+  -> [String]
+  -> ParseResult a
+specRun param args = parseArgs args $
+  mkDefaultApp param ""
+
+willFail :: Show a => ParseResult a -> H.Assertion
+willFail res = case res  of
+  Left _    -> return ()
+  Right val -> assertFailure $
+    "\nexpected parsing to fail but got " ++ show val
+
+willSucceed
+  :: (Show a, Eq a)
+  => a
+  -> ParseResult a
+  -> H.Assertion
+willSucceed val res = case res  of
+  Left msg     -> assertFailure $ "\nparsing failed: " ++ msg
+  Right resval -> assertEqual val resval
+
+behavior
+  :: ([String] -> ParseResult a)
+  -> [(ParseResult a -> H.Assertion, [String])]
+  -> H.Assertion
+behavior parser candidates = sequence_ assertions where
+  (preds, args) = unzip candidates
+  results = map parser args
+  assertions = zipWith ($) preds results
+
+getIntSuccessProp
+  :: (Show a, Num a, Eq a)
+  => ([String] -> ParseResult a)
+  -> (a -> [String])
+  -> Positive a
+  -> Bool
+getIntSuccessProp parser repr = prop where
+  prop (Positive i) = (Right i ==) $ parser $ repr i
+
+getStrSuccessProp
+  :: ([String] -> ParseResult String)
+  -> String
+  -> Property
+getStrSuccessProp parser = prop where
+  prop str = (take 1 str /= "-") ==> Right str == parser [str]
+
+getIntSumSuccessProp
+  :: ([String] -> ParseResult Int)
+  -> [String]
+  -> NonEmptyList (Positive Int)
+  -> Bool
+getIntSumSuccessProp parser prefix = prop where
+  prop (NonEmpty positives) = (Right expected ==) $ parser args where
+    unpos (Positive i) = i
+    expected = sum $ map unpos positives
+    args = prefix ++ map (show . unpos) positives
+ tests/TestsHTF.hs view
@@ -0,0 +1,14 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}
+module Main where
+
+
+import Test.Framework
+
+import {-@ HTF_TESTS @-} System.Console.ArgParser.FormatTest
+import {-@ HTF_TESTS @-} System.Console.ArgParser.SubParserTest
+import {-@ HTF_TESTS @-} System.Console.ArgParser.QuickParamsTest
+import {-@ HTF_TESTS @-} System.Console.ArgParser.ParserTest
+import {-@ HTF_TESTS @-} System.Console.ArgParser.ArgsProcessTest
+
+main :: IO()
+main = htfMain htf_importedTests