cmdargs 0.8 → 0.9

raw patch · 21 files changed

+1178/−76 lines, 21 filesdep +processdep +template-haskellPVP ok

version bump matches the API change (PVP)

Dependencies added: process, template-haskell

API changes (from Hackage documentation)

Files

• Main.hs +16/−3
• System/Console/CmdArgs/Annotate.hs +2/−1
• System/Console/CmdArgs/Explicit.hs +79/−6
• System/Console/CmdArgs/Explicit/Complete.hs +201/−0
• System/Console/CmdArgs/Explicit/Help.hs +13/−4
• System/Console/CmdArgs/Explicit/Process.hs +1/−24
• System/Console/CmdArgs/Explicit/SplitJoin.hs +54/−0
• System/Console/CmdArgs/Explicit/Type.hs +2/−6
• System/Console/CmdArgs/GetOpt.hs +1/−1
• System/Console/CmdArgs/Helper.hs +324/−0
• System/Console/CmdArgs/Implicit.hs +7/−2
• System/Console/CmdArgs/Implicit/Global.hs +1/−1
• System/Console/CmdArgs/Quote.hs +213/−0
• System/Console/CmdArgs/Test/All.hs +2/−0
• System/Console/CmdArgs/Test/Explicit.hs +19/−1
• System/Console/CmdArgs/Test/Implicit/Diffy.hs +28/−3
• System/Console/CmdArgs/Test/Implicit/HLint.hs +2/−3
• System/Console/CmdArgs/Test/Implicit/Tests.hs +34/−14
• System/Console/CmdArgs/Test/Implicit/Util.hs +16/−5
• System/Console/CmdArgs/Test/SplitJoin.hs +148/−0
• cmdargs.cabal +15/−2

@@ -10,6 +10,7 @@ import System.Console.CmdArgs.Text import System.Console.CmdArgs.Default +import Control.Monad import Data.List import Data.Maybe import System.IO@@ -25,8 +26,8 @@     where         flags = [flagHelpFormat $ \a b _ -> Help a b                 ,flagVersion $ const Version-                ,flagNone ["t","test"] (const Test) "Run the tests"-                ,flagNone ["g","generate"] (const Generate) "Generate the manual"]+                ,flagNone ["test","t"] (const Test) "Run the tests"+                ,flagNone ["generate","g"] (const Generate) "Generate the manual"]          ms = map (remap Demo (\(Demo x) -> (x,Demo))) demo @@ -36,10 +37,22 @@     let ver = "CmdArgs demo program, (C) Neil Mitchell"     case x of         Version -> putStrLn ver-        Help hlp txt -> putStrLn $ showText txt $ Line ver : Line "" : helpText hlp args+        Help hlp txt -> do+            let xs = showText txt $ helpText [ver] hlp args+            putStrLn xs+            when (hlp == HelpFormatBash) $ do+                writeFileBinary "cmdargs.bash_comp" xs+                putStrLn "# Output written to cmdargs.bash_comp"         Test -> test         Generate -> generateManual         Demo x -> runDemo x+++writeFileBinary :: FilePath -> String -> IO ()+writeFileBinary file x = do+    h <- openBinaryFile file WriteMode+    hPutStr h x+    hClose h   ---------------------------------------------------------------------

@@ -206,6 +206,7 @@     | AMany [Annotate ann]     | AAtom Any     | ACtor Any [Annotate ann]+      deriving Typeable       -- specifically DOES NOT derive Data, to avoid people accidentally including it  @@ -227,7 +228,7 @@ -- --   This operation is not type safe, and may raise an exception at runtime --   if any field has the wrong type or label.-record :: Data a => a -> [Annotate b] -> Annotate b+record :: Data a => a -> [Annotate ann] -> Annotate ann record a b = ACtor (Any a) b  -- | Capture the annotations from an annotated value.

@@ -1,4 +1,4 @@-+{-# LANGUAGE ScopedTypeVariables #-} {-|     This module constructs command lines. You may either use the helper functions     ('flagNone', 'flagOpt', 'mode' etc.) or construct the type directly. These@@ -22,7 +22,7 @@   > main = do   >     xs <- processArgs arguments   >     if ("help","") `elem` xs then-  >         print $ helpText def arguments+  >         print $ helpText HelpFormatDefault arguments   >      else   >         print xs @@ -49,24 +49,95 @@ -} module System.Console.CmdArgs.Explicit(     -- * Running command lines-    module System.Console.CmdArgs.Explicit.Process,+    process, processArgs, processValue,     -- * Constructing command lines     module System.Console.CmdArgs.Explicit.Type,-    module System.Console.CmdArgs.Explicit,+    flagHelpSimple, flagHelpFormat, flagVersion, flagsVerbosity,     -- * Displaying help-    module System.Console.CmdArgs.Explicit.Help+    module System.Console.CmdArgs.Explicit.Help,+    -- * Utilities for working with command line+    module System.Console.CmdArgs.Explicit.SplitJoin,+    Complete(..), complete     ) where -import System.Console.CmdArgs.Explicit.Type hiding (showRecord, (*=))+import System.Console.CmdArgs.Explicit.Type import System.Console.CmdArgs.Explicit.Process import System.Console.CmdArgs.Explicit.Help+import System.Console.CmdArgs.Explicit.SplitJoin+import System.Console.CmdArgs.Explicit.Complete import System.Console.CmdArgs.Default+import System.Console.CmdArgs.Helper import System.Console.CmdArgs.Text import System.Console.CmdArgs.Verbosity +import Control.Monad import Data.Char+import Data.Maybe+import System.Environment+import System.Exit+import System.IO  +-- | Process the flags obtained by @'getArgs'@ with a mode. Displays+--   an error and exits with failure if the command line fails to parse, or returns+--   the associated value. Implemented in terms of 'process'. This function makes+--   use of the following environment variables:+--+-- * @$CMDARGS_COMPLETE@ - causes the program to produce completions using 'complete', then exit.+--   Completions are based on the result of 'getArgs', the index of the current argument is taken+--   from @$CMDARGS_COMPLETE@ (set it to @-@ to complete the last argument), and the index within+--   that argument is taken from @$CMDARGS_COMPLETE_POS@ (if set).+--+-- * @$CMDARGS_HELPER@\/@$CMDARGS_HELPER_/PROG/@ - uses the helper mechanism for entering command+--   line programs as described in "System.Console.CmdArgs.Helper".+processArgs :: Mode a -> IO a+processArgs m = do+    env <- getEnvironment+    case lookup "CMDARGS_COMPLETE" env of+        Just x -> do+            args <- getArgs+            let argInd = fromMaybe (length args - 1) $ readMay x+                argPos = fromMaybe (if argInd >= 0 && argInd < length args then length (args !! argInd) else 0) $+                         readMay =<< lookup "CMDARGS_COMPLETE_POS" env+            print $ complete m (concatMap words args) (argInd,argPos)+            exitWith ExitSuccess+        Nothing -> do+            nam <- getProgName+            let var = mplus (lookup ("CMDARGS_HELPER_" ++ show (map toUpper $ head $ modeNames m ++ [nam])) env)+                            (lookup "CMDARGS_HELPER" env)+            case var of+                Nothing -> run =<< getArgs+                Just cmd -> do+                    res <- execute cmd m []+                    case res of+                        Left err -> do+                            hPutStrLn stderr $ "Error when running helper " ++ cmd+                            hPutStrLn stderr err+                            exitFailure               +                        Right args -> run args+    where+        run args = case process m args of+            Left x -> do hPutStrLn stderr x; exitFailure+            Right x -> return x+++readMay :: Read a => String -> Maybe a+readMay s = case [x | (x,t) <- reads s, ("","") <- lex t] of+                [x] -> Just x+                _ -> Nothing+++-- | Process a list of flags (usually obtained from @getArgs@) with a mode. Displays+--   an error and exits with failure if the command line fails to parse, or returns+--   the associated value. Implemeneted in terms of 'process'. This function+--   does not take account of any environment variables that may be set+--   (see 'processArgs').+processValue :: Mode a -> [String] -> a+processValue m xs = case process m xs of+    Left x -> error x+    Right x -> x++ -- | Create a help flag triggered by @-?@/@--help@. flagHelpSimple :: (a -> a) -> Flag a flagHelpSimple f = flagNone ["help","?"] f "Display help message"@@ -96,6 +167,8 @@                     "def" -> Right (HelpFormatDefault,b)                     "html" -> Right (a,HTML)                     "text" -> Right (a,defaultWrap)+                    "bash" -> Right (HelpFormatBash,Wrap 1000000)+                    "zsh"  -> Right (HelpFormatZsh ,Wrap 1000000)                     _ | all isDigit x -> Right (a,Wrap $ read x)                     _ -> Left "unrecognised help format, expected one of: all one def html text <NUMBER>" 

@@ -0,0 +1,201 @@+{-# LANGUAGE PatternGuards #-}++-- | This module does command line completion+module System.Console.CmdArgs.Explicit.Complete(+    Complete(..), complete,+    completeBash, completeZsh+    ) where++import System.Console.CmdArgs.Explicit.Type+import Control.Monad+import Data.List+import Data.Maybe+++-- | How to complete a command line option.+--   The 'Show' instance is suitable for parsing from shell scripts.+data Complete+    = CompleteValue String -- ^ Complete to a particular value+    | CompleteFile String FilePath -- ^ Complete to a prefix, and a file+    | CompleteDir String FilePath -- ^ Complete to a prefix, and a directory+      deriving (Eq,Ord)++instance Show Complete where+    show (CompleteValue a) = "VALUE " ++ a+    show (CompleteFile a b) = "FILE " ++ a ++ " " ++ b+    show (CompleteDir a b) = "DIR " ++ a ++ " " ++ b++    showList xs = showString $ unlines (map show xs)+++prepend :: String -> Complete -> Complete+prepend a (CompleteFile b c) = CompleteFile (a++b) c+prepend a (CompleteDir b c) = CompleteDir (a++b) c+prepend a (CompleteValue b) = CompleteValue (a++b)+++-- | Given a current state, return the set of commands you could type now, in preference order.+complete+    :: Mode a -- ^ Mode specifying which arguments are allowed+    -> [String] -- ^ Arguments the user has already typed+    -> (Int,Int) -- ^ 0-based index of the argument they are currently on, and the position in that argument+    -> [Complete]+-- Roll forward looking at modes, and if you match a mode, enter it+-- If the person just before is a flag without arg, look at how you can complete that arg+-- If your prefix is a complete flag look how you can complete that flag+-- If your prefix looks like a flag, look for legitimate flags+-- Otherwise give a file/dir if they are arguments to this mode, and all flags+-- If you haven't seen any args/flags then also autocomplete to any child modes+complete mode_ args_ (i,_) = nub $ followArgs mode args now+    where+        (seen,next) = splitAt i args_+        now = head $ next ++ [""]+        (mode,args) = followModes mode_ seen+++-- | Given a mode and some arguments, try and drill down into the mode+followModes :: Mode a -> [String] -> (Mode a, [String])+followModes m (x:xs) | Just m2 <- pickBy modeNames x $ modeModes m = followModes m2 xs+followModes m xs = (m,xs)+++pickBy :: (a -> [String]) -> String -> [a] -> Maybe a+pickBy f name xs = find (\x -> name `elem` f x) xs `mplus` +                   find (\x -> any (name `isPrefixOf`) (f x)) xs+++-- | Follow args deals with all seen arguments, then calls on to deal with the next one+followArgs :: Mode a -> [String] -> (String -> [Complete])+followArgs m = first+    where+        first [] = expectArgFlagMode (modeModes m) (argsPick 0) (modeFlags m)+        first xs = norm 0 xs++        -- i is the number of arguments that have gone past+        norm i [] = expectArgFlag (argsPick i) (modeFlags m)+        norm i ("--":xs) = expectArg $ argsPick (i + length xs)+        norm i (('-':'-':x):xs) | null b, flagInfo flg == FlagReq = val i flg xs+                                | otherwise = norm i xs+            where (a,b) = break (== '=') x+                  flg = getFlag a+        norm i (('-':x:y):xs) = case flagInfo flg of+            FlagReq | null y -> val i flg xs+                    | otherwise -> norm i xs+            FlagOpt{} -> norm i xs+            _ | "=" `isPrefixOf` y -> norm i xs+              | null y -> norm i xs+              | otherwise -> norm i (('-':y):xs)+            where flg = getFlag [x]+        norm i (x:xs) = norm (i+1) xs++        val i flg [] = expectVal flg+        val i flg (x:xs) = norm i xs++        argsPick i = let (lst,end) = modeArgs m in if i < length lst then Just $ lst !! i else end++        -- if you can't find the flag, pick one that is FlagNone (has all the right fallback)+        getFlag x = fromMaybe (flagNone [] id "") $ pickBy flagNames x $ modeFlags m+++expectArgFlagMode :: [Mode a] -> Maybe (Arg a) -> [Flag a] -> String -> [Complete]+expectArgFlagMode mode arg flag x+    | "-" `isPrefixOf` x = expectFlag flag x ++ [CompleteValue "-" | x == "-", isJust arg]+    | otherwise = expectMode mode x ++ expectArg arg x ++ expectFlag flag x++expectArgFlag :: Maybe (Arg a) -> [Flag a] -> String -> [Complete]+expectArgFlag arg flag x+    | "-" `isPrefixOf` x = expectFlag flag x ++ [CompleteValue "-" | x == "-", isJust arg]+    | otherwise = expectArg arg x ++ expectFlag flag x++expectMode :: [Mode a] -> String -> [Complete]+expectMode mode = expectStrings (map modeNames mode)++expectArg :: Maybe (Arg a) -> String -> [Complete]+expectArg Nothing x = []+expectArg (Just arg) x = expectFlagHelp (argType arg) x++expectFlag :: [Flag a] -> String -> [Complete]+expectFlag flag x+    | (a,_:b) <- break (== '=') x = case pickBy (map f . flagNames) a flag of+        Nothing -> []+        Just flg -> map (prepend (a ++ "=")) $ expectVal flg b+    | otherwise = expectStrings (map (map f . flagNames) flag) x+    where f x = "-" ++ ['-' | length x > 1] ++ x++expectVal :: Flag a -> String -> [Complete]+expectVal flg = expectFlagHelp (flagType flg)++expectStrings :: [[String]] -> String -> [Complete]+expectStrings xs x = map CompleteValue $ concatMap (take 1 . filter (x `isPrefixOf`)) xs++expectFlagHelp :: FlagHelp -> String -> [Complete]+expectFlagHelp typ x = case typ of+    "FILE" -> [CompleteFile "" x]+    "DIR" -> [CompleteDir "" x]+    "FILE/DIR" -> [CompleteFile "" x, CompleteDir "" x]+    "DIR/FILE" -> [CompleteDir "" x, CompleteFile "" x]+    '[':s | "]" `isSuffixOf` s -> expectFlagHelp (init s) x+    _ -> []+++---------------------------------------------------------------------+-- BASH SCRIPT++completeBash :: String -> [String]+completeBash prog =+    ["# Completion for " ++ prog+    ,"# Generated by CmdArgs: http://community.haskell.org/~ndm/cmdargs/"+    ,"_" ++ prog ++ "()"+    ,"{"+    ,"    # local CMDARGS_DEBUG=1 # uncomment to debug this script"+    ,""+    ,"    COMPREPLY=()"+    ,"    function add { COMPREPLY[((${#COMPREPLY[@]} + 1))]=$1 ; }"+    ,"    IFS=$'\\n\\r'"+    ,""+    ,"    export CMDARGS_COMPLETE=$((${COMP_CWORD} - 1))"+    ,"    result=`" ++ prog ++ " ${COMP_WORDS[@]:1}`"+    ,""+    ,"    if [ -n $CMDARGS_DEBUG ]; then"+    ,"        echo Call \\(${COMP_WORDS[@]:1}, $CMDARGS_COMPLETE\\) > cmdargs.tmp"+    ,"        echo $result >> cmdargs.tmp"+    ,"    fi"+    ,"    unset CMDARGS_COMPLETE"+    ,"    unset CMDARGS_COMPLETE_POS"+    ,""+    ,"    for x in $result ; do"+    ,"        case $x in"+    ,"            VALUE\\ *)"+    ,"                add ${x:6}"+    ,"                ;;"+    ,"            FILE\\ *)"+    ,"                local prefix=`expr match \"${x:5}\" '\\([^ ]*\\)'`"+    ,"                local match=`expr match \"${x:5}\" '[^ ]* \\(.*\\)'`"+    ,"                for x in `compgen -f -- \"$match\"`; do"+    ,"                    add $prefix$x"+    ,"                done"+    ,"                ;;"+    ,"            DIR\\ *)"+    ,"                local prefix=`expr match \"${x:4}\" '\\([^ ]*\\)'`"+    ,"                local match=`expr match \"${x:4}\" '[^ ]* \\(.*\\)'`"+    ,"                for x in `compgen -d -- \"$match\"`; do"+    ,"                    add $prefix$x"+    ,"                done"+    ,"                ;;"+    ,"        esac"+    ,"    done"+    ,"    unset IFS"+    ,""+    ,"    if [ -n $CMDARGS_DEBUG ]; then"+    ,"        echo echo COMPREPLY: ${#COMPREPLY[@]} = ${COMPREPLY[@]} >> cmdargs.tmp"+    ,"    fi"+    ,"}"+    ,"complete -o bashdefault -F _" ++ prog ++ " " ++ prog+    ]+++---------------------------------------------------------------------+-- ZSH SCRIPT++completeZsh :: String -> [String]+completeZsh _ = ["echo TODO: help add Zsh completions to cmdargs programs"]

@@ -45,6 +45,7 @@ module System.Console.CmdArgs.Explicit.Help(HelpFormat(..), helpText) where  import System.Console.CmdArgs.Explicit.Type+import System.Console.CmdArgs.Explicit.Complete import System.Console.CmdArgs.Text import System.Console.CmdArgs.Default import Data.List@@ -56,6 +57,8 @@     = HelpFormatDefault -- ^ Equivalent to 'HelpFormatAll' if there is not too much text, otherwise 'HelpFormatOne'.     | HelpFormatOne -- ^ Display only the first mode.     | HelpFormatAll -- ^ Display all modes.+    | HelpFormatBash -- ^ Bash completion information+    | HelpFormatZsh -- ^ Z shell completion information       deriving (Read,Show,Enum,Bounded,Eq,Ord)  instance Default HelpFormat where def = HelpFormatDefault@@ -71,10 +74,16 @@     show = show . argType  -- | Generate a help message from a mode.-helpText :: HelpFormat -> Mode a -> [Text]-helpText HelpFormatDefault = helpTextDefault-helpText HelpFormatOne = helpTextOne-helpText HelpFormatAll = helpTextAll+helpText :: [String] -> HelpFormat -> Mode a -> [Text]+helpText pre HelpFormatDefault x = helpPrefix pre ++ helpTextDefault x+helpText pre HelpFormatOne x = helpPrefix pre ++ helpTextOne x+helpText pre HelpFormatAll x = helpPrefix pre ++ helpTextAll x+helpText pre HelpFormatBash x = map Line $ completeBash $ head $ modeNames x ++ ["unknown"]+helpText pre HelpFormatZsh x = map Line $ completeZsh $ head $ modeNames x ++ ["unknown"]+++helpPrefix :: [String] -> [Text]+helpPrefix xs = map Line xs ++ [Line "" | not $ null xs]   helpTextDefault x = if length all > 40 then one else all

@@ -1,33 +1,10 @@ {-# LANGUAGE RecordWildCards #-}-module System.Console.CmdArgs.Explicit.Process(process, processValue, processArgs) where+module System.Console.CmdArgs.Explicit.Process(process) where  import System.Console.CmdArgs.Explicit.Type import Control.Arrow import Data.List import Data.Maybe-import System.Environment-import System.Exit-import System.IO----- | Process the flags obtained by @getArgs@ with a mode. Displays---   an error and exits with failure if the command line fails to parse, or returns---   the associated value. Implemented in terms of 'process'.-processArgs :: Mode a -> IO a-processArgs m = do-    xs <- getArgs-    case process m xs of-        Left x -> do hPutStrLn stderr x; exitFailure-        Right x -> return x----- | Process a list of flags (usually obtained from @getArgs@) with a mode. Displays---   an error and exits with failure if the command line fails to parse, or returns---   the associated value. Implemeneted in terms of 'process'.-processValue :: Mode a -> [String] -> a-processValue m xs = case process m xs of-    Left x -> error x-    Right x -> x   -- | Process a list of flags (usually obtained from @getArgs@) with a mode. Returns

@@ -0,0 +1,54 @@+{-# LANGUAGE RecordWildCards #-}+module System.Console.CmdArgs.Explicit.SplitJoin(splitArgs, joinArgs) where++import Data.Char+import Data.Maybe+++-- | Given a sequence of arguments, join them together in a manner that could be used on+--   the command line, giving preference to the Windows @cmd@ shell quoting conventions.+--+--   For an alternative version, intended for actual running the result in a shell, see "System.Process.showCommandForUser"+joinArgs :: [String] -> String+joinArgs = unwords . map f+    where+        f x = q ++ g x ++ q+            where+                hasSpace = any isSpace x+                q = ['\"' | hasSpace || null x]++                g ('\\':'\"':xs) = '\\':'\\':'\\':'\"': g xs+                g "\\" | hasSpace = "\\\\"+                g ('\"':xs) = '\\':'\"': g xs+                g (x:xs) = x : g xs+                g [] = []+++data State = Init -- either I just started, or just emitted something+           | Norm -- I'm seeing characters+           | Quot -- I've seen a quote++-- | Given a string, split into the available arguments. The inverse of 'joinArgs'.+splitArgs :: String -> [String]+splitArgs = join . f Init+    where+        -- Nothing is start a new string+        -- Just x is accumulate onto the existing string+        join :: [Maybe Char] -> [String]+        join [] = []+        join xs = map fromJust a : join (drop 1 b)+            where (a,b) = break isNothing xs++        f Init (x:xs) | isSpace x = f Init xs+        f Init "\"\"" = [Nothing]+        f Init "\"" = [Nothing]+        f Init xs = f Norm xs+        f m ('\"':'\"':'\"':xs) = Just '\"' : f m xs+        f m ('\\':'\"':xs) = Just '\"' : f m xs+        f m ('\\':'\\':'\"':xs) = Just '\\' : f m ('\"':xs)+        f Norm ('\"':xs) = f Quot xs+        f Quot ('\"':'\"':xs) = Just '\"' : f Norm xs+        f Quot ('\"':xs) = f Norm xs+        f Norm (x:xs) | isSpace x = Nothing : f Init xs+        f m (x:xs) = Just x : f m xs+        f m [] = []

@@ -63,10 +63,6 @@ --------------------------------------------------------------------- -- TYPES -showRecord x ys = x ++ " {" ++ intercalate ", " ys ++ "}"-a *= b = a ++ " = " ++ show b-- -- | A mode. Each mode has three main features: -- --   * A list of submodes ('modeGroupModes')@@ -98,8 +94,8 @@ -- -- -- >              FlagReq     FlagOpt      FlagOptRare/FlagNone--- > -xfoo        -x=foo      -x=foo       -x= -foo--- > -x foo       -x=foo      -x foo       -x= foo+-- > -xfoo        -x=foo      -x=foo       -x -foo+-- > -x foo       -x=foo      -x foo       -x foo -- > -x=foo       -x=foo      -x=foo       -x=foo -- > --xx foo     --xx=foo    --xx foo     --xx foo -- > --xx=foo     --xx=foo    --xx=foo     --xx=foo

@@ -24,7 +24,7 @@ -- --   * list of short option characters -----   * list of long option strings (without "--", may not be 1 character long)+--   * list of long option strings (without @\"--\"@, may not be 1 character long) -- --   * argument descriptor --

@@ -0,0 +1,324 @@+{-# LANGUAGE RecordWildCards, TypeSynonymInstances, FlexibleInstances #-}++-- | Module for implementing CmdArgs helpers. A CmdArgs helper is an external program,+--   that helps a user construct the command line arguments. To use a helper set the+--   environment variable @$CMDARGS_HELPER@ (or @$CMDARGS_HELPER_/YOURPROGRAM/@) to+--   one of:+--+-- * @echo /foo/@ will cause @/foo/@ to be used as the command arguments.+--+-- * @cmdargs-browser@ will cause a web browser to appear to help entering the arguments.+--   For this command to work, you will need to install the @cmdargs-browser@ package:+--   <http://hackage.haskell.org/package/cmdargs-browser>+module System.Console.CmdArgs.Helper(+    -- * Called by the main program+    execute,+    -- * Called by the helper program+    Unknown, receive, reply, comment+    ) where+-- Should really be under Explicit, but want to export it top-level as Helper++import System.Console.CmdArgs.Explicit.Type+import System.Console.CmdArgs.Explicit.SplitJoin+import System.Process+import Control.Exception+import Control.Monad+import Data.Char+import Data.IORef+import Data.List+import Data.Maybe+import System.Exit+import System.IO+import System.IO.Unsafe+++hOut h x = do+    hPutStrLn h x+    hFlush h+++-- | Run a remote command line entry.+execute+    :: String -- ^ Name of the command to run, e.g. @echo argument@, @cmdargs-browser@+    -> Mode a -- ^ Mode to run remotely+    -> [String] -- ^ Initial set of command line flags (not supported by all helpers)+    -> IO (Either String [String]) -- ^ Either an error message, or a list of flags to use+execute cmd mode args+    | "echo" == takeWhile (not . isSpace) cmd = return $ Right $ splitArgs $ drop 4 cmd+    | otherwise = withBuffering stdout NoBuffering $ do+        (Just hin, Just hout, _, _) <- createProcess (shell cmd){std_in=CreatePipe, std_out=CreatePipe}+        -- none of the buffering seems necessary in practice, but better safe than sorry+        hSetBuffering hin LineBuffering+        hSetBuffering hout LineBuffering+        (m, ans) <- saveMode mode+        hOut hin m+        loop ans hin hout+    where+        loop ans hin hout = do+            x <- hGetLine hout+            if "Result " `isPrefixOf` x then+                return $ read $ drop 7 x+             else if "Send " `isPrefixOf` x then do+                hOut hin =<< ans (drop 5 x)+                loop ans hin hout+             else if "#" `isPrefixOf` x then do+                hOut stdout x+                loop ans hin hout+             else+                return $ Left $ "Unexpected message from program: " ++ show x+++withBuffering hndl mode act = bracket+    (do old <- hGetBuffering hndl; hSetBuffering hndl mode; return old)+    (hSetBuffering hndl)+    (const act)+++-- | Unknown value, representing the values stored within the 'Mode' structure. While the values+--   are not observable, they behave identically to the original values.+newtype Unknown = Unknown {fromUnknown :: Value} -- wrap Value so the Pack instance doesn't leak+++-- | Receive information about the mode to display.+receive :: IO (Mode Unknown)+receive = do+    m <- getLine+    return $ remap2 Unknown fromUnknown $ loadMode m $ \msg -> unsafePerformIO $ do+        hOut stdout $ "Send " ++ msg+        getLine+++-- | Send a reply with either an error, or a list of flags to use. This function exits the helper program.+reply :: Either String [String] -> IO ()+reply x = do+    hOut stdout $ "Result " ++ show x+    exitWith ExitSuccess+++-- | Send a comment which will be displayed on the calling console, mainly useful for debugging.+comment :: String -> IO ()+comment x = hOut stdout $ "# " ++ x+++---------------------------------------------------------------------+-- IO MAP++data IOMap a = IOMap (IORef (Int,[(Int,a)]))++newIOMap :: IO (IOMap a)+newIOMap = fmap IOMap $ newIORef (0, [])++addIOMap :: IOMap a -> a -> IO Int+addIOMap (IOMap ref) x = atomicModifyIORef ref $ \(i,xs) -> let j = i+1 in ((j,(j,x):xs), j)++getIOMap :: IOMap a -> Int -> IO a+getIOMap (IOMap ref) i = do (_,xs) <- readIORef ref; return $ fromJust $ lookup i xs+++---------------------------------------------------------------------+-- SERIALISE A MODE++newtype Value = Value Int+++{-# NOINLINE toValue #-}+toValue :: Mode a -> Mode Value+-- fairly safe, use of a table and pointers from one process to another, but referentially transparent+toValue x = unsafePerformIO $ do+    -- the ref accumulates, so is a space leak+    -- but it will all disappear after the helper goes, so not too much of an issue+    mp <- newIOMap+    let embed x = unsafePerformIO $ fmap Value $ addIOMap mp x+        proj (Value x) = unsafePerformIO $ getIOMap mp x+    return $ remap2 embed proj x+++saveMode :: Mode a -> IO (String, String -> IO String) -- (value, ask questions from stdin)+saveMode m = do+    mp <- newIOMap+    res <- add mp $ pack $ toValue m+    return $ (show res, fmap show . get mp . read)+    where+        add :: IOMap (Pack -> Pack) -> Pack -> IO Pack+        add mp x = flip transformM x $ \x -> case x of+            Func (NoShow f) -> do i <- addIOMap mp f; return $ FuncId i+            x -> return x++        get :: IOMap (Pack -> Pack) -> (Int,Pack) -> IO Pack+        get mp (i,x) = do+            f <- getIOMap mp i+            add mp $ f x+++loadMode :: String -> (String -> String) -> Mode Value -- given serialised, question asker, give me a value+loadMode x f = unpack $ rep $ read x+    where+        rep :: Pack -> Pack+        rep x = flip transform x $ \x -> case x of+            FuncId i -> Func $ NoShow $ \y -> rep $ read $ f $ show (i,y)+            x -> x+++-- Support data types++data Pack = Ctor String [(String, Pack)]+          | List [Pack]+          | Char Char+          | Int Int+          | Func (NoShow (Pack -> Pack))+          | FuncId Int -- Never passed to pack/unpack, always transfromed away by saveMode/loadMode+          | String String+          | None -- ^ Never generated, only used for reading in bad cases+            deriving (Show,Read)++newtype NoShow a = NoShow a+instance Show (NoShow a) where -- deliberately leave the methods unimplemented+instance Read (NoShow a) where -- deliberately leave the methods unimplemented+++transformM, descendM :: Monad m => (Pack -> m Pack) -> Pack -> m Pack+transformM f x = f =<< descendM (transformM f) x+descendM f x = let (a,b) = uniplate x in liftM b $ mapM f a++transform, descend :: (Pack -> Pack) -> Pack -> Pack+transform f = f . descend (transform f)+descend f x = let (a,b) = uniplate x in b $ map f a++uniplate :: Pack -> ([Pack], [Pack] -> Pack)+uniplate (List xs) = (xs, List)+uniplate (Ctor x ys) = (map snd ys, Ctor x . zip (map fst ys))+uniplate x = ([], const x)+++class Packer a where+    pack :: a -> Pack+    unpack :: Pack -> a++add a b = (a, pack b)+ctor x (Ctor y xs) | x == y = xs+ctor _ _ = []+get a b = unpack $ fromMaybe None $ lookup a b+++-- General instances++instance Packer a => Packer [a] where+    pack xs = if length ys == length zs && not (null ys) then String zs else List ys+        where ys = map (pack) xs+              zs = [x | Char x <- ys]++    unpack (String xs) = unpack $ List $ map Char xs+    unpack (List xs) = map (unpack) xs+    unpack _ = []++instance (Packer a, Packer b) => Packer (a -> b) where+    pack f = Func $ NoShow $ pack . f . unpack+    unpack (Func (NoShow f)) = unpack . f . pack++instance Packer Value where+    pack (Value x) = pack x+    unpack x = Value $ unpack x++instance Packer Char where+    pack = Char+    unpack (Char x) = x+    unpack _ = ' '++instance Packer Int where+    pack = Int+    unpack (Int x) = x+    unpack _ = -1++instance (Packer a, Packer b) => Packer (a,b) where+    pack (a,b) = Ctor "(,)" [add "fst" a, add "snd" b]+    unpack x = (get "fst" y, get "snd" y)+        where y = ctor "(,)" x++instance Packer a => Packer (Maybe a) where+    pack Nothing = Ctor "Nothing" []+    pack (Just x) = Ctor "Just" [add "fromJust" x]+    unpack x@(Ctor "Just" _) = Just $ get "fromJust" $ ctor "Just" x+    unpack _ = Nothing++instance (Packer a, Packer b) => Packer (Either a b) where+    pack (Left x) = Ctor "Left" [add "fromLeft" x]+    pack (Right x) = Ctor "Right" [add "fromRight" x]+    unpack x@(Ctor "Left" _) = Left $ get "fromLeft" $ ctor "Left" x+    unpack x@(Ctor "Right" _) = Right $ get "fromRight" $ ctor "Right" x+    unpack _ = Left $ unpack None++instance Packer Bool where+    pack True = Ctor "True" []+    pack _ = Ctor "False" []+    unpack (Ctor "True" _) = True+    unpack _ = False+++-- CmdArgs specific++instance Packer a => Packer (Group a) where+    pack Group{..} = Ctor "Group"+        [add "groupUnnamed" groupUnnamed+        ,add "groupHidden" groupHidden+        ,add "groupNamed" groupNamed]+    unpack x = let y = ctor "Group" x in Group+        {groupUnnamed = get "groupUnnamed" y+        ,groupHidden = get "groupHidden" y+        ,groupNamed = get "groupNamed" y}       ++instance Packer a => Packer (Mode a) where+    pack Mode{..} = Ctor "Mode"+        [add "modeGroupModes" modeGroupModes+        ,add "modeNames" modeNames+        ,add "modeHelp" modeHelp+        ,add "modeHelpSuffix" modeHelpSuffix+        ,add "modeArgs" modeArgs+        ,add "modeGroupFlags" modeGroupFlags+        ,add "modeValue" modeValue+        ,add "modeCheck" modeCheck+        ,add "modeReform" modeReform]+    unpack x = let y = ctor "Mode" x in Mode+        {modeGroupModes = get "modeGroupModes" y+        ,modeNames = get "modeNames" y+        ,modeHelp = get "modeHelp" y+        ,modeHelpSuffix = get "modeHelpSuffix" y+        ,modeArgs = get "modeArgs" y+        ,modeGroupFlags = get "modeGroupFlags" y+        ,modeValue = get "modeValue" y+        ,modeCheck = get "modeCheck" y+        ,modeReform = get "modeReform" y}++instance Packer a => Packer (Flag a) where+    pack Flag{..} = Ctor "Flag"+        [add "flagNames" flagNames+        ,add "flagInfo" flagInfo+        ,add "flagType" flagType+        ,add "flagHelp" flagHelp+        ,add "flagValue" flagValue]+    unpack x = let y = ctor "Flag" x in Flag+        {flagNames = get "flagNames" y+        ,flagInfo = get "flagInfo" y+        ,flagType = get "flagType" y+        ,flagHelp = get "flagHelp" y+        ,flagValue = get "flagValue" y}++instance Packer a => Packer (Arg a) where+    pack Arg{..} = Ctor "Arg"+        [add "argType" argType+        ,add "argRequire" argRequire+        ,add "argValue" argValue]+    unpack x = let y = ctor "Arg" x in Arg+        {argType = get "argType" y+        ,argRequire = get "argRequire" y+        ,argValue = get "argValue" y}++instance Packer FlagInfo where+    pack FlagReq = Ctor "FlagReq" []+    pack (FlagOpt x) = Ctor "FlagOpt" [add "fromFlagOpt" x]+    pack (FlagOptRare x) = Ctor "FlagOptRare" [add "fromFlagOpt" x]+    pack FlagNone = Ctor "FlagNone" []+    unpack x@(Ctor name _) = case name of+        "FlagReq" -> FlagReq+        "FlagOpt" -> FlagOpt $ get "fromFlagOpt" $ ctor name x+        "FlagOptRare" -> FlagOpt $ get "fromFlagOpt" $ ctor name x+    unpack _ = FlagNone

@@ -59,8 +59,13 @@          > Ctor {field1 = value1 &= ann1, field2 = value2} &= ann2 ==> record Ctor{} [field1 := value1 += ann1, field2 := value2] += ann2     > Ctor (value1 &= ann1) value2 &= ann2 ==> record Ctor{} [atom value1 += ann1, atom value2] += ann2-    > many [Ctor1{...}, Ctor2{...}] ==> many_ [record Ctor1{} [...], record Ctor2{} [...]]-    > Ctor {field1 = enum [X &= ann, Y]} ==> record Ctor{} [field1 := enum_ [atom X += ann, atom Y]]+    > modes [Ctor1{...}, Ctor2{...}] ==> modes_ [record Ctor1{} [...], record Ctor2{} [...]]+    > Ctor {field1 = enum [X &= ann, Y]} ==> record Ctor{} [enum_ field1 [atom X += ann, atom Y]]++    If you are willing to use TemplateHaskell, you can write in the impure syntax,+    but have your code automatically translated to the pure style. For more details see+    "System.Console.CmdArgs.Quote".+ -} module System.Console.CmdArgs.Implicit(     -- * Running command lines

@@ -176,7 +176,7 @@         mapModes1 f pre m = m{modeGroupModes = fmap (mapModes0 f (pre ++ head (modeNames m) ++ " ")) $ modeGroupModes m}          add pre m = changeHelp p m $ \hlp txt x -> x{cmdArgsHelp=Just $ showText txt $ msg hlp}-            where msg hlp = map Line (progHelpOutput p) ++ Line "" : helpText hlp (prepare m{modeNames = map (pre++) $ modeNames m})+            where msg hlp = helpText (progHelpOutput p) hlp (prepare m{modeNames = map (pre++) $ modeNames m})          prepare = mapModes1 (\_ m -> m{modeGroupFlags = groupCommonHide $ modeGroupFlags m}) "" 

@@ -0,0 +1,213 @@+{-# LANGUAGE TemplateHaskell, PatternGuards, MagicHash #-}++-- | This module provides a quotation feature to let you write command line+--   arguments in the impure style, but have them translated into the pure style,+--   as per "System.Console.CmdArgs.Implicit". An example:+--+-- > {-# LANGUAGE TemplateHaskell, DeriveDataTypeable, MagicHash #-}+-- > import System.Console.CmdArgs.Implicit+-- > import System.Console.CmdArgs.Quote+-- >+-- > data Sample = Sample {hello :: String} deriving (Show, Data, Typeable)+-- >+-- > $(cmdArgsQuote [d|+-- >     sample = Sample{hello = def &=# help "World argument" &=# opt "world"}+-- >                    &=# summary "Sample v1"+-- > +-- >     run = cmdArgs# sample :: IO Sample+-- >     |])+-- >+-- > main = print =<< run+--+--   Inside 'cmdArgsQuote' you supply the command line parser using attributes in the+--   impure style. If you run with @-ddump-splices@ (to see the Template Haskell output),+--   you would see:+--+-- > run = cmdArgs_+-- >     (record Sample{} [hello := def += help "World argument" += opt "world"]+-- >         += summary "Sample v1")+-- >     :: IO Sample+--+--   /Stubs/+--+--   To define the original parser you may use either the standard impure annotations ('(&=)', 'modes'), or+--   the stub annotations versions defined in this module ('(&=#)', 'modes'). The stub versions do not include+--   a "Data" constraint, so can be used in situations where the Data instance is not yet available - typically+--   when defining the parser in the same module as the data type on GHC 7.2 and above. The stub versions should+--   never be used outside 'cmdArgsQuote' and will always raise an error.+--+--   /Explicit types/+--+--   There will be a limited number of situations where an impure parser will require additional types, typically+--   on the result of 'cmdArgs' if the result is used without a fixed type - for example if you 'show' it. Most users+--   will not need to add any types. In some cases you may need to remove some explicit types, where the intermediate+--   type of the annotations has changed - but again, this change should be rare.+--+--   /Completeness/+--+--   The translation is not complete, although works for all practical instances I've tried. The translation works+--   by first expanding out the expression (inlining every function defined within the quote, inlining let bindings),+--   then performs the translation. This scheme leads to two consequences: 1) Any expensive computation executed inside+--   the quotation to produce the command line flags may be duplicated (a very unlikely scenario). 2) As I do not yet+--   have expansion rules for all possible expressions, the expansion (and subsequently the translation) may fail.+--   I am interested in any bug reports where the feature does not work as intended.+module System.Console.CmdArgs.Quote(+    -- * Template Haskell quotation function+    cmdArgsQuote,+    -- * Stub versions of the impure annotations+    (&=#), modes#, cmdArgsMode#, cmdArgs#, enum#+    ) where++import Language.Haskell.TH+import Control.Arrow+import Control.Monad+import Data.Data+import Data.Maybe+import System.Console.CmdArgs.Implicit++stub name = error $+    "System.Console.CmdArgs.Quote." ++ name +++    ": this function is provided only for use inside cmdArgsQuote, and should never be called"++-- | Version of '&=' without a 'Data' context, only to be used within 'cmdArgsQuote'.+(&=#) :: a -> Ann -> a+(&=#) = stub "(&=#)"++-- | Version of 'modes' without a 'Data' context, only to be used within 'cmdArgsQuote'.+modes# :: [a] -> a+modes# = stub "modes#"++-- | Version of 'cmdArgsMode' without a 'Data' context, only to be used within 'cmdArgsQuote'.+cmdArgsMode# :: a -> Mode (CmdArgs a)+cmdArgsMode# = stub "cmdArgsMode#"++-- | Version of 'cmdArgs' without a 'Data' context, only to be used within 'cmdArgsQuote'.+cmdArgs# :: a -> IO a+cmdArgs# = stub "cmdArgs#"++-- | Version of 'enum' without a 'Data' context, only to be used within 'cmdArgsQuote'.+enum# :: [a] -> a+enum# = stub "enum#"+++-- | Quotation function to turn an impure version of "System.Console.CmdArgs.Implicit" into a pure one.+--   For details see "System.Console.CmdArgs.Quote".+cmdArgsQuote :: Q [Dec] -> Q [Dec]+cmdArgsQuote x = do+    x <- x+    translate $ rename $ simplify $ inline x+++-- | Apply the rewrite rules+translate :: [Dec] -> Q [Dec]+translate = descendBiM f+    where+        dull = ['Just, 'Left, 'Right, '(:)] -- Prelude constructors of non-zero arity++        f (RecConE x xs) = return $+            let args = [anns (InfixE (Just $ VarE lbl) (ConE '(:=)) (Just val)) as | (lbl,x) <- xs, let (val, as) = asAnns x]+            in VarE 'record `AppE` RecConE x [] `AppE` ListE args++        f x | (ConE x, xs@(_:_)) <- asApps x, x `notElem` dull = do+            names <- forM [1..length xs] $ \i -> newName $ "_" ++ nameBase x ++ show i+            let (vals, ass) = unzip $ map asAnns xs+                bind = [ValD (VarP name) (NormalB val) [] | (name,val) <- zip names vals]+                args = [anns (VarE 'atom `AppE` VarE name) as | (name,as) <- zip names ass]+            return $ LetE bind $ VarE 'record `AppE` (ConE x `apps` map VarE names) `AppE` ListE args+        +        f x = descendM f x++        apps x [] = x+        apps x (y:ys) = apps (x `AppE` y) ys++        asApps (AppE x y) = let (a,b) = asApps x in (a,b++[y])+        asApps x = (x,[])++        anns x [] = x+        anns x (a:as) = anns (InfixE (Just x) (VarE '(+=)) (Just a)) as++        asAnns (InfixE (Just x) (VarE op) (Just y)) | op == '(+=) = let (a,b) = asAnns x in (a,b++[y])+        asAnns (AppE (AppE (VarE op) x) y) | op == '(+=) = let (a,b) = asAnns x in (a,b++[y])+        asAnns x = (x, [])+++-- | Move from the old names to the new names, sufficient for where that is the full translation+rename :: [Dec] -> [Dec]+rename = transformBi f+    where+        rep = let f a b c = [(a,c),(b,c)] in concat+            [f '(&=) '(&=#) '(+=)+            ,f 'modes 'modes# 'modes_+            ,f 'enum 'enum# 'enum_+            ,f 'cmdArgsMode 'cmdArgsMode# 'cmdArgsMode_+            ,f 'cmdArgs 'cmdArgs# 'cmdArgs_]++        f (VarE x) | Just x <- lookup x rep = VarE x+        f x = x+++-- | Simplify the syntax tree - things like application of a lambda+simplify :: [Dec] -> [Dec]+simplify = transformBi f+    where+        f (AppE (LamE [VarP v] bod) x) = f $ subst v x bod+        f x = x++        subst v x bod = transform f bod+            where f (VarE v2) | v == v2 = x+                  f x = x+++-- | Evaluate through all locally defined functions and let expressions, at most once per defn+inline :: [Dec] -> [Dec]+inline xs = map (dec $ addEnv xs []) xs+    where+        newEnv = concatMap $ \x -> case x of+            FunD x [Clause ps (NormalB e) ds] -> [(x, LamE ps $ let_ ds e)]+            ValD (VarP x) (NormalB e) ds -> [(x, let_ ds e)]+            _ -> []++        addEnv xs env = without [] (newEnv xs) ++ env+            where+                -- create an environment where everything in ns is missing, recursively drop one thing each time+                without ns new = [(n, exp (new2 ++ env) e) | (n,e) <- new, n `notElem` ns, let new2 = without (n:ns) new]+                ++        dec env (FunD n cs) = FunD n $ map (clause env) cs+        dec env (ValD p x ds) = ValD p (body (addEnv ds env) x) ds++        clause env (Clause ps x ds) = Clause ps (body (addEnv ds env) x) ds++        body env (GuardedB xs) = GuardedB $ map (second $ exp env) xs+        body env (NormalB x) = NormalB $ exp env x++        -- FIXME: propagating the env ignores variables shadowed by LamE/CaseE+        exp env (LetE ds x) = LetE ds $ exp (addEnv ds env) x+        exp env (VarE x) | Just x <- lookup x env = x+        exp env x = descend (exp env) x++        let_ ds e = if null ds then e else LetE ds e+++---------------------------------------------------------------------+-- MINI UNIPLATE - Avoid the dependency just for one small module++descendBi :: (Data a, Data b) => (b -> b) -> a -> a+descendBi f x | Just f <- cast f = f x+              | otherwise = gmapT (descendBi f) x++descend :: Data a => (a -> a) -> a -> a+descend f = gmapT (descendBi f)++transform :: Data a => (a -> a) -> a -> a+transform f = f . descend (transform f)++transformBi :: (Data a, Data b) => (b -> b) -> a -> a+transformBi f = descendBi (transform f)++descendBiM :: (Data a, Data b, Monad m) => (b -> m b) -> a -> m a+descendBiM f x | Just x <- cast x = liftM (fromJust . cast) $ f x -- guaranteed safe+               | otherwise = gmapM (descendBiM f) x++descendM :: (Data a, Monad m) => (a -> m a) -> a -> m a+descendM f = gmapM (descendBiM f)

@@ -6,12 +6,14 @@ import qualified System.Console.CmdArgs.Test.Explicit as Explicit import qualified System.Console.CmdArgs.Test.Implicit as Implicit import qualified System.Console.CmdArgs.Test.GetOpt as GetOpt+import qualified System.Console.CmdArgs.Test.SplitJoin as SplitJoin  test :: IO () test = do     Explicit.test     GetOpt.test     Implicit.test+    SplitJoin.test     putStrLn "\nTest completed"  demo :: [Mode Demo]

@@ -8,7 +8,7 @@  demo = [newDemo act dem] -act xs | ("help","") `elem` xs = print $ helpText def dem+act xs | ("help","") `elem` xs = print $ helpText [] def dem        | otherwise = print xs  dem :: Mode [(String,String)]@@ -33,6 +33,10 @@     checkGood m ["fred","bob"] ["fred","bob"]     checkGood m ["--","--test"] ["--test"]     checkGood m [] []+    checkComp m [] (0,0) []+    checkComp m ["--"] (0,2) []+    checkComp m ["bob"] (0,3) []+    checkComp m ["-"] (0,1) [CompleteValue "-"]  testFlags = do     let m = name "Flags" $ mode "" [] "" (flagArg (upd "") "")@@ -58,6 +62,14 @@     checkGood m ["-tm"] ["test","more"]     checkGood m ["--col=red"] ["colorred"]     checkGood m ["--col","red","-t"] ["colorred","test"]+    checkComp m ["--tes"] (0,5) [CompleteValue "--test"]+    checkComp m ["--color","--tes"] (1,5) []+    checkComp m ["--more","--tes"] (1,5) [CompleteValue "--test"]+    checkComp m ["--moo","--tes"] (1,5) [CompleteValue "--test"]+    checkComp m ["--col"] (0,5) [CompleteValue "--color"]+    checkComp m ["--bob"] (0,5) [CompleteValue "--bobby",CompleteValue "--bob"]+    checkComp m ["-"] (0,1) $ map CompleteValue $ words "--test --more --color --bob -x -"+    checkComp m ["--"] (0,2) $ map CompleteValue $ words "--test --more --color --bob --xxx"  testModes = do     let m = name "Modes" $ modes "" [] ""@@ -91,3 +103,9 @@     Left err -> failure "Failed when should have succeeded" [("Name",n),("Args",show xs),("Error",err)]     Right a | reverse a /= ys -> failure "Wrong parse" [("Name",n),("Args",show xs),("Wanted",show ys),("Got",show $ reverse a)]     _ -> success++checkComp :: (String,Mode [String]) -> [String] -> (Int,Int) -> [Complete] -> IO ()+checkComp (n,m) xs ab want+    | want == got = success+    | otherwise = failure "Bad completions" [("Name",n),("Args",show xs),("Index",show ab),("Wanted",show want),("Got",show got)]+    where got = complete m xs ab

@@ -1,6 +1,8 @@-{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}+{-# LANGUAGE DeriveDataTypeable, RecordWildCards, TemplateHaskell, MagicHash #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-} module System.Console.CmdArgs.Test.Implicit.Diffy where import System.Console.CmdArgs+import System.Console.CmdArgs.Quote import System.Console.CmdArgs.Test.Implicit.Util  data Diffy = Create {src :: Maybe FilePath, out :: FilePath}@@ -22,12 +24,32 @@  mode = cmdArgsMode $ modes [create,diff] &= help "Create and compare differences" &= program "diffy" &= summary "Diffy v1.0" ++$(cmdArgsQuote+    [d|+        outFlags_ x = x &=# help "Output file" &=# typFile++        create_ = Create+            {src = Nothing &=# help "Source directory" &=# typDir+            ,out = outFlags_ "ls.txt"+            } &=# help "Create a fingerprint"++        diff_ = Diff+            {old = "" &=# typ "OLDFILE" &=# argPos 0+            ,new = "" &=# typ "NEWFILE" &=# argPos 1+            ,out = outFlags_ "diff.txt"+            } &=# help "Perform a diff"++        mode_ = cmdArgsMode# $ modes# [create_,diff_] &=# help "Create and compare differences" &=# program "diffy" &=# summary "Diffy v1.0"+    |])++ -- STOP MANUAL  test = do-    let Tester{..} = tester "Diffy" mode+    let Tester{..} = testers "Diffy" [mode,mode_]     fails []-    isHelp ["--help"] []+    isHelp ["--help"] ["diffy [COMMAND] ... [OPTIONS]"] -- FIXME: Should know that root is not valid, thus no brackets on [COMMAND]     isHelp ["create","--help"] []     isHelp ["diff","--help"] []     isHelpNot ["--help"] ["diffy"]@@ -44,4 +66,7 @@     ["diff","foo1","foo2"] === diff{old="foo1",new="foo2"}     fails ["diff","foo1"]     fails ["diff","foo1","foo2","foo3"]+    completion [] (0,0) [CompleteValue "create",CompleteValue "diff",CompleteValue "--out",CompleteValue "--help",CompleteValue "--version"]+    completion ["d"] (0,1) [CompleteValue "diff"]+    completion ["dd"] (0,2) [] 

@@ -39,7 +39,7 @@     ,datadir = def &= typDir &= help "Override the data directory"     ,cpp_define = def &= typ "NAME[=VALUE]" &= help "CPP #define"     ,cpp_include = def &= typDir &= help "CPP include path"-    ,files = def &= args &= typ "FILES/DIRS"+    ,files = def &= args &= typ "FILE/DIR"     } &=     verbosity &=     help "Suggest improvements to Haskell source code" &=@@ -72,5 +72,4 @@     ["--cpp-define=val","x"] === hlint{cpp_define=["val"],files=["x"]}     fails ["--cpp-define"]     ["--cpp-define","val","x","y"] === hlint{cpp_define=["val"],files=["x","y"]}--+    completion ["T"] (0,1) [CompleteFile "" "T", CompleteDir "" "T"]

@@ -1,23 +1,15 @@-{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}+{-# LANGUAGE DeriveDataTypeable, RecordWildCards, TemplateHaskell, MagicHash #-} {-# OPTIONS_GHC -fno-warn-missing-fields -fno-warn-unused-binds #-} -module System.Console.CmdArgs.Test.Implicit.Tests where+module System.Console.CmdArgs.Test.Implicit.Tests(test, demos) where  import System.Console.CmdArgs import System.Console.CmdArgs.Explicit(modeHelp) import System.Console.CmdArgs.Test.Implicit.Util+import System.Console.CmdArgs.Quote import Data.Int  -test = test1 >> test2 >> test3 >> test4 >> test5 >> test6 >> test7 >> test8 >> test9 >> test10 >>-       test11 >> test12 >> test13 >> test14 >> test15 >> test16-demos = zipWith f [1..]-        [toDemo mode1, toDemo mode2, toDemo mode3, toDemo mode4, toDemo mode5, toDemo mode6-        ,toDemo mode7, toDemo mode8, toDemo mode9, toDemo mode10, toDemo mode11, toDemo mode12-        ,toDemo mode13, toDemo mode14, toDemo mode15, toDemo mode16]-    where f i x = x{modeHelp = "Testing various corner cases (" ++ show i ++ ")"}-- -- from bug #256 and #231 data Test1     = Test1 {maybeInt :: Maybe Int, listDouble :: [Double], maybeStr :: Maybe String, float :: Float@@ -27,8 +19,13 @@ def1 = Test1 def def def (def &= args) def def def def mode1 = cmdArgsMode def1 +$(cmdArgsQuote [d|+    mode1_ = cmdArgsMode# def1_+    def1_ = Test1 def def def (def &=# args) def def def def+    |])+ test1 = do-    let Tester{..} = tester "Test1" mode1+    let Tester{..} = testers "Test1" [mode1,mode1_]     [] === def1     ["--maybeint=12"] === def1{maybeInt = Just 12}     ["--maybeint=12","--maybeint=14"] === def1{maybeInt = Just 14}@@ -69,8 +66,11 @@  mode3 = cmdArgsMode $ Test3 (def &= argPos 1) (def &= argPos 2 &= opt "foo") (def &= args) +$(cmdArgsQuote [d| mode3_ = cmdArgsMode# $ Test3 (def &=# argPos 1) (def &=# argPos 2 &=# opt "foo") (def &=# args) |])++ test3 = do-    let Tester{..} = tester "Test3" mode3+    let Tester{..} = testers "Test3" [mode3,mode3_]     fails []     fails ["a"]     ["a","1"] === Test3 [1] ["foo"] ["a"]@@ -267,8 +267,14 @@          &= helpArg [groupname "GROUP", name "h", name "nohelp", explicit, help "whatever"] &= versionArg [ignore]          &= verbosityArgs [ignore] [explicit,name "silent"] +$(cmdArgsQuote [d|+    mode15_ = cmdArgsMode# $ Test15 (False &=# name "help")+              &=# helpArg [groupname "GROUP", name "h", name "nohelp", explicit, help "whatever"] &=# versionArg [ignore]+              &=# verbosityArgs [ignore] [explicit,name "silent"]+    |])+ test15 = do-    let Tester{..} = tester "Test15" mode15+    let Tester{..} = testers "Test15" [mode15,mode15_]     invalid $ \_ -> Test15 (False &= name "help")     ["--help"] === Test15 True     ["-t"] === Test15 True@@ -294,3 +300,17 @@     fails ["--test16a"]     ["--test16a=5"] === Test16 (MyInt 5) []     ["--test16b=5","--test16b=82"] === Test16 (MyInt 12) [MyInt 5, MyInt 82]+++-- For some reason, these must be at the end, otherwise the Template Haskell+-- stage restriction kicks in.++test = test1 >> test2 >> test3 >> test4 >> test5 >> test6 >> test7 >> test8 >> test9 >> test10 >>+       test11 >> test12 >> test13 >> test14 >> test15 >> test16+demos = zipWith f [1..]+        [toDemo mode1, toDemo mode2, toDemo mode3, toDemo mode4, toDemo mode5, toDemo mode6+        ,toDemo mode7, toDemo mode8, toDemo mode9, toDemo mode10, toDemo mode11, toDemo mode12+        ,toDemo mode13, toDemo mode14, toDemo mode15, toDemo mode16]+    where f i x = x{modeHelp = "Testing various corner cases (" ++ show i ++ ")"}++

@@ -1,6 +1,9 @@ {-# LANGUAGE PatternGuards #-} -module System.Console.CmdArgs.Test.Implicit.Util where+module System.Console.CmdArgs.Test.Implicit.Util(+    module System.Console.CmdArgs.Test.Implicit.Util,+    Complete(..)+    ) where  import System.Console.CmdArgs.Implicit import System.Console.CmdArgs.Explicit@@ -29,19 +32,21 @@     ,isHelpNot :: [String] -> [String] -> IO ()     ,isVersion :: [String] -> String -> IO ()     ,isVerbosity :: [String] -> Verbosity -> IO ()+    ,completion :: [String] -> (Int,Int) -> [Complete] -> IO ()     }  testers :: (Show a, Eq a) => String -> [Mode (CmdArgs a)] -> Tester a testers name = foldr1 f . map (tester name)     where-        f (Tester x1 x2 x3 x4 x5 x6) (Tester y1 y2 y3 y4 y5 y6) =-            Tester (f2 x1 y1) (f1 x2 y2) (f2 x3 y3) (f2 x4 y4) (f2 x5 y5) (f2 x6 y6)+        f (Tester x1 x2 x3 x4 x5 x6 x7) (Tester y1 y2 y3 y4 y5 y6 y7) =+            Tester (f2 x1 y1) (f1 x2 y2) (f2 x3 y3) (f2 x4 y4) (f2 x5 y5) (f2 x6 y6) (f3 x7 y7)         f1 x y a = x a >> y a         f2 x y a b = x a b >> y a b+        f3 x y a b c = x a b c >> y a b c   tester :: (Show a, Eq a) => String -> Mode (CmdArgs a) -> Tester a-tester name m = Tester (===) fails isHelp isHelpNot isVersion isVerbosity+tester name m = Tester (===) fails isHelp isHelpNot isVersion isVerbosity completion     where         failed msg args xs = failure msg $ ("Name","Implicit "++name):("Args",show args):xs @@ -70,7 +75,7 @@          isHelp args want = f args $ \x -> case x of             Right x | Just got <- cmdArgsHelp x, match want (lines got) -> success-            _ -> failed "Failed on isHelp" args []+            _ -> failed "Failed on isHelp" args [("Want",show want)]          isHelpNot args want = f args $ \x -> case x of             Right x | Just got <- cmdArgsHelp x, not $ match want (lines got) -> success@@ -83,6 +88,12 @@         isVerbosity args v = f args $ \x -> case x of             Right x | fromMaybe Normal (cmdArgsVerbosity x) == v -> success             _ -> failed "Failed on isVerbosity" args []++        completion args pos res+            | res == ans = success+            | otherwise = failed "Failed on completion" args [("Position",show pos),("Want",shw res),("Got",shw ans)]+            where ans = complete m args pos+                  shw = intercalate ", " . lines . show   match :: [String] -> [String] -> Bool

@@ -0,0 +1,148 @@+{-# LANGUAGE QuasiQuotes #-}++module System.Console.CmdArgs.Test.SplitJoin(test) where++import System.Console.CmdArgs.Explicit+import System.Console.CmdArgs.Test.Util+import Control.Monad++++test = do+    forM_ tests $ \(src,parsed) -> do+        let a = splitArgs src+            b1 = joinArgs parsed+            b2 = joinArgs $ splitArgs b1+        if a == parsed then return () else failure "splitArgs" [("Given   ",src),("Expected",show parsed),("Found   ",show a)]+        if b1 == b2 then return () else failure "joinArgs" [("Given   ",show parsed),("Expected",b1),("Found   ",b2)]+    success++{-+newtype CmdLine = CmdLine String deriving Show++instance Arbitrary CmdLine where+    arbitrary = fmap CmdLine $ listOf $ elements "abcd \\/\'\""++generateTests :: IO ()+generateTests = withTempFile $ \src -> do+    writeFile src "import System.Environment\nmain = print =<< getArgs\n"+    quickCheckWith stdArgs{chatty=False} $ \(CmdLine x) -> unsafePerformIO $ do+        putStr $ ",(,) " ++ (show x) ++ " "+        system $ "runhaskell \"" ++ src ++ "\" " ++ x+        return True+++withTempFile :: (FilePath -> IO a) -> IO a+withTempFile f = bracket+    (do (file,h) <- openTempFile "." "cmdargs.hs"; hClose h; return file)+    removeFile+    f+-}++-- Pregenerate the QuickCheck tests and run them through the system console+-- Not done each time for three reasons+-- * Avoids an extra dependency on QuickCheck + process+-- * Slow to run through the command line+-- * Can't figure out how to read the output, without adding more escaping (which breaks the test)+tests =+    [(,) "" []+    ,(,) "c" ["c"]+    ,(,) "b" ["b"]+    ,(,) "\\" ["\\"]+    ,(,) "'//" ["'//"]+    ,(,) "a" ["a"]+    ,(,) "cda" ["cda"]+    ,(,) "b'" ["b'"]+    ,(,) "" []+    ,(,) " " []+    ,(,) "/b" ["/b"]+    ,(,) "\"b/\"d a'b'b" ["b/d","a'b'b"]+    ,(,) "d'c a\"/\\" ["d'c","a/\\"]+    ,(,) "d" ["d"]+    ,(,) "bb' " ["bb'"]+    ,(,) "b'\\" ["b'\\"]+    ,(,) "\"\\ac" ["\\ac"]+    ,(,) "\\'\"abbb\"c/''' \\ c" ["\\'abbbc/'''","\\","c"]+    ,(,) "/bbdbb a " ["/bbdbb","a"]+    ,(,) "b\" d" ["b d"]+    ,(,) "" []+    ,(,) "\\cc/''\\b\\ccc\\'\\b\\" ["\\cc/''\\b\\ccc\\'\\b\\"]+    ,(,) "/" ["/"]+    ,(,) "///\"b\\c/b\"cd//c'\"" ["///b\\c/bcd//c'"]+    ,(,) "\\\"d\\\\' /d\\\\/bb'a /\\d" ["\"d\\\\'","/d\\\\/bb'a","/\\d"]+    ,(,) "c/ \\''/c b\\'" ["c/","\\''/c","b\\'"]+    ,(,) "dd'b\\\\\\' /c'aaa\"" ["dd'b\\\\\\'","/c'aaa"]+    ,(,) "b'd''\\/ b\\'b'db/'cd " ["b'd''\\/","b\\'b'db/'cd"]+    ,(,) "a\"ba\\/\\ " ["aba\\/\\ "]+    ,(,) "b\"'dd'c /b/c\"bbd \"\"\\ad'\"c\\\"" ["b'dd'c /b/cbbd","\\ad'c\""]+    ,(,) "da 'c\\\\acd/'dbaaa///dccbc a \\" ["da","'c\\\\acd/'dbaaa///dccbc","a","\\"]+    ,(,) "a'ac \"da\"" ["a'ac","da"]+    ,(,) "\"'\\\"/\"\"b\\b  \"'\"\"ccd'a\"/c /da " ["'\"/\"b\\b","'\"ccd'a/c /da "]+    ,(,) "d\"\\c\\\\cb c/\"aa' b\"\\/d \"'c c/" ["d\\c\\\\cb c/aa'","b\\/d 'c","c/"]+    ,(,) "dbc\\/\"\"//c/\"accda" ["dbc\\///c/accda"]+    ,(,) "aca a'' \\ c b'\\/d\\" ["aca","a''","\\","c","b'\\/d\\"]+    ,(,) "dc\"bc/a\\ccdd\\\\aad\\c'ab '\\cddcdba" ["dcbc/a\\ccdd\\\\aad\\c'ab '\\cddcdba"]+    ,(,) " c'\"ba \"b\\dc\"" ["c'ba b\\dc"]+    ,(,) "a\\acd/a \"'c /'c'" ["a\\acd/a","'c /'c'"]+    ,(,) " ac ddc/\"\"a/\\bd\\d c'cac\"c\\a/a''c" ["ac","ddc/a/\\bd\\d","c'cacc\\a/a''c"]+    ,(,) "b/cd\"//bb\"/daaab/  b b \"'     d\"a\" 'd b" ["b/cd//bb/daaab/","b","b","'     da 'd b"]+    ,(,) "a\"cc'cd\"\\'ad '\"dcc acb\"\\\\" ["acc'cd\\'ad","'dcc acb\\\\"]+    ,(,) "/bc/bc'/\"d  \"a/\"\\ad aba\\da" ["/bc/bc'/d  a/\\ad aba\\da"]+    ,(,) "b\\a" ["b\\a"]+    ,(,) "/dc ''c'a\"'/'\\ /'cd\\'d/'db/b\"' cabacaaa\"\"dd" ["/dc","''c'a'/'\\ /'cd\\'d/'db/b'","cabacaaadd"]+    ,(,) "\"ac\\\"c'/c'b\"b\"b'd\"c\"\"" ["ac\"c'/c'bbb'dc"]+    ,(,) "/ 'ccc\"d\\dc'\"'\\  b" ["/","'cccd\\dc''\\","b"]+    ,(,) "  '\"/\\cc\\/c '\\\\" ["'/\\cc\\/c '\\\\"]+    ,(,) "\\ \\' ' /d  \"cc\\\\//da\"d'a/a\"ca\\\\\"\\cb c\"d'b 'acb" ["\\","\\'","'","/d","cc\\\\//dad'a/aca\\\\cb","cd'b 'acb"]+    ,(,) "a\"\"d'\"a\"\\ \\c db'da/d\\c\"a/ aa c/db" ["ad'a\\","\\c","db'da/d\\ca/ aa c/db"]+    ,(,) " d\\" ["d\\"]+    ,(,) "d c b'/\\/'\"/'a'aa\"a\"/ad\\/" ["d","c","b'/\\/'/'a'aaa/ad\\/"]+    ,(,) "  a \\' /" ["a","\\'","/"]+    ,(,) "'/ c" ["'/","c"]+    ,(,) "acd 'bcab /ba'daa'/ba/\"dcdadbcacb" ["acd","'bcab","/ba'daa'/ba/dcdadbcacb"]+    ,(,) "a\\\"dd'a c\"a\"\"ac\\" ["a\"dd'a","ca\"ac\\"]+    ,(,) "\"dba /'bb\\ d ba '/c' \"dd\\' cbcd c /b/\\b///" ["dba /'bb\\ d ba '/c' dd\\'","cbcd","c","/b/\\b///"]+    ,(,) "a'c/c \"ccb '/d\\abd/bc  " ["a'c/c","ccb '/d\\abd/bc  "]+    ,(,) "\\da\"\\//add\\\\ c" ["\\da\\//add\\\\ c"]+    ,(,) "c/\\\"//  a/\"ac\"//''ba\"c/\\bc\\\"d\"bc/d" ["c/\"//","a/ac//''bac/\\bc\"dbc/d"]+    ,(,) "/d/ a   dc'\\ \"" ["/d/","a","dc'\\",""]+    ,(,) " \"dc//b\\cd/ \\ac\"b\"b\"d\"\"\"dd\"\" ' a\\'/ \"/'/\\a/abd\\ddd" ["dc//b\\cd/ \\acbbd\"dd","'","a\\'/","/'/\\a/abd\\ddd"]+    ,(,) "\\'  ' d\"b bbc" ["\\'","'","db bbc"]+    ,(,) "'ba\\a'db/bd d\\'b\\ \\/a'da' " ["'ba\\a'db/bd","d\\'b\\","\\/a'da'"]+    ,(,) "\\b\\cc\"\"d' dd ddcb\"d" ["\\b\\ccd'","dd","ddcbd"]+    ,(,) "d\"dc'\\d\"/'\\\"b\\c'c\" db' \\'b/\"a' / da'\"/ab'\\ c\\bc\\//dbcb\\" ["ddc'\\d/'\"b\\c'c db' \\'b/a'","/","da'/ab'\\ c\\bc\\//dbcb\\"]+    ,(,) " b ddbbbbc\"da\\c\"'\\" ["b","ddbbbbcda\\c'\\"]+    ,(,) "b/\"d dacd'/'\\\"''a a /'\\c'b ab\\  dda\\c'abdd'a\"//d \\\\\\ d\"\"" ["b/d dacd'/'\"''a a /'\\c'b ab\\  dda\\c'abdd'a//d","\\\\\\","d"]+    ,(,) "/c\"\" dd'a'/b\\/'\"'/" ["/c","dd'a'/b\\/''/"]+    ,(,) "/\"'\"\"'cc a a\\dd''\\'b" ["/'\"'cc","a","a\\dd''\\'b"]+    ,(,) "c\"dcd''aba\" \" /'" ["cdcd''aba"," /'"]+    ,(,) "'\"/''\\\\d'/ad\\baadabdca\\ /\\'''bd\\/\"'/' aca \\  \\a'\\ cd\"d /bdcd''cac" ["'/''\\\\d'/ad\\baadabdca\\ /\\'''bd\\/'/'","aca","\\","\\a'\\","cdd /bdcd''cac"]+    ,(,) "\" /\"da" [" /da"]+    ,(,) "'\"ca/'d/d/d\\ca\"/\"\" ddac cc\" ''a c''bd\"bc'dc\\/\"b\"a\\\"\"a/\\ " ["'ca/'d/d/d\\ca/","ddac","cc ''a c''bdbc'dc\\/ba\"a/\\ "]+    ,(,) "\\\\d'ad ' ''\"cd/a \"\"\\'\\\"'dc\\" ["\\\\d'ad","'","''cd/a \"\\'\"'dc\\"]+    ,(,) " ab  c'\\a" ["ab","c'\\a"]+    ,(,) "b" ["b"]+    ,(,) "''c dc c\\'d'ab'd\"\\\"cca\"b'da\"dbcdbd\"cd'/d \\cd'\"d  \"\"b cdc''/\\\"b'" ["''c","dc","c\\'d'ab'd\"ccab'dadbcdbdcd'/d","\\cd'd  \"b","cdc''/\"b'"]+    ,(,) " \"'cb dbddbdd/" ["'cb dbddbdd/"]+    ,(,) "a/\"d// dd/cc/\"cc\"d\" d\\/a a \\c\"  \\\\/\"\\ bcc'ac'\"\\c//d\"da/\\aac\\b\"c/'b\"\"bbd/\\" ["a/d// dd/cc/ccd","d\\/a","a","\\c  \\\\/\\","bcc'ac'\\c//dda/\\aac\\bc/'b\"bbd/\\"]+    ,(,) "b\"ddccd\"a\"/ba\"" ["bddccda/ba"]+    ,(,) " \"  c/b/'/bdd  cb d'c a'\"'a d\\\\db//\\\"' c'/'c\\/aa" ["  c/b/'/bdd  cb d'c a''a","d\\\\db//\"'","c'/'c\\/aa"]+    ,(,) "\\caab" ["\\caab"]+    ,(,) "bb\"'\"/d'bad 'd\\/'\\b//\\\\ \\d''c\"c b\\b/\\" ["bb'/d'bad","'d\\/'\\b//\\\\","\\d''cc b\\b/\\"]+    ,(,) " c'a\"  \\cab\"bd\"dcd\"/cb/\"\"b\"b'\"d" ["c'a  \\cabbddcd/cb/bb'd"]+    ,(,) "\\/ \"c'ca" ["\\/","c'ca"]+    ,(,) "  d' /c'bc\"'/'\\\\dca'cc\"'\"''/d cb//'a \"bd ab\"dcaadc\\\"'d\\\"/a\"a\\\"ba//b/ d/dbac/d\\caa\"bc/ " ["d'","/c'bc'/'\\\\dca'cc'''/d cb//'a bd","abdcaadc\"'d\"/aa\"ba//b/","d/dbac/d\\caabc/ "]+    ,(,) "/\"\\db'd/ ca\"ad b\\\\\"cd/a bbc\\ " ["/\\db'd/ caad","b\\cd/a bbc\\ "]+    ,(,) "cdc bd'/\"c''c d \\\"aa \\d\\ bb'b/ /b/a/c'acda\\'\"\"c \"bbbaa/'/a \\aca\"'/ac' " ["cdc","bd'/c''c d \"aa \\d\\ bb'b/ /b/a/c'acda\\'\"c","bbbaa/'/a \\aca'/ac'"]+    ,(,) "ad/'b\\d /cc\"\"ab \\ \"'  ''b\\\"/\\  a\"'d\"\\ddacdbbabb b b  //' acd\"c\\d'd\\b\"'\\\"aaba/bda/c'// \\b" ["ad/'b\\d","/ccab","\\","'  ''b\"/\\  a'd\\ddacdbbabb b b  //' acdc\\d'd\\b'\"aaba/bda/c'// \\b"]+    ,(,) "bac cc \"ac\"/ca/ '\"\" b/b d /cd'\\'bb\" \\ \"b '/ b c ' c''\"a/ad\\ " ["bac","cc","ac/ca/","'","b/b","d","/cd'\\'bb \\ b","'/","b","c","'","c''a/ad\\ "]+    ,(,) "baa'  b'b''\\dab/'c" ["baa'","b'b''\\dab/'c"]+    ,(,) "cb\\\\ " ["cb\\\\"]+    ,(,) "/b'a''d\"b\"   'c'b ba\\'b\" bb" ["/b'a''db","'c'b","ba\\'b bb"]+    ,(,) "b /\"ca\\cbac " ["b","/ca\\cbac "]+    ,(,) " \"\"/\"bcaa\"\"a' \\/bb \"a\\\"'\"" ["/bcaa\"a'","\\/bb","a\"'"]+    ,(,) "\"c /''c\"\\badc/\\daa/\\ c\"a c\\ \\/cab \"b\"\\ ba\"\"/d/cd'a ad'c/ad\"' a\\d/d\\c\\'cdccd/\"a'/\"b///ac\"" ["c /''c\\badc/\\daa/\\","ca c\\ \\/cab b\\ ba\"/d/cd'a","ad'c/ad' a\\d/d\\c\\'cdccd/a'/b///ac"]+    ,(,) "/cbbd\"/b' /dd\"/c\\ca/'\"\\ cc  \\d\"aca/\"b caa\\d\\'\"b'b  dc\"cd\\'c\" 'd/ac\"cacc\"" ["/cbbd/b' /dd/c\\ca/'\\ cc  \\daca/b caa\\d\\'b'b","dccd\\'c","'d/accacc"]+    ,(,) "bc/bd\\ca\\bcacca\"\"\\c/\\ /\"\"a/\"c'//b'\\d/a/'ab/cbd/cacb//b \\d\"aac\\d'\"/" ["bc/bd\\ca\\bcacca\\c/\\","/a/c'//b'\\d/a/'ab/cbd/cacb//b \\daac\\d'/"]+    ,(,) "bbac bdc/d\\\"/db\"dbdb\"a \" /\"/'a\\acacbcc c'//\\//b\"ca\"bcca c\\/aaa/c/bccbccaa  \"\" cdccc/bddcbc c''" ["bbac","bdc/d\"/dbdbdba"," //'a\\acacbcc","c'//\\//bcabcca","c\\/aaa/c/bccbccaa","","cdccc/bddcbc","c''"]+    ]

@@ -1,7 +1,7 @@ cabal-version:      >= 1.6 build-type:         Simple name:               cmdargs-version:            0.8+version:            0.9 license:            BSD3 license-file:       LICENSE category:           Console@@ -41,11 +41,20 @@     default: True     description: Build the test program +flag quotation+    default: True+    description: Build the Quote module+ library     build-depends:         base == 4.*,-        transformers == 0.2.*+        transformers == 0.2.*,+        process >= 1.0 && < 1.2 +    if flag(quotation)+        build-depends: template-haskell+        exposed-modules: System.Console.CmdArgs.Quote+     exposed-modules:         System.Console.CmdArgs         System.Console.CmdArgs.Annotate@@ -54,13 +63,16 @@         System.Console.CmdArgs.GetOpt         System.Console.CmdArgs.Implicit         System.Console.CmdArgs.Text+        System.Console.CmdArgs.Helper         System.Console.CmdArgs.Verbosity      other-modules:         Data.Generics.Any         Data.Generics.Any.Prelude+        System.Console.CmdArgs.Explicit.Complete         System.Console.CmdArgs.Explicit.Help         System.Console.CmdArgs.Explicit.Process+        System.Console.CmdArgs.Explicit.SplitJoin         System.Console.CmdArgs.Explicit.Type         System.Console.CmdArgs.Implicit.Ann         System.Console.CmdArgs.Implicit.Global@@ -87,4 +99,5 @@         System.Console.CmdArgs.Test.Implicit.Maker         System.Console.CmdArgs.Test.Implicit.Tests         System.Console.CmdArgs.Test.Implicit.Util+        System.Console.CmdArgs.Test.SplitJoin         System.Console.CmdArgs.Test.Util