[VersionTool uses darcs Manuel M T Chakravarty **20060607004828] { hunk ./Config.hs.in 51 -versnum = "@VERSION@" -versnick = "@VERSNICK@" -date = "@VERSDATE@" -version = name ++ ", version " ++ versnum ++ " " ++ versnick ++ ", " ++ date +versnum = @VERSION@ +versnick = @VERSNICK@ +versdate = @VERSDATE@ +patchlevel = @PATCHLEVEL@ +context = @CONTEXT@ +confdate = @CONFDATE@ +version = name ++ ", version " ++ versnum ++ " (" ++ patchlevel ++ ") " ++ + versnick ++ ", " ++ versdate +exactvers = version ++ "\nConfigured " ++ confdate ++ " in context:\n" ++ + context hunk ./VersionTool.hs 3 --- |Tool to insert version information into program source +-- |Tool to insert version information into darcs-controlled program source. hunk ./VersionTool.hs 7 --- License: BSD3 +-- License: BSD3 hunk ./VersionTool.hs 14 --- to VersionTool. If that file's name is `Config.hs', there must be a --- template file `Config.hs.in' containing version information markers where +-- to VersionTool. If that file's name is `Version.hs', there must be a +-- template file `Version.hs.in' containing version information markers where hunk ./VersionTool.hs 19 --- VERSION -- version number, typically in XX.YY.ZZ format --- VERSNICK -- version nickname, a string that may contain white space --- VERSDATE -- date of version in DD MMM YYYY format (MMM is alpha) --- +-- @VERSION@ -- version number, typically in XX.YY.ZZ format +-- (from `Version' entry in Cabal file) +-- @VERSNICK@ -- version nickname, a string that may contain white space +-- (from non-standard `--Versnick' entry in Cabal file) +-- @VERSDATE@ -- date of version, typically in DD MMM YYYY format +-- (from non-standard `--Versdate' entry in Cabal file) +-- @PATCHLEVEL@ -- number of darcs patches after a tag including VERSION, in +-- `plN' format +-- @CONTEXT@ -- first entry of `darcs changes --context' +-- @CONFDATE@ -- date when VersionTool ran, in DD MMM YYYY format +-- +-- The markers are replace by H98 string literals. +-- +-- VersionTool expects the Cabal file to have two extra entries not +-- recognised by Cabal itself. Hence, these entries start with the Cabal +-- comment characters `--'. +-- +-- VersionTool uses darcs to find a tag containing the version number +-- VERSION. If finds such a tag, the number of patches added, since that +-- tag, determine the patchlevel. If it does not find such a tag, it tags +-- the repository with "Version VERSION" and the patchlevel is "pl0". +-- hunk ./VersionTool.hs 49 +import System.Process ( + runInteractiveCommand, waitForProcess) hunk ./VersionTool.hs 55 +import System.Exit ( + ExitCode(..)) +import System.IO ( + hGetContents) hunk ./VersionTool.hs 64 +-- --------- + +-- Suffix of input file hunk ./VersionTool.hs 71 --- Actual program +-- Darcs commands hunk ./VersionTool.hs 73 +darcsChangesFromTag, darcsContext :: String +darcsChangesFromTag = "darcs changes --from-tag=" +darcsTag = "darcs tag " +darcsContext = "darcs changes --context --last=1" + + +-- Data +-- ---- + +-- Versioning information +-- +data Version = Version { + version :: String, + nickname :: String, + versdate :: String, + patchlevel :: String, + context :: String, + confdate :: String + } + + +-- Actual program +-- -------------- + hunk ./VersionTool.hs 103 - error "Usage: VersionTool.hs CONFIG-FILE" - let configFName = head args - exists <- doesFileExist (configFName ++ ".in") + error "Usage: VersionTool.hs VERSION-FILE" + let versionFName = head args + exists <- doesFileExist (versionFName ++ ".in") hunk ./VersionTool.hs 107 - error $ "VersionTool: `" ++ configFName ++ ".in' does not exist" + error $ "VersionTool: `" ++ versionFName ++ ".in' does not exist" hunk ./VersionTool.hs 114 - (version, versnick) <- getCabalInfo (head cabalFNames) + (version, versnick, versdate) <- getCabalInfo (head cabalFNames) + + -- Query darcs for tag, patchlevel, and context; maybe add tag + (patchlevel, context) <- darcsPatchLevelAndContext version hunk ./VersionTool.hs 120 - versdate <- getCurrentDate + confdate <- getCurrentDate hunk ./VersionTool.hs 122 - -- Enter the gathered information into the configuration file - rewriteFile configFName version versnick versdate + -- Enter the gathered information into the version file + rewriteFile versionFName + (Version version versnick versdate patchlevel context confdate) hunk ./VersionTool.hs 133 -getCabalInfo :: FilePath -> IO (String, String) +getCabalInfo :: FilePath -> IO (String, String, String) hunk ./VersionTool.hs 139 + versdateLs = [line | line <- cabalSpec, "--Versdate" `isPrefix` line] hunk ./VersionTool.hs 145 - return (extract versionLs, extract versnickLs) + when (null versdateLs) $ + putStrLn $ "Warning: VersionTool: no line with `--versdate' tag in `" ++ + fname ++ "'" + return (extract versionLs, extract versnickLs, extract versdateLs) hunk ./VersionTool.hs 154 +-- Darcs interaction +-- ----------------- + +-- Compute the current patchlevel in darcs, obtain the context, and maybe set +-- a new version tag. +-- +-- * The computation of the patchlevel relies on the fact that `darcs changes' +-- produces output where only the first line of every patch has a non-space +-- character. +-- +darcsPatchLevelAndContext :: String -> IO (String, String) +darcsPatchLevelAndContext version = + do + changes <- runDarcs (darcsChangesFromTag ++ version) + ("darcs: Couldn't find" `isPrefix`) + patchlevel <- case changes of + Nothing -> do + runDarcs_ (darcsTag ++ "\"version " ++ version ++ "\"") + return 0 + Just changes -> + return $ length [ line + | line <- lines changes + , not (null line || isSpace (head line))] + - 1 -- don't count tag itself + Just context <- runDarcs darcsContext (const False) + return ("pl" ++ show patchlevel, dropWhile (/= '[') context) + where + runDarcs cmd errorTest = + do + (stdin, stdout, stderr, hdl) <- runInteractiveCommand cmd + exitcode <- waitForProcess hdl + case exitcode of + ExitSuccess -> liftM Just $ hGetContents stdout + ExitFailure code -> do + errMsg <- hGetContents stderr + if errorTest errMsg + then return Nothing + else + error $ "VersionTool: darcs error " ++ show code ++ + (if null errMsg then "" else ": " ++ errMsg) + + runDarcs_ cmd = runDarcs cmd (const False) >> return () + + hunk ./VersionTool.hs 208 - day = if length preday == 1 then ' ':preday else preday + day = if length preday == 1 then '0':preday else preday hunk ./VersionTool.hs 217 --- Enter version information into the configuration source. +-- Enter version information into the version source. hunk ./VersionTool.hs 219 -rewriteFile :: FilePath -> String -> String -> String -> IO () -rewriteFile fname version versnick versdate = +rewriteFile :: FilePath -> Version -> IO () +rewriteFile fname vers = hunk ./VersionTool.hs 228 - Just (new, rest') -> new ++ rewrite rest' + Just (new, rest') -> show new ++ rewrite rest' hunk ./VersionTool.hs 231 - match str | "VERSION@" `isPrefix` str = - Just (version, drop (length "VERSION@" ) str) - | "VERSNICK@" `isPrefix` str = - Just (versnick, drop (length "VERSNICK@") str) - | "VERSDATE@" `isPrefix` str = - Just (versdate, drop (length "VERSDATE@") str) - match _ = Nothing + match str | "VERSION@" `isPrefix` str = + Just (version vers, drop (length "VERSION@" ) str) + | "VERSNICK@" `isPrefix` str = + Just (nickname vers, drop (length "VERSNICK@") str) + | "VERSDATE@" `isPrefix` str = + Just (versdate vers, drop (length "VERSDATE@") str) + | "PATCHLEVEL@" `isPrefix` str = + Just (patchlevel vers, drop (length "PATCHLEVEL@") str) + | "CONTEXT@" `isPrefix` str = + Just (context vers, drop (length "CONTEXT@") str) + | "CONFDATE@" `isPrefix` str = + Just (confdate vers, drop (length "CONFDATE@") str) + match _ = Nothing hunk ./lambdaFeed.cabal 4 +--Versdate: 31 May 2006 }