hashed-storage 0.5.9 → 0.5.10

raw patch · 4 files changed

+14/−9 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Storage/Hashed/Darcs.hs +4/−3
• Storage/Hashed/Tree.hs +5/−4
• hashed-storage.cabal +1/−1
• test.hs +4/−1

@@ -1,15 +1,16 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}  -- | A few darcs-specific utility functions. These are used for reading and -- writing darcs and darcs-compatible hashed trees. module Storage.Hashed.Darcs where -import Prelude hiding ( lookup )+import Prelude hiding ( lookup, catch ) import System.FilePath ( (</>) )  import System.Directory( doesFileExist ) import Codec.Compression.GZip( decompress, compress ) import Control.Applicative( (<$>) )+import Control.Exception( catch, IOException )  import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy.Char8 as BL8@@ -290,7 +291,7 @@  darcsPristineRefs :: FileSegment -> IO [Hash] darcsPristineRefs fs = do-  con <- (darcsParseDir <$> readSegment fs) `catch` \_ -> return []+  con <- (darcsParseDir <$> readSegment fs) `catch` \(_ :: IOException) -> return []   return $! [ hash | (_, _, _, hash) <- con, valid hash ]     where valid NoHash = False           valid _ = True

@@ -28,7 +28,8 @@     , modifyTree, updateTree, partiallyUpdateTree, updateSubtrees, overlay     , addMissingHashes ) where -import Prelude hiding( lookup, filter, all )+import Control.Exception( catch, IOException )+import Prelude hiding( lookup, filter, all, catch ) import Storage.Hashed.AnchoredPath import Storage.Hashed.Hash @@ -195,7 +196,7 @@         let             subtree (name, sub) =                 do let here = path `appendPath` name-                   sub' <- (Just <$> unstub sub) `catch` \_ -> return Nothing+                   sub' <- (Just <$> unstub sub) `catch` \(_ :: IOException) -> return Nothing                    case sub' of                      Nothing -> return $ Left [(here, treeHash t_, Nothing)]                      Just sub -> do@@ -204,10 +205,10 @@                               Left problems -> Left problems                               Right tree -> Right (name, SubTree tree)             badBlob (_, f@(File (Blob s h))) =-              fmap (/= h) (hashFunc f `catch` (\_ -> return NoHash))+              fmap (/= h) (hashFunc f `catch` (\(_ :: IOException) -> return NoHash))             badBlob _ = return False             render (name, f@(File (Blob _ h))) = do-              h' <- (Just <$> hashFunc f) `catch` \_ -> return Nothing+              h' <- (Just <$> hashFunc f) `catch` \(_ :: IOException) -> return Nothing               return (path `appendPath` name, h, h')         subs <- mapM subtree [ x | x@(_, item) <- listImmediate t_, isSub item ]         badBlobs <- filterM badBlob (listImmediate t) >>= mapM render

@@ -1,5 +1,5 @@ name:          hashed-storage-version:       0.5.9+version:       0.5.10 synopsis:      Hashed file storage support code.  description:   Support code for reading and manipulating hashed file storage

@@ -1,13 +1,16 @@+{-# LANGUAGE ScopedTypeVariables #-} import Storage.Hashed.Test( tests )+import Prelude hiding( catch ) import Test.Framework( defaultMain ) import System.Directory( createDirectory, removeDirectoryRecursive                        , setCurrentDirectory ) import Codec.Archive.Zip( extractFilesFromArchive, toArchive ) import qualified Data.ByteString.Lazy as BL+import Control.Exception( catch, IOException )  main :: IO () main = do zip <- toArchive `fmap` BL.readFile "testdata.zip"-          removeDirectoryRecursive "_test_playground" `catch` \_ -> return ()+          removeDirectoryRecursive "_test_playground" `catch` \(_ :: IOException) -> return ()           createDirectory "_test_playground"           setCurrentDirectory "_test_playground"           extractFilesFromArchive [] zip