content: -- |
  -- Module      : Data.Git.Storage.Pack
  -- License     : BSD-style
  -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
  -- Stability   : experimental
  -- Portability : unix
  --
  {-# LANGUAGE OverloadedStrings #-}
  module Data.Git.Storage.Pack
          ( PackedObjectInfo(..)
          , PackedObjectRaw
          -- * Enumerators of packs
          , packEnumerate
          -- * Helpers to process packs
          , packOpen
          , packClose
          -- * Command for the content of a pack
          , packReadHeader
          , packReadMapAtOffset
          , packReadAtOffset
          , packReadRawAtOffset
          , packEnumerateObjects
          -- * turn a packed object into a
          , packedObjectToObject
          , packObjectFromRaw
          ) where
  
  import Control.Arrow (second)
  
  import Data.Bits
  import Data.List
  import qualified Data.ByteString.Lazy as L
  
  import qualified Data.Git.Parser as P
  import Data.Git.Internal
  import Data.Git.Imports
  import Data.Git.Path
  import Data.Git.Storage.Object
  import Data.Git.Delta
  import Data.Git.Ref
  import Data.Git.Types
  import Data.Git.OS
  import Data.Git.Storage.FileReader
  
  import Data.Word
  
  type PackedObjectRaw hash = (PackedObjectInfo hash, L.ByteString)
  
  data PackedObjectInfo hash = PackedObjectInfo
          { poiType       :: ObjectType
          , poiOffset     :: Word64
          , poiSize       :: Word64
          , poiActualSize :: Word64
          , poiExtra      :: Maybe (ObjectPtr hash)
          } deriving (Show,Eq)
  
  -- | Enumerate the pack refs available in this repository.
  packEnumerate :: HashAlgorithm hash => LocalPath -> IO [Ref hash]
  packEnumerate repoPath = map onlyHash . filter isPackFile <$> listDirectoryFilename (repoPath </> "objects" </> "pack")
    where
          isPackFile :: String -> Bool
          isPackFile x = ".pack" `isSuffixOf` x
          onlyHash = fromHexString . takebut 5 . drop 5
          takebut n l = take (length l - n) l
  
  -- | open a pack
  packOpen :: LocalPath -> Ref hash -> IO FileReader
  packOpen repoPath packRef = openFile (packPath repoPath packRef) ReadMode >>= fileReaderNew False
  
  -- | close a pack
  packClose :: FileReader -> IO ()
  packClose = fileReaderClose
  
  -- | return the number of entries in this pack
  packReadHeader :: LocalPath -> Ref hash -> IO Word32
  packReadHeader repoPath packRef =
          withFileReader (packPath repoPath packRef) $ \filereader ->
                  fileReaderParse filereader parseHeader
          where parseHeader = do
                  packMagic <- P.word32
                  when (packMagic /= 0x5041434b) $ error "not a git packfile"
                  ver <- P.word32
                  when (ver /= 2) $ error ("pack file version not supported: " ++ show ver)
                  P.word32
  
  -- | read an object at a specific position using a map function on the objectData
  packReadMapAtOffset :: HashAlgorithm hash
                      => FileReader
                      -> Word64
                      -> (L.ByteString -> L.ByteString)
                      -> IO (Maybe (Object hash))
  packReadMapAtOffset fr offset mapData = fileReaderSeek fr offset >> getNextObject fr mapData
  
  -- | read an object at a specific position
  packReadAtOffset :: HashAlgorithm hash => FileReader -> Word64 -> IO (Maybe (Object hash))
  packReadAtOffset fr offset = packReadMapAtOffset fr offset id
  
  -- | read a raw representation at a specific position
  packReadRawAtOffset :: HashAlgorithm hash
                      => FileReader
                      -> Word64
                      -> IO (PackedObjectRaw hash)
  packReadRawAtOffset fr offset = fileReaderSeek fr offset >> getNextObjectRaw fr
  
  -- | enumerate all objects in this pack and callback to f for reach raw objects
  packEnumerateObjects :: HashAlgorithm hash
                       => LocalPath
                       -> Ref hash
                       -> Int
                       -> (PackedObjectRaw hash -> IO a)
                       -> IO ()
  packEnumerateObjects repoPath packRef entries f =
          withFileReader (packPath repoPath packRef) $ \filebuffer -> do
                  fileReaderSeek filebuffer 12
                  parseNext filebuffer entries
          where
                  parseNext :: FileReader -> Int -> IO ()
                  parseNext _  0    = return ()
                  parseNext fr ents = getNextObjectRaw fr >>= f >> parseNext fr (ents-1)
  
  getNextObject :: HashAlgorithm hash
                => FileReader
                -> (L.ByteString -> L.ByteString)
                -> IO (Maybe (Object hash))
  getNextObject fr mapData =
          packedObjectToObject . second mapData <$> getNextObjectRaw fr
  
  packedObjectToObject :: HashAlgorithm hash
                       => (PackedObjectInfo hash, L.ByteString)
                       -> Maybe (Object hash)
  packedObjectToObject (PackedObjectInfo { poiType = ty, poiExtra = extra }, objData) =
          packObjectFromRaw (ty, extra, objData)
  
  packObjectFromRaw :: HashAlgorithm hash
                    => (ObjectType, Maybe (ObjectPtr hash), L.ByteString)
                    -> Maybe (Object hash)
  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)
  packObjectFromRaw (TypeTag, Nothing, objData)    = P.maybeParseChunks objectParseTag (L.toChunks objData)
  packObjectFromRaw (TypeDeltaOff, Just (PtrOfs o), objData) = toObject . DeltaOfs o <$> deltaRead (L.toChunks objData)
  packObjectFromRaw (TypeDeltaRef, Just (PtrRef r), objData) = toObject . DeltaRef r <$> deltaRead (L.toChunks objData)
  packObjectFromRaw _                              = error "can't happen unless someone change getNextObjectRaw"
  
  getNextObjectRaw :: HashAlgorithm hash => FileReader -> IO (PackedObjectRaw hash)
  getNextObjectRaw fr = do
          sobj       <- fileReaderGetPos fr
          (ty, size) <- fileReaderParse fr parseObjectHeader
          extra      <- case ty of
                  TypeDeltaRef -> Just . PtrRef <$> fileReaderGetRef hashAlg fr
                  TypeDeltaOff -> Just . PtrOfs . deltaOffFromList <$> fileReaderGetVLF fr
                  _            -> return Nothing
          objData    <- fileReaderInflateToSize fr size
          eobj       <- fileReaderGetPos fr
  
          return (PackedObjectInfo ty sobj (eobj - sobj) size extra, objData)
    where
      parseObjectHeader = do
          (m, ty, sz) <- splitFirst <$> P.anyByte
          size <- if m then (sz +) <$> getNextSize 4 else return sz
          return (ty, size)
        where
          getNextSize n = do
              (c, sz) <- splitOther n <$> P.anyByte
              if c then (sz +) <$> getNextSize (n+7) else return sz
  
          splitFirst :: Word8 -> (Bool, ObjectType, Word64)
          splitFirst w = (w `testBit` 7, toEnum $ fromIntegral ((w `shiftR` 4) .&. 0x7), fromIntegral (w .&. 0xf))
          splitOther n w = (w `testBit` 7, fromIntegral (w .&. 0x7f) `shiftL` n)
  
      deltaOffFromList (x:xs) = foldl' acc (fromIntegral (x `clearBit` 7)) xs
        where acc a w = ((a+1) `shiftL` 7) + fromIntegral (w `clearBit` 7)
      deltaOffFromList [] = error "cannot happen"
  