diff --git a/System/Console/CmdArgs/Explicit.hs b/System/Console/CmdArgs/Explicit.hs --- a/System/Console/CmdArgs/Explicit.hs +++ b/System/Console/CmdArgs/Explicit.hs @@ -112,7 +112,7 @@ let var = mplus (lookup ("CMDARGS_HELPER_" ++ show (map toUpper $ head $ modeNames m ++ [nam])) env) (lookup "CMDARGS_HELPER" env) case var of - Nothing -> run =<< (if modeExpandAt m then expandArgsAt else return) =<< getArgs + Nothing -> run =<< expandArgsAt =<< getArgs Just cmd -> do res <- execute cmd m [] case res of diff --git a/System/Console/CmdArgs/Explicit/ExpandArgsAt.hs b/System/Console/CmdArgs/Explicit/ExpandArgsAt.hs --- a/System/Console/CmdArgs/Explicit/ExpandArgsAt.hs +++ b/System/Console/CmdArgs/Explicit/ExpandArgsAt.hs @@ -11,15 +11,9 @@ -- -- Any @\@@ directives in the files will be recursively expanded (raising an error -- if there is infinite recursion). --- --- To supress @\@@ expansion, pass any @\@@ arguments after @--@. expandArgsAt :: [String] -> IO [String] -expandArgsAt args = do - ebefore <- mapM (f [] ".") before - return $ concat ebefore ++ after +expandArgsAt = fmap concat . mapM (f [] ".") where - (before,after) = break (== "--") args - f seen dir ('@':x) | x `elem` seen = error $ unlines $ "System.Console.CmdArgs.Explicit.expandArgsAt, recursion in @ directives:" : diff --git a/System/Console/CmdArgs/Explicit/Type.hs b/System/Console/CmdArgs/Explicit/Type.hs --- a/System/Console/CmdArgs/Explicit/Type.hs +++ b/System/Console/CmdArgs/Explicit/Type.hs @@ -70,16 +70,12 @@ -- * A list of flags ('modeGroupFlags') -- -- * Optionally an unnamed argument ('modeArgs') --- --- To produce the help information for a mode, either use 'helpText' or 'show'. data Mode a = Mode {modeGroupModes :: Group (Mode a) -- ^ The available sub-modes ,modeNames :: [Name] -- ^ The names assigned to this mode (for the root mode, this name is used as the program name) ,modeValue :: a -- ^ Value to start with ,modeCheck :: a -> Either String a -- ^ Check the value reprsented by a mode is correct, after applying all flags ,modeReform :: a -> Maybe [String] -- ^ Given a value, try to generate the input arguments. - ,modeExpandAt :: Bool -- ^ Expand @\@@ arguments with 'expandArgsAt', defaults to 'True', only applied if using an 'IO' processing function. - -- Only the root 'Mode's value will be used. ,modeHelp :: Help -- ^ Help text ,modeHelpSuffix :: [String] -- ^ A longer help suffix displayed after a mode ,modeArgs :: ([Arg a], Maybe (Arg a)) -- ^ The unnamed arguments, a series of arguments, followed optionally by one for all remaining slots @@ -208,7 +204,7 @@ -- | Create an empty mode specifying only 'modeValue'. All other fields will usually be populated -- using record updates. modeEmpty :: a -> Mode a -modeEmpty x = Mode mempty [] x Right (const Nothing) True "" [] ([],Nothing) mempty +modeEmpty x = Mode mempty [] x Right (const Nothing) "" [] ([],Nothing) mempty -- | Create a mode with a name, an initial value, some help text, a way of processing arguments -- and a list of flags. diff --git a/System/Console/CmdArgs/Helper.hs b/System/Console/CmdArgs/Helper.hs --- a/System/Console/CmdArgs/Helper.hs +++ b/System/Console/CmdArgs/Helper.hs @@ -276,8 +276,7 @@ ,add "modeGroupFlags" modeGroupFlags ,add "modeValue" modeValue ,add "modeCheck" modeCheck - ,add "modeReform" modeReform - ,add "modeExpandAt" modeExpandAt] + ,add "modeReform" modeReform] unpack x = let y = ctor "Mode" x in Mode {modeGroupModes = get "modeGroupModes" y ,modeNames = get "modeNames" y @@ -287,8 +286,7 @@ ,modeGroupFlags = get "modeGroupFlags" y ,modeValue = get "modeValue" y ,modeCheck = get "modeCheck" y - ,modeReform = get "modeReform" y - ,modeExpandAt = get "modeExpandAt" y} + ,modeReform = get "modeReform" y} instance Packer a => Packer (Flag a) where pack Flag{..} = Ctor "Flag" diff --git a/System/Console/CmdArgs/Implicit/Ann.hs b/System/Console/CmdArgs/Implicit/Ann.hs --- a/System/Console/CmdArgs/Implicit/Ann.hs +++ b/System/Console/CmdArgs/Implicit/Ann.hs @@ -26,5 +26,4 @@ | ProgHelpArg [Ann] | ProgVersionArg [Ann] | ProgVerbosityArgs [Ann] [Ann] - | ProgNoAtExpand deriving (Eq,Ord,Show,Data,Typeable) diff --git a/System/Console/CmdArgs/Implicit/Global.hs b/System/Console/CmdArgs/Implicit/Global.hs --- a/System/Console/CmdArgs/Implicit/Global.hs +++ b/System/Console/CmdArgs/Implicit/Global.hs @@ -19,14 +19,8 @@ global :: Prog_ -> Mode (CmdArgs Any) -global x = setReform (reform y) $ setHelp y $ setProgOpts x $ collapse $ assignGroups y +global x = setReform (reform y) $ setHelp y $ collapse $ assignGroups y where y = assignNames $ extraFlags x - - -setProgOpts :: Prog_ -> Mode a -> Mode a -setProgOpts p m = m{modeExpandAt = False -- not $ progNoAtExpand p - ,modeGroupModes = fmap (setProgOpts p) $ modeGroupModes m} - --------------------------------------------------------------------- -- COLLAPSE THE FLAGS/MODES UPWARDS diff --git a/System/Console/CmdArgs/Implicit/Local.hs b/System/Console/CmdArgs/Implicit/Local.hs --- a/System/Console/CmdArgs/Implicit/Local.hs +++ b/System/Console/CmdArgs/Implicit/Local.hs @@ -30,10 +30,9 @@ ,progVerbosityArgs :: (Maybe Builtin_, Maybe Builtin_) -- (verbose, quiet) ,progHelpArg :: Maybe Builtin_ ,progVersionArg :: Maybe Builtin_ - ,progNoAtExpand :: Bool } deriving Show instance Default Prog_ where - def = Prog_ def def def def def (Just def) (Just def) def + def = Prog_ def def def def def (Just def) (Just def) progOutput f x = fromMaybe ["The " ++ progProgram x ++ " program"] $ (builtinSummary =<< f x) `mplus` progSummary x @@ -154,7 +153,6 @@ progAnn (ProgHelpArg a) x = x{progHelpArg = builtinAnns (progHelpArg x) a} progAnn (ProgVersionArg a) x = x{progVersionArg = builtinAnns (progVersionArg x) a} progAnn (ProgVerbosityArgs a b) x = x{progVerbosityArgs=(builtinAnns (Just $ fromMaybe def $ fst $ progVerbosityArgs x) a, builtinAnns (Just $ fromMaybe def $ snd $ progVerbosityArgs x) b)} -progAnn ProgNoAtExpand x = x{progNoAtExpand=True} progAnn a x | length (progModes x) == 1 = x{progModes = map (modeAnn a) $ progModes x} progAnn a x = err "program" $ show a diff --git a/System/Console/CmdArgs/Implicit/UI.hs b/System/Console/CmdArgs/Implicit/UI.hs --- a/System/Console/CmdArgs/Implicit/UI.hs +++ b/System/Console/CmdArgs/Implicit/UI.hs @@ -208,13 +208,3 @@ -- > Sample{..} &= verbosityArgs [ignore] [name "silent", explicit] verbosityArgs :: [Ann] -> [Ann] -> Ann verbosityArgs = ProgVerbosityArgs - - --- | Program: \"Turn off \@ expansion.\" --- --- Usually arguments starting with \@ are treated as a file containing --- a set of arguments. This annotation turns off that behaviour. --- --- > Sample{..} &= noAtExpand -noAtExpand :: Ann -noAtExpand = ProgNoAtExpand diff --git a/System/Console/CmdArgs/Test/Implicit/Tests.hs b/System/Console/CmdArgs/Test/Implicit/Tests.hs --- a/System/Console/CmdArgs/Test/Implicit/Tests.hs +++ b/System/Console/CmdArgs/Test/Implicit/Tests.hs @@ -301,19 +301,7 @@ ["--test16a=5"] === Test16 (MyInt 5) [] ["--test16b=5","--test16b=82"] === Test16 (MyInt 12) [MyInt 5, MyInt 82] --- #552, @ directives not expanded after -- symbols --- not actually checked because this path doesn't go through processArgs -data Test17 = Test17 {test17_ :: [String]} deriving (Eq,Show,Data,Typeable) -mode17 = cmdArgsMode $ Test17 ([] &= args) &= noAtExpand - -test17 = do - let Tester{..} = tester "Test17" mode17 - [] === Test17 [] - ["test","of","this"] === Test17 ["test","of","this"] - ["test","--","@foo"] === Test17 ["test","@foo"] - - -- For some reason, these must be at the end, otherwise the Template Haskell -- stage restriction kicks in. @@ -322,7 +310,7 @@ 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, toDemo mode17] + ,toDemo mode13, toDemo mode14, toDemo mode15, toDemo mode16] where f i x = x{modeHelp = "Testing various corner cases (" ++ show i ++ ")"} diff --git a/cmdargs.cabal b/cmdargs.cabal --- a/cmdargs.cabal +++ b/cmdargs.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.6 build-type: Simple name: cmdargs -version: 0.9.6 +version: 0.9.7 license: BSD3 license-file: LICENSE category: Console @@ -88,8 +88,6 @@ executable cmdargs main-is: Main.hs - if flag(quotation) - extensions: TemplateHaskell if flag(testprog) && flag(quotation) buildable: True else