Permalink
Browse files

pack: return found objects, add commit headers to commit poData

Now commit data is found from pack objects, and git log works with packs.
  • Loading branch information...
1 parent d51cb86 commit 101c18acff549f09a2fc58f6c4b182e1fdb5e6de @kfish committed May 11, 2011
Showing with 39 additions and 21 deletions.
  1. +14 −2 Git/Blob.hs
  2. +12 −0 Git/Pack.hs
  3. +8 −13 Git/PackIndex.hs
  4. +5 −6 tools/ght.hs
View
@@ -9,24 +9,36 @@ module Git.Blob (
import Codec.Compression.Zlib
import Control.Applicative ((<$>))
import Control.Monad
+import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (listToMaybe)
-- show-prefix, show-root use these
import System.FilePath
import System.Posix.Files
+import System.IO
import Git.Commit
+import Git.Pack
+import Git.PackIndex
import Git.Path
+import Git.SHA
------------------------------------------------------------
-readBlob :: String -> IO C.ByteString
+readBlob :: String -> IO (Maybe L.ByteString)
readBlob blob = do
let (bH,bT) = splitAt 2 blob
path <- gitPath ("objects" </> bH </> bT)
- decompress <$> L.readFile path
+ exists <- fileExist path
+ if exists
+ then do
+ Just . decompress <$> C.readFile path
+ else do
+ let sha = readDigestBS blob
+ m'po <- findInPackIdxs sha
+ return $ fmap (packObjectPretty sha) m'po
prettyBlob :: String -> C.ByteString -> C.ByteString
prettyBlob blob bs
View
@@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS -Wall #-}
module Git.Pack (
@@ -8,6 +9,7 @@ module Git.Pack (
PackObjectType,
packPretty,
+ packObjectPretty,
-- * Iteratee
packRead,
@@ -145,6 +147,16 @@ packObjectRead = do
castEnum = toEnum . fromEnum
+packObjectPretty :: ByteString -> PackObject -> L.ByteString
+packObjectPretty sha PackObject{..}
+ | poType == OBJ_COMMIT =
+ C.concat [commitHeader, sha'c, C.pack "\n", poData'c]
+ | otherwise = poData'c
+ where
+ commitHeader = C.pack "commit "
+ sha'c = C.fromChunks [sha]
+ poData'c = C.fromChunks [poData]
+
------------------------------------------------------------
-- packPretty
--
View
@@ -10,6 +10,7 @@ module Git.PackIndex (
) where
import Control.Applicative ((<$>))
+import Control.Monad (msum)
import qualified Data.ByteString as BS
import Data.Word (Word32)
import Foreign.Ptr
@@ -112,7 +113,7 @@ idxFind :: IDX -> BS.ByteString -> IO (Maybe (IDX, Int))
idxFind idx sha = idxFind' 0 (idxSize idx)
where
idxFind' lo hi
- | lo == hi = do
+ | lo >= hi = do
iSha <- idxSha1 idx lo
case (sha `compare` iSha) of
EQ -> return (Just (idx, lo))
@@ -122,30 +123,24 @@ idxFind idx sha = idxFind' 0 (idxSize idx)
case (sha `compare` iSha) of
EQ -> return (Just (idx, i))
LT -> idxFind' lo i
- GT -> idxFind' i hi
+ GT -> idxFind' (i+1) hi
where
i = floor ((fromIntegral (lo + hi)) / 2.0 :: Double)
-findInPackIdxs :: BS.ByteString -> IO ()
+findInPackIdxs :: BS.ByteString -> IO (Maybe PackObject)
findInPackIdxs sha = do
idxs <- idxFiles
- mapM_ (findInPackIndex' sha) idxs
+ msum <$> mapM (findInPackIndex' sha) idxs
-findInPackIndex' :: BS.ByteString -> FilePath -> IO ()
+findInPackIndex' :: BS.ByteString -> FilePath -> IO (Maybe PackObject)
findInPackIndex' sha fp = do
idx <- readIdx fp
m'i <- idxFind idx sha
case m'i of
Just (_, i) -> do
off <- idxOffset idx i
- m'po <- packReadObject (idxPack idx) off
- case m'po of
- Just PackObject{..} -> do
- putStrLn $ "Found at index " ++ show i
- putStrLn $ show poType
- putStrLn $ show poData
- Nothing -> putStrLn $ "Error reading pack"
- Nothing -> putStrLn $ "Not found"
+ packReadObject (idxPack idx) off
+ Nothing -> return Nothing
------------------------------------------------------------
-- Debugging
View
@@ -3,7 +3,7 @@
module Main where
import Control.Applicative ((<$>))
-import Control.Monad ((<=<))
+import Control.Monad ((<=<), join)
import Control.Monad.Trans (liftIO)
import Data.Default
@@ -109,8 +109,7 @@ ghtLogHandler = liftIO . showLog =<< liftIO . findBlob =<< appArgs
showLog (blob:_)
| blob == "" = return ()
| otherwise = do
- d <- readBlob blob
- let m'pb = prettyLog blob d
+ m'pb <- join . fmap (prettyLog blob) <$> readBlob blob
case m'pb of
Just c -> do
let p = C.concat [commitHeader, C.pack (blob ++ "\n"), commitPretty c]
@@ -169,7 +168,7 @@ ghtFindIdx = defCmd {
ghtFindIdxHandler = do
(sha:_) <- appArgs
- liftIO $ findInPackIdxs (readDigestBS sha)
+ liftIO $ print =<< findInPackIdxs (readDigestBS sha)
------------------------------------------------------------
-- show-raw
@@ -185,7 +184,7 @@ ghtShowRaw = defCmd {
ghtShowRawHandler = liftIO . showRawBlob =<< liftIO . findBlob =<< appArgs
-showRawBlob (blob:_) = L.hPut stdout =<< readBlob blob
+showRawBlob (blob:_) = maybe (putStrLn "Not found") (L.hPut stdout) =<< readBlob blob
------------------------------------------------------------
-- show
@@ -201,7 +200,7 @@ ghtShow = defCmd {
ghtShowHandler = liftIO . showBlob =<< liftIO . findBlob =<< appArgs
-showBlob (blob:_) = L.hPut stdout =<< prettyBlob blob <$> readBlob blob
+showBlob (blob:_) = maybe (putStrLn "Not found") (C.hPut stdout . prettyBlob blob) =<< readBlob blob
------------------------------------------------------------
-- hash-object

0 comments on commit 101c18a

Please sign in to comment.