diff --git a/Graph.hs b/Graph.hs --- a/Graph.hs +++ b/Graph.hs @@ -15,27 +15,22 @@ import Data.Maybe import qualified Data.IntMap as I -import Data.ByteString.Char8 (ByteString,append,pack,unpack) +import Data.ByteString.Char8 (ByteString,pack,unpack) import qualified Data.ByteString.Char8 as C import qualified Data.ByteString as B import Control.Exception (bracket,handle) import Control.Monad (when) -import Foreign.C.Error -import Foreign.Storable (peek) -import Foreign.Ptr (Ptr, nullPtr) -import Foreign.Marshal (alloca) - import System.Console.GetOpt import System.Environment (getArgs) -import System.Posix.Internals -import System.IO.Error (modifyIOError, ioeSetFileName) import System.IO import System.IO.Unsafe -import System.Time import System.Directory import System.Process +import System.Exit +import Data.Time +import System.Locale tmp :: FilePath tmp = unsafePerformIO $ getTemporaryDirectory @@ -66,10 +61,10 @@ (o, n, []) -> return (o, n) (_, _, errs) -> fail $ unlines errs -getFilter :: [Flag] -> Maybe ByteString +getFilter :: [Flag] -> Maybe Day--ByteString getFilter l = let l' = [s | (DateFlag s) <- l] - in if null l' then Nothing else Just . pack . head $ l' + in if null l' then Nothing else parseTime defaultTimeLocale "%Y%m%d" (head l') getYFlag :: [Flag] -> Maybe Int getYFlag l = @@ -106,10 +101,9 @@ return (x,y)) (\((f,_),(g,_)) -> removeFile f >> removeFile g) $ \((f,h),(g,i)) -> do - -- read patches dir, count patch dates, and write to temp file - ps <- readDir (path `append` pack "/_darcs/patches/") + changes <- darcsChanges (unpack path) - let stats' = uniq . sort . map (C.take 8) . filter ignore $ ps + let stats' = uniq $ sort $ parseChanges changes -- filter out stats earlier than 'yyyymmdd' let stats | (Just date) <- mfilter = filter (\(x,_) -> x > date) stats' @@ -119,7 +113,7 @@ (C.hPutStr h . C.unlines . map fmt) stats >> hClose h -- now work out the sliding average, and write it out too - let days = enumDates (toClock . fst . head $ stats) (toClock . fst . last $ stats) + let days = enumDates (fst . head $ stats) (fst . last $ stats) avrg = sliding (map readFst stats) (map toInt days) (C.hPutStr i . C.unlines . map fmt') avrg >> hClose i @@ -157,18 +151,34 @@ putStrLn $ "Output written to: " ++ out where - readFst (a,b) = ((fst . fromJust . C.readInt) a, b) + readFst (a,b) = (toInt a, b) uniq = map (\n -> (head n, length $ n)) . group - fmt (s,n) = joinWithSpace s (pack . show $ n) - fmt' (n,d) = joinWithSpace (pack.show $ n) (pack.show $ d) + fmtCT c = formatTime defaultTimeLocale "%Y%m%d" c + fmt (s,n) = joinWithSpace (fmtCT s) (show n) + fmt' (n,d) = joinWithSpace (show n) (show d) - ignore f = f /= pack "unrevert" - && not (pack "pending" `C.isPrefixOf` f) - && not (pack "." `C.isPrefixOf` f) + joinWithSpace s t = B.intercalate (B.singleton 32) [pack s,pack t] - joinWithSpace s t = B.intercalate (B.singleton 32) [s,t] +parseChanges :: ByteString -> [Day] +parseChanges chs + = worker (C.lines chs) + where worker [] = [] + worker (c:cs) | Just utcTime <- parseTime defaultTimeLocale "%a %b %e %X %Z %Y" (unwords $ take 6 $ words $ C.unpack c) + = utcTime:worker cs + worker (_:cs) = worker cs +darcsChanges :: FilePath -> IO ByteString +darcsChanges path + = do (inh,outh,errh,pid) <- runInteractiveProcess "darcs" ["changes","--repo="++path] Nothing Nothing + hClose inh + hClose errh + out <- B.hGetContents outh + code <- waitForProcess pid + case code of + ExitFailure c -> do hPutStrLn stderr "`darcs --changes` failed." + exitWith (ExitFailure c) + ExitSuccess -> return out ------------------------------------------------------------------------ -- Dealing with clock times @@ -176,45 +186,16 @@ -- -- enumerate all the days, as ClockTimes, between the two dates -- -enumDates :: ClockTime -> ClockTime -> [ClockTime] -enumDates d0 dn = map (\d -> addToClockTime (TimeDiff 0 0 d 0 0 0 0) d0) [0 .. days] +enumDates :: Day -> Day -> [Day] +enumDates d0 dn = map (\d -> addDays d d0) [0 .. days] where - t = diffClockTimes dn d0 - days = floor (((fromIntegral $ tdSec t) / 60 / 60 / 24) :: Double) - --- --- convert a date packed in a bytestring to a ClockTime --- yyyymmdd format. --- -toClock :: ByteString -> ClockTime -toClock x = toClockTime $ CalendarTime { - ctYear = y, - ctMonth = toEnum (m-1) :: Month, - ctDay = d, - ctHour = 0, ctMin = 0, ctSec = 0, ctPicosec = 0, - ctWDay = undefined, ctYDay = undefined, - ctTZName = "GMT", ctTZ = 0 , ctIsDST = False - } - where (y,m,d) = split x - - -- read the bytestring as a triple of yyyymmdd - split s = let a = fst . fromJust . C.readInt . C.take 4 $ s - b = fst . fromJust . C.readInt . C.drop 4 . C.take 6 $ s - c = fst . fromJust . C.readInt . C.drop 6 . C.take 8 $ s - in (a,b,c) + days = diffDays dn d0 -- -- convert a ClockTime back to an Int in yyyymmdd format -- -toInt :: ClockTime -> Int -toInt ct = read $ show yyyy ++ show0 mm ++ show0 dd - where yyyy = ctYear cl - mm = fromEnum (ctMonth cl) + 1 - dd = ctDay cl - - cl = unsafePerformIO (toCalendarTime ct) - show0 n | n < 10 && n >= 0 = '0' : show n - | otherwise = show n +toInt :: Day -> Int +toInt ct = read $ formatTime defaultTimeLocale "%Y%m%d" ct -- sliding average window window :: Int @@ -281,44 +262,6 @@ Nothing -> fps Just i -> C.drop (i+1) s where s = C.reverse . C.dropWhile (=='/') . C.reverse $ fps - --- --- | Packed version of get directory contents. super fast --- -readDir :: ByteString -> IO [ByteString] -readDir path = do - modifyIOError (`ioeSetFileName` (unpack path)) $ - alloca $ \ ptr_dEnt -> - bracket - (C.useAsCString path $ \s -> - throwErrnoIfNullRetry desc (c_opendir s)) - (\p -> throwErrnoIfMinus1_ desc (c_closedir p)) - (\p -> loop ptr_dEnt p) - where - desc = "readDir" - - loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [ByteString] - loop ptr_dEnt dir = do - resetErrno - r <- readdir dir ptr_dEnt - if (r == 0) - then do dEnt <- peek ptr_dEnt - if (dEnt == nullPtr) - then return [] - else do -- copy entry out before we free: - entry <- C.packCString =<< d_name dEnt - C.length entry `seq` return () -- strictify - freeDirEnt dEnt - entries <- loop ptr_dEnt dir - return $! (entry:entries) - - else do errno <- getErrno - if (errno == eINTR) - then loop ptr_dEnt dir - else do let (Errno eo) = errno - if (eo == end_of_dir) - then return [] - else throwErrno desc -- useful infixr 6 diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,25 @@ +-- darcs-graph +-- +-- draw pretty graphs of a darcs repository's activity, including a +-- 7-day sliding average +-- + +Depends on the fps library included with 6.6, and available separate for 6.4: + http://www.cse.unsw.edu.au/~dons/fps.html +(version 0.7 or greater) + +Invokes gnuplot to generate the graph: http://www.gnuplot.info/ + +Building: + $ chmod +x Setup.hs + $ ./Setup.hs configure --prefix=/home/dons + $ ./Setup.hs build + $ ./Setup.hs install + +Use: + $ darcs-graph /home/dons/lambdabot + Output written to: /tmp/lambdabot-commits.png + +Author: + Don Stewart, http://www.cse.unsw.edu.au/~dons + Wed Jun 14 17:49:32 EST 2006 diff --git a/darcs-graph.cabal b/darcs-graph.cabal --- a/darcs-graph.cabal +++ b/darcs-graph.cabal @@ -1,5 +1,5 @@ Name: darcs-graph -Version: 0.3.2 +Version: 1.0 License: BSD3 License-file: LICENSE Category: Distribution @@ -17,12 +17,14 @@ Main-is: Graph.hs Extensions: CPP, PatternGuards Ghc-options: -Wall - + + build-depends: time if flag(small_base) - build-depends: base >= 3, + build-depends: base >= 3 && < 4, process, directory, old-time, + old-locale, bytestring, containers else diff --git a/remote-darcs-graph b/remote-darcs-graph new file mode 100644 --- /dev/null +++ b/remote-darcs-graph @@ -0,0 +1,54 @@ +#!/bin/sh + +# Copyright (c) 2006 Don Stewart - http://www.cse.unsw.edu.au/~dons +# GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html) + +set -e + +# +# generate a graph of a remote darcs repository +# +# requires darcs-graph and wget in the $PATH + +# +# reads darcs repo urls line-by-line on stdin, generating graphs, and +# playing them in a web server dir (currently hard coded below) +# + +# create a fake patches dir +d=`mktemp -d` +cd $d + +# read darcs repo urls on stdin +while read url ; do + + b=`basename $url` + p=$b/_darcs/patches + + mkdir $b + cd $b + + # get index.html for patches dir + echo "Fetching " $url + if wget -q "$url/_darcs/patches" ; then + + mkdir -p $p + + # assumes servers return patch dirs in the same format + cd $p + cat ../../../index.html | tr A-Z a-z |\ + sed '/href/!d; s/.*href="//; s/">.*$//;/\.gz$/!d' | xargs touch + cd ../../.. + + /home/dons/bin/darcs-graph -y 25 $b && \ + mv /tmp/$b-commits.png /home/dons/www/images/commits/community + + fi & + + cd .. + +done + +wait + +rm -rf $d