packages feed

cmdargs (empty) → 0.1

raw patch · 14 files changed

+1503/−0 lines, 14 filesdep +basedep +filepathdep +mtlsetup-changed

Dependencies added: base, filepath, mtl

Files

+ Diffy.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Diffy where+import System.Console.CmdArgs++data Diffy = Create {src :: FilePath, out :: FilePath}+           | Diff {old :: FilePath, new :: FilePath, out :: FilePath}+             deriving (Data,Typeable,Show,Eq)++outFlags = text "Output file" & typFile++create = mode $ Create+    {src = "." &= text "Source directory" & typDir+    ,out = "ls.txt" &= outFlags+    } &= prog "diffy" & text "Create a fingerprint"++diff = mode $ Diff+    {old = def &= typ "OLDFILE" & argPos 0+    ,new = def &= typ "NEWFILE" & argPos 1+    ,out = "diff.txt" &= outFlags+    } &= text "Perform a diff"++modes = [create,diff]++main = print =<< cmdArgs "Diffy v1.0" modes
+ HLint.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE DeriveDataTypeable #-}+module HLint where+import System.Console.CmdArgs++data HLint = HLint+    {report :: [FilePath]+    ,hint :: [FilePath]+    ,color :: Bool+    ,ignore :: [String]+    ,show_ :: Bool+    ,test :: Bool+    ,cpp_define :: [String]+    ,cpp_include :: [String]+    ,files :: [String]+    }+    deriving (Data,Typeable,Show,Eq)++hlint = mode $ HLint+    {report = def &= empty "report.html" & typFile & text "Generate a report in HTML"+    ,hint = def &= typFile & text "Hint/ignore file to use"+    ,color = def &= flag "c" & flag "colour" & text "Color the output (requires ANSI terminal)"+    ,ignore = def &= typ "MESSAGE" & text "Ignore a particular hint"+    ,show_ = def &= text "Show all ignored ideas"+    ,test = def &= text "Run in test mode"+    ,cpp_define = def &= typ "NAME[=VALUE]" & text "CPP #define"+    ,cpp_include = def &= typDir & text "CPP include path"+    ,files = def &= args & typ "FILE/DIR"+    } &=+    prog "hlint" &+    text "Suggest improvements to Haskell source code" &+    helpSuffix ["To check all Haskell files in 'src' and generate a report type:","  hlint src --report"]++modes = [hlint]++main = print =<< cmdArgs "HLint v1.6.5, (C) Neil Mitchell 2006-2009" modes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Neil Mitchell 2006-2007.+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 Neil Mitchell nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Main.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import System.Console.CmdArgs+import Control.Monad+import System.IO+import System.Environment+import Control.Exception+import Data.List++import qualified HLint as H+import qualified Diffy as D+import qualified Maker as M+++main = do+    args <- getArgs+    case args of+        "hlint":xs -> withArgs xs H.main+        "diffy":xs -> withArgs xs D.main+        "maker":xs -> withArgs xs M.main+        "test":_ -> testHLint >> testDiffy >> testMaker >> putStrLn "Test successful"+        "generate":_ -> generateManual+        _ -> error "CmdArgs test program, expected one of: test hlint diffy maker"+++test x = (map modeValue x, (===), fails)+    where+        (===) args v = do+            res <- withArgs args $ cmdArgs "" x+            when (res /= v) $+                error $ "Mismatch on flags " ++ show args++        fails args = do+            res <- try $ withArgs args $ cmdArgs "" x+            case res of+                Left (e :: SomeException) -> return ()+                Right _ -> error $ "Expected failure " ++ show args+++---------------------------------------------------------------------+-- TESTS++testHLint = do+    let ([v],(===),fails) = test H.modes+    [] === v+    fails ["-ch"]+    ["--colo"] === v{H.color=True}+    ["-ct"] === v{H.color=True,H.test=True}+    ["--colour","--test"] === v{H.color=True,H.test=True}+    ["-thfoo"] === v{H.test=True,H.hint=["foo"]}+    ["-cr"] === v{H.color=True,H.report=["report.html"]}+    ["--cpp-define=val","x"] === v{H.cpp_define=["val"],H.files=["x"]}+    fails ["--cpp-define"]+    ["--cpp-define","val","x","y"] === v{H.cpp_define=["val"],H.files=["x","y"]}+++testDiffy = do+    let ([create,diff],(===),fails) = test D.modes+    fails []+    ["create"] === create+    fails ["create","file1"]+    ["create","--src","x"] === create{D.src="x"}+    ["create","--src","x","--src","y"] === create{D.src="y"}+    fails ["diff","--src","x"]+    fails ["create","foo"]+    ["diff","foo1","foo2"] === diff{D.old="foo1",D.new="foo2"}+    fails ["diff","foo1"]+    fails ["diff","foo1","foo2","foo3"]+++testMaker = do+    let ([build,wipe,tst],(===),fails) = test M.modes+    [] === build+    ["build","foo","--profile"] === build{M.files=["foo"],M.method=M.Profile}+    ["foo","--profile"] === build{M.files=["foo"],M.method=M.Profile}+    ["foo","--profile","--release"] === build{M.files=["foo"],M.method=M.Release}+    ["-d"] === build{M.method=M.Debug}+    ["build","-j3"] === build{M.threads=3}+    ["build","-j=3"] === build{M.threads=3}+    fails ["build","-jN"]+    -- FIXME: should fail, but -t gets intepreted as --t, which matches --threaded+    -- fails ["build","-t1"]+    ["wipe"] === wipe+    ["test"] === tst+    ["test","foo"] === tst{M.extra=["foo"]}+    ["test","foo","-baz","-j3","--what=1"] === tst{M.extra=["foo","-baz","--what=1"],M.threads=3}+++---------------------------------------------------------------------+-- GENERATE MANUAL++generateManual :: IO ()+generateManual = do+    src <- readFile "cmdargs.htm"+    () <- length src `seq` return ()+    res <- fmap unlines $ f $ lines src+    () <- length res `seq` return ()+    h <- openBinaryFile "cmdargs.htm" WriteMode+    hPutStr h res+    hClose h+    where+        f (x:xs) | "<!-- BEGIN " `isPrefixOf` x = do+            ys <- generateChunk $ init $ drop 2 $ words x+            zs <- f $ tail $ dropWhile (not . isPrefixOf "<!-- END") xs+            return $ x : ys ++ ["<!-- END -->"] ++ zs+        f [] = return []+        f (x:xs) = fmap (x:) $ f xs++generateChunk :: [String] -> IO [String]+generateChunk ["help",x] = do+    src <- readFile $ x ++ ".hs"+    let str = head [takeWhile (/= '\"') $ drop 1 $ dropWhile (/= '\"') x | x <- lines src, "main" `isPrefixOf` x]+    () <- length src `seq` return ()+    fmap lines $ case x of+        "hlint" -> cmdArgsHelp str H.modes HTML+        "diffy" -> cmdArgsHelp str D.modes HTML+        "maker" -> cmdArgsHelp str M.modes HTML++generateChunk ["code",x] = do+    src <- readFile $ x ++ ".hs"+    return $ ["<pre>"] ++ lines src ++ ["</pre>"]
+ Maker.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Maker where+import System.Console.CmdArgs++data Method = Debug | Release | Profile+              deriving (Data,Typeable,Show,Eq)++data Maker+    = Wipe+    | Test {threads :: Int, extra :: [String]}+    | Build {threads :: Int, method :: Method, files :: [FilePath]}+      deriving (Data,Typeable,Show,Eq)++threadsMsg = text "Number of threads to use" & flag "j" & typ "NUM"++wipe = mode $ Wipe &= prog "maker" & text "Clean all build objects"++test = mode $ Test+    {threads = def &= threadsMsg+    ,extra = def &= typ "ANY" & args & unknownFlags+    } &= text "Run the test suite"++build = mode $ Build+    {threads = def &= threadsMsg+    ,method = enum Release+        [Debug &= text "Debug build"+        ,Release &= text "Release build"+        ,Profile &= text "Profile build"]+    ,files = def &= args+    } &= text "Build the project" & defMode++modes = [build,wipe,test]++main = print =<< cmdArgs "Maker v1.0" modes
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/Console/CmdArgs.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, PatternGuards #-}+{-|+    This module provides simple command line argument processing.+    The main function of interest is 'cmdArgs'.+    A simple example is:++    @data Sample = Sample {hello :: String} deriving (Show, Data, Typeable)@++    @sample = 'mode' $ Sample{hello = def '&=' 'text' \"World argument\" '&' 'empty' \"world\"}@++    @main = print =<< 'cmdArgs' \"Sample v1, (C) Neil Mitchell 2009\" [sample]@+++    Attributes are used to control a number of behaviours:+    +    * The help message: 'text', 'typ', 'helpSuffix', 'prog'+    +    * Default behaviour: 'empty', 'defMode'+    +    * Flag name assignment: 'flag', 'explicit', 'enum'+    +    * Controlling non-flag arguments: 'args', 'argPos', 'unknownFlags'+-}++module System.Console.CmdArgs(+    -- * Running command lines+    cmdArgs, modeValue,+    -- * Attributes+    module System.Console.CmdArgs.UI,+    -- * Verbosity control+    isQuiet, isNormal, isLoud,+    -- * Display help information+    HelpFormat(..), cmdArgsHelp,+    -- * Default values+    Default(..),+    -- * Re-exported for convenience+    Data, Typeable+    ) where++import System.IO.Unsafe+import Data.Dynamic+import Data.Data+import Data.List+import Data.Maybe+import Data.IORef+import System.Environment+import System.Exit+import System.FilePath+import Data.Char+import Control.Monad.State+import Data.Function++import System.Console.CmdArgs.Type+import System.Console.CmdArgs.UI+import System.Console.CmdArgs.Expand+import System.Console.CmdArgs.Flag+import System.Console.CmdArgs.Help+++---------------------------------------------------------------------+-- DEFAULTS++-- | Class for default values+class Default a where+    -- | Provide a default value+    def :: a++instance Default Bool where def = False+instance Default [a] where def = []+instance Default Int where def = 0+instance Default Integer where def = 0+instance Default Float where def = 0+instance Default Double where def = 0+++---------------------------------------------------------------------+-- VERBOSITY CONTROL++{-# NOINLINE verbosity #-}+verbosity :: IORef Int -- 0 = quiet, 1 = normal, 2 = verbose+verbosity = unsafePerformIO $ newIORef 1++-- | Used to test if essential messages should be output to the user.+--   Always true (since even @--quiet@ wants essential messages output).+--   Must be called after 'cmdArgs'.+isQuiet :: IO Bool+isQuiet = return True++-- | Used to test if normal messages should be output to the user.+--   True unless @--quiet@ is specified.+--   Must be called after 'cmdArgs'.+isNormal :: IO Bool+isNormal = fmap (>=1) $ readIORef verbosity++-- | Used to test if helpful debug messages should be output to the user.+--   False unless @--verbose@ is specified.+--   Must be called after 'cmdArgs'.+isLoud :: IO Bool+isLoud = fmap (>=2) $ readIORef verbosity+++---------------------------------------------------------------------+-- MAIN DRIVERS++-- | Extract the default value from inside a Mode.+modeValue :: Mode a -> a+modeValue = modeVal+++-- | The main entry point for programs using CmdArgs.+--   For an example see "System.Console.CmdArgs".+cmdArgs :: Data a+    => String -- ^ Information about the program, something like: @\"ProgramName v1.0, Copyright PersonName 2000\"@.+    -> [Mode a] -- ^ The modes of operation, constructed by 'mode'. For single mode programs it is a singleton list.+    -> IO a+cmdArgs short modes = do+    modes <- return $ expand modes+    (mode,args) <- parseModes modes `fmap` getArgs+    when (hasAction args "!help") $ do+        hlp <- case mode of+            Right (True,mode) -> helpInfo short modes [mode]+            _ -> helpInfo short modes modes+        let Update _ op = fromJust $ getAction args "!help"+        putStr $ showHelp hlp (fromDyn (op undefined) "")+        exitSuccess+    when (hasAction args "!version") $ do+        putStrLn short+        exitSuccess+    mode <- case mode of+        Right (_,x) -> return x+        Left x -> putStrLn x >> exitFailure+    sequence_ [putStrLn x >> exitFailure | Error x <- args]+    when (hasAction args "!verbose") $ writeIORef verbosity 2+    when (hasAction args "!quiet") $ writeIORef verbosity 0+    return $ applyActions args $ modeValue mode+++---------------------------------------------------------------------+-- HELP INFORMATION++-- | Format to display help in.+data HelpFormat+    = Text -- ^ As output on the console.+    | HTML -- ^ Suitable for inclusion in web pages (uses a table rather than explicit wrapping).+    deriving (Eq,Ord,Show,Read,Enum,Bounded)++-- | Display the help message, as it would appear with @--help@.+--   The first argument should match the first argument to 'cmdArgs'.+cmdArgsHelp :: String -> [Mode a] -> HelpFormat -> IO String+cmdArgsHelp short xs format = fmap (`showHelp` (show format)) $ helpInfo short modes modes+    where modes = expand xs+++helpInfo :: String -> [Mode a] -> [Mode a] -> IO [Help]+helpInfo short tot now = do+    prog <- fmap (map toLower . takeBaseName) getProgName+    prog <- return $ head $ mapMaybe modeProg tot ++ [prog]+    let info = [([Norm $ unwords $ prog : [['['|def] ++ name ++ [']'|def] | length tot /= 1] ++ "[FLAG]" : args] +++                 [Norm $ "  " ++ text | text /= ""]+                ,concatMap helpFlag flags)+               | Mode{modeName=name,modeFlags=flags,modeText=text,modeDef=def} <- now+               , let args = map snd $ sortBy (compare `on` fst) $ concatMap helpFlagArgs flags]+    let dupes = if length now == 1 then [] else foldr1 intersect (map snd info)+    return $+        Norm short :+        concat [ Norm "" : mode ++ [Norm "" | flags /= []] ++ map Trip flags+               | (mode,args) <- info, let flags = args \\ dupes] +++        (if null dupes then [] else Norm "":Norm "Common flags:":map Trip dupes) +++        concat [ map Norm $ "":suf | suf@(_:_) <- map modeHelpSuffix tot]+++---------------------------------------------------------------------+-- PROCESS FLAGS++parseModes :: [Mode a] -> [String] -> (Either String (Bool, Mode a), [Action])+parseModes modes args+    | [mode] <- modes = (Right (False,mode), parseFlags (modeFlags mode) args)+    | [] <- poss, Just mode <- def = (Right (False,mode), parseFlags (modeFlags mode) args)+    | [mode] <- poss = (Right (True, mode), parseFlags (modeFlags mode) $ tail args)+    | otherwise = (Left err, parseFlags autoFlags args)+    where+        err = if null poss+              then "No mode given, expected one of: " ++ unwords (map modeName modes)+              else "Multiple modes given, could be any of: " ++ unwords (map modeName poss)++        def = listToMaybe $ filter modeDef modes+        poss = let f eq = [m | a <- take 1 args, m <- modes, a `eq` modeName m]+                   (exact,prefix) = (f (==), f isPrefixOf)+               in if null exact then prefix else exact+++---------------------------------------------------------------------+-- APPLICATION++setField :: Data a => a -> String -> (Dynamic -> Dynamic) -> a+setField x name v = flip evalState (constrFields $ toConstr x) $ flip gmapM x $ \i -> do+    n:ns <- get+    put ns+    return $ if n == name then fromDyn (v $ toDyn i) i else i+++applyActions :: Data a => [Action] -> a -> a+applyActions (Update name op:as) x | not $ "!" `isPrefixOf` name = applyActions as $ setField x name op+applyActions (a:as) x = applyActions as x+applyActions [] x = x
+ System/Console/CmdArgs/Expand.hs view
@@ -0,0 +1,83 @@++module System.Console.CmdArgs.Expand(defaults,expand,autoFlags) where++import System.Console.CmdArgs.Type+import Data.Dynamic+import Data.List+import Data.Maybe+import Data.Char+import Data.Function+++---------------------------------------------------------------------+-- PRESUPPLIED ARGS++autoFlags :: [Flag]+autoFlags =+    [(f "!help" "?" "help" "Show usage information (optional format)")+        {flagType=fromJust $ toFlagType (typeOf ""),flagOpt=Just "",flagTyp="FORMAT"}+    ,f "!version" "V" "version" "Show version information"+    ,f "!verbose" "v" "verbose" "Higher verbosity"+    ,f "!quiet" "q" "quiet" "Lower verbosity"+    ]+    where f name short long text = flagDefault+            {flagName=name,flagKey=name,flagFlag=[short,long],flagText=text,flagType=FlagBool (toDyn True),flagVal=toDyn False,flagExplicit=True}++---------------------------------------------------------------------+-- FLAG DEFAULTS++-- FIXME: Add the string (default=foo) in the appropriate places+defaults :: a -> Flag -> Flag+defaults = error "todo" +++---------------------------------------------------------------------+-- FLAG EXPANSION+-- Introduce more long/short names++-- (keyname,([flags],explicit))+type FlagNames = [(String,([String],Bool))]++-- Error if:+--   Two things with the same FldName have different FldFlag or Explicit+--   Two fields without the same FldName have different FldFlag+expand :: [Mode a] -> [Mode a]+expand xs | not $ checkFlags ys = error "Flag's don't meet their condition"+          | otherwise = xs3+    where+        xs3 = map (\x -> x{modeFlags=[if isFlagArgs c then c else c{flagFlag=fst $ fromJust $ lookup (flagKey c) ys2} | c <- modeFlags x]}) xs2+        ys2 = assignShort $ assignLong ys+        ys = sort $ nub [(flagKey x, (flagFlag x, flagExplicit x)) | x <- map modeFlags xs2, x <- x, isFlagFlag x]+        xs2 = map (\x -> x{modeFlags = autoFlags ++ modeFlags x}) xs+++checkFlags :: FlagNames -> Bool+checkFlags xs | any ((/=) 1 . length) $ groupBy ((==) `on` fst) xs = error "Two record names have different flags"+              | nub names /= names = error "One flag has been assigned twice"+              | otherwise = True+    where names = concatMap (fst . snd) xs+++assignLong :: FlagNames -> FlagNames+assignLong xs = map f xs+    where+        seen = concatMap (fst . snd) xs+        f (name,(already,False)) | name `notElem` seen = (name,(g name:already,False))+        f x = x+        g xs | "_" `isSuffixOf` xs = g $ init xs+        g xs = [if x == '_' then '-' else x | x <- xs]+++assignShort :: FlagNames -> FlagNames+assignShort xs = zipWith (\x (a,(b,c)) -> (a,(maybe [] (return . return) x ++ b,c))) good xs+    where+        seen = concat $ filter ((==) 1 . length) $ concatMap (fst . snd) xs+        guesses = map guess xs :: [Maybe Char]+        dupes = let gs = catMaybes guesses in nub $ gs \\ nub gs+        good = [if maybe True (`elem` (dupes++seen)) g then Nothing else g | g <- guesses] :: [Maybe Char]++        -- guess at a possible short flag+        guess (name,(already,False)) | all ((/=) 1 . length) already = Just $ head $ head already+        guess _ = Nothing++
+ System/Console/CmdArgs/Flag.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE PatternGuards #-}++module System.Console.CmdArgs.Flag where++import Data.Dynamic+import Data.List+import Data.Maybe+import Data.Char+import Control.Monad+import Data.Function++import System.Console.CmdArgs.Type+++data Action = Update String (Dynamic -> Dynamic)+            | Error String++instance Show Action where+    show (Update x y) = "Update " ++ show x ++ " <function>"+    show (Error x) = "Error " ++ show x++getAction :: [Action] -> String -> Maybe Action+getAction as x = listToMaybe [a | a@(Update s _) <- as, s == x]++hasAction :: [Action] -> String -> Bool+hasAction as = isJust . getAction as+++---------------------------------------------------------------------+-- HELP INFORMATION FOR A FLAG++helpFlag :: Flag -> [(String,String,String)]+helpFlag xs =+    [(unwords (map ("-"++) short)+     ,unwords (map ("--"++) long) ++ val+     ,flagText xs ++ maybe "" (\x -> " (default=" ++ x ++ ")") (defaultFlag xs))+    | isFlagFlag xs]+    where+        (short,long) = partition ((==) 1 . length) $ flagFlag xs+        val = if isFlagBool xs then ""+              else ['['|opt] ++ "=" ++ flagTypDef "VALUE" xs ++ [']'|opt]+        opt = isFlagOpt xs+++-- Given a flag, see what argument positions it should have+-- with the Int being a sort order+helpFlagArgs :: Flag -> [(Int,String)]+helpFlagArgs xs = case (flagArgs xs, flagTypDef "FILE" xs) of+    (Just Nothing,x) -> [(maxBound :: Int,"[" ++ x ++ "]")]+    (Just (Just i),x) -> [(i,x)]+    _ -> []+++defaultFlag :: Flag -> Maybe String+defaultFlag x = if res `elem` [Just "",Just "0"] then Nothing else res+    where+        res = flagOpt x `mplus` val+        val = case flagVal x of+                x | Just v <- fromDynamic x -> Just (v :: String)+                  | Just v <- fromDynamic x -> Just $ show (v :: Int)+                  | Just v <- fromDynamic x -> Just $ show (v :: Integer)+                  | Just v <- fromDynamic x -> Just $ show (v :: Float)+                  | Just v <- fromDynamic x -> Just $ show (v :: Double)+                _ -> Nothing+++---------------------------------------------------------------------+-- PROCESS A FLAG++parseFlags :: [Flag] -> [String] -> [Action]+parseFlags flags = f 0+    where+        f seen [] = case reverse $ sort [i | Flag{flagArgs=Just (Just i),flagOpt=Nothing} <- flags, i >= seen] of+            [] -> []+            x:_ -> [Error $ "Not enough non-flag arguments, expected " ++ show (x+1) ++ ", but got " ++ show seen]++        f seen (x:xs) = act : f (seen + if "-" `isPrefixOf` x then 0 else 1) ys+            where (act,ys) = case sortBy (compare `on` fst) $ mapMaybe (\flag -> parseFlag flag seen (x:xs)) flags of+                    [] -> (Error $ "Unknown flag: " ++ x, xs)+                    r1:r2:_ | fst r1 == fst r2 -> (Error $ "Ambiguous flag: " ++ x, xs)+                    r:_ -> snd r+++data Priority = PriExactFlag | PriPrefixFlag | PriFilePos | PriFile | PriUnknown+                deriving (Eq,Ord,Show)+++parseFlag :: Flag -> Int -> [String] -> Maybe (Priority, (Action, [String]))++parseFlag flag seen (x:xs) | flagUnknown flag = Just (PriUnknown, (Update (flagName flag) (addMany x), xs))++parseFlag flag seen (('-':x:xs):ys) | xs /= "" && x `elem` expand = parseFlag flag seen (['-',x]:('-':xs):ys)+    where expand = [x | isFlagBool flag, [x] <- flagFlag flag]++parseFlag flag seen (('-':x:xs):ys) | x /= '-' = parseFlag flag seen (x2:ys)+    where x2 = '-':'-':x:['='| xs /= [] && head xs /= '=']++xs++parseFlag flag seen (('-':'-':x):xs)+    | not $ any (a `isPrefixOf`) (flagFlag flag) = Nothing+    | otherwise = Just $ (,) (if a `elem` flagFlag flag then PriExactFlag else PriPrefixFlag) $+    case flagType flag of+        FlagBool r ->+            if b /= "" then err "does not take an argument" xs+                       else upd (const r) xs+        FlagItem r ->+            if not (isFlagOpt flag) && null b && (null xs || "-" `isPrefixOf` head xs)+            then err "needs an argument" xs+            else let (text,rest) = case flagOpt flag of+                        Just v | null b -> (v, xs)+                        _ | null b -> (head xs, tail xs)+                        _ -> (drop 1 b, xs)+                 in case r text of+                        Nothing -> err "couldn't parse argument" rest+                        Just v -> upd v rest+    where+        (a,b) = break (== '=') x+        err msg rest = (Error $ "Error on flag " ++ show x ++ ", flag " ++ msg, rest)+        upd v rest = (Update (flagName flag) v, rest)++parseFlag flag seen (x:xs) = case flagArgs flag of+    Just Nothing -> upd (addMany x) PriFile+    Just (Just i) | i == seen -> upd (addOne x) PriFilePos+    _ -> Nothing+    where upd op p = Just (p, (Update (flagName flag) op, xs))++addMany x v = toDyn $ fromDyn v [""] ++ [x]+addOne x v = toDyn x
+ System/Console/CmdArgs/Help.hs view
@@ -0,0 +1,50 @@++module System.Console.CmdArgs.Help(Help(..), showHelp) where++import Data.Char+++data Help = Norm String+          | Trip (String,String,String)+++showHelp :: [Help] -> String -> String+showHelp help format = case map toLower format of+    "html" -> showHTML help+    x | x `elem` ["text",""] -> showText help+    _ -> "Unknown help mode " ++ show format ++ ", expected one of: text html\n\n" +++         showText help+++showText :: [Help] -> String+showText xs = unlines $ map f xs+    where+        f (Norm x) = x+        f (Trip (a,b,c)) = "  " ++ pad an a ++ pad bn b ++ " " ++ c++        (as,bs,_) = unzip3 [x | Trip x <- xs]+        an = maximum $ map length as+        bn = maximum $ map length bs+        pad n x = x ++ replicate (n - length x + 1) ' '+++showHTML :: [Help] -> String+showHTML xs = unlines $+    ["<table class='cmdargs'>"] +++    map f xs +++    ["</table>"]+    where+        f (Norm x) = "<tr><td colspan='3'" ++ (if null a then "" else " class='indent'") ++ ">" +++                     (if null b then "&nbsp;" else escape b) ++ "</td></tr>"+            where (a,b) = span isSpace x+        f (Trip (a,b,c)) = "<tr><td class='indent'>" ++ escape a ++ "</td>" +++                           "<td>" ++ escape b ++ "</td>" +++                           "<td>" ++ escape c ++ "</td></tr>"+++escape :: String -> String+escape = concatMap f+    where f '&' = "&amp;"+          f '>' = "&gt;"+          f '<' = "&lt;"+          f x = [x]
+ System/Console/CmdArgs/Type.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE ScopedTypeVariables, PatternGuards #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}++module System.Console.CmdArgs.Type where++import Data.Dynamic+import Data.Data+import Data.List+import Data.Maybe+import Data.Char+import Data.Function+++data Mode a = Mode+    {modeVal :: a+    ,modeName :: String+    ,modeText :: String+    ,modeHelpSuffix :: [String]+    ,modeExplicit :: Bool+    ,modeDef :: Bool+    ,modeProg :: Maybe String+    ,modeFlags :: [Flag]+    }+    deriving Show -- FIXME: The Show should be the --help++modeDefault = Mode{modeText="",modeHelpSuffix=[],modeExplicit=False,modeDef=False,modeProg=Nothing}++data Flag = Flag+    {flagName :: String -- field name+    ,flagKey :: String -- disambiguator (equal to field name, apart from enums)+    ,flagArgs :: Maybe (Maybe Int) -- Nothing = all arguments, Just i = position i, 0-based+    ,flagType :: FlagType+    ,flagVal :: Dynamic -- FIXME: Remove, only used in default computation+    ,flagOpt :: Maybe String+    ,flagTyp :: String+    ,flagText :: String+    ,flagFlag :: [String]+    ,flagUnknown :: Bool -- place to put unknown args+    ,flagExplicit :: Bool+    }+    deriving Show++flagDefault = Flag{flagArgs=Nothing,flagOpt=Nothing,flagTyp="",flagText="",flagFlag=[],flagUnknown=False,flagExplicit=False}+++---------------------------------------------------------------------+-- STRUCTURED FLAGS+++isFlagFlag = not . isFlagArgs+isFlagArgs = isJust . flagArgs+isFlagBool x = case flagType x of FlagBool{} -> True; _ -> False+isFlagOpt = isJust . flagOpt+flagTypDef def x = case flagTyp x of "" -> def; y -> y+++-- Flag types+data FlagType+    = FlagBool Dynamic+    | FlagItem (String -> Maybe (Dynamic -> Dynamic))++instance Show FlagType where+    show (FlagBool x) = "FlagBool " ++ show x+    show (FlagItem x) = "FlagItem <function>"++toFlagType :: TypeRep -> Maybe FlagType+toFlagType typ+    | typ == typeOf True = Just $ FlagBool $ toDyn True+    | Just r <- toFlagTypeRead False typ = Just $ FlagItem r+    | a == typeRepTyCon (typeOf ""), Just r <- toFlagTypeRead True (head b) = Just $ FlagItem r+    where (a,b) = splitTyConApp typ++toFlagTypeRead :: Bool -> TypeRep -> Maybe (String -> Maybe (Dynamic -> Dynamic))+toFlagTypeRead list x+    | x == typeOf "" = with (\x -> [(x,"")])+    | x == typeOf (0 :: Int) = with (reads :: ReadS Int)+    | x == typeOf (0 :: Integer) = with (reads :: ReadS Integer)+    | x == typeOf (0 :: Float) = with (reads :: ReadS Float)+    | x == typeOf (0 :: Double) = with (reads :: ReadS Double)+    | otherwise = Nothing+    where+        with :: forall a . Typeable a => ReadS a -> Maybe (String -> Maybe (Dynamic -> Dynamic))+        with r = Just $ \x -> case r x of+            [(v,"")] -> Just $ \old -> if list then toDyn $ fromJust (fromDynamic old) ++ [v] else toDyn v+            _ -> Nothing
+ System/Console/CmdArgs/UI.hs view
@@ -0,0 +1,229 @@+{-# LANGUAGE PatternGuards #-}+{-|+    This module describes the attributes that can be specified on flags and modes.++    Many attributes have examples specified on the following data type:++    > data Sample = Sample+    >    {str :: String+    >    ,strs :: [String]}+-}++module System.Console.CmdArgs.UI(+    -- ** Attribute mechanism+    mode, Mode, (&=), (&), Attrib,+    -- ** Flag attributes+    text, typ, typFile, typDir, empty, flag, explicit, enum, args, argPos, unknownFlags,+    -- ** Mode attributes+    prog, helpSuffix, defMode+    ) where++import System.Console.CmdArgs.Type+import System.IO.Unsafe+import Data.Dynamic+import Data.Data+import Data.List+import Data.Maybe+import Data.IORef+import Control.Exception+import Data.Char+import Control.Monad.State+import Data.Function+++infix 1 &=+infixl 2 &++---------------------------------------------------------------------+-- STATE MANAGEMENT++{-# NOINLINE info #-}+info :: IORef Attrib+info = unsafePerformIO $ newIORef $ Attrib []++-- | Add attributes to a value. Always returns the first argument, but+--   has a non-pure effect on the environment. Take care when performing+--   program transformations.+--+-- > value &= attrib1 & attrib2+(&=) :: a -> Attrib -> a+(&=) x is = unsafePerformIO $ do+    writeIORef info is+    return x++-- | Combine two attributes.+(&) :: Attrib -> Attrib -> Attrib+(&) (Attrib x) (Attrib y) = Attrib $ x ++ y++collect :: a -> IO [Info]+collect x = do+    evaluate x+    Attrib x <- readIORef info+    writeIORef info $ Attrib [] -- don't leak the info's+    return x++-- | Construct a 'Mode' from a value annotated with attributes.+mode :: Data a => a -> Mode a+mode val = unsafePerformIO $ do+    info <- collect val+    let con = toConstr val+        name = map toLower $ showConstr con+    ref <- newIORef $ constrFields con+    flags <- liftM concat $ sequence $ flip gmapQ val $ \i -> do+        info <- collect i+        n:ns <- readIORef ref+        writeIORef ref ns+        case toFlagType $ typeOf i of+            _ | [FldEnum xs] <- info -> return [x{flagName=n} | x <- xs]+            Nothing -> error $ "Can't handle a type of " ++ show (typeOf i)+            Just x -> return [flagInfo flagDefault{flagName=n,flagKey=n,flagVal=toDyn i,flagType=x} info]+    return $ modeInfo modeDefault{modeVal=val,modeName=name,modeFlags=flags} info+++---------------------------------------------------------------------+-- INFO ITEMS++-- | Attributes to modify the behaviour.+newtype Attrib = Attrib [Info]++data Info+    = FldEmpty String+    | FldArgs+    | FldArgPos Int+    | FldTyp String+    | Text String+    | FldFlag String+    | FldExplicit+    | HelpSuffix [String]+    | FldUnknown+    | FldEnum [Flag]+    | ModDefault+    | ModProg String+      deriving Show+++modeInfo :: Mode a -> [Info] -> Mode a+modeInfo = foldl $ \m x -> case x of+    Text x -> m{modeText=x}+    HelpSuffix x -> m{modeHelpSuffix=x}+    ModDefault -> m{modeDef=True}+    ModProg x -> m{modeProg=Just x}+    x -> error $ "Invalid attribute at mode level: " ++ show x+++flagInfo :: Flag -> [Info] -> Flag+flagInfo = foldl $ \m x -> case x of+    Text x -> m{flagText=x}+    FldExplicit -> m{flagExplicit=True}+    FldTyp x -> m{flagTyp=x}+    FldEmpty x -> m{flagOpt=Just x}+    FldFlag x -> m{flagFlag=x:flagFlag m}+    FldArgs -> m{flagArgs=Just Nothing}+    FldArgPos i -> m{flagArgs=Just (Just i)}+    FldUnknown -> m{flagUnknown=True}+    x -> error $ "Invalid attribute at argument level: " ++ show x+++---------------------------------------------------------------------+-- USER INTERFACE++-- | Flag: Make the value of a flag optional, using the supplied+--   value if none is given.+--+-- > {str = def &= empty "foo"}+-- >   -s --str[=VALUE]    (default=foo)+empty :: (Show a, Typeable a) => a -> Attrib+empty x = Attrib $ return $ case cast x of+    Just y -> FldEmpty y+    _ -> FldEmpty $ show x++-- | Flag: The the type of a flag's value, usually upper case. Only+--   used for the help message.+--+-- > {str = def &= typ "FOO"}+-- >   -s --str=FOO+typ :: String -> Attrib+typ = Attrib . return . FldTyp++-- | Flag/Mode: Descriptive text used in the help output.+--+-- > {str = def &= text "Help message"}+-- >   -s --str=VALUE      Help message+text :: String -> Attrib+text = Attrib . return . Text++-- | Flag: Add flags which trigger this option.+--+-- > {str = def &= flag "foo"}+-- >   -s --str --foo=VALUE+flag :: String -> Attrib+flag = Attrib . return . FldFlag++-- | Flag: This field should be used to store the non-flag arguments. Can+--   only be applied to fields of type @[String]@.+--+-- > {strs = def &= args}+args :: Attrib+args = Attrib [FldArgs]++-- | Flag: This field should be used to store a particular argument position+--   (0-based). Can only be applied to fields of type @String@.+--+-- > {str = def &= argPos 0}+argPos :: Int -> Attrib+argPos = Attrib . return . FldArgPos+++-- | Flag: Alias for @'typ' \"FILE\"@.+typFile :: Attrib+typFile = typ "FILE"++-- | Flag: Alias for @'typ' \"DIR\"@.+typDir :: Attrib+typDir = typ "DIR"+++-- | Mode: Suffix to be added to the help message.+helpSuffix :: [String] -> Attrib+helpSuffix = Attrib . return . HelpSuffix++-- | Flag: This field should be used to store all unknown flag arguments.+--   If no @unknownFlags@ field is set, unknown flags raise errors.+--   Can only be applied to fields of type @[String]@.+--+-- > {strs = def &= unknownFlags}+unknownFlags :: Attrib+unknownFlags = Attrib [FldUnknown]++-- | Mode: This mode is the default. If no mode is specified and a mode has this+--   attribute then that mode is selected, otherwise an error is raised.+defMode :: Attrib+defMode = Attrib [ModDefault]++-- | Mode: This is the name of the program running, used to override the result+--   from @getProgName@. Only used in the help message.+prog :: String -> Attrib+prog = Attrib . return . ModProg++-- | Flag: A field is an enumeration of possible values.+--+-- > data Choice = Yes | No deriving (Data,Typeable,Show,Eq)+-- > data Sample = Sample {choice :: Choice}+-- > {choice = Yes & enum [Yes &= "say yes", No &= "say no"]}+--+-- >   -y --yes    say yes (default)+-- >   -n --no     say no+enum :: (Typeable a, Eq a, Show a) => a -> [a] -> a+enum def xs = unsafePerformIO $ do+    ys <- forM xs $ \x -> do+        y <- collect x+        return $ flagInfo flagDefault{flagKey=map toLower (show x), flagType=FlagBool (toDyn x), flagVal = toDyn False} y+    return $ def &= Attrib [FldEnum ys]++-- | Flag: A field should not have any flag names guessed for it.+--   All flag names must be specified by 'flag'.+--+-- > {str = def &= explicit & flag "foo"}+-- >   --foo=VALUE+explicit :: Attrib+explicit = Attrib [FldExplicit]
+ cmdargs.cabal view
@@ -0,0 +1,40 @@+cabal-version:      >= 1.6+build-type:         Simple+name:               cmdargs+version:            0.1+license:            BSD3+license-file:       LICENSE+category:           Console+author:             Neil Mitchell <ndmitchell@gmail.com>+maintainer:         Neil Mitchell <ndmitchell@gmail.com>+copyright:          Neil Mitchell 2009+synopsis:           Command line argument processing+description:+    An easy way to define command line parsers. The two key features are:+    +    1) It's very concise to use, up to three times shorter than getopt.++    2) It supports programs with multiple modes (e.g. darcs or cabal).+homepage:           http://community.haskell.org/~ndm/cmdargs/+stability:          Beta+extra-source-files:+    cmdargs.htm++library+    build-depends: base == 4.*, mtl, filepath++    exposed-modules:+        System.Console.CmdArgs+    other-modules:+        System.Console.CmdArgs.UI+        System.Console.CmdArgs.Help+        System.Console.CmdArgs.Flag+        System.Console.CmdArgs.Type+        System.Console.CmdArgs.Expand++executable cmdargs+    main-is: Main.hs+    other-modules:+        HLint+        Diffy+        Maker
+ cmdargs.htm view
@@ -0,0 +1,436 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"+        "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">+<html>+    <head>+        <meta http-equiv="Content-Type" content="text/html;charset=utf-8" />+        <title>CmdArgs: Easy Command Line Processing</title>+        <style type="text/css">+pre, .cmdargs {+    border: 2px solid gray;+    padding: 1px;+    padding-left: 5px;+    margin-left: 10px;+    background-color: #eee;+}++pre.define {+    background-color: #ffb;+    border-color: #cc0;+}++body {+    font-family: sans-serif;+}++h1, h2, h3 {+    font-family: serif;+}++h1 {+    color: rgb(23,54,93);+    border-bottom: 1px solid rgb(79,129,189);+    padding-bottom: 2px;+    font-variant: small-caps;+    text-align: center;+}++a {+    color: rgb(54,95,145);+}++h2 {+    color: rgb(54,95,145);+}++h3 {+    color: rgb(79,129,189);+}++p.rule {+    background-color: #ffb;+    padding: 3px;+    margin-left: 50px;+    margin-right: 50px;+}+++.cmdargs {+	display: block;+	font-family: monospace;+}+.cmdargs td {+	padding: 0px;+	margin: 0px;+	padding-right: 1em;+}+.cmdargs td.indent {+	padding-left: 1em;+}+        </style>+    </head>+    <body>++<h1>CmdArgs: Easy Command Line Processing</h1>++<p style="text-align:right;margin-bottom:25px;">+    by <a href="http://community.haskell.org/~ndm/">Neil Mitchell</a>+</p>++<p>+    <a href="http://community.haskell.org/~ndm/cmdargs/">CmdArgs</a> is a library for defining and parsing command lines. The focus of CmdArgs is allowing the concise definition of fully-featured command line argument processors, in a mainly declarative manner (i.e. little coding needed). CmdArgs also supports multiple mode programs, for example as used in <a href="http://darcs.net/">darcs</a>.+</p><p>+	This document explains how to write the "hello world" of command line processors, then how to extend it with features into a complex command line processor. Finally this document gives three samples, which the <tt>cmdargs</tt> program can run. The three samples are:+</p>+<ol>+    <li><tt>hlint</tt> - the <a href="http://community.haskell.org/~ndm/hlint/">HLint</a> program.</li>+    <li><tt>diffy</tt> - a program to compare the differences between directories.</li>+    <li><tt>maker</tt> - a make style program.</li>+</ol>+<p>+	For each example you are encouraged to look at it's source (see the <a href="http://community.haskell.org/~ndm/darcs/hlint">darcs repo</a>, or the bottom of this document) and run it (try <tt>cmdargs hlint --help</tt>). The HLint program is fairly standard in terms of it's argument processing, and previously used the <a href="http://haskell.org/ghc/docs/latest/html/libraries/base/System-Console-GetOpt.html">System.Console.GetOpt</a> library. Using GetOpt required 90 lines and a reasonable amount of duplication. Using CmdArgs the code requires 30 lines, and the logic is much simpler.+</p>+++<h2>Hello World Example</h2>+<p>+	The following code defines a complete command line argument processor:+</p>+<pre>+{-# LANGUAGE DeriveDataTypeable #-}+module Sample where+import System.Console.CmdArgs++data Sample = Sample {hello :: String}+              deriving (Show, Data, Typeable)++sample = mode $ Sample{hello = def}++main = print =<< cmdArgs "Sample v1, (C) Neil Mitchell 2009" [sample]+</pre>+<p>+	To use the CmdArgs library there are three steps:+</p>+<ol>+	<li>Define a record data type (<tt>Sample</tt>) that contains a field for each argument. This type needs to have instances for <tt>Show</tt>, <tt>Data</tt> and <tt>Typeable</tt>.</li>+	<li>Give a value of that type (<tt>sample</tt>) with default values (<tt>def</tt> is the default value of any type). This value must be turned into a command line mode by calling the function <tt>mode</tt>.</li>+	<li>Call <tt>cmdArgs</tt> passing the mode, along with some text about the program.</li>+</ol>+<p>+	Now we have a reasonably functional command line argument processor. Some sample interactions are:+</p>+<pre>+$ runhaskell Sample.hs --hello=world+Sample {hello = "world"}++$ runhaskell Sample.hs --help+Sample v1, (C) Neil Mitchell 2009++sample [FLAG]++  -? --help[=FORMAT]  Show usage information (optional format)+  -V --version        Show version information+  -v --verbose        Higher verbosity+  -q --quiet          Lower verbosity+  -h --hello=VALUE+</pre>+<p>+	The CmdArgs library automatically provides support for:+</p>+<ul>+	<li>Help - if the user specifies <tt>--help</tt> then a help message is displayed. If <tt>--help=HTML</tt> is specified, then the help message is formatted in HTML, suitable for pasting into a web page (see the bottom of this document).</li>+	<li>Version - if the user specifies <tt>--version</tt> then the first argument passed to <tt>cmdArgs</tt> is written to the screen.</li>+	<li>Verbosity - if the user specifies <tt>--verbose</tt> or <tt>--quiet</tt> then the verbosity is set appropriately. The current verbosity can be queried with the functions <tt>isQuiet</tt>, <tt>isNormal</tt> and <tt>isLoud</tt>.</li>+</ul>++<h2>Specifying Attributes</h2>+<p>+	In order to control the behaviour we can add attributes. For example to add an attribute specifying the help text for the <tt>--hello</tt> argument we can write:+</p>+<pre>+sample = mode $ Sample{hello = def &= text "Who to say hello to"}+</pre>+<p>+	We can add additional attributes, for example to specify the type of the value expected by hello:+</p>+<pre>+sample = mode $ Sample {hello = def &= text "Who to say hello to" & typ "WORLD"}+</pre>+<p>+	Now when running <tt>--help</tt> the final line is:+</p>+<pre>+  -h --hello=WORLD    Who to say hello to+</pre>+<p>+	There are many more attributes, detailed in the <a href="http://hackage.haskell.org/packages/archive/cmdargs/latest/doc/html/System-Console-CmdArgs.html#2">Haddock documentation</a>.+</p>+++<h2>Multiple Modes</h2>+<p>+	To specify a program with multiple modes, similar to <a href="http://darcs.net/">darcs</a>, we can supply a data type with multiple constructors, for example:+</p>+<pre>+data Sample = Hello {whom :: String}+            | Goodbye+              deriving (Show, Data, Typeable)++hello = mode $ Hello{whom = def}+goodbye = mode $ Goodbye++main = print =<< cmdArgs "Sample v2, (C) Neil Mitchell 2009" [hello,goodbye]+</pre>+<p>+	Compared to the first example, we now have multiple constructors, and a sample value for each constructor is passed to <tt>cmdArgs</tt>. Some sample interactions with this command line are:+</p>+<pre>+$ runhaskell Sample.hs hello --whom=world+Hello {whom = "world"}++$ runhaskell Sample.hs goodbye+Goodbye++$ runhaskell Sample.hs --help+Sample v2, (C) Neil Mitchell 2009++sample hello [FLAG]++  -w --whom=VALUE++sample goodbye [FLAG]++Common flags:+  -? --help[=FORMAT]  Show usage information (optional format)+  -V --version        Show version information+  -v --verbose        Higher verbosity+  -q --quiet          Lower verbosity+</pre>+<p>+	As before, the behaviour can be customised using attributes.+</p>++<h2>Larger Examples</h2>++<p>+	For each of the following examples we first explain the purpose of the program, then give the source code, and finally the output of <tt>--help=HTML</tt>. The programs are intended to show sample uses of CmdArgs, and are available to experiment with through <tt>cmdargs <i>progname</i></tt>.+</p>++<h3>HLint</h3>++<p>+	The <a href="http://community.haskell.org/~ndm/hlint/">HLint</a> program analyses a list of files, using various options to control the analysis. The command line processing is simple, but a few interesting points are:+</p>+<ul>+	<li>The <tt>--report</tt> flag can be used to output a report in a standard location, but giving the flag a value changes where the file is output.</li>+	<li>The <tt>color</tt> field is assigned two flag aliases, <tt>--colour</tt> and <tt>-c</tt>. Assigning the <tt>-c</tt> short flag explicitly stops either of the CPP fields using it.</li>+	<li>The <tt>show_</tt> field would clash with <tt>show</tt> if given the expected name, but CmdArgs automatically strips the trailing underscore.</li>+	<li>The <tt>cpp_define</tt> field has an underscore in it's name, which is transformed into a hyphen for the flag name.</li>+</ul>++<!-- BEGIN code hlint -->+<pre>+{-# LANGUAGE DeriveDataTypeable #-}+module HLint where+import System.Console.CmdArgs++data HLint = HLint+    {report :: [FilePath]+    ,hint :: [FilePath]+    ,color :: Bool+    ,ignore :: [String]+    ,show_ :: Bool+    ,test :: Bool+    ,cpp_define :: [String]+    ,cpp_include :: [String]+    ,files :: [String]+    }+    deriving (Data,Typeable,Show,Eq)++hlint = mode $ HLint+    {report = def &= empty "report.html" & typFile & text "Generate a report in HTML"+    ,hint = def &= typFile & text "Hint/ignore file to use"+    ,color = def &= flag "c" & flag "colour" & text "Color the output (requires ANSI terminal)"+    ,ignore = def &= typ "MESSAGE" & text "Ignore a particular hint"+    ,show_ = def &= text "Show all ignored ideas"+    ,test = def &= text "Run in test mode"+    ,cpp_define = def &= typ "NAME[=VALUE]" & text "CPP #define"+    ,cpp_include = def &= typDir & text "CPP include path"+    ,files = def &= args & typ "FILE/DIR"+    } &=+    prog "hlint" &+    text "Suggest improvements to Haskell source code" &+    helpSuffix ["To check all Haskell files in 'src' and generate a report type:","  hlint src --report"]++modes = [hlint]++main = print =<< cmdArgs "HLint v1.6.5, (C) Neil Mitchell 2006-2009" modes+</pre>+<!-- END -->+<!-- BEGIN help hlint -->+<table class='cmdargs'>+<tr><td colspan='3'>HLint v1.6.5, (C) Neil Mitchell 2006-2009</td></tr>+<tr><td colspan='3'>&nbsp;</td></tr>+<tr><td colspan='3'>hlint [FLAG] [FILE/DIR]</td></tr>+<tr><td colspan='3' class='indent'>Suggest improvements to Haskell source code</td></tr>+<tr><td colspan='3'>&nbsp;</td></tr>+<tr><td class='indent'>-?</td><td>--help[=FORMAT]</td><td>Show usage information (optional format)</td></tr>+<tr><td class='indent'>-V</td><td>--version</td><td>Show version information</td></tr>+<tr><td class='indent'>-v</td><td>--verbose</td><td>Higher verbosity</td></tr>+<tr><td class='indent'>-q</td><td>--quiet</td><td>Lower verbosity</td></tr>+<tr><td class='indent'>-r</td><td>--report[=FILE]</td><td>Generate a report in HTML (default=report.html)</td></tr>+<tr><td class='indent'>-h</td><td>--hint=FILE</td><td>Hint/ignore file to use</td></tr>+<tr><td class='indent'>-c</td><td>--color --colour</td><td>Color the output (requires ANSI terminal)</td></tr>+<tr><td class='indent'>-i</td><td>--ignore=MESSAGE</td><td>Ignore a particular hint</td></tr>+<tr><td class='indent'>-s</td><td>--show</td><td>Show all ignored ideas</td></tr>+<tr><td class='indent'>-t</td><td>--test</td><td>Run in test mode</td></tr>+<tr><td class='indent'></td><td>--cpp-define=NAME[=VALUE]</td><td>CPP #define</td></tr>+<tr><td class='indent'></td><td>--cpp-include=DIR</td><td>CPP include path</td></tr>+<tr><td colspan='3'>&nbsp;</td></tr>+<tr><td colspan='3'>To check all Haskell files in 'src' and generate a report type:</td></tr>+<tr><td colspan='3' class='indent'>hlint src --report</td></tr>+</table>+<!-- END -->++<h3>Diffy</h3>++<p>+	The Diffy sample is a based on the idea of creating directory listings and comparing them. The tool can operate in two separate modes, <tt>create</tt> or <tt>diff</tt>. This sample is fictional, but the ideas are drawn from a real program. A few notable features:+</p>+<ul>+	<li>There are multiple modes of execution, creating and diffing.</li>+	<li>The diff mode takes exactly two arguments, the old file and the new file.</li>+	<li>Default values are given for the <tt>out</tt> field, which are different in both modes.</li>+</ul>++<!-- BEGIN code diffy -->+<pre>+{-# LANGUAGE DeriveDataTypeable #-}+module Diffy where+import System.Console.CmdArgs++data Diffy = Create {src :: FilePath, out :: FilePath}+           | Diff {old :: FilePath, new :: FilePath, out :: FilePath}+             deriving (Data,Typeable,Show,Eq)++outFlags = text "Output file" & typFile++create = mode $ Create+    {src = "." &= text "Source directory" & typDir+    ,out = "ls.txt" &= outFlags+    } &= prog "diffy" & text "Create a fingerprint"++diff = mode $ Diff+    {old = def &= typ "OLDFILE" & argPos 0+    ,new = def &= typ "NEWFILE" & argPos 1+    ,out = "diff.txt" &= outFlags+    } &= text "Perform a diff"++modes = [create,diff]++main = print =<< cmdArgs "Diffy v1.0" modes+</pre>+<!-- END -->+<!-- BEGIN help diffy -->+<table class='cmdargs'>+<tr><td colspan='3'>Diffy v1.0</td></tr>+<tr><td colspan='3'>&nbsp;</td></tr>+<tr><td colspan='3'>diffy create [FLAG]</td></tr>+<tr><td colspan='3' class='indent'>Create a fingerprint</td></tr>+<tr><td colspan='3'>&nbsp;</td></tr>+<tr><td class='indent'>-s</td><td>--src=DIR</td><td>Source directory (default=.)</td></tr>+<tr><td class='indent'>-o</td><td>--out=FILE</td><td>Output file (default=ls.txt)</td></tr>+<tr><td colspan='3'>&nbsp;</td></tr>+<tr><td colspan='3'>diffy diff [FLAG] OLDFILE NEWFILE</td></tr>+<tr><td colspan='3' class='indent'>Perform a diff</td></tr>+<tr><td colspan='3'>&nbsp;</td></tr>+<tr><td class='indent'>-o</td><td>--out=FILE</td><td>Output file (default=diff.txt)</td></tr>+<tr><td colspan='3'>&nbsp;</td></tr>+<tr><td colspan='3'>Common flags:</td></tr>+<tr><td class='indent'>-?</td><td>--help[=FORMAT]</td><td>Show usage information (optional format)</td></tr>+<tr><td class='indent'>-V</td><td>--version</td><td>Show version information</td></tr>+<tr><td class='indent'>-v</td><td>--verbose</td><td>Higher verbosity</td></tr>+<tr><td class='indent'>-q</td><td>--quiet</td><td>Lower verbosity</td></tr>+</table>+<!-- END -->++<h3>Maker</h3>++<p>+	The Maker sample is based around a build system, where we can either build a project, clean the temporary files, or run a test. The test mode is designed to run another program, passing any unknown arguments onwards. Some interesting features are:+</p>+<ul>+	<li>The build mode is the default, so <tt>maker</tt> on it's own will be interpretted as a build command.</li>+	<li>The build method is an enumeration.</li>+	<li>The test mode collects unknown flags in the field <tt>extra</tt>.</li>+	<li>The <tt>threads</tt> field is in two of the constructors, but not all three. It is given the short flag <tt>-j</tt>, rather than the default <tt>-t</tt>.</li>+</ul>+++<!-- BEGIN code maker -->+<pre>+{-# LANGUAGE DeriveDataTypeable #-}+module Maker where+import System.Console.CmdArgs++data Method = Debug | Release | Profile+              deriving (Data,Typeable,Show,Eq)++data Maker+    = Wipe+    | Test {threads :: Int, extra :: [String]}+    | Build {threads :: Int, method :: Method, files :: [FilePath]}+      deriving (Data,Typeable,Show,Eq)++threadsMsg = text "Number of threads to use" & flag "j" & typ "NUM"++wipe = mode $ Wipe &= prog "maker" & text "Clean all build objects"++test = mode $ Test+    {threads = def &= threadsMsg+    ,extra = def &= typ "ANY" & args & unknownFlags+    } &= text "Run the test suite"++build = mode $ Build+    {threads = def &= threadsMsg+    ,method = enum Release+        [Debug &= text "Debug build"+        ,Release &= text "Release build"+        ,Profile &= text "Profile build"]+    ,files = def &= args+    } &= text "Build the project" & defMode++modes = [build,wipe,test]++main = print =<< cmdArgs "Maker v1.0" modes+</pre>+<!-- END -->+<!-- BEGIN help maker -->+<table class='cmdargs'>+<tr><td colspan='3'>Maker v1.0</td></tr>+<tr><td colspan='3'>&nbsp;</td></tr>+<tr><td colspan='3'>maker [build] [FLAG] [FILE]</td></tr>+<tr><td colspan='3' class='indent'>Build the project</td></tr>+<tr><td colspan='3'>&nbsp;</td></tr>+<tr><td class='indent'>-j</td><td>--threads=NUM</td><td>Number of threads to use</td></tr>+<tr><td class='indent'>-d</td><td>--debug</td><td>Debug build</td></tr>+<tr><td class='indent'>-r</td><td>--release</td><td>Release build</td></tr>+<tr><td class='indent'>-p</td><td>--profile</td><td>Profile build</td></tr>+<tr><td colspan='3'>&nbsp;</td></tr>+<tr><td colspan='3'>maker wipe [FLAG]</td></tr>+<tr><td colspan='3' class='indent'>Clean all build objects</td></tr>+<tr><td colspan='3'>&nbsp;</td></tr>+<tr><td colspan='3'>maker test [FLAG] [ANY]</td></tr>+<tr><td colspan='3' class='indent'>Run the test suite</td></tr>+<tr><td colspan='3'>&nbsp;</td></tr>+<tr><td class='indent'>-j</td><td>--threads=NUM</td><td>Number of threads to use</td></tr>+<tr><td colspan='3'>&nbsp;</td></tr>+<tr><td colspan='3'>Common flags:</td></tr>+<tr><td class='indent'>-?</td><td>--help[=FORMAT]</td><td>Show usage information (optional format)</td></tr>+<tr><td class='indent'>-V</td><td>--version</td><td>Show version information</td></tr>+<tr><td class='indent'>-v</td><td>--verbose</td><td>Higher verbosity</td></tr>+<tr><td class='indent'>-q</td><td>--quiet</td><td>Lower verbosity</td></tr>+</table>+<!-- END -->++    </body>+</html>