Commits

Stefan Saasen committed 9962892

Rename Blob to Object where it is being used to refer to the actual file 'blob' instead of the git object type

Comments (0)

Files changed (7)

src/Git/Repository.hs

 import qualified Data.ByteString as B
 import Text.Printf                                          (printf)
 import Git.Common                                           (GitRepository(..), ObjectId, WithRepository)
-import Git.Store.Blob
+import Git.Store.Object
 import Git.Store.ObjectStore
 import Git.Store.Index
 import System.FilePath
         repo <- ask
         blob <- liftIO $ readBlob repo sha' -- readBlob :: GitRepository -> ObjectId -> IO (Maybe Blob)
         maybe (return Nothing) walk blob
-    where walk  (Blob _ BTree sha1)                = do
+    where walk  (Object _ BTree sha1)                = do
                                                       repo <- ask
                                                       liftIO $ readTree repo sha1
-          walk  c@(Blob _ BCommit _)               = do
+          walk  c@(Object _ BCommit _)               = do
                                                         let maybeCommit = parseCommit $ getBlobContent c
                                                         maybe (return Nothing) extractTree maybeCommit
           walk _                                   = return Nothing

src/Git/Store/Blob.hs

-{-# LANGUAGE OverloadedStrings #-}
-
-module Git.Store.Blob (
-    parseTree
-  , parseCommit
-  , parsePerson     -- Remove?
-  , parseBlob
-  , toCommit
-  , Commit(..)
-  , Blob(..)
-  , BlobType(..)
-  , Tree(..)
-  , TreeEntry(..)
-) where
-
-import Prelude hiding (take, takeWhile)
-import qualified Data.ByteString.Char8 as C
-import qualified Data.ByteString as B
-import Data.Attoparsec.ByteString.Char8
-import Control.Applicative ((<|>))
-import Git.Common                                           (eitherToMaybe, ObjectId)
-
-data BlobType = BTree | BCommit | BTag | BBlob deriving (Eq)
-
-instance Show BlobType where
-    show BTree      = "tree"
-    show BCommit    = "commit"
-    show BTag       = "tag"
-    show BBlob      = "blob"
-
-data Blob = Blob {
-    getBlobContent  :: B.ByteString
-  , objType         :: BlobType
-  , sha             :: ObjectId
-} deriving (Eq, Show)
-
-data Author = Author B.ByteString B.ByteString deriving (Eq, Show)
-data Commiter = Commiter B.ByteString B.ByteString deriving (Eq, Show)
-
-data Tree = Tree {
-    getObjectId :: ObjectId
-  , getEntries  :: [TreeEntry]
-} deriving (Eq, Show)
-
-data TreeEntry = TreeEntry {
-    getMode    :: C.ByteString
-  , getPath    :: C.ByteString
-  , getBlobSha :: C.ByteString
-} deriving (Eq, Show)
-
-data Commit = Commit {
-    getTree        :: B.ByteString
-  , getParents     :: [B.ByteString]
-  , getSha         :: B.ByteString
-  , getAuthor      :: Author
-  , getCommiter    :: Commiter
-  , getMessage     :: B.ByteString
-} 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
-
--- header: "type size\0"
--- sha1 $ header ++ content
-blobParser :: ObjectId -> Parser Blob
-blobParser sha1 = do
-   objType' <- string "commit" <|> string "tree" <|> string "blob" <|> string "tag"
-   char ' '
-   _size <- takeWhile isDigit
-   nul
-   blob <- takeByteString
-   return $ Blob blob (obj objType') sha1
-   where obj "commit"   = BCommit
-         obj "tree"     = BTree
-         obj "tag"      = BTag
-         obj "blob"     = BBlob
-         obj _          = error "Invalid blob type" -- FIXME Let the parser fail
-
-
-parseTree :: ObjectId -> C.ByteString -> Maybe Tree
-parseTree sha' input = eitherToMaybe $ parseOnly (treeParser sha') input
-
-parseCommit :: C.ByteString -> Maybe Commit
-parseCommit input = eitherToMaybe $ parseOnly commitParser input
-
-{-
-from e.g. `ls-tree.c`, `tree-walk.c`
--}
-treeParser :: ObjectId -> Parser Tree
-treeParser sha' = do
-    entries <- many' treeEntryParser
-    return $ Tree sha' entries
-
-
--- | An entry in the tree has the following format:
---
--- @
--- mode SP path NUL sha1
--- @
---
--- E.g.
--- @
--- 100644 .ghci\NUL\208k\227\&0F\190\137A$\210\193\216j\247#\SI\ETBw;?
--- @
---
--- with:
---   * mode: octal
---   * SP: space
---   * path: filename
---   * NUL: null byte
---   * sha1: 20 byte of SHA1
-treeEntryParser :: Parser TreeEntry
-treeEntryParser = do
-    mode <- takeTill (== ' ')
-    space
-    path <- takeTill (== '\0')
-    nul
-    sha' <- take 20
-    return $ TreeEntry mode path sha'
-
-
-{-
-tree b5213cb334e855fb5c89edc99d54606377e15d70
-parent 3c1d7b88edaf2119aff47104de389867cad0f0fb
-author Stefan Saasen <stefan@saasen.me> 1361272292 +1100
-committer Stefan Saasen <stefan@saasen.me> 1361272292 +1100
-
-Remove git INSTALL instructions
-
--}
-commitParser :: Parser Commit
-commitParser = do
-    tree <- "tree " .*> take 40
-    space
-    parents <- many' parseParentCommit
-    author <- "author " .*> parsePerson
-    space
-    _commiter <- "committer " .*> parsePerson
-    space
-    space
-    message <- takeByteString
-    return $ Commit tree parents B.empty (Author (getPersonName author) (getPersonEmail author)) (Commiter "" "") message -- FIXME Use Commiter
-
-parseParentCommit :: Parser C.ByteString
-parseParentCommit = do
-   parent <- "parent " .*> take 40
-   space
-   return parent
-
-parsePerson :: Parser Person
-parsePerson = do
-    name <- takeWhile (/= '<')
-    email <- "<" .*> takeWhile (/= '>') <*. ">"
-    date <- takeTill (== '\n')
-    return $ Person name email date
-
-data Person = Person {
-    getPersonName   :: B.ByteString
-  , getPersonEmail  :: B.ByteString
-  , getDate         :: B.ByteString -- FIXME
-} deriving (Eq, Show)
-
-nul :: Parser Char
-nul = satisfy (== '\0')

src/Git/Store/Object.hs

+{-# LANGUAGE OverloadedStrings #-}
+
+module Git.Store.Object (
+    parseTree
+  , parseCommit
+  , parsePerson     -- Remove?
+  , parseObject
+  , toCommit
+  , Commit(..)
+  , Object(..)
+  , ObjectType(..)
+  , Tree(..)
+  , TreeEntry(..)
+) where
+
+import Prelude hiding (take, takeWhile)
+import qualified Data.ByteString.Char8 as C
+import qualified Data.ByteString as B
+import Data.Attoparsec.ByteString.Char8
+import Control.Applicative ((<|>))
+import Git.Common                                           (eitherToMaybe, ObjectId)
+
+data ObjectType = BTree | BCommit | BTag | BBlob deriving (Eq)
+
+instance Show ObjectType where
+    show BTree      = "tree"
+    show BCommit    = "commit"
+    show BTag       = "tag"
+    show BBlob      = "blob"
+
+data Object = Object {
+    getBlobContent  :: B.ByteString
+  , objType         :: ObjectType
+  , sha             :: ObjectId
+} deriving (Eq, Show)
+
+data Author = Author B.ByteString B.ByteString deriving (Eq, Show)
+data Commiter = Commiter B.ByteString B.ByteString deriving (Eq, Show)
+
+data Tree = Tree {
+    getObjectId :: ObjectId
+  , getEntries  :: [TreeEntry]
+} deriving (Eq, Show)
+
+data TreeEntry = TreeEntry {
+    getMode    :: C.ByteString
+  , getPath    :: C.ByteString
+  , getBlobSha :: C.ByteString
+} deriving (Eq, Show)
+
+data Commit = Commit {
+    getTree        :: B.ByteString
+  , getParents     :: [B.ByteString]
+  , getSha         :: B.ByteString
+  , getAuthor      :: Author
+  , getCommiter    :: Commiter
+  , getMessage     :: B.ByteString
+} deriving (Eq,Show)
+
+
+toCommit :: Object -> Maybe Commit
+toCommit (Object content BCommit _) = parseCommit content
+toCommit _ = Nothing
+
+parseObject :: ObjectId -> C.ByteString -> Maybe Object
+parseObject sha1 obj = eitherToMaybe $ parseOnly (objParser sha1) obj
+
+-- header: "type size\0"
+-- sha1 $ header ++ content
+objParser :: ObjectId -> Parser Object
+objParser sha1 = do
+   objType' <- string "commit" <|> string "tree" <|> string "blob" <|> string "tag"
+   char ' '
+   _size <- takeWhile isDigit
+   nul
+   content <- takeByteString
+   return $ Object content (obj objType') sha1
+   where obj "commit"   = BCommit
+         obj "tree"     = BTree
+         obj "tag"      = BTag
+         obj "blob"     = BBlob
+         obj _          = error "Invalid object type" -- FIXME Let the parser fail
+
+
+parseTree :: ObjectId -> C.ByteString -> Maybe Tree
+parseTree sha' input = eitherToMaybe $ parseOnly (treeParser sha') input
+
+parseCommit :: C.ByteString -> Maybe Commit
+parseCommit input = eitherToMaybe $ parseOnly commitParser input
+
+{-
+from e.g. `ls-tree.c`, `tree-walk.c`
+-}
+treeParser :: ObjectId -> Parser Tree
+treeParser sha' = do
+    entries <- many' treeEntryParser
+    return $ Tree sha' entries
+
+
+-- | An entry in the tree has the following format:
+--
+-- @
+-- mode SP path NUL sha1
+-- @
+--
+-- E.g.
+-- @
+-- 100644 .ghci\NUL\208k\227\&0F\190\137A$\210\193\216j\247#\SI\ETBw;?
+-- @
+--
+-- with:
+--   * mode: octal
+--   * SP: space
+--   * path: filename
+--   * NUL: null byte
+--   * sha1: 20 byte of SHA1
+treeEntryParser :: Parser TreeEntry
+treeEntryParser = do
+    mode <- takeTill (== ' ')
+    space
+    path <- takeTill (== '\0')
+    nul
+    sha' <- take 20
+    return $ TreeEntry mode path sha'
+
+
+{-
+tree b5213cb334e855fb5c89edc99d54606377e15d70
+parent 3c1d7b88edaf2119aff47104de389867cad0f0fb
+author Stefan Saasen <stefan@saasen.me> 1361272292 +1100
+committer Stefan Saasen <stefan@saasen.me> 1361272292 +1100
+
+Remove git INSTALL instructions
+
+-}
+commitParser :: Parser Commit
+commitParser = do
+    tree <- "tree " .*> take 40
+    space
+    parents <- many' parseParentCommit
+    author <- "author " .*> parsePerson
+    space
+    _commiter <- "committer " .*> parsePerson
+    space
+    space
+    message <- takeByteString
+    return $ Commit tree parents B.empty (Author (getPersonName author) (getPersonEmail author)) (Commiter "" "") message -- FIXME Use Commiter
+
+parseParentCommit :: Parser C.ByteString
+parseParentCommit = do
+   parent <- "parent " .*> take 40
+   space
+   return parent
+
+parsePerson :: Parser Person
+parsePerson = do
+    name <- takeWhile (/= '<')
+    email <- "<" .*> takeWhile (/= '>') <*. ">"
+    date <- takeTill (== '\n')
+    return $ Person name email date
+
+data Person = Person {
+    getPersonName   :: B.ByteString
+  , getPersonEmail  :: B.ByteString
+  , getDate         :: B.ByteString -- FIXME
+} deriving (Eq, Show)
+
+nul :: Parser Char
+nul = satisfy (== '\0')

src/Git/Store/ObjectStore.hs

 import Git.Pack.Delta                                       (patch)
 import Git.Common                                           (GitRepository(..), ObjectId, WithRepository, Ref(..))
 -- Tree
-import Git.Store.Blob
+import Git.Store.Object
 import System.FilePath
 import System.Directory
 import Data.Foldable                                        (forM_)
 
 -- header: "type size\0"
 -- sha1 $ header ++ content
-readBlob :: GitRepository -> ObjectId -> IO (Maybe Blob)
+readBlob :: GitRepository -> ObjectId -> IO (Maybe Object)
 readBlob GitRepository{..} sha = do
     let (path, name) = pathForObject getName sha
         filename     = path </> name
     exists <- doesFileExist filename
     if exists then do
         bs <- C.readFile filename
-        return $ parseBlob sha $ inflate bs
+        return $ parseObject sha $ inflate bs
     else return Nothing
     where inflate blob = B.concat . L.toChunks . Z.decompress $ L.fromChunks [blob]
 
 -- header: "type size\0"
 -- sha1 $ header ++ content
-encodeBlob :: BlobType -> C.ByteString -> (ObjectId, C.ByteString)
+encodeBlob :: ObjectType -> C.ByteString -> (ObjectId, C.ByteString)
 encodeBlob blobType content = do
     let header       = headerForBlob (C.pack $ show blobType)
         blob         = header `C.append` content
     where headerForBlob objType = objType `C.append` " " `C.append` C.pack (show $ C.length content) `C.append` "\0"
           hsh = toHex . SHA1.hash
 
-writeBlob :: GitRepository -> BlobType -> C.ByteString -> IO FilePath
+writeBlob :: GitRepository -> ObjectType -> C.ByteString -> IO FilePath
 writeBlob GitRepository{..} blobType content = do
     let (sha1, blob) = encodeBlob blobType content
         (path, name) = pathForObject getName sha1

tests/src/Git/Store/BlobTest.hs

-{-# LANGUAGE OverloadedStrings #-}
-module Git.Store.BlobTest
-  (
-    main
-  , test
-  ) where
-
-import qualified Test.HUnit as H
-import Git.Store.Blob
-import Test.QuickCheck hiding ((.&.))
-import Test.Framework (Test, defaultMain, testGroup)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.Framework.Providers.HUnit
-import Data.Maybe
-
-main :: IO ()
-main = defaultMain [test]
-
-commit_1 = "tree b5213cb334e855fb5c89edc99d54606377e15d70\nparent 3c1d7b88edaf2119aff47104de389867cad0f0fb\nauthor Stefan Saasen <stefan@saasen.me> 1361272292 +1100\ncommitter Stefan Saasen <stefan@saasen.me> 1361272292 +1100\n\nRemove git INSTALL instructions\n"
-
-commit_no_parent = "tree 920512d27e4df0c79ca4a929bc5d4254b3d05c4c\nauthor Stefan Saasen <ssaasen@atlassian.com> 1362201640 +1100\ncommitter Stefan Saasen <ssaasen@atlassian.com> 1362201640 +1100\n\nAdd test.txt\n"
-
-commit_merge = "tree 639e28af470be85166a2bbfcaa2835fc68a257a5\nparent 7517fa2cf314c8c9f5e54aa5ae8fab514c88e2cf\nparent e5fe0a4bfbf1d28d41805c8e80e4ffd826c30ac9\nauthor Ludovic Landry <landry.ludovic+github@gmail.com> 1350079175 -0700\ncommitter Ludovic Landry <landry.ludovic+github@gmail.com> 1350079175 -0700\n\nMerge e5fe0a4bfbf1d28d41805c8e80e4ffd826c30ac9 into 7517fa2cf314c8c9f5e54aa5ae8fab514c88e2cf"
-
-tree_1 = "100644 M.hs\NUL\130N\229H6\233\249\USd\n\DC3I\223'\CANp;\165\158\150\&100644 RunMain.hs\NUL\240i\182\&3g\183\194\241-\131\187W\137\ESC\CAN\f\SOHX\180\174"
-
-test_parseValidCommit = H.assertBool
-    "A valid commit should be successfully parsed"
-    (isJust $ parseCommit commit_1)
-
-test_parseValidCommitTree = H.assertEqual
-    ""
-    "b5213cb334e855fb5c89edc99d54606377e15d70"
-    (getTree $ fromJust $ parseCommit commit_1)
-
-test_parseValidCommitParent = H.assertEqual
-    ""
-    "3c1d7b88edaf2119aff47104de389867cad0f0fb"
-    (head $ getParents $ fromJust $ parseCommit commit_1)
-
-test_parseValidCommitMerge = H.assertEqual
-    ""
-    ["7517fa2cf314c8c9f5e54aa5ae8fab514c88e2cf", "e5fe0a4bfbf1d28d41805c8e80e4ffd826c30ac9"]
-    (getParents $ fromJust $ parseCommit commit_merge)
-
-test_parseValidCommitRootWithoutParent = H.assertEqual
-    ""
-    []
-    (getParents $ fromJust $ parseCommit commit_no_parent)
-
-
-
--- =================================================================================
-
-test_parseValidTree = H.assertBool
-    "Should be able to parse a valid Tree blob"
-    (isJust $ parseTree "abc" tree_1)
-
-test_parseValidTreeEntries = H.assertEqual
-    "Should be able to parse a valid Tree blob"
-    (Just 2)
-    (fmap (length . getEntries) $ parseTree "abc" tree_1)
-
-test_parseValidTreeEntryPath = H.assertEqual
-    "Should be able to parse a valid Tree blob"
-    (Just "M.hs")
-    (fmap (getPath . head . getEntries) $ parseTree "abc" tree_1)
-
-test_parseValidTreeEntryMode = H.assertEqual
-    "Should be able to parse a valid Tree blob"
-    (Just "100644")
-    (fmap (getMode . head . getEntries) $ parseTree "abc" tree_1)
-
-test :: Test
-test = testGroup "Objects"
-    [
-        testCase "parseCommit/1"    test_parseValidCommit
-      , testCase "parseCommit/2"    test_parseValidCommitTree
-      , testCase "parseCommit/3"    test_parseValidCommitParent
-      , testCase "parseCommit/4"    test_parseValidCommitRootWithoutParent
-      , testCase "parseCommit/5"    test_parseValidCommitMerge
-      , testCase "parseTree/1"      test_parseValidTree
-      , testCase "parseTree/2"      test_parseValidTreeEntries
-      , testCase "parseTree/3"      test_parseValidTreeEntryPath
-      , testCase "parseTree/4"      test_parseValidTreeEntryMode
-    ]
-
-
-

tests/src/Git/Store/ObjectTest.hs

+{-# LANGUAGE OverloadedStrings #-}
+module Git.Store.ObjectTest
+  (
+    main
+  , test
+  ) where
+
+import qualified Test.HUnit as H
+import Git.Store.Object
+import Test.QuickCheck hiding ((.&.))
+import Test.Framework (Test, defaultMain, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.Framework.Providers.HUnit
+import Data.Maybe
+
+main :: IO ()
+main = defaultMain [test]
+
+commit_1 = "tree b5213cb334e855fb5c89edc99d54606377e15d70\nparent 3c1d7b88edaf2119aff47104de389867cad0f0fb\nauthor Stefan Saasen <stefan@saasen.me> 1361272292 +1100\ncommitter Stefan Saasen <stefan@saasen.me> 1361272292 +1100\n\nRemove git INSTALL instructions\n"
+
+commit_no_parent = "tree 920512d27e4df0c79ca4a929bc5d4254b3d05c4c\nauthor Stefan Saasen <ssaasen@atlassian.com> 1362201640 +1100\ncommitter Stefan Saasen <ssaasen@atlassian.com> 1362201640 +1100\n\nAdd test.txt\n"
+
+commit_merge = "tree 639e28af470be85166a2bbfcaa2835fc68a257a5\nparent 7517fa2cf314c8c9f5e54aa5ae8fab514c88e2cf\nparent e5fe0a4bfbf1d28d41805c8e80e4ffd826c30ac9\nauthor Ludovic Landry <landry.ludovic+github@gmail.com> 1350079175 -0700\ncommitter Ludovic Landry <landry.ludovic+github@gmail.com> 1350079175 -0700\n\nMerge e5fe0a4bfbf1d28d41805c8e80e4ffd826c30ac9 into 7517fa2cf314c8c9f5e54aa5ae8fab514c88e2cf"
+
+tree_1 = "100644 M.hs\NUL\130N\229H6\233\249\USd\n\DC3I\223'\CANp;\165\158\150\&100644 RunMain.hs\NUL\240i\182\&3g\183\194\241-\131\187W\137\ESC\CAN\f\SOHX\180\174"
+
+test_parseValidCommit = H.assertBool
+    "A valid commit should be successfully parsed"
+    (isJust $ parseCommit commit_1)
+
+test_parseValidCommitTree = H.assertEqual
+    ""
+    "b5213cb334e855fb5c89edc99d54606377e15d70"
+    (getTree $ fromJust $ parseCommit commit_1)
+
+test_parseValidCommitParent = H.assertEqual
+    ""
+    "3c1d7b88edaf2119aff47104de389867cad0f0fb"
+    (head $ getParents $ fromJust $ parseCommit commit_1)
+
+test_parseValidCommitMerge = H.assertEqual
+    ""
+    ["7517fa2cf314c8c9f5e54aa5ae8fab514c88e2cf", "e5fe0a4bfbf1d28d41805c8e80e4ffd826c30ac9"]
+    (getParents $ fromJust $ parseCommit commit_merge)
+
+test_parseValidCommitRootWithoutParent = H.assertEqual
+    ""
+    []
+    (getParents $ fromJust $ parseCommit commit_no_parent)
+
+
+
+-- =================================================================================
+
+test_parseValidTree = H.assertBool
+    "Should be able to parse a valid Tree blob"
+    (isJust $ parseTree "abc" tree_1)
+
+test_parseValidTreeEntries = H.assertEqual
+    "Should be able to parse a valid Tree blob"
+    (Just 2)
+    (fmap (length . getEntries) $ parseTree "abc" tree_1)
+
+test_parseValidTreeEntryPath = H.assertEqual
+    "Should be able to parse a valid Tree blob"
+    (Just "M.hs")
+    (fmap (getPath . head . getEntries) $ parseTree "abc" tree_1)
+
+test_parseValidTreeEntryMode = H.assertEqual
+    "Should be able to parse a valid Tree blob"
+    (Just "100644")
+    (fmap (getMode . head . getEntries) $ parseTree "abc" tree_1)
+
+test :: Test
+test = testGroup "Objects"
+    [
+        testCase "parseCommit/1"    test_parseValidCommit
+      , testCase "parseCommit/2"    test_parseValidCommitTree
+      , testCase "parseCommit/3"    test_parseValidCommitParent
+      , testCase "parseCommit/4"    test_parseValidCommitRootWithoutParent
+      , testCase "parseCommit/5"    test_parseValidCommitMerge
+      , testCase "parseTree/1"      test_parseValidTree
+      , testCase "parseTree/2"      test_parseValidTreeEntries
+      , testCase "parseTree/3"      test_parseValidTreeEntryPath
+      , testCase "parseTree/4"      test_parseValidTreeEntryMode
+    ]
+
+
+

tests/src/TestRunner.hs

 
 import qualified Git.CommonTests
 import qualified Git.RemoteTests
-import qualified Git.Store.BlobTest
+import qualified Git.Store.ObjectTest
 import Test.Framework
 
 main ::
       [
           Git.CommonTests.test
         , Git.RemoteTests.test
-        , Git.Store.BlobTest.test
+        , Git.Store.ObjectTest.test
       ]
   ]