packages feed

darcs-graph 0.3.2 → 1.0

raw patch · 4 files changed

+121/−97 lines, 4 filesdep +old-localedep +timedep ~base

Dependencies added: old-locale, time

Dependency ranges changed: base

Files

Graph.hs view
@@ -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 </>
+ README view
@@ -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
darcs-graph.cabal view
@@ -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
+ remote-darcs-graph view
@@ -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