mcm 0.6.4.10 → 0.6.5.0

raw patch · 22 files changed

+144/−66 lines, 22 files

Files

• Action.hs +1/−1
• FileCorrector.hs +1/−1
• Interpret.hs +32/−21
• InterpretState.hs +4/−4
• Parser.hs +3/−6
• ParserTypes.hs +5/−2
• PathToMCM.hs +1/−1
• README.txt +1/−1
• VarsParser.hs +1/−1
• changelog +6/−0
• commands2html.1 +1/−1
• commands2html.hs +2/−2
• copyright +1/−1
• mcm.1 +1/−1
• mcm.cabal +4/−5
• mcm.hs +1/−1
• mcm.vim +26/−1
• mcm2html.1 +1/−1
• mcm2html.hs +8/−4
• mcmtags.1 +7/−1
• mcmtags.hs +37/−10
• mcmtestfiles.tgz binary

@@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories--- Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>+-- Copyright (c) 2013-2017 Anthony Doggett <mcm@interfaces.org.uk> -- -- Licence: --     This program is free software: you can redistribute it and/or modify

@@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories--- Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>+-- Copyright (c) 2013-2017 Anthony Doggett <mcm@interfaces.org.uk> -- -- Licence: --     This program is free software: you can redistribute it and/or modify

@@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories--- Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>+-- Copyright (c) 2013-2017 Anthony Doggett <mcm@interfaces.org.uk> -- -- Licence: --     This program is free software: you can redistribute it and/or modify@@ -21,7 +21,6 @@ import Control.Monad (unless, when) import Data.Either (partitionEithers) import Data.Maybe (fromMaybe, isNothing)-import Data.List (intercalate) import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text.Lazy as T@@ -36,7 +35,7 @@ import FileCorrector (PathType(..), DirType(..), Path, Permissions(..), emptyPermissions, OwnerP(..), GroupP(..)) import InterpretState import Parser (mcmLoadAndParse, mcmParse)-import ParserTypes (Import(..), PackagePath, lookupDefine, Section(..), Define(..), Invocation(..), InvocationArgs(..), CondLocal(..), packagePath, Content(..), Group(..), Separator(..), Prepend(..), Append(..), section, imports, InvocationCmd(..), ExpandedInvocationCmd(..), lookupImport, DefName(..), UnexpandedDefName(..), Ident(..), OptArgs(..), Locals(..), Value(..), MCMFile(..), VarsExpand(..))+import ParserTypes (Import(..), PackagePath, lookupDefine, Section(..), Define(..), Invocation(..), InvocationArgs(..), CondLocal(..), packagePath, Content(..), Group(..), Separator(..), Prepend(..), Append(..), section, imports, InvocationCmd(..), ExpandedInvocationCmd(..), lookupImport, DefName(..), UnexpandedDefName(..), Ident(..), OptArgs(..), Locals(..), Value(..), MCMFile(..), VarsExpand(..),dummyDefName) import VarsParser (expandString)  {- Interpreting stages:@@ -108,18 +107,27 @@ loadSection s0 pp = do     let (SearchPath sp) = getSearchPath s0     fpsect <- keepTrying (loadSect pp) sp-    let fpsect' = fromMaybe ("dummy", MCMFile pp (Section [] Map.empty Map.empty)) fpsect-        (_, s1) = runInterpret s0 (addNewSection pp fpsect')-        is = imports (section $ snd fpsect')-    return (is, s1)+    let (fp, fileOrError) = fromMaybe ("dummy", Right $ MCMFile pp (Section [] Map.empty Map.empty)) fpsect+    return $ runInterpret s0 $ case fileOrError of+        Left es -> do+            pushLocation pp dummyDefName+            mapM_ addError (("Error parsing " ++ fp ++ ":"):es)+            popLocation+            return []+        Right sect -> do+            addNewSection pp (fp, sect)+            return $ imports (section sect)  fullyLoadSectionFromHandle :: FilePath -> Handle -> PackagePath -> State -> IO State fullyLoadSectionFromHandle handleName h pp s0 = do     t <- TextIO.hGetContents h-    loadImports $ snd $ runInterpret s0 $ addNewSection pp $-            case mcmParse t of-                Right a -> (handleName, a)-                Left e -> error $ intercalate "\n" (("Error parsing " ++ handleName ++ ":"):e)+    loadImports $ snd $ runInterpret s0 $ case mcmParse t of+        Right a -> addNewSection pp (handleName, a)+        Left es -> do+            pushLocation pp dummyDefName+            mapM_ addError (("Error parsing " ++ handleName ++ ":"):es)+            popLocation+            return ()  -- Add the given section -- and an error if the requested pp is not among them@@ -136,14 +144,24 @@             return ()         Just _ -> return () +uppercaseConsts :: Map.Map Ident Expander+uppercaseConsts =+            Map.fromList [((Ident . T.pack) "COMMA", Expanded $ T.pack ",")+                         ,((Ident . T.pack) "NEWLINE", Expanded $ T.pack "\n")+                         ,((Ident . T.pack) "SPACE", Expanded $ T.pack " ")+                         ,((Ident . T.pack) "TAB", Expanded $ T.pack "\t")+                         ]+ -- Add the given section, or an error that it's aleady defined addSectionOrError :: MCMFile -> Interpret () addSectionOrError (MCMFile name sect@(Section _ plets _)) = do     s0 <- lookupSection name     case s0 of         Nothing -> do-            plets' <- solve' name (AllLocals Map.empty) plets []+            pushLocation name dummyDefName+            plets' <- solve' name (AllLocals uppercaseConsts) plets []             addSection (name, PLSection sect plets')+            popLocation         Just _ -> addError $ "Section " ++ show name ++ " already defined."  -- Try the given action repeatedly until one succeeds or all fail@@ -155,7 +173,7 @@         Just _ -> return r         Nothing -> keepTrying f xs -loadSect :: PackagePath -> FilePath -> IO (Maybe (FilePath, MCMFile))+loadSect :: PackagePath -> FilePath -> IO (Maybe (FilePath, Either [String] MCMFile)) loadSect pp fp = do     let f = combine fp (packagePath pp)     e <- doesFileExist f@@ -173,15 +191,8 @@         givenargs = Map.keysSet . fromArgs $ args'     checkForExtraArgs expectedargs givenargs     combined <- unionLocals (fromArgs args') plets-    let uppercaseConsts =-            Map.fromList [((Ident . T.pack) "COMMA", Expanded $ T.pack ",")-                         ,((Ident . T.pack) "NEWLINE", Expanded $ T.pack "\n")-                         ,((Ident . T.pack) "SPACE", Expanded $ T.pack " ")-                         ,((Ident . T.pack) "TAB", Expanded $ T.pack "\t")-                         ]-        combined' = Args $ combined `Map.union` uppercaseConsts     pushLocation pp dName-    al <- solve pp d combined'+    al <- solve pp d (Args combined)     mapM_ (invoke pp al) (defInvokes d)     popLocation 

@@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories--- Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>+-- Copyright (c) 2013-2017 Anthony Doggett <mcm@interfaces.org.uk> -- -- Licence: --     This program is free software: you can redistribute it and/or modify@@ -27,7 +27,7 @@ import qualified Data.Text.Lazy as T  import FileCorrector(theRootDir,Path,addPath,PathType, Permissions)-import ParserTypes(Group(..),Section,Prepend,Append,Separator,PackagePath, dummyPP,imports,Import,ExpandedInvocationCmd,Ident(..),DefName(..))+import ParserTypes(Group(..),Section,Prepend,Append,Separator,PackagePath, dummyPP,imports,Import,ExpandedInvocationCmd,Ident(..),DefName(..),dummyDefName) import System.FilePath(normalise,dropTrailingPathSeparator,combine) import System.Posix.User(UserEntry(userName, userID), GroupEntry(groupName, groupID)) import System.Posix.Types (UserID, GroupID)@@ -189,7 +189,7 @@ initState users groups sp r =     State theRootDir Map.empty sp r' [] [] Map.empty Set.empty Map.empty Set.empty [l0] us gs Set.empty Set.empty Set.empty     where-        l0 = Location dummyPP $ (DefName . T.pack) "<init>"+        l0 = Location dummyPP dummyDefName         r' = dropTrailingPathSeparator $ normalise r         us = Map.fromList (map ((T.pack . userName) &&& userID ) users)         gs = Map.fromList (map ((T.pack . groupName) &&& groupID) groups)@@ -303,7 +303,7 @@         addMentioned pis = (concatMap mentionedfragments pis, pis)          mentionedfragments :: PendingInvocation -> [(PackagePath, Group)]-        mentionedfragments (PI {piArgs=Args as}) = mentionedfragments' (Map.elems as)+        mentionedfragments PI {piArgs=Args as} = mentionedfragments' (Map.elems as)         mentionedfragments' [] = []         mentionedfragments' (EFragments ppF g _ _ _:as) = (ppF,g):mentionedfragments' as         mentionedfragments' (EMulti xs:as) = mentionedfragments' xs ++ mentionedfragments' as

@@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories--- Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>+-- Copyright (c) 2013-2017 Anthony Doggett <mcm@interfaces.org.uk> -- -- Licence: --     This program is free software: you can redistribute it and/or modify@@ -20,7 +20,6 @@  import Control.Monad(unless, when) import Data.Char (isLower, isUpper, isAlpha, isAlphaNum, isSpace, generalCategory, GeneralCategory(..))-import Data.List (intercalate) import Data.Int (Int64) import Data.Foldable (foldlM) import qualified Data.Map as Map@@ -206,12 +205,10 @@     (Right _, State(_, es), v) | T.null v -> Left $ reverse es     (Right _, State(_, es), v) -> Left (("Failed to parse end: " ++ T.unpack v):reverse es) -mcmLoadAndParse :: FilePath -> IO MCMFile+mcmLoadAndParse :: FilePath -> IO (Either [String] MCMFile) mcmLoadAndParse f = do     t <- TextIO.readFile f-    case mcmParse t of-        Right s -> return s-        Left e -> error $ intercalate "\n" (("Error parsing " ++ f ++ ":") : e)+    return $ mcmParse t  pFile :: P MCMFile pFile = do

@@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories--- Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>+-- Copyright (c) 2013-2017 Anthony Doggett <mcm@interfaces.org.uk> -- -- Licence: --     This program is free software: you can redistribute it and/or modify@@ -15,7 +15,7 @@ --     You should have received a copy of the GNU General Public License --     along with this program.  If not, see <http://www.gnu.org/licenses/>. -module ParserTypes (Import(..), PackagePath(..), dummyPP, packagePath, Ident(..), Value(..), UnexpandedDefName(..), DefName(..), Locals(..), OptArgs(..), CondLocal(..), Define(..), Section(..), section, imports, lookupDefine, lookupImport, InvocationCmd(..), ExpandedInvocationCmd(..), InvocationArgs(..), MCMFile(..), Invocation(..), Group(..), Separator(..), Prepend(..), Append(..), ContentLine(..), Content(..), ContentType(..), toContent, VarsExpand(..)) where+module ParserTypes (Import(..), PackagePath(..), dummyPP, packagePath, Ident(..), Value(..), UnexpandedDefName(..), DefName(..), dummyDefName, Locals(..), OptArgs(..), CondLocal(..), Define(..), Section(..), section, imports, lookupDefine, lookupImport, InvocationCmd(..), ExpandedInvocationCmd(..), InvocationArgs(..), MCMFile(..), Invocation(..), Group(..), Separator(..), Prepend(..), Append(..), ContentLine(..), Content(..), ContentType(..), toContent, VarsExpand(..)) where  import Data.Char (isAlpha) import Data.List (find, intercalate)@@ -54,6 +54,9 @@ -- UnexpandedDefName is like DefName but can contain one or more @-vars that need expanding newtype UnexpandedDefName = UnexpandedDefName {fromUnexpandedDefName :: T.Text}     deriving (Eq, Ord)++dummyDefName :: DefName+dummyDefName = (DefName . T.pack) "<init>"  instance Show Ident where     show (Ident i) = T.unpack i

@@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories--- Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>+-- Copyright (c) 2013-2017 Anthony Doggett <mcm@interfaces.org.uk> -- -- Licence: --     This program is free software: you can redistribute it and/or modify

@@ -1,5 +1,5 @@ MCM - Machine Configuration Manager; manages the contents of files and directories-Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>+Copyright (c) 2013-2017 Anthony Doggett <mcm@interfaces.org.uk> http://interfaces.org.uk/mcm  Written for Debian and friends (though as yet only really tested on Debian and

@@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories--- Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>+-- Copyright (c) 2013-2017 Anthony Doggett <mcm@interfaces.org.uk> -- -- Licence: --     This program is free software: you can redistribute it and/or modify

@@ -1,3 +1,9 @@+[0.6.5.0] 2017-01-09+    - enable mcmtags to generate qualified tags (e.g. Admin.Packages.add)+    - enhance mcm.vim to make use of qualified tags+[0.6.4.12] 2016-11-29+    - clean up emission of parse errors+    - permit use of @SPACE and other uppercase constants in package lets [0.6.4.10] 2016-06-28     - improve "mcm --help" output     - fix why-can-immediate-locals-not-have-underscores bug

@@ -56,6 +56,6 @@ .SH REPORTING BUGS Please email the author at the above address, preferably with sufficient information to reproduce the bug. .SH COPYRIGHT-Copyright (c) 2015-2016 Anthony Doggett+Copyright (c) 2015-2017 Anthony Doggett .PP <http://interfaces.org.uk/mcm>

@@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -- MCM - Machine Configuration Manager; manages the contents of files and directories--- Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>+-- Copyright (c) 2013-2017 Anthony Doggett <mcm@interfaces.org.uk> -- -- Licence: --     This program is free software: you can redistribute it and/or modify@@ -211,7 +211,7 @@     deriving Show  colourwith :: ColourType -> H5.Html -> H5.Html-colourwith c h = H5.span H5.! class_ (fromString . show $ c) $ h+colourwith c = H5.span H5.! class_ (fromString . show $ c)  type P = Parser Char 

@@ -1,5 +1,5 @@ MCM - Machine Configuration Manager; manages the contents of files and directories-Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>+Copyright (c) 2013-2017 Anthony Doggett <mcm@interfaces.org.uk>  Licence:     This program is free software: you can redistribute it and/or modify

@@ -133,7 +133,7 @@ .SH REPORTING BUGS Please email the author at the above address, preferably with sufficient information to reproduce the bug. .SH COPYRIGHT-Copyright (c) 2014-2016 Anthony Doggett+Copyright (c) 2014-2017 Anthony Doggett .PP <http://interfaces.org.uk/mcm> .SH SEE ALSO

@@ -1,8 +1,7 @@ name: mcm-version: 0.6.4.10-synopsis: Machine Configuration Manager-description:- Machine Configuration Manager (MCM) manages the contents of files and+version: 0.6.5.0+synopsis: Manages the contents of files and directories+description:  Machine Configuration Manager (MCM) manages the contents of files and  directories.  One or more of those files can be a script, enabling MCM to  control anything.  Typically MCM is used to manage the configurations of user  profiles, machines, systems and systems of systems.@@ -12,7 +11,7 @@ license-file: LICENCE author: Anthony Doggett <mcm@interfaces.org.uk> maintainer: Anthony Doggett <mcm@interfaces.org.uk>-copyright: (c) 2013-2016 Anthony Doggett+copyright: (c) 2013-2017 Anthony Doggett homepage: http://interfaces.org.uk/mcm category: Language, System, Text stability: alpha

@@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories--- Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>+-- Copyright (c) 2013-2017 Anthony Doggett <mcm@interfaces.org.uk> -- -- Licence: --     This program is free software: you can redistribute it and/or modify

@@ -2,7 +2,7 @@ " Maintainer:  Anthony Doggett (MCM@interfaces.org.uk) " " MCM - Machine Configuration Manager; manages the contents of files and directories-" Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>+" Copyright (c) 2013-2017 Anthony Doggett <mcm@interfaces.org.uk> " " Licence: "     This program is free software: you can redistribute it and/or modify@@ -120,6 +120,31 @@    delcommand HiLink endif++if !exists("g:qualifiedtagjump")+ function MCM_QualifiedTagJump()+   let save_cursor = getcurpos()+   let cWord = expand("<cWORD>")+   let id = matchstr(cWord, "\\.\\zs\\S\\+\\ze")+   let prefix = matchstr(cWord, "^[^.]\\+")+   call cursor(1,1)+   let mcmline = search('^MCM ','n')+   let thispackage = matchstr(getline(mcmline), "^MCM \\zs\\S\\+\\ze")+   let importline = search('^import \S\+ as ' . prefix . '$', 'nW')+   let fullnameprefix = matchstr(getline(importline), "^import \\zs\\S\\+\\ze")+   if prefix == ""+     let fulltag = thispackage . "." . id+   elseif id == ""+     let fulltag = fullnameprefix+   else+     let fulltag = fullnameprefix . "." . id+   endif+   call setpos('.', save_cursor)+   execute 'tag' fnameescape(fulltag)+ endfunction+ let g:qualifiedtagjump = "mcm"+endif+map <C-]> :call MCM_QualifiedTagJump()<Return>  setlocal iskeyword=a-z,A-Z,_,48-57 setlocal softtabstop=4

@@ -56,7 +56,7 @@ .SH REPORTING BUGS Please email the author at the above address, preferably with sufficient information to reproduce the bug. .SH COPYRIGHT-Copyright (c) 2014-2016 Anthony Doggett+Copyright (c) 2014-2017 Anthony Doggett .PP <http://interfaces.org.uk/mcm> .SH SEE ALSO

@@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -- MCM - Machine Configuration Manager; manages the contents of files and directories--- Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>+-- Copyright (c) 2013-2017 Anthony Doggett <mcm@interfaces.org.uk> -- -- Licence: --     This program is free software: you can redistribute it and/or modify@@ -65,8 +65,12 @@     when (extension == "") $ error "Extension can't be empty!"     let outfilename = infilename ++ extension     putStrLn $ "Writing " ++ outfilename-    f <- mcmLoadAndParse infilename-    B.writeFile outfilename $ Render_Utf8.renderHtml . wrapper $ toHtml f+    r <- mcmLoadAndParse infilename+    case r of+        Left es -> do+            mapM_ putStrLn es+            exitFailure+        Right f -> B.writeFile outfilename $ Render_Utf8.renderHtml . wrapper $ toHtml f  data Options = Options     {optOutFilenameExtension :: String@@ -148,7 +152,7 @@     deriving Show  colourwith :: ColourType -> H5.Html -> H5.Html-colourwith c h = H5.span H5.! class_ (fromString . show $ c) $ h+colourwith c = H5.span H5.! class_ (fromString . show $ c)  instance ToMarkup MCMFile where     toMarkup (MCMFile pp s) = do

@@ -16,6 +16,12 @@ .TP \fB\-V\fR, \fB\-\-version\fR show version+.TP+\fB\-t\fR \fIsimple\fR|\fIqualified\fR|\fIboth\fR, \fB\-\-tag\-type\fR=\fIsimple\fR|\fIqualified\fR|\fIboth\fR+type of tag to output (default = \fIboth\fR).+\fIsimple\fR works with all editors that support tags.+\fIqualified\fR outputs qualified tags (e.g. "Admin.Packages.add" instead of just "add").  Use of these tags requires additional support in your editor (e.g. with the supplied mcm.vim).+\fIboth\fR outputs both simple and qualified tags.  This produces a larger-than-necessary tags file but should work in all situations. .SH EXAMPLES Generate ./tags from all *.mcm files found below the current directory: .IP@@ -29,7 +35,7 @@ .SH REPORTING BUGS Please email the author at the above address, preferably with sufficient information to reproduce the bug. .SH COPYRIGHT-Copyright (c) 2014-2016 Anthony Doggett+Copyright (c) 2014-2017 Anthony Doggett .PP <http://interfaces.org.uk/mcm> .SH SEE ALSO

@@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories--- Copyright (c) 2013-2016 Anthony Doggett <mcm@interfaces.org.uk>+-- Copyright (c) 2013-2017 Anthony Doggett <mcm@interfaces.org.uk> -- -- Licence: --     This program is free software: you can redistribute it and/or modify@@ -28,7 +28,7 @@  import Control.Monad (filterM, unless) import Data.Char (isAsciiUpper)-import Data.List (isSuffixOf, intercalate, sort, foldl')+import Data.List (isSuffixOf, intercalate, sort, foldl', nub) import Data.Version (showVersion) import qualified Data.Map as Map import qualified Data.Text.Lazy as T@@ -46,6 +46,8 @@                 ,"or if directories given as arguments, below those directories."                 ,"The resulting tags are written to ./tags."                 ,"Print warnings for any files that fail to parse."+                ,""+                ,"TAGTYPE\t\tsimple|qualified|both"                 ]  toWarn :: FilePath -> String@@ -61,11 +63,26 @@ makeTag :: FilePath -> String -> String -> String makeTag f n ex_cmd = n ++ "\t" ++ f ++ "\t" ++ ex_cmd -toTags :: (FilePath, MCMFile) -> [String]-toTags (f, MCMFile pp (Section _ _ ds)) = ppTag:map dsTag (Map.elems ds)+toTags :: TagType -> (FilePath, MCMFile) -> [String]+toTags tagtype (f, MCMFile pp (Section _ _ ds)) = makePTags ++ concatMap makeDTags (Map.elems ds)     where+        makePTags = case tagtype of+                        TTsimple -> [ppTag]+                        TTqualified -> [ppFullTag]+                        TTboth -> nub [ppTag, ppFullTag]         ppTag = makeTag f (lastBitOfPath (show pp)) "/^MCM/"-        dsTag d = makeTag f (strDefName d) ("/^define " ++ strDefName d ++ "(/")+        ppFullTag = makeTag f (show pp) "/^MCM/"+        makeDTags :: Define -> [String]+        makeDTags d = case tagtype of+                        TTsimple -> [dsTag d]+                        TTqualified -> [qualTag d]+                        TTboth -> [dsTag d, qualTag d]+        dsTag :: Define -> String+        dsTag d = makeTag f (strDefName d) (definesearch d)+        qualTag :: Define -> String+        qualTag d = makeTag f (show pp ++ '.':strDefName d) (definesearch d)+        definesearch :: Define -> String+        definesearch d = "/^define " ++ strDefName d ++ "(/"         lastBitOfPath :: String -> String         lastBitOfPath = reverse . takeWhile (/= '.') . reverse         strDefName = T.unpack . fromDefName . defName@@ -98,28 +115,32 @@     args <- getArgs     let (actions, nonOpts, msgs) = getOpt Permute options args     unless (null msgs) $ error $ concat msgs ++ usageInfo usage options-    _ <- foldl' (>>=) (return defaultOptions) actions+    opts <- foldl' (>>=) (return defaultOptions) actions+    let Options {optTagType = tagtype} = opts     let toRecurse = case nonOpts of                         [] -> ["."]-                        _ -> args+                        ps -> ps     toParse <- mapM findMcm toRecurse     let toParse' = concat toParse     parsed <- mapM tryParse toParse'     let fparsed = zip toParse' parsed     let (bad, good) = splitParsed fparsed-        tags = sort $ concatMap toTags good+        tags = sort $ concatMap (toTags tagtype) good     mapM_ (putStrLn . toWarn) bad     writeFile "tags" $ intercalate "\n" tags     return () -data Options = Options {}+data TagType = TTsimple | TTqualified | TTboth +data Options = Options {optTagType :: TagType}+ defaultOptions :: Options-defaultOptions = Options {}+defaultOptions = Options {optTagType = TTboth}  options :: [OptDescr (Options -> IO Options)] options = [Option "V" ["version"] (NoArg displayVersion) "show version and exit"           ,Option "h" ["help"] (NoArg justHelp) "show this help and exit"+          ,Option "t" ["tag-type"] (ReqArg tagType "TAGTYPE") "type of tag to output (default = \"both\")"           ]  displayVersion :: Options -> IO Options@@ -131,3 +152,9 @@ justHelp _ = do     putStrLn $ usageInfo usage options     exitSuccess++tagType :: String -> Options -> IO Options+tagType "simple" opt = return opt {optTagType = TTsimple}+tagType "qualified" opt = return opt {optTagType = TTqualified}+tagType "both" opt = return opt {optTagType = TTboth}+tagType tt _ = error ("Unrecognised tag type: " ++ tt ++ "\n" ++ usageInfo usage options)

binary file changed (23397 → 23881 bytes)