1. Stefan Saasen
  2. git-in-haskell-from-the-bottom-up

Commits

Stefan Saasen  committed c20a833

Rename readObject -> readBlob; WIP on resolving the Tree based on a <tree-ish>

  • Participants
  • Parent commits 95b327c
  • Branches master

Comments (0)

Files changed (3)

File src/Git/Repository.hs

View file
 import Text.Printf                                          (printf)
 import Git.Pack.Packfile
 import Git.Pack.Delta                                       (patch)
-import Git.Common                                           (GitRepository(..), eitherToMaybe)
+import Git.Common                                           (GitRepository(..), eitherToMaybe, ObjectId)
 -- Tree
 import Git.Store.Blob
 import Git.Store.ObjectStore
 import System.FilePath
 import System.Directory
-import Control.Monad                                        (unless, liftM)
+import Control.Monad                                        (unless, liftM, join)
 import Data.Char                                            (isSpace)
+import Data.Maybe
 import Debug.Trace
 
 -- | Updates files in the working tree to match the given <tree-ish>
 
 -- | Resolve a tree given a <tree-ish>
 -- Similar to `parse_tree_indirect` defined in tree.c
-resolveTree :: GitRepository -> ObjectId -> IO String
+resolveTree :: GitRepository -> ObjectId -> IO (Maybe Tree)
 resolveTree repo sha = do
-        obj <- readObject repo sha
-        return $ show obj
+        blob <- readBlob repo sha
+        return $ join $ fmap walk blob
+    where walk t@(Blob _ BTree _)                   = return $ Tree "tree" -- FIXME
+          walk c@(Blob _ BCommit _)                 = fmap extractTree $ parseCommit $ getBlobContent c
+          walk _                                    = error "Urgh"
 
 
 readHead :: GitRepository -> IO ObjectId

File src/Git/Store/Blob.hs

View file
   , parseCommit
   , parsePerson     -- Remove?
   , parseBlob
+  , toCommit
+  , extractTree
   , Commit(..)
   , Blob(..)
   , BlobType(..)
+  , Tree(..)
 ) where
 
 import Prelude hiding (take, takeWhile)
 import Data.Attoparsec.ByteString.Char8
 import Control.Applicative ((<|>))
 import Git.Common                                           (eitherToMaybe, ObjectId)
+import Debug.Trace
 {-
 data Person = Person {
     getPersonName     :: B.ByteString
     getBlobContent  :: B.ByteString
   , objType         :: BlobType
   , sha             :: ObjectId
-}
+} deriving (Eq, Show)
 
 --data Blob = BlobCommit Commit | BlobTree Tree deriving (Eq,Show)
 
 } deriving (Eq,Show)
 
 
+toCommit :: Blob -> Maybe Commit
+toCommit (Blob content BCommit _) = parseCommit content
+toCommit _ = Nothing
+
 parseBlob :: ObjectId -> C.ByteString -> Maybe Blob
 parseBlob sha1 blob = eitherToMaybe $ parseOnly (blobParser sha1) blob
 
+extractTree :: Commit -> Tree
+extractTree = Tree . C.unpack . getTree
+
 -- header: "type size\0"
 -- sha1 $ header ++ content
 blobParser :: ObjectId -> Parser Blob

File src/Git/Store/ObjectStore.hs

View file
   , createGitRepositoryFromPackfile
   , updateHead
   -- ?
-  , readObject
+  , readBlob
   , createRef
   , getGitDirectory
 ) where
 writeDelta :: GitRepository -> PackfileObject -> IO (Maybe FilePath)
 writeDelta repo (PackfileObject ty@(OBJ_REF_DELTA _) _ content) = do
         base <- case toObjectId ty of
-            Just sha -> readObject repo sha
+            Just sha -> readBlob repo sha
             _        -> return Nothing
         if isJust base then
             case patch (getBlobContent $ fromJust base) content of
 
 -- header: "type size\0"
 -- sha1 $ header ++ content
-readObject :: GitRepository -> ObjectId -> IO (Maybe Blob)
-readObject GitRepository{..} sha = do
+readBlob :: GitRepository -> ObjectId -> IO (Maybe Blob)
+readBlob GitRepository{..} sha = do
     let (path, name) = pathForObject getName sha
         filename     = path </> name
-    exists <- trace ("readObject: " ++ filename) $ doesFileExist filename
+    exists <- trace ("readBlob: " ++ filename) $ doesFileExist filename
     if exists then do
         bs <- C.readFile filename
         return $ parseBlob sha $ inflate bs