From 7092528091981136e0ff927fd67dd457ca2d9c0d Mon Sep 17 00:00:00 2001
From: Vincent Hanquez <vincent@snarc.org>
Date: Sun, 22 May 2016 17:06:08 +0100
Subject: [PATCH] add signatures
---
Data/Git/Config.hs | 4 ++++
Data/Git/Delta.hs | 1 +
Data/Git/OS.hs | 10 ++++++++++
Data/Git/Parser.hs | 9 ++++++++-
Data/Git/Path.hs | 9 +++++++++
Data/Git/Ref.hs | 3 +++
Data/Git/Repository.hs | 1 +
Data/Git/Revision.hs | 18 ++++++------------
Data/Git/Storage.hs | 4 ++++
Data/Git/Storage/CacheFile.hs | 3 +--
Data/Git/Storage/FileReader.hs | 3 ++-
Data/Git/Storage/FileWriter.hs | 7 +++++++
Data/Git/Storage/Loose.hs | 17 ++++++++++-------
Data/Git/Storage/Object.hs | 13 +++++++++++++
Data/Git/Storage/Pack.hs | 6 ++++++
Data/Git/Storage/PackIndex.hs | 6 ++++++
git.cabal | 3 ++-
17 files changed, 93 insertions(+), 24 deletions(-)
diff --git a/Data/Git/Config.hs b/Data/Git/Config.hs
index 82e9de8..03c7198 100644
--- a/Data/Git/Config.hs
+++ b/Data/Git/Config.hs
@@ -61,9 +61,13 @@ parseConfig = Config . reverse . toSections . foldl accSections ([], Nothing) .
strip s = dropSpaces $ reverse $ dropSpaces $ reverse s
where dropSpaces = dropWhile (\c -> c == ' ' || c == '\t')
+readConfigPath :: LocalPath -> IO Config
readConfigPath filepath = parseConfig <$> readTextFile filepath
+
+readConfig :: LocalPath -> IO Config
readConfig gitRepo = readConfigPath (configPath gitRepo)
+readGlobalConfig :: IO Config
readGlobalConfig = getHomeDirectory >>= readConfigPath . (\homeDir -> homeDir </> ".gitconfig")
listSections :: [Config] -> [String]
diff --git a/Data/Git/Delta.hs b/Data/Git/Delta.hs
index 020f0d2..3757f0c 100644
--- a/Data/Git/Delta.hs
+++ b/Data/Git/Delta.hs
@@ -36,6 +36,7 @@ data DeltaCmd =
-- * if first byte MSB is set, we copy from source.
-- * otherwise, we copy from delta.
-- * extensions are not handled.
+deltaParse :: P.Parser Delta
deltaParse = do
srcSize <- getDeltaHdrSize
resSize <- getDeltaHdrSize
diff --git a/Data/Git/OS.hs b/Data/Git/OS.hs
index ca3c089..9c1b70c 100644
--- a/Data/Git/OS.hs
+++ b/Data/Git/OS.hs
@@ -33,6 +33,7 @@ module Data.Git.OS
, valid
, getSize
, MTime(..)
+ , timeZero
, getMTime
, withFile
, rename
@@ -60,19 +61,28 @@ import qualified Data.ByteString.Lazy as L
type LocalPath = FilePath
+listDirectoryFilename :: LocalPath -> IO [String]
listDirectoryFilename dir =
map (Rules.encodeString Rules.posix . filename) <$> listDirectory dir
+createParentDirectory :: LocalPath -> IO ()
createParentDirectory filepath = createTree $ parent filepath
+readTextFile :: LocalPath -> IO String
readTextFile filepath = Prelude.readFile (encodeString filepath)
+writeTextFile :: LocalPath -> String -> IO ()
writeTextFile filepath = Prelude.writeFile (encodeString filepath)
newtype MTime = MTime EpochTime deriving (Eq,Ord)
+timeZero :: EpochTime
+timeZero = 0
+
+getMTime :: LocalPath -> IO MTime
getMTime filepath = MTime . modificationTime <$> getFileStatus (encodeString filepath)
+getEnvAsPath :: String -> IO LocalPath
getEnvAsPath envName = Rules.decodeString Rules.posix <$> getEnv envName
localPathDecode :: B.ByteString -> LocalPath
diff --git a/Data/Git/Parser.hs b/Data/Git/Parser.hs
index f57b9cf..095705b 100644
--- a/Data/Git/Parser.hs
+++ b/Data/Git/Parser.hs
@@ -32,9 +32,10 @@ module Data.Git.Parser
) where
import qualified Data.ByteArray.Parse as P
+import Data.ByteArray (ByteArray)
import Data.Bits
-import Data.Word (Word8)
+import Data.Word (Word8, Word32)
import Data.Char (isDigit)
import qualified Data.ByteString as B
@@ -52,8 +53,10 @@ vlf = do
l <- P.anyByte
return $ (map (\w -> w `clearBit` 7) $ B.unpack bs) ++ [l]
+word32 :: Parser Word32
word32 = be32 <$> P.take 4
+ref, referenceBin, referenceHex :: Parser Ref
ref = referenceBin
referenceBin = fromBinary <$> P.take 20
referenceHex = fromHex <$> P.take 40
@@ -77,6 +80,7 @@ maybeParseChunks p (i:is) = loop (P.parse p i) is
loop (P.ParseMore c) (x:xs) = loop (c $ Just x) xs
loop _ _ = Nothing
+toMaybe :: P.Result t a -> Maybe a
toMaybe (P.ParseOK _ a) = Just a
toMaybe (P.ParseMore c) = toMaybe (c Nothing)
toMaybe _ = Nothing
@@ -93,10 +97,12 @@ eitherParseChunks p (i:is) = loop (P.parse p i) is
loop (P.ParseMore c) (x:xs) = loop (c $ Just x) xs
loop ps l = Left ("eitherParseChunk: error: " <> show ps <> " : " <> show l)
+toEither :: P.Result t b -> Either String b
toEither (P.ParseOK _ a) = Right a
toEither (P.ParseFail e) = Left e
toEither (P.ParseMore c) = toEither (c Nothing)
+takeUntilASCII :: ByteArray byteArray => Char -> P.Parser byteArray byteArray
takeUntilASCII char = P.takeWhile (\c -> if fromEnum c < 0x80 then fromEnum c /= fromEnum char else True)
tillEOL :: Parser B.ByteString
@@ -115,6 +121,7 @@ skipASCII c
asciiEOL :: Word8
asciiEOL = fromIntegral $ fromEnum '\n'
+isByte :: ByteArray byteArray => (Word8 -> Bool) -> P.Parser byteArray Word8
isByte predicate = do
b <- P.anyByte
if predicate b then return b else fail "isByte"
diff --git a/Data/Git/Path.hs b/Data/Git/Path.hs
index ff846ae..277cf63 100644
--- a/Data/Git/Path.hs
+++ b/Data/Git/Path.hs
@@ -14,6 +14,7 @@ import Data.Git.Imports
import Data.Git.OS
import Data.String
+configPath, headsPath, tagsPath, remotesPath, packedRefsPath :: LocalPath -> LocalPath
configPath gitRepo = gitRepo </> "config"
headsPath gitRepo = gitRepo </> "refs" </> "heads" </> ""
@@ -21,25 +22,33 @@ tagsPath gitRepo = gitRepo </> "refs" </> "tags" </> ""
remotesPath gitRepo = gitRepo </> "refs" </> "remotes" </> ""
packedRefsPath gitRepo = gitRepo </> "packed-refs"
+headPath, tagPath, remotePath, specialPath :: LocalPath -> String -> LocalPath
headPath gitRepo name = headsPath gitRepo </> fromString name
tagPath gitRepo name = tagsPath gitRepo </> fromString name
remotePath gitRepo name = remotesPath gitRepo </> fromString name
specialPath gitRepo name = gitRepo </> fromString name
+remoteEntPath :: LocalPath -> String -> String -> LocalPath
remoteEntPath gitRepo name ent = remotePath gitRepo name </> fromString ent
+packDirPath :: LocalPath -> LocalPath
packDirPath repoPath = repoPath </> "objects" </> "pack"
+indexPath, packPath :: LocalPath -> Ref -> LocalPath
indexPath repoPath indexRef =
packDirPath repoPath </> fromString ("pack-" ++ toHexString indexRef ++ ".idx")
packPath repoPath packRef =
packDirPath repoPath </> fromString ("pack-" ++ toHexString packRef ++ ".pack")
+objectPath :: LocalPath -> String -> String -> LocalPath
objectPath repoPath d f = repoPath </> "objects" </> fromString d </> fromString f
+
+objectPathOfRef :: LocalPath -> Ref -> LocalPath
objectPathOfRef repoPath ref = objectPath repoPath d f
where (d,f) = toFilePathParts ref
+objectTemporaryPath :: LocalPath -> IO LocalPath
objectTemporaryPath repoPath = do
r <- fst . random <$> getStdGen :: IO Int
return (repoPath </> "objects" </> fromString ("tmp-" ++ show r ++ ".tmp"))
diff --git a/Data/Git/Ref.hs b/Data/Git/Ref.hs
index 0277846..53ebcce 100644
--- a/Data/Git/Ref.hs
+++ b/Data/Git/Ref.hs
@@ -63,7 +63,10 @@ data RefNotFound = RefNotFound Ref
instance Exception RefInvalid
instance Exception RefNotFound
+isHex :: ByteString -> Bool
isHex = and . map isHexDigit . BC.unpack
+
+isHexString :: String -> Bool
isHexString = and . map isHexDigit
-- | take a hexadecimal bytestring that represent a reference
diff --git a/Data/Git/Repository.hs b/Data/Git/Repository.hs
index b294fef..244ae1d 100644
--- a/Data/Git/Repository.hs
+++ b/Data/Git/Repository.hs
@@ -75,6 +75,7 @@ data InvalidType = InvalidType Ref ObjectType
instance Exception InvalidType
-- should be a standard function that do that...
+mapJustM :: Monad m => (t -> m (Maybe a)) -> Maybe t -> m (Maybe a)
mapJustM f (Just o) = f o
mapJustM _ Nothing = return Nothing
diff --git a/Data/Git/Revision.hs b/Data/Git/Revision.hs
index d13095b..42fb472 100644
--- a/Data/Git/Revision.hs
+++ b/Data/Git/Revision.hs
@@ -87,11 +87,13 @@ revFromString s = either (error.show) fst $ runStream parser s
RevModAtDate <$> many (noneOf "}")
-- combinator
-char c = eatRet (\x -> if x == c then Just c else Nothing)
-string s = prefix (\x -> if isPrefixOf s x then Just (s, length s) else Nothing)
-digit = eatRet (\x -> if isDigit x then Just x else Nothing)
-noneOf l = eatRet (\x -> if not (x `elem` l) then Just x else Nothing)
+ char c = eatRet (\x -> if x == c then Just c else Nothing)
+ string str = prefix (\x -> if isPrefixOf str x then Just (str, length str) else Nothing)
+ digit = eatRet (\x -> if isDigit x then Just x else Nothing)
+ noneOf l = eatRet (\x -> if not (x `elem` l) then Just x else Nothing)
+
+prefix :: ([elem] -> Maybe (a, Int)) -> Stream elem a
prefix predicate = Stream $ \el ->
case el of
[] -> Left ("empty stream: prefix")
@@ -109,14 +111,6 @@ eatRet predicate = Stream $ \el ->
Just a -> Right (a, xs)
Nothing -> Left ("unexpected atom got: " ++ show x)
-eat :: Show elem => (elem -> Bool) -> Stream elem ()
-eat predicate = Stream $ \el ->
- case el of
- [] -> Left ("empty stream: eating")
- x:xs
- | predicate x -> Right ((), xs)
- | otherwise -> Left ("unexpected atom got: " ++ show x)
-
newtype Stream elem a = Stream { runStream :: [elem] -> Either String (a, [elem]) }
instance Functor (Stream elem) where
fmap f s = Stream $ \e1 -> case runStream s e1 of
diff --git a/Data/Git/Storage.hs b/Data/Git/Storage.hs
index 2d22bdb..f5cbad8 100644
--- a/Data/Git/Storage.hs
+++ b/Data/Git/Storage.hs
@@ -141,6 +141,7 @@ findRepo = do
if e then return filepath else checkDir (n+1) (if absolute wd then parent wd else wd </> "..")
-- | execute a function f with a git context.
+withRepo :: LocalPath -> (Git -> IO c) -> IO c
withRepo path f = bracket (openRepo path) closeRepo f
-- | execute a function on the current repository.
@@ -187,6 +188,9 @@ setDescription git desc = do
writeTextFile descriptionPath desc
where descriptionPath = (gitRepoPath git) </> "description"
+iterateIndexes :: Git
+ -> (b -> (Ref, PackIndexReader) -> IO (b, Bool))
+ -> b -> IO b
iterateIndexes git f initAcc = do
allIndexes <- packIndexEnumerate (gitRepoPath git)
readers <- readIORef (indexReaders git)
diff --git a/Data/Git/Storage/CacheFile.hs b/Data/Git/Storage/CacheFile.hs
index 3bfb33f..4b53e68 100644
--- a/Data/Git/Storage/CacheFile.hs
+++ b/Data/Git/Storage/CacheFile.hs
@@ -20,8 +20,6 @@ data CacheFile a = CacheFile
, cacheLock :: MVar (MTime, a)
}
-timeZero = 0
-
newCacheVal :: LocalPath -> IO a -> a -> IO (CacheFile a)
newCacheVal path refresh initialVal =
CacheFile path refresh initialVal <$> newMVar (MTime timeZero, initialVal)
@@ -35,4 +33,5 @@ getCacheVal cachefile = modifyMVar (cacheLock cachefile) getOrRefresh
Just newMtime | newMtime > mtime -> cacheRefresh cachefile >>= \v -> return ((newMtime, v), v)
| otherwise -> return (s, cachedVal)
+tryGetMTime :: LocalPath -> IO (Maybe MTime)
tryGetMTime filepath = (Just <$> getMTime filepath) `E.catch` \(_ :: E.SomeException) -> return Nothing
diff --git a/Data/Git/Storage/FileReader.hs b/Data/Git/Storage/FileReader.hs
index 5f7262f..f08aa2a 100644
--- a/Data/Git/Storage/FileReader.hs
+++ b/Data/Git/Storage/FileReader.hs
@@ -168,12 +168,13 @@ fileReaderInflateToSize fb@(FileReader { fbRemaining = ref }) outputSize = do
augmentAndRaise left exn = throwIO $ InflateException outputSize left (show exn)
-- lowlevel helpers to inflate only to a specific size.
-
+inflateNew :: IO (ForeignPtr ZStreamStruct)
inflateNew = do
zstr <- zstreamNew
inflateInit2 zstr defaultWindowBits
newForeignPtr c_free_z_stream_inflate zstr
+inflateToSize :: ForeignPtr ZStreamStruct -> Int -> Bool -> ByteString -> IO ByteString -> IO (ByteString, ByteString)
inflateToSize inflate sz isLastBlock ibs nextBs = withForeignPtr inflate $ \zstr -> do
let boundSz = min defaultChunkSize sz
-- create an output buffer
diff --git a/Data/Git/Storage/FileWriter.hs b/Data/Git/Storage/FileWriter.hs
index 3a9074d..4eda473 100644
--- a/Data/Git/Storage/FileWriter.hs
+++ b/Data/Git/Storage/FileWriter.hs
@@ -16,6 +16,7 @@ import Control.Exception (bracket)
import Crypto.Hash
+defaultCompression :: Int
defaultCompression = 6
-- this is a copy of modifyIORef' found in base 4.6 (ghc 7.6),
@@ -32,6 +33,7 @@ data FileWriter = FileWriter
, writerDigest :: IORef (Context SHA1)
}
+fileWriterNew :: Handle -> IO FileWriter
fileWriterNew handle = do
deflate <- initDeflate defaultCompression defaultWindowBits
digest <- newIORef hashInit
@@ -41,17 +43,22 @@ fileWriterNew handle = do
, writerDigest = digest
}
+withFileWriter :: LocalPath -> (FileWriter -> IO c) -> IO c
withFileWriter path f =
bracket (openFile path WriteMode) (hClose) $ \handle ->
bracket (fileWriterNew handle) (fileWriterClose) f
+postDeflate :: Handle -> Maybe B.ByteString -> IO ()
postDeflate handle = maybe (return ()) (B.hPut handle)
+fileWriterOutput :: FileWriter -> B.ByteString -> IO ()
fileWriterOutput (FileWriter { writerHandle = handle, writerDigest = digest, writerDeflate = deflate }) bs = do
modifyIORefStrict digest (\ctx -> hashUpdate ctx bs)
(>>= postDeflate handle) =<< feedDeflate deflate bs
+fileWriterClose :: FileWriter -> IO ()
fileWriterClose (FileWriter { writerHandle = handle, writerDeflate = deflate }) =
postDeflate handle =<< finishDeflate deflate
+fileWriterGetDigest :: FileWriter -> IO Ref
fileWriterGetDigest (FileWriter { writerDigest = digest }) = (fromDigest . hashFinalize) `fmap` readIORef digest
diff --git a/Data/Git/Storage/Loose.hs b/Data/Git/Storage/Loose.hs
index 997e0dc..ed7137f 100644
--- a/Data/Git/Storage/Loose.hs
+++ b/Data/Git/Storage/Loose.hs
@@ -57,6 +57,7 @@ readZippedFile fp = Zipped <$> readBinaryFileLazy fp
dezip :: Zipped -> L.ByteString
dezip = decompress . getZippedData
+isObjectPrefix :: [Char] -> Bool
isObjectPrefix [a,b] = isHexDigit a && isHexDigit b
isObjectPrefix _ = False
@@ -70,6 +71,7 @@ parseHeader = do
data HeaderType = HeaderTree | HeaderTag | HeaderCommit | HeaderBlob
+parseTreeHeader, parseTagHeader, parseCommitHeader, parseBlobHeader :: P.Parser HeaderType
parseTreeHeader = P.string "tree " >> parseLength >> P.byte 0 >> return HeaderTree
parseTagHeader = P.string "tag " >> parseLength >> P.byte 0 >> return HeaderTag
parseCommitHeader = P.string "commit " >> parseLength >> P.byte 0 >> return HeaderCommit
@@ -78,13 +80,6 @@ parseBlobHeader = P.string "blob " >> parseLength >> P.byte 0 >> return Header
parseLength :: P.Parser Int
parseLength = P.decimal
-{-
-parseTree = parseTreeHeader >> objectParseTree
-parseTag = parseTagHeader >> objectParseTag
-parseCommit = parseCommitHeader >> objectParseCommit
-parseBlob = parseBlobHeader >> objectParseBlob
--}
-
parseObject :: L.ByteString -> Object
parseObject = parseSuccess getOne
where
@@ -122,6 +117,7 @@ looseUnmarshallZippedRaw :: Zipped -> (ObjectHeader, ObjectData)
looseUnmarshallZippedRaw = looseUnmarshallRaw . dezip
-- | read a specific ref from a loose object and returns an header and data.
+looseReadRaw :: LocalPath -> Ref -> IO (ObjectHeader, ObjectData)
looseReadRaw repoPath ref = looseUnmarshallZippedRaw <$> readZippedFile (objectPathOfRef repoPath ref)
-- | read only the header of a loose object.
@@ -131,12 +127,15 @@ looseReadHeader repoPath ref = toHeader <$> readZippedFile (objectPathOfRef repo
toHeader = either (error . ("parseHeader: " ++)) id . P.eitherParseChunks parseHeader . L.toChunks . dezip
-- | read a specific ref from a loose object and returns an object
+looseRead :: LocalPath -> Ref -> IO Object
looseRead repoPath ref = looseUnmarshallZipped <$> readZippedFile (objectPathOfRef repoPath ref)
-- | check if a specific ref exists as loose object
+looseExists :: LocalPath -> Ref -> IO Bool
looseExists repoPath ref = isFile (objectPathOfRef repoPath ref)
-- | enumarate all prefixes available in the object store.
+looseEnumeratePrefixes :: LocalPath -> IO [[Char]]
looseEnumeratePrefixes repoPath = filter isObjectPrefix <$> getDirectoryContents (repoPath </> fromString "objects")
-- | enumerate all references available with a specific prefix.
@@ -152,6 +151,7 @@ looseEnumerateWithPrefix repoPath prefix =
looseEnumerateWithPrefixFilter repoPath prefix (const True)
-- | marshall as lazy bytestring an object except deltas.
+looseMarshall :: Object -> L.ByteString
looseMarshall obj
| objectIsDelta obj = error "cannot write delta object loose"
| otherwise = L.concat [ L.fromChunks [hdrB], objData ]
@@ -161,6 +161,7 @@ looseMarshall obj
-- | create a new blob on a temporary location and on success move it to
-- the object store with its digest name.
+looseWriteBlobFromFile :: LocalPath -> LocalPath -> IO Ref
looseWriteBlobFromFile repoPath file = do
fsz <- getSize file
let hdr = objectWriteHeader TypeBlob (fromIntegral fsz)
@@ -183,6 +184,7 @@ looseWriteBlobFromFile repoPath file = do
-- | write an object to disk as a loose reference.
-- use looseWriteBlobFromFile for efficiently writing blobs when being commited from a file.
+looseWrite :: LocalPath -> Object -> IO Ref
looseWrite repoPath obj = createParentDirectory path
>> isFile path
>>= \exists -> unless exists (writeFileLazy path $ compress content)
@@ -193,4 +195,5 @@ looseWrite repoPath obj = createParentDirectory path
ref = hashLBS content
writeFileLazy p bs = withFile p WriteMode (\h -> L.hPut h bs)
+getDirectoryContents :: LocalPath -> IO [String]
getDirectoryContents p = listDirectoryFilename p
diff --git a/Data/Git/Storage/Object.hs b/Data/Git/Storage/Object.hs
index 564d430..38f067a 100644
--- a/Data/Git/Storage/Object.hs
+++ b/Data/Git/Storage/Object.hs
@@ -165,15 +165,18 @@ modeperm :: P.Parser ModePerm
modeperm = ModePerm . fromIntegral <$> octal
-- | parse a tree content
+treeParse :: P.Parser Tree
treeParse = Tree <$> parseEnts
where parseEnts = P.hasMore >>= \b -> if b then liftM2 (:) parseEnt parseEnts else return []
parseEnt = liftM3 (,,) modeperm parseEntName (P.byte 0 >> P.referenceBin)
parseEntName = entName <$> (P.skipASCII ' ' >> P.takeWhile (/= 0))
-- | parse a blob content
+blobParse :: P.Parser Blob
blobParse = (Blob . L.fromChunks . (:[]) <$> P.takeAll)
-- | parse a commit content
+commitParse :: P.Parser Commit
commitParse = do
tree <- P.string "tree " >> P.referenceHex
P.skipEOL
@@ -202,6 +205,7 @@ commitParse = do
concatLines = B.concat . intersperse (B.pack [0xa])
-- | parse a tag content
+tagParse :: P.Parser Tag
tagParse = do
object <- P.string "object " >> P.referenceHex
P.skipEOL
@@ -214,6 +218,7 @@ tagParse = do
signature <- P.takeAll
return $ Tag object type_ tag tagger signature
+parsePerson :: P.Parser Person
parsePerson = do
name <- B.init <$> P.takeUntilASCII '<'
P.skipASCII '<'
@@ -228,6 +233,7 @@ parsePerson = do
P.skipEOL
return $ Person name email (gitTime time timezone)
+ascii :: Char -> P.Parser ()
ascii c = P.byte (asciiChar c)
asciiChar :: Char -> Word8
@@ -236,6 +242,7 @@ asciiChar c
| otherwise = error ("char " <> show c <> " not valid ASCII")
where cp = fromEnum c
+objectParseTree, objectParseCommit, objectParseTag, objectParseBlob :: P.Parser Object
objectParseTree = ObjTree <$> treeParse
objectParseCommit = ObjCommit <$> commitParse
objectParseTag = ObjTag <$> tagParse
@@ -252,6 +259,7 @@ objectWrite (ObjBlob blob) = blobWrite blob
objectWrite (ObjTree tree) = treeWrite tree
objectWrite _ = error "delta cannot be marshalled"
+treeWrite :: Tree -> L.ByteString
treeWrite (Tree ents) = toLazyByteString $ mconcat $ concatMap writeTreeEnt ents
where writeTreeEnt (ModePerm perm,name,ref) =
[ string7 (printf "%o" perm)
@@ -261,6 +269,7 @@ treeWrite (Tree ents) = toLazyByteString $ mconcat $ concatMap writeTreeEnt ents
, byteString $ toBinary ref
]
+commitWrite :: Commit -> L.ByteString
commitWrite (Commit tree parents author committer encoding extra msg) =
toLazyByteString $ mconcat els
where
@@ -283,6 +292,7 @@ commitWrite (Commit tree parents author committer encoding extra msg) =
,byteString msg
]
+tagWrite :: Tag -> L.ByteString
tagWrite (Tag ref ty tag tagger signature) =
toLazyByteString $ mconcat els
where els = [ string7 "object ", byteString (toHex ref), eol
@@ -293,8 +303,10 @@ tagWrite (Tag ref ty tag tagger signature) =
, byteString signature
]
+eol :: Builder
eol = string7 "\n"
+blobWrite :: Blob -> L.ByteString
blobWrite (Blob bData) = bData
instance Objectable Blob where
@@ -337,6 +349,7 @@ objectHash :: ObjectType -> Word64 -> L.ByteString -> Ref
objectHash ty w lbs = hashLBS $ L.fromChunks (objectWriteHeader ty w : L.toChunks lbs)
-- used for objectWrite for commit and tag
+writeName :: ByteString -> Person -> ByteString
writeName label (Person name email locTime) =
B.concat [label, " ", name, " <", email, "> ", BC.pack timeStr]
where timeStr = show locTime
diff --git a/Data/Git/Storage/Pack.hs b/Data/Git/Storage/Pack.hs
index ff923c8..2a0b996 100644
--- a/Data/Git/Storage/Pack.hs
+++ b/Data/Git/Storage/Pack.hs
@@ -55,6 +55,7 @@ data PackedObjectInfo = PackedObjectInfo
} deriving (Show,Eq)
-- | Enumerate the pack refs available in this repository.
+packEnumerate :: LocalPath -> IO [Ref]
packEnumerate repoPath = map onlyHash . filter isPackFile <$> listDirectoryFilename (repoPath </> "objects" </> "pack")
where
isPackFile :: String -> Bool
@@ -71,6 +72,7 @@ packClose :: FileReader -> IO ()
packClose = fileReaderClose
-- | return the number of entries in this pack
+packReadHeader :: LocalPath -> Ref -> IO Word32
packReadHeader repoPath packRef =
withFileReader (packPath repoPath packRef) $ \filereader ->
fileReaderParse filereader parseHeader
@@ -82,6 +84,7 @@ packReadHeader repoPath packRef =
P.word32
-- | read an object at a specific position using a map function on the objectData
+packReadMapAtOffset :: FileReader -> Word64 -> (L.ByteString -> L.ByteString) -> IO (Maybe Object)
packReadMapAtOffset fr offset mapData = fileReaderSeek fr offset >> getNextObject fr mapData
-- | read an object at a specific position
@@ -93,6 +96,7 @@ packReadRawAtOffset :: FileReader -> Word64 -> IO (PackedObjectRaw)
packReadRawAtOffset fr offset = fileReaderSeek fr offset >> getNextObjectRaw fr
-- | enumerate all objects in this pack and callback to f for reach raw objects
+packEnumerateObjects :: LocalPath -> Ref -> Int -> (PackedObjectRaw -> IO a) -> IO ()
packEnumerateObjects repoPath packRef entries f =
withFileReader (packPath repoPath packRef) $ \filebuffer -> do
fileReaderSeek filebuffer 12
@@ -106,9 +110,11 @@ getNextObject :: FileReader -> (L.ByteString -> L.ByteString) -> IO (Maybe Objec
getNextObject fr mapData =
packedObjectToObject . second mapData <$> getNextObjectRaw fr
+packedObjectToObject :: (PackedObjectInfo, L.ByteString) -> Maybe Object
packedObjectToObject (PackedObjectInfo { poiType = ty, poiExtra = extra }, objData) =
packObjectFromRaw (ty, extra, objData)
+packObjectFromRaw :: (ObjectType, Maybe ObjectPtr, L.ByteString) -> Maybe Object
packObjectFromRaw (TypeCommit, Nothing, objData) = P.maybeParseChunks objectParseCommit (L.toChunks objData)
packObjectFromRaw (TypeTree, Nothing, objData) = P.maybeParseChunks objectParseTree (L.toChunks objData)
packObjectFromRaw (TypeBlob, Nothing, objData) = P.maybeParseChunks objectParseBlob (L.toChunks objData)
diff --git a/Data/Git/Storage/PackIndex.hs b/Data/Git/Storage/PackIndex.hs
index 258e0d5..3982a35 100644
--- a/Data/Git/Storage/PackIndex.hs
+++ b/Data/Git/Storage/PackIndex.hs
@@ -28,6 +28,7 @@ module Data.Git.Storage.PackIndex
import Data.List
import Data.Bits
import Data.Word
+import Data.ByteString (ByteString)
import Data.Vector (Vector, (!))
import qualified Data.Vector as V
@@ -53,6 +54,7 @@ data PackIndex = PackIndex
}
-- | enumerate every indexes file in the pack directory
+packIndexEnumerate :: LocalPath -> IO [Ref]
packIndexEnumerate repoPath = map onlyHash . filter isPackFile <$> listDirectoryFilename (repoPath </> "objects" </> "pack")
where
isPackFile :: String -> Bool
@@ -69,6 +71,7 @@ packIndexClose :: FileReader -> IO ()
packIndexClose = fileReaderClose
-- | variant of withFile on the index file and with a FileReader
+withPackIndex :: LocalPath -> Ref -> (FileReader -> IO a) -> IO a
withPackIndex repoPath indexRef = withFileReader (indexPath repoPath indexRef)
-- | returns the number of references, referenced in this index.
@@ -133,6 +136,7 @@ packIndexGetReferencesWithPrefix idxHdr fr prefix =
refprefix = read ("0x" ++ take 2 prefix)
-- | returns absolute offset in the index file of the sha1s, the crcs and the packfiles offset.
+packIndexOffsets :: PackIndexHeader -> (Word32, Word32, Word32)
packIndexOffsets idx = (packIndexSha1sOffset, packIndexCRCsOffset, packIndexPackOffOffset)
where
packIndexPackOffOffset = packIndexCRCsOffset + crcsTableSz
@@ -143,6 +147,7 @@ packIndexOffsets idx = (packIndexSha1sOffset, packIndexCRCsOffset, packIndexPack
sz = packIndexHeaderGetSize idx
-- | parse index header
+parsePackIndexHeader :: P.Parser PackIndexHeader
parsePackIndexHeader = do
magic <- P.word32
when (magic /= 0xff744f63) $ error "wrong magic number for packIndex"
@@ -160,6 +165,7 @@ packIndexGetHeader :: LocalPath -> Ref -> IO PackIndexHeader
packIndexGetHeader repoPath indexRef = withPackIndex repoPath indexRef $ packIndexReadHeader
-- | read all index
+packIndexRead :: LocalPath -> Ref -> IO (PackIndexHeader, (Vector Ref, Vector Word32, Vector Word32, [ByteString], Ref, Ref))
packIndexRead repoPath indexRef = do
withPackIndex repoPath indexRef $ \fr -> do
idx <- fileReaderParse fr parsePackIndexHeader
diff --git a/git.cabal b/git.cabal
index a330f03..f917c13 100644
--- a/git.cabal
+++ b/git.cabal
@@ -75,7 +75,8 @@ Library
Data.Git.Path
Data.Git.Parser
Data.Git.WorkTree
- ghc-options: -Wall -fno-warn-unused-imports -fno-warn-missing-signatures
+ ghc-options: -Wall -fno-warn-unused-imports
+ -- -fno-warn-missing-signatures
Test-Suite test-unit
--
GitLab