darcswatch 0.4.3 → 0.4.4

raw patch · 15 files changed

+55/−34 lines, 15 filesdep +safedep ~base

Dependencies added: safe

Dependency ranges changed: base

Files

darcswatch.cabal +3/−2
src/CGI-Main.hs +2/−2
src/ConvertData-Main.hs +3/−2
src/Darcs/Watch/GenerateOutput.hs +4/−3
src/Darcs/Watch/PullRepos.hs +8/−4
src/Darcs/Watch/Roundup.hs +4/−1
src/Darcs/Watch/Storage.hs +9/−6
src/Darcs/Watch/UpdateRepoData.hs +1/−1
src/Generate-Main.hs +5/−4
src/HTML.hs +4/−2
src/ImportBundle-Main.hs +2/−1
src/ImportMail-Main.hs +2/−1
src/LockRestart.hs +4/−3
src/PullRepos-Main.hs +2/−1
src/UpdateRepoData-Main.hs +2/−1

darcswatch.cabal view

@@ -1,5 +1,5 @@ Name:            darcswatch-version:         0.4.3+version:         0.4.4 Category:        Distribution name:            darcswatch author:          Joachim Breitner@@ -60,7 +60,7 @@                         , Darcs.Watch.UpdateRepoData                         , Darcs.Watch.Storage                         , Darcs.Watch.Mail-        Build-Depends:  base > 3 && < 4+        Build-Depends:  base == 4.*                         , network                         , HTTP >= 4000                         , old-time@@ -82,6 +82,7 @@                         , regex-compat                         , cgi                         , mtl+                        , safe         if flag(Static)                 ghc-options: -static -optl-static -optl-pthread

src/CGI-Main.hs view

@@ -23,6 +23,7 @@ import System.FilePath import Network.CGI import Control.Applicative+import Safe  import Darcs.Watch.Storage import Darcs.Watch.Data@@ -31,8 +32,7 @@ main = do 	confdir <- getEnv "HTTP_DARCSWATCH_DIR" -        config <- read `fmap` readFile (confdir </> "config") :: IO DarcsWatchConfig-+        config <- readNote "reading Configuration" `fmap` readFile (confdir </> "config") :: IO DarcsWatchConfig 	 	runCGI $ handleErrors $ authenticated config $ \openID -> do

src/ConvertData-Main.hs view

@@ -25,10 +25,11 @@ import System.Directory import Control.Monad import qualified Data.ByteString.Char8 as B+import Safe+import Data.Maybe  import Darcs.Watch.Data import Darcs.Watch.Storage-import Data.Maybe  main = do 	args <- getArgs@@ -36,7 +37,7 @@                         [confdir] -> (addSlash confdir)                         _         -> error "Use convert confdir/"         putStrLn "Reading configuration..."-        config <- read `fmap` readFile (confdir ++ "config")+        config <- readNote "reading Configuration" `fmap` readFile (confdir ++ "config")  	putStrLn "Reading emails..."         mailFiles' <- getDirectoryFiles (cMails config)

src/Darcs/Watch/GenerateOutput.hs view

@@ -40,6 +40,7 @@ import Data.Maybe import Data.Monoid import System.FilePath+import Safe  import qualified Data.ByteString.Char8 as B import Data.ByteString.Char8 (ByteString)@@ -55,7 +56,7 @@ 	nowStamp <- getCurrentTime 	let outputStampFile = cData config </> "output.stamp" 	ex <- doesFileExist outputStampFile-	lastStamp <- if ex then read . B.unpack <$> B.readFile outputStampFile+	lastStamp <- if ex then readNote "output.stamp" . B.unpack <$> B.readFile outputStampFile 	                   else return $ UTCTime (ModifiedJulianDay 0) 0  	date <- getClockTime >>= toCalendarTime@@ -108,7 +109,7 @@ 		(bundleHashes,_) <- readBundleList (cData config) (RepositoryBundleList r) 		bundleInfos <- mapM getBundleInfos bundleHashes 		inv <- readRepository (cData config) r-		return $ strict6 (,,,,,) +		return $! strict6 (,,,,,)  			r 			(length inv) 			(length $ bundleInfoFilter Applied bundleInfos)@@ -118,7 +119,7 @@ 	userData <- forM authors $ \u -> do 		(bundleHashes,_) <- readBundleList (cData config) (AuthorBundleList u) 		bundleInfos <- mapM getBundleInfos bundleHashes-		return $ strict5 (,,,,) +		return $! strict5 (,,,,)  			u 			(length bundleInfos) 			(length (bundleInfoFilter Applicable bundleInfos))

