diff --git a/Action.hs b/Action.hs --- a/Action.hs +++ b/Action.hs @@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories --- Copyright (c) 2013-2016 Anthony Doggett +-- Copyright (c) 2013-2017 Anthony Doggett -- -- Licence: -- This program is free software: you can redistribute it and/or modify diff --git a/FileCorrector.hs b/FileCorrector.hs --- a/FileCorrector.hs +++ b/FileCorrector.hs @@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories --- Copyright (c) 2013-2016 Anthony Doggett +-- Copyright (c) 2013-2017 Anthony Doggett -- -- Licence: -- This program is free software: you can redistribute it and/or modify diff --git a/Interpret.hs b/Interpret.hs --- a/Interpret.hs +++ b/Interpret.hs @@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories --- Copyright (c) 2013-2016 Anthony Doggett +-- Copyright (c) 2013-2017 Anthony Doggett -- -- 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 diff --git a/InterpretState.hs b/InterpretState.hs --- a/InterpretState.hs +++ b/InterpretState.hs @@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories --- Copyright (c) 2013-2016 Anthony Doggett +-- Copyright (c) 2013-2017 Anthony Doggett -- -- 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) "" + 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 diff --git a/Parser.hs b/Parser.hs --- a/Parser.hs +++ b/Parser.hs @@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories --- Copyright (c) 2013-2016 Anthony Doggett +-- Copyright (c) 2013-2017 Anthony Doggett -- -- 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 diff --git a/ParserTypes.hs b/ParserTypes.hs --- a/ParserTypes.hs +++ b/ParserTypes.hs @@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories --- Copyright (c) 2013-2016 Anthony Doggett +-- Copyright (c) 2013-2017 Anthony Doggett -- -- 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 . -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) "" instance Show Ident where show (Ident i) = T.unpack i diff --git a/PathToMCM.hs b/PathToMCM.hs --- a/PathToMCM.hs +++ b/PathToMCM.hs @@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories --- Copyright (c) 2013-2016 Anthony Doggett +-- Copyright (c) 2013-2017 Anthony Doggett -- -- Licence: -- This program is free software: you can redistribute it and/or modify diff --git a/README.txt b/README.txt --- a/README.txt +++ b/README.txt @@ -1,5 +1,5 @@ MCM - Machine Configuration Manager; manages the contents of files and directories -Copyright (c) 2013-2016 Anthony Doggett +Copyright (c) 2013-2017 Anthony Doggett http://interfaces.org.uk/mcm Written for Debian and friends (though as yet only really tested on Debian and diff --git a/VarsParser.hs b/VarsParser.hs --- a/VarsParser.hs +++ b/VarsParser.hs @@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories --- Copyright (c) 2013-2016 Anthony Doggett +-- Copyright (c) 2013-2017 Anthony Doggett -- -- Licence: -- This program is free software: you can redistribute it and/or modify diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -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 diff --git a/commands2html.1 b/commands2html.1 --- a/commands2html.1 +++ b/commands2html.1 @@ -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 diff --git a/commands2html.hs b/commands2html.hs --- a/commands2html.hs +++ b/commands2html.hs @@ -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 +-- Copyright (c) 2013-2017 Anthony Doggett -- -- 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 diff --git a/copyright b/copyright --- a/copyright +++ b/copyright @@ -1,5 +1,5 @@ MCM - Machine Configuration Manager; manages the contents of files and directories -Copyright (c) 2013-2016 Anthony Doggett +Copyright (c) 2013-2017 Anthony Doggett Licence: This program is free software: you can redistribute it and/or modify diff --git a/mcm.1 b/mcm.1 --- a/mcm.1 +++ b/mcm.1 @@ -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 .SH SEE ALSO diff --git a/mcm.cabal b/mcm.cabal --- a/mcm.cabal +++ b/mcm.cabal @@ -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 maintainer: Anthony Doggett -copyright: (c) 2013-2016 Anthony Doggett +copyright: (c) 2013-2017 Anthony Doggett homepage: http://interfaces.org.uk/mcm category: Language, System, Text stability: alpha diff --git a/mcm.hs b/mcm.hs --- a/mcm.hs +++ b/mcm.hs @@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories --- Copyright (c) 2013-2016 Anthony Doggett +-- Copyright (c) 2013-2017 Anthony Doggett -- -- Licence: -- This program is free software: you can redistribute it and/or modify diff --git a/mcm.vim b/mcm.vim --- a/mcm.vim +++ b/mcm.vim @@ -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 +" Copyright (c) 2013-2017 Anthony Doggett " " 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("") + 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 :call MCM_QualifiedTagJump() setlocal iskeyword=a-z,A-Z,_,48-57 setlocal softtabstop=4 diff --git a/mcm2html.1 b/mcm2html.1 --- a/mcm2html.1 +++ b/mcm2html.1 @@ -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 .SH SEE ALSO diff --git a/mcm2html.hs b/mcm2html.hs --- a/mcm2html.hs +++ b/mcm2html.hs @@ -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 +-- Copyright (c) 2013-2017 Anthony Doggett -- -- 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 diff --git a/mcmtags.1 b/mcmtags.1 --- a/mcmtags.1 +++ b/mcmtags.1 @@ -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 .SH SEE ALSO diff --git a/mcmtags.hs b/mcmtags.hs --- a/mcmtags.hs +++ b/mcmtags.hs @@ -1,5 +1,5 @@ -- MCM - Machine Configuration Manager; manages the contents of files and directories --- Copyright (c) 2013-2016 Anthony Doggett +-- Copyright (c) 2013-2017 Anthony Doggett -- -- 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) diff --git a/mcmtestfiles.tgz b/mcmtestfiles.tgz Binary files a/mcmtestfiles.tgz and b/mcmtestfiles.tgz differ