Commits

Stefan Saasen committed 6ce1333

Move writeDelta and writeDeltas into the unpackPackfile function

  • Participants
  • Parent commits c20a833
  • Tags v0.1

Comments (0)

Files changed (1)

File src/Git/Store/ObjectStore.hs

                 _ <- writeBlob repo (tt objType) content
                 writeObjects xs
             writeObjects []     = return []
+
             tt OBJ_COMMIT       = BCommit
             tt OBJ_TREE         = BTree
             tt OBJ_BLOB         = BBlob
             tt OBJ_TAG          = BTag
             tt _                = error "Unexpected blob type"
 
-writeDeltas :: GitRepository -> [PackfileObject] -> IO ()
-writeDeltas repo (x:xs) = do
-    _ <- writeDelta repo x
-    writeDeltas repo xs
-writeDeltas _ [] = return ()
-
-writeDelta :: GitRepository -> PackfileObject -> IO (Maybe FilePath)
-writeDelta repo (PackfileObject ty@(OBJ_REF_DELTA _) _ content) = do
-        base <- case toObjectId ty of
-            Just sha -> readBlob repo sha
-            _        -> return Nothing
-        if isJust base then
-            case patch (getBlobContent $ fromJust base) content of
-                Right target -> do
-                                let base'        = fromJust base
-                                filename <- writeBlob repo (objType base') target
-                                return $ Just filename
-                Left _       -> return Nothing
-        else return Nothing -- FIXME - base object doesn't exist yet
-writeDelta _ _ = error "Don't expect a resolved object here"
+
+            -- Needs more fold
+            writeDeltas repo (x:xs) = do
+                _ <- writeDelta repo x
+                writeDeltas repo xs
+            writeDeltas _ [] = return ()
+
+            writeDelta repo (PackfileObject ty@(OBJ_REF_DELTA _) _ content) = do
+                    base <- case toObjectId ty of
+                        Just sha -> readBlob repo sha
+                        _        -> return Nothing
+                    if isJust base then
+                        case patch (getBlobContent $ fromJust base) content of
+                            Right target -> do
+                                            let base'        = fromJust base
+                                            filename <- writeBlob repo (objType base') target
+                                            return $ Just filename
+                            Left _       -> return Nothing
+                    else return Nothing -- FIXME - base object doesn't exist yet
+            writeDelta _ _ = error "Don't expect a resolved object here"
 
 
 updateHead :: GitRepository -> Packfile -> IO ()