src/Darcs/Watch/PullRepos.hs view

@@ -22,6 +22,8 @@ import Control.Monad import Control.Concurrent import Control.Applicative+import Control.Exception+import Prelude hiding (catch) import System.Environment (getArgs) import System.Directory import System.Posix.Files@@ -58,9 +60,11 @@         putStrLn "Updating repositories..." 	let updateRepo rep = do                 writeC $ "Updating " ++ rep ++ ":\n"-		thisNew <- updateRepository (cData config) writeC rep-		writeC (if thisNew then "Repostory is new.\n" else "Repository is cached.\n")-		return thisNew+		catch ( do+			thisNew <- updateRepository (cData config) writeC rep+			writeC (if thisNew then "Repostory is new.\n" else "Repository is cached.\n")+			return thisNew+		 ) (\e -> writeC ("Error Updateing " ++ rep ++ ": " ++ show (e::SomeException) ++ "\n") >> return False) 	new <- or <$> forkSequence (map updateRepo (cRepositories config))          unless new $ putStrLn "Nothing new found"@@ -74,7 +78,7 @@         mvar <- newEmptyMVar         forkIO $ do              waitQSem sem-            act >>= putMVar mvar+            catch (act >>= putMVar mvar) (\e -> putMVar mvar (throw (e::SomeException)))             signalQSem sem         return mvar     mapM takeMVar mvars

src/Darcs/Watch/Roundup.hs view

