[Basic VersionTool Manuel M T Chakravarty **20060531165550] { move ./Config.hs ./Config.hs.in addfile ./VersionTool.hs hunk ./Config.hs.in 51 -versnum = "0.3.0" -versnick = "'Lambdas are food for thought'" -date = "29 May 2006" +versnum = "@VERSION@" +versnick = "@VERSNICK@" +date = "@VERSDATE@" hunk ./README 7 -into HTML for inclusion into web pages. +into HTML for inclusion into web pages. The project web site is at + + http://www.cse.unsw.edu.au/~chak/lambdaFeed/ hunk ./VersionTool.hs 1 +#!/bin/env runhaskell + +-- |Tool to insert version information into program source +-- +-- Copyright (c) 2006 Manuel M T Chakravarty +-- +-- License: BSD3 +-- +--- Description --------------------------------------------------------------- +-- +-- Extract version information from a .cabal file and from darcs, and then, +-- insert it into a source file. The name of the source file that is to be +-- rewritten with the version information must be passed as the only argument +-- to VersionTool. If that file's name is `Config.hs', there must be a +-- template file `Config.hs.in' containing version information markers where +-- VersionTool is supposed to enter the version information. The markers are +-- the following: +-- +-- 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) +-- + +module Main (main) +where + +import Data.Char ( + toLower, isSpace) +import Control.Monad ( + when, unless, liftM) +import System.Directory ( + getDirectoryContents, doesFileExist) +import System.Environment ( + getArgs) +import System.Time ( + ClockTime, Month, CalendarTime(..), getClockTime, toUTCTime) + + +-- Constants +-- +inSuffix :: String +inSuffix = ".in" + +-- Actual program +-- +main :: IO () +main = + do + -- Get name of source file into which we enter the version information + args <- getArgs + when (length args /= 1) $ + error "Usage: VersionTool.hs CONFIG-FILE" + let configFName = head args + exists <- doesFileExist (configFName ++ ".in") + unless exists $ + error $ "VersionTool: `" ++ configFName ++ ".in' does not exist" + + -- Get the package's Cabal file and extract version information from it + fnames <- getDirectoryContents "." + let cabalFNames = [fname | fname <- fnames, suffix fname == "cabal"] + when (null cabalFNames) $ + error "VersionTool: no .cabal file in current directory" + (version, versnick) <- getCabalInfo (head cabalFNames) + + -- Get current date + versdate <- getCurrentDate + + -- Enter the gathered information into the configuration file + rewriteFile configFName version versnick versdate + + +-- Cabal file processing +-- --------------------- + +-- Extract version information (version number and version nick) from Cabal +-- file. +-- +getCabalInfo :: FilePath -> IO (String, String) +getCabalInfo fname = + do + cabalSpec <- liftM lines $ readFile fname + let versionLs = [line | line <- cabalSpec, "Version" `isPrefix` line] + versnickLs = [line | line <- cabalSpec, "--Versnick" `isPrefix` line] + when (null versionLs) $ + error $ "VersionTool: no line with `version' tag in `" ++ fname ++ "'" + when (null versnickLs) $ + putStrLn $ "Warning: VersionTool: no line with `--versnick' tag in `" ++ + fname ++ "'" + return (extract versionLs, extract versnickLs) + where + extract ls | null ls = "" + | otherwise = clean . tail . dropWhile (/= ':') . head $ ls + + +-- Date information +-- ---------------- + +-- Get the current date in `DD MMM YYYY' format. +-- +getCurrentDate :: IO String +getCurrentDate = + do + time <- liftM toUTCTime $ getClockTime + let preday = show $ ctDay time + day = if length preday == 1 then ' ':preday else preday + month = take 3 (show $ ctMonth time) + year = show $ ctYear time + return $ day ++ " " ++ month ++ " " ++ year + + +-- Target rewriting +-- ---------------- + +-- Enter version information into the configuration source. +-- +rewriteFile :: FilePath -> String -> String -> String -> IO () +rewriteFile fname version versnick versdate = + do + contents <- readFile (fname ++ inSuffix) + writeFile fname (rewrite contents) + where + rewrite "" = "" + rewrite ('@':rest) = case match rest of + Nothing -> '@' : rewrite rest + Just (new, rest') -> new ++ rewrite rest' + rewrite (c :rest) = c : rewrite rest + -- + 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 + + +-- Utility functions +-- ----------------- + +-- Lose leading and trailing whitespace. +-- +clean :: String -> String +clean = reverse . dropWhile isSpace . reverse . dropWhile isSpace + +-- Check for string prefix disregarding case. +-- +isPrefix :: String -> String -> Bool +str1 `isPrefix` str2 = + map toLower str1 == map toLower (take (length str1) str2) + +-- Project the suffix from a filename. +-- +suffix :: FilePath -> String +suffix = reverse . takeWhile (/= '.') . reverse hunk ./lambdaFeed.cabal 3 ---Versnick: "Lambdas are food for thought" ---Versdate: "29 May 2006" +--Versnick: 'Lambdas are food for thought' }