module Data.Git.Loose
(
looseUnmarshall
, looseUnmarshallRaw
, looseMarshall
, looseRead
, looseReadHeader
, looseReadRaw
, looseExists
, looseWriteBlobFromFile
, looseWrite
, looseEnumeratePrefixes
, looseEnumerateWithPrefixFilter
, looseEnumerateWithPrefix
) where
import Codec.Compression.Zlib
import Data.Git.Ref
import Data.Git.Path
import Data.Git.FileWriter
import Data.Git.Object
import System.FilePath
import System.Directory
import System.Posix.Files
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as L
import Data.Attoparsec.Lazy
import qualified Data.Attoparsec.Char8 as PC
import Control.Applicative ((<$>), (<|>))
import Control.Monad
import Control.Exception (onException, SomeException)
import qualified Control.Exception as E
import Data.Char (isHexDigit)
isObjectPrefix [a,b] = isHexDigit a && isHexDigit b
isObjectPrefix _ = False
decimal :: Parser Int
decimal = PC.decimal
parseHeader = do
h <- takeWhile1 ((/=) 0x20)
_ <- word8 0x20
sz <- decimal
return (objectTypeUnmarshall $ BC.unpack h, fromIntegral sz, Nothing)
parseTreeHeader = string "tree " >> decimal >> word8 0
parseTagHeader = string "tag " >> decimal >> word8 0
parseCommitHeader = string "commit " >> decimal >> word8 0
parseBlobHeader = string "blob " >> decimal >> word8 0
parseTree = parseTreeHeader >> objectParseTree
parseTag = parseTagHeader >> objectParseTag
parseCommit = parseCommitHeader >> objectParseCommit
parseBlob = parseBlobHeader >> objectParseBlob
parseObject = parseSuccess (parseTree <|> parseBlob <|> parseCommit <|> parseTag)
where parseSuccess p = either error id . eitherResult . parse p
looseUnmarshall :: L.ByteString -> Object
looseUnmarshall = parseObject . decompress
looseUnmarshallRaw :: L.ByteString -> (ObjectHeader, ObjectData)
looseUnmarshallRaw l =
let dl = decompress l in
let i = L.findIndex ((==) 0) dl in
case i of
Nothing -> error "object not right format. missing 0"
Just idx ->
let (h, r) = L.splitAt (idx+1) dl in
case maybeResult $ parse parseHeader h of
Nothing -> error "cannot open object"
Just hdr -> (hdr, r)
looseReadRaw repoPath ref = looseUnmarshallRaw <$> L.readFile (objectPathOfRef repoPath ref)
looseReadHeader repoPath ref = toHeader <$> L.readFile (objectPathOfRef repoPath ref)
where toHeader = either error id . eitherResult . parse parseHeader . decompress
looseRead repoPath ref = looseUnmarshall <$> L.readFile (objectPathOfRef repoPath ref)
looseExists repoPath ref = doesFileExist (objectPathOfRef repoPath ref)
looseEnumeratePrefixes repoPath = filter isObjectPrefix <$> getDirectoryContents (repoPath </> "objects")
looseEnumerateWithPrefixFilter :: FilePath -> String -> (Ref -> Bool) -> IO [Ref]
looseEnumerateWithPrefixFilter repoPath prefix filterF =
filter filterF . map (fromHexString . (prefix ++)) . filter isRef <$> getDir (repoPath </> "objects" </> prefix)
where
getDir p = E.catch (getDirectoryContents p) (\(_::SomeException) -> return [])
isRef l = length l == 38
looseEnumerateWithPrefix repoPath prefix =
looseEnumerateWithPrefixFilter repoPath prefix (const True)
looseMarshall (DeltaOfs _ _) = error "cannot write delta offset as single object"
looseMarshall (DeltaRef _ _) = error "cannot write delta ref as single object"
looseMarshall obj = compress $ L.concat [ L.fromChunks [hdrB], objData ]
where
objData = objectWrite obj
hdrB = objectWriteHeader (objectToType obj) (fromIntegral $ L.length objData)
looseWriteBlobFromFile repoPath file = do
fsz <- fromIntegral . fileSize <$> getFileStatus file
let hdr = objectWriteHeader TypeBlob fsz
tmpPath <- objectTemporaryPath repoPath
flip onException (removeFile tmpPath) $ do
npath <- withFileWriter tmpPath $ \fw -> do
fileWriterOutput fw hdr
chunks <- L.toChunks <$> L.readFile file
mapM_ (fileWriterOutput fw) chunks
digest <- fileWriterGetDigest fw
return $ objectPathOfRef repoPath digest
exists <- doesFileExist npath
when exists $ error "destination already exists"
renameFile tmpPath npath
looseWrite repoPath obj = L.writeFile (objectPathOfRef repoPath ref) content
where
content = looseMarshall obj
ref = hashLBS content