[Initial version of DarcsGraph, pretty little web script Neil Mitchell **20060313143756] { addfile ./misc/DarcsGraph.hs hunk ./misc/DarcsGraph.hs 1 + +module Main where + +import System +import List +import Char + + +main = do (x:_) <- getArgs + y <- readFile x + writeFile (x ++ ".htm") (process y) + + + +type Date = (Int, Int, Int) -- year, month, day + + +type Chart = [(Int, Int)] + + +process :: String -> String +process x = drawChart chart + where + chart = map g items + items = accumCount 0 $ map f $ group $ sort $ map getDate $ filter (not.isBlank) $ lines x + + isBlank "" = True + isBlank (' ':_) = True + isBlank x = False + + f xs = (length xs, head xs) + minv = snd $ head items + maxv = snd $ last items + maxc = fst $ last items + + accumCount n [] = [] + accumCount n ((a,b):c) = (a+n,getValue b) : accumCount (a+n) c + + g (count, val) = (x,y) + where + x = ((val - minv) * 300) `div` (maxv - minv) + y = ((maxc - count) * 150) `div` maxc + +getDate :: String -> Date +getDate x = (read (xs !! 7), getMonth (xs !! 1), read (xs !! 2)) + where xs = words x + + +months = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"] + +getMonth x = case elemIndex (map toLower x) months of + Nothing -> error $ "Unrecognised month: " ++ x + Just x -> x + +getDays x | x == 1 = 29 + | x `elem` [0,2,4,6,7,9,11] = 31 + | otherwise = 30 + + +getValue :: Date -> Int +getValue (year,month,day) = (year*366) + f (month-1) + day + where + f (-1) = 0 + f n = getDays n + f (n-1) + + + +drawChart :: Chart -> String +drawChart = showChart . allY . allX . nubX + where + showChart xs = prefix ++ unlines (map f xs) ++ suffix + f (x,y) = "
 
" + + nubX = map head . groupBy (\a b -> fst a == fst b) + + allX ((x1,y1):(x2,y2):res) = (x1,y1) : [(x,y2 + ((y1-y2)`div`(x-x1))) | x <- [x1+1..x2-1]] ++ allX ((x2,y2):res) + allX x = x + + allY ((x1,y1):(x2,y2):res) = (x1,y1) : [(x2,y) | y <- [y2+1..y1-1]] ++ allY ((x2,y2):res) + allY x = x + + +prefix = "Darcs Statistics for Yhc

Darcs Statistics for Yhc

\n" ++ + "
\n" + +suffix = "
\n\n" }