@@ -14,6 +14,7 @@ tellRoundup :: DarcsWatchConfig -> String -> RepositoryURL -> BundleHash -> PatchBundle -> BundleState -> IO () tellRoundup _      _   _    _          _      status | status `notElem` [Applied, Applicable] = return () tellRoundup _      url _    _          _      _      | not $ "http://bugs.darcs.net/" `isPrefixOf` url = return ()+tellRoundup _      _   repo _          _      status | repo == "http://darcs.net/screened" && status == Applicable = return () -- No applicable mails for the screened repo tellRoundup config url repo bundleHash bundle status = do 	message <- flatten [mk_header ["From: " ++ from] 	                   ,mk_header ["To: " ++ to]@@ -27,7 +28,9 @@         to = "bugs@darcs.net" 	subject = case status of 	 	   Applicable -> "This patch is being tracked by DarcsWatch [" ++ roundupId ++ "] [darcswatchurl=" ++ bundleLink ++ "]"-		   Applied -> "This patch has been applied [" ++ roundupId ++ "] [status=accepted]"+		   Applied -> "This patch has been applied [" ++ roundupId ++ "] [status=" ++ roundupStatus ++ "]"+        roundupStatus | repo == "http://darcs.net/screened" = "needs-review"+                      | otherwise                           = "accepted" 	body = case status of 		Applicable -> "" -- no messages about this, please 		Applied ->    "This patch bundle (with " ++ show (length (fst bundle)) ++

src/Darcs/Watch/Storage.hs view

@@ -32,6 +32,7 @@ import Control.Applicative import Control.Monad import Data.Char+import Safe   -- | Adds a new patch bundle to the stogare@@ -54,7 +55,8 @@ -- | Retrieves the meta information for the handle getBundleHistory :: StorageConf -> BundleHash -> IO [BundleHistory] getBundleHistory path hash =-	read <$> B.unpack <$> B.readFile (bundleDir path </> hash <.> "data")+        let filename = bundleDir path </> hash <.> "data"+	in  readNote ("Bundle data in " ++ filename) <$> B.unpack <$> B.readFile filename  -- | Adds a new entry to the bundle history (stamped with the current time) changeBundleState :: StorageConf -> BundleHash -> Source -> BundleState -> IO ()@@ -79,7 +81,7 @@ 	let infoFile = repoDir path </> safeName repo <.> "data" 	let repoFile = repoDir path </> safeName repo <.> "inventory" 	ex <- doesFileExist infoFile-	info <- if ex then read . B.unpack <$> B.readFile infoFile+	info <- if ex then readNote ("Repo data in " ++ infoFile) . B.unpack <$> B.readFile infoFile                       else return (RepositoryInfo Nothing Nothing) 	now <- getCurrentTime 	(ps,changed) <- getInventory write (cacheDir path) repo@@ -101,7 +103,7 @@ getRepositoryInfo path repo = do 	let infoFile = repoDir path </> safeName repo <.> "data" 	ex <- doesFileExist infoFile-	if ex then read . B.unpack <$> B.readFile infoFile+	if ex then readNote ("Repo data in " ++ infoFile) . B.unpack <$> B.readFile infoFile 	      else return (RepositoryInfo Nothing Nothing)  setBundleListList :: StorageConf -> [BundleList] -> IO ()@@ -110,7 +112,8 @@  getBundleListList :: StorageConf -> IO [BundleList] getBundleListList path = do-	read <$> B.unpack <$> B.readFile (bundleListDir path </> "index")+        let indexFile = bundleListDir path </> "index"+	readNote ("Bundle index in " ++ indexFile)  <$> B.unpack <$> B.readFile indexFile  writeBundleList :: StorageConf -> BundleList -> [BundleHash] -> IO () writeBundleList path bl blist = do@@ -127,7 +130,7 @@ 	ex <- doesFileExist filename	 	if not ex then return ([],UTCTime (ModifiedJulianDay 0) 0) else do 		(stamp:bhashes) <- lines <$> B.unpack <$> B.readFile filename-		return (bhashes, read stamp)+		return (bhashes, readNote ("Bundle list stamp in " ++ filename) stamp)  writeNameMapping :: StorageConf -> M.Map Author String -> IO () writeNameMapping path map = do@@ -138,7 +141,7 @@ 	let filename = nameMappingFilename path 	ex <- doesFileExist filename	 	if not ex then return M.empty else -		read <$> B.unpack <$> B.readFile filename+		readNote ("Name mapping in " ++ filename) <$> B.unpack <$> B.readFile filename  bundleListFilename path (RepositoryBundleList repo) = 	bundleListDir path </> "repo_" ++ safeName repo

src/Darcs/Watch/UpdateRepoData.hs view

@@ -41,7 +41,7 @@ import Data.Digest.OpenSSL.MD5 (md5sum) import Data.Maybe import System.FilePath-import Control.Monad.Writer+import Control.Monad.Writer.Strict  -- Darcs stuff import Darcs

src/Generate-Main.hs view

@@ -36,7 +36,11 @@ import Data.List import Data.Time import System.FilePath+import Safe+import Data.Digest.OpenSSL.MD5 (md5sum)+import Data.Maybe + import qualified Data.ByteString.Char8 as B import Data.ByteString.Char8 (ByteString) @@ -46,10 +50,7 @@ import Darcs.Watch.Data import LockRestart -import Data.Digest.OpenSSL.MD5 (md5sum)-import Data.Maybe - main = do 	hSetBuffering stdout NoBuffering         args <- getArgs@@ -58,6 +59,6 @@                         [confdir, "new"] -> (addSlash confdir, True)                         _         -> error "Use darcswatch confdir/"         putStrLn "Reading configuration..."-        config <- read `fmap` readFile (confdir ++ "config")+        config <- readNote "reading Configuration" `fmap` readFile (confdir ++ "config")  	lockRestart (cData config) patchNew or True (generateOutput config)

src/HTML.hs view

@@ -118,7 +118,8 @@ 		count Applied "tracked" tracked +++ 		count Applicable "applicable" applicable +++ 		count Obsoleted "obsolete" obsolete +++-		count Rejected "rejected" rejected+		count Rejected "rejected" rejected +++ " " ++++                hotlink ("http://handra.rampa.sk/dawb/changes?repoPage=0&repoURL=" ++ r ++ "&repoSummary=on&repoLimit=50&repoElem=&repoRegex=") << "view repo" 	count s t 0 = noHtml 	count s t n = inColor (stateColor s) << (show n +++ " " +++ t) +++ " " @@ -179,7 +180,8 @@ 	) +++    body << form !!! [ method "GET", action "cgi"] << ( 	h1 << ("DarcsWatch overview for " +++ r) +++-	p << hotlink "." << "Return to main page" ++++	p << (hotlink "." << "Return to main page" +++ " " ++++              hotlink ("http://handra.rampa.sk/dawb/changes?repoPage=0&repoURL=" ++ r ++ "&repoSummary=on&repoLimit=50&repoElem=&repoRegex=") << "View repository") +++ 	bundleList nameMapping "Unapplied patch bundles" (bundleInfoFilter Applicable bundleInfos) +++  	bundleList nameMapping "Applied patch bundles" (bundleInfoFilter Applied bundleInfos) +++  	bundleList nameMapping "Obsoleted patch bundles" (bundleInfoFilter Obsoleted bundleInfos) +++

src/ImportBundle-Main.hs view

@@ -27,6 +27,7 @@ import qualified Data.ByteString.Char8 as B import Data.Maybe import System.FilePath+import Safe  import Darcs.Watch.Data import Darcs.Watch.Storage@@ -37,7 +38,7 @@                         [confdir, file] -> (confdir, file)                         _         -> error "Use convert confdir/ patchfile"         putStrLn "Reading configuration..."-        config <- read `fmap` readFile (confdir </> "config")+        config <- readNote "reading Configuration" `fmap` readFile (confdir </> "config")  	putStrLn "Reading patch bundle..." 	mail <- B.readFile file

src/ImportMail-Main.hs view

@@ -23,6 +23,7 @@ import Data.Maybe import System.FilePath import System.Posix.IO+import Safe  import Darcs.Watch.Data import Darcs.Watch.ImportMail@@ -35,7 +36,7 @@         let (confdir) = case args of                         [confdir] -> (confdir)                         _         -> error "Use import-mail confdir/ and pipe mail to it"-        config <- read `fmap` readFile (confdir </> "config")+        config <- readNote "reading Configuration" `fmap` readFile (confdir </> "config") 	foundMail <- importMail config 	when foundMail $ do 		-- We do not want output here

src/LockRestart.hs view

@@ -28,7 +28,9 @@ import System.IO.Error import System.Posix.Temp import Control.Monad+import Control.Exception (finally) import GHC.IOBase+import Safe  -- | tries to get the lock. If it fails, notifies the running process --   to re-start itself afterwards, with the given information@@ -63,7 +65,7 @@       mapM (\f -> do     	c <- readFile f         when (c==c) $ removeFile f-        return (read c)+        return (readNote "in releaseLock" c)         ) files   where interesting "." = False         interesting ".." = False@@ -95,8 +97,7 @@ 	    workAndCheck event 	  else 	    when verbose $ putStrLn "Could not get locked, signaled restart"-  where workAndCheck event = do-        action event+  where workAndCheck event = finally (action event) $ do 	when verbose $ putStrLn "Trying to release the lock..." 	msgs <- releaseLock dir 	if null msgs then do

src/PullRepos-Main.hs view

@@ -34,6 +34,7 @@ import MultiMap ((!!!!)) import Data.Char import Data.List+import Safe  import qualified Data.ByteString.Char8 as B import Data.ByteString.Char8 (ByteString)@@ -56,7 +57,7 @@                         [confdir] -> confdir                         _         -> error "Use darcswatch confdir/"         putStrLn "Reading configuration..."-        config <- read `fmap` readFile (confdir </> "config")+        config <- readNote "reading Configuration" `fmap` readFile (confdir </> "config")  	new <- pullRepos config 	when new $ do

src/UpdateRepoData-Main.hs view

@@ -27,6 +27,7 @@ import System.Time import System.IO import System.Terminal.Concurrent+import Safe  import qualified Data.Map as M import qualified Data.Set as S@@ -55,6 +56,6 @@                         [confdir] -> confdir                         _         -> error "Use darcswatch confdir/"         putStrLn "Reading configuration..."-        config <- read `fmap` readFile (confdir </> "config")+        config <- readNote "reading Configuration" `fmap` readFile (confdir </> "config")  	updateRepoData config