crazy optimisation
Crazy like a fox..
This commit is contained in:
parent
c1b432ee54
commit
ca9ee21bd7
4 changed files with 54 additions and 22 deletions
|
@ -10,7 +10,8 @@ module Git.CatFile (
|
|||
catFileStart,
|
||||
catFileStop,
|
||||
catFile,
|
||||
catObject
|
||||
catObject,
|
||||
catObjectDetails,
|
||||
) where
|
||||
|
||||
import System.IO
|
||||
|
@ -42,7 +43,11 @@ catFile h branch file = catObject h $ Ref $ show branch ++ ":" ++ file
|
|||
{- Uses a running git cat-file read the content of an object.
|
||||
- Objects that do not exist will have "" returned. -}
|
||||
catObject :: CatFileHandle -> Ref -> IO L.ByteString
|
||||
catObject h object = CoProcess.query h send receive
|
||||
catObject h object = maybe L.empty fst <$> catObjectDetails h object
|
||||
|
||||
{- Gets both the content of an object, and its Sha. -}
|
||||
catObjectDetails :: CatFileHandle -> Ref -> IO (Maybe (L.ByteString, Sha))
|
||||
catObjectDetails h object = CoProcess.query h send receive
|
||||
where
|
||||
send to = do
|
||||
fileEncoding to
|
||||
|
@ -55,16 +60,16 @@ catObject h object = CoProcess.query h send receive
|
|||
| length sha == shaSize &&
|
||||
isJust (readObjectType objtype) ->
|
||||
case reads size of
|
||||
[(bytes, "")] -> readcontent bytes from
|
||||
[(bytes, "")] -> readcontent bytes from sha
|
||||
_ -> dne
|
||||
| otherwise -> dne
|
||||
_
|
||||
| header == show object ++ " missing" -> dne
|
||||
| otherwise -> error $ "unknown response from git cat-file " ++ show (header, object)
|
||||
readcontent bytes from = do
|
||||
readcontent bytes from sha = do
|
||||
content <- S.hGet from bytes
|
||||
c <- hGetChar from
|
||||
when (c /= '\n') $
|
||||
error "missing newline from git cat-file"
|
||||
return $ L.fromChunks [content]
|
||||
dne = return L.empty
|
||||
return $ Just (L.fromChunks [content], Ref sha)
|
||||
dne = return Nothing
|
||||
|
|
|
@ -24,7 +24,6 @@ import Git
|
|||
import Git.Types
|
||||
import Git.Command
|
||||
import Git.FilePath
|
||||
import Git.HashObject
|
||||
import Git.Sha
|
||||
|
||||
{- Streamers are passed a callback and should feed it lines in the form
|
||||
|
@ -70,10 +69,10 @@ unstageFile file repo = do
|
|||
return $ pureStreamer $ "0 " ++ show nullSha ++ "\t" ++ getTopFilePath p
|
||||
|
||||
{- A streamer that adds a symlink to the index. -}
|
||||
stageSymlink :: FilePath -> String -> Repo -> IO Streamer
|
||||
stageSymlink file linktext repo = do
|
||||
stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
|
||||
stageSymlink file sha repo = do
|
||||
line <- updateIndexLine
|
||||
<$> hashObject BlobObject linktext repo
|
||||
<$> pure sha
|
||||
<*> pure SymlinkBlob
|
||||
<*> toTopFilePath file repo
|
||||
return $ pureStreamer line
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue