darcswatch 0.1 → 0.2
raw patch · 4 files changed
+33/−29 lines, 4 filesdep +concurrentoutput
Dependencies added: concurrentoutput
Files
- darcswatch.cabal +3/−2
- src/CachedGet.hs +8/−7
- src/Darcs.hs +14/−14
- src/Main.hs +8/−6
darcswatch.cabal view
@@ -1,5 +1,5 @@ Name: darcswatch-version: 0.1+version: 0.2 Category: Distribution name: darcswatch author: Joachim Breitner@@ -63,6 +63,7 @@ , zlib , filepath , bytestring+ , concurrentoutput source-repository head type: darcs@@ -71,4 +72,4 @@ source-repository this type: darcs location: http://darcs.nomeata.de/darcswatch/- tag: v0.1+ tag: v0.2
src/CachedGet.hs view
@@ -35,22 +35,23 @@ -- an URL to download, it will return the content of the URL. -- The boolean return value is true when the file was updated, -- and False if it is the same as in the cache.-get :: FilePath -> String -> IO (Maybe (ByteString, Bool))-get dir' uri = flip catch (\e -> putStrLn ("Error downloading uri: " ++ show e) >> return Nothing) $ do- putStr $ "Getting URL " ++ uri ++ " ... "+get :: (String -> IO ()) -> FilePath -> String -> IO (Maybe (ByteString, Bool))+get write dir' uri = flip catch (\e -> write ("Error downloading uri: " ++ show e++ "\n")+ >> return Nothing) $ do+ write $ "Getting URL " ++ uri ++ " ... " e_cache <- doesFileExist cacheFile e_tag <- doesFileExist tagFile let update = do newFile <- get' uri case newFile of Nothing -> do- putStrLn "not found."+ write "not found.\n" return Nothing Just (newFile, Nothing) -> do- putStrLn "downloaded."+ write "downloaded.\n" return $ Just (newFile, True) Just (newFile, Just newTag) -> do- putStrLn "downloaded."+ write "downloaded.\n" B.writeFile cacheFile newFile writeFile tagFile newTag return $ Just (newFile, True)@@ -66,7 +67,7 @@ maybe'' mbNewTag (return Nothing) $ \newTag -> do if oldTag == newTag then do- putStrLn "cached."+ write "cached.\n" oldFile <- B.readFile cacheFile return $ Just (oldFile, False) else do
src/Darcs.hs view
@@ -53,24 +53,24 @@ -- | Given a directory used for caching, and an URL of a Darcs repository, -- it will return the list of patches in the repository, and whether the -- repository as changed since the last run.-getInventory :: FilePath -> String -> IO ([PatchInfo], Bool)-getInventory cDir repo = do- format <- get cDir formatUrl+getInventory :: (String -> IO ()) -> FilePath -> String -> IO ([PatchInfo], Bool)+getInventory write cDir repo = do+ format <- get write cDir formatUrl case format of- Nothing -> getInventory1 cDir repo- Just (f,_) | f == B.pack "hashed\ndarcs-2\n" -> getInventory2 cDir repo- | f == B.pack "darcs-1.0\n" -> getInventory1 cDir repo+ Nothing -> getInventory1 write cDir repo+ Just (f,_) | f == B.pack "hashed\ndarcs-2\n" -> getInventory2 write cDir repo+ | f == B.pack "darcs-1.0\n" -> getInventory1 write cDir repo | otherwise -> error $ "Unkown repository format: " ++ B.unpack f where formatUrl = addSlash repo ++ "_darcs/format" -- | Gets called when old style format was detected-getInventory1 :: FilePath -> String -> IO ([PatchInfo],Bool)-getInventory1 cDir repo = getInventoryFile (addSlash repo ++ "_darcs/inventory")+getInventory1 :: (String -> IO ()) -> FilePath -> String -> IO ([PatchInfo],Bool)+getInventory1 write cDir repo = getInventoryFile (addSlash repo ++ "_darcs/inventory") where maybe' m f d = maybe d f m getInventoryFile url = do- inv <- get cDir url+ inv <- get write cDir url maybe' inv parseBody $ do- putStrLn $ "Repository " ++ repo ++ " not found."+ write $ "Repository " ++ repo ++ " not found.\n" return ([],False) parseBody (body, updated) = do let unzipped = maybeUnzipB body@@ -84,13 +84,13 @@ _ -> return (patches, updated) -- | Gets called when new style format was detected-getInventory2 :: FilePath -> String -> IO ([PatchInfo],Bool)-getInventory2 cDir repo = getInventoryFile (addSlash repo ++ "_darcs/hashed_inventory")+getInventory2 :: (String -> IO ()) -> FilePath -> String -> IO ([PatchInfo],Bool)+getInventory2 write cDir repo = getInventoryFile (addSlash repo ++ "_darcs/hashed_inventory") where maybe' m f d = maybe d f m getInventoryFile url = do- inv <- get cDir url+ inv <- get write cDir url maybe' inv parseBody $ do- putStrLn $ "Repository " ++ repo ++ " not found."+ write $ "Repository " ++ repo ++ " not found.\n" return ([],False) skip_pristine s = case breakOn '\n' s of (l1,r) | B.pack "pristine" `B.isPrefixOf` l1 -> B.tail r
src/Main.hs view
@@ -25,6 +25,7 @@ import System.Posix.Files import System.Time import System.IO+import System.Terminal.Concurrent import qualified Data.Map as M import qualified Data.Set as S@@ -64,11 +65,13 @@ lockRestart (cOutput config) patchNew or True (do_work config) do_work config patchNew = do+ writeC <- getConcurrentOutputter+ putStrLn "Reading repositories..." let loadInv rep = do- putStrLn $ "Reading " ++ rep ++ ":"- (ps,thisNew) <- getInventory (cOutput config ++ "/cache/") rep- putStrLn (if thisNew then "Repostory is new." else "Repository is cached.")+ writeC $ "Reading " ++ rep ++ ":\n"+ (ps,thisNew) <- getInventory writeC (cOutput config ++ "/cache/") rep+ writeC (if thisNew then "Repostory is new.\n" else "Repository is cached.\n") return (rep, ps, thisNew) readInv (p2r,r2p,new) (rep, ps,thisNew) = do let p2r' = foldr (\p -> MM.append p rep) p2r ps@@ -190,7 +193,6 @@ on :: (b -> b -> c) -> (a -> b) -> a -> a -> c (*) `on` f = \x y -> f x * f y -forkSequence = sequence-{- Enable for parallel downloads+{- forkSequence = sequence -}+-- Enable for parallel downloads forkSequence acts = mapM (\act -> newEmptyMVar >>= \mvar -> forkIO (act >>= putMVar mvar) >> return mvar) acts >>= mapM takeMVar--}