    -- |
    -- Module      : Data.Git.Storage.Loose
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unix
    --
    {-# LANGUAGE OverloadedStrings, ScopedTypeVariables, ViewPatterns #-}
    module Data.Git.Storage.Loose
            (
              Zipped(..)
            -- * marshall from and to lazy bytestring
            , looseUnmarshall
            , looseUnmarshallRaw
            , looseUnmarshallZipped
            , looseUnmarshallZippedRaw
            , looseMarshall
            -- * read and check object existence
            , looseRead
            , looseReadHeader
            , looseReadRaw
            , looseExists
            -- * write objects
            , looseWriteBlobFromFile
            , looseWrite
            -- * enumeration of loose objects
            , looseEnumeratePrefixes
            , looseEnumerateWithPrefixFilter
            , looseEnumerateWithPrefix
            ) where

    import Codec.Compression.Zlib
    import Data.Git.Ref
    import Data.Git.Path
    import Data.Git.Internal
    import Data.Git.Storage.FileWriter
    import Data.Git.Storage.Object

    import Filesystem
    import Filesystem.Path
    import Filesystem.Path.Rules

    import qualified Data.ByteString.Char8 as BC
    import qualified Data.ByteString.Lazy as L
    import qualified Data.ByteString as B

    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.String
    import Data.Char (isHexDigit)

    import Prelude hiding (FilePath)

    isObjectPrefix [a,b] = isHexDigit a && isHexDigit b
    isObjectPrefix _     = False

    decimal :: Parser Int
    decimal = PC.decimal

    -- loose object parsing
    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 :: L.ByteString -> Object
    parseObject = parseSuccess (parseTree <|> parseBlob <|> parseCommit <|> parseTag)
            where parseSuccess p = either error id . eitherResult . parse p

    -- | unmarshall an object (with header) from a bytestring.
    looseUnmarshall :: L.ByteString -> Object
    looseUnmarshall = parseObject

    -- | unmarshall an object (with header) from a zipped stream.
    looseUnmarshallZipped :: Zipped -> Object
    looseUnmarshallZipped = parseObject . dezip

    -- | unmarshall an object as (header, data) tuple from a bytestring
    looseUnmarshallRaw :: L.ByteString -> (ObjectHeader, ObjectData)
    looseUnmarshallRaw stream =
            case L.findIndex ((==) 0) stream of
                    Nothing  -> error "object not right format. missing 0"
                    Just idx ->
                            let (h, r) = L.splitAt (idx+1) stream in
                            case maybeResult $ parse parseHeader h of
                                    Nothing  -> error "cannot open object"
                                    Just hdr -> (hdr, r)

    -- | unmarshall an object as (header, data) tuple from a zipped stream
    looseUnmarshallZippedRaw :: Zipped -> (ObjectHeader, ObjectData)
    looseUnmarshallZippedRaw = looseUnmarshallRaw . dezip

    -- | read a specific ref from a loose object and returns an header and data.
    looseReadRaw repoPath ref = looseUnmarshallZippedRaw <$> readZippedFile (objectPathOfRef repoPath ref)

    -- | read only the header of a loose object.
    looseReadHeader repoPath ref = toHeader <$> readZippedFile (objectPathOfRef repoPath ref)
            where toHeader = either error id . eitherResult . parse parseHeader . dezip

    -- | read a specific ref from a loose object and returns an object
    looseRead repoPath ref = looseUnmarshallZipped <$> readZippedFile (objectPathOfRef repoPath ref)

    -- | check if a specific ref exists as loose object
    looseExists repoPath ref = isFile (objectPathOfRef repoPath ref)

    -- | enumarate all prefixes available in the object store.
    looseEnumeratePrefixes repoPath = filter isObjectPrefix <$> getDirectoryContents (repoPath </> fromString "objects")

    -- | enumerate all references available with a specific prefix.
    looseEnumerateWithPrefixFilter :: FilePath -> String -> (Ref -> Bool) -> IO [Ref]
    looseEnumerateWithPrefixFilter repoPath prefix filterF =
            filter filterF . map (fromHexString . (prefix ++)) . filter isRef <$> getDir (repoPath </> fromString "objects" </> fromString prefix)
            where
                    getDir p = E.catch (getDirectoryContents p) (\(_::SomeException) -> return [])
                    isRef l = length l == 38

    looseEnumerateWithPrefix :: FilePath -> String -> IO [Ref]
    looseEnumerateWithPrefix repoPath prefix =
            looseEnumerateWithPrefixFilter repoPath prefix (const True)

    -- | marshall as lazy bytestring an object except deltas.
    looseMarshall obj
            | objectIsDelta obj = error "cannot write delta object loose"
            | otherwise         = L.concat [ L.fromChunks [hdrB], objData ]
            where
                    objData = objectWrite obj
                    hdrB    = objectWriteHeader (objectToType obj) (fromIntegral $ L.length objData)

    -- | create a new blob on a temporary location and on success move it to
    -- the object store with its digest name.
    looseWriteBlobFromFile repoPath file = do
            fsz <- getSize file
            let hdr = objectWriteHeader TypeBlob (fromIntegral fsz)
            tmpPath <- objectTemporaryPath repoPath
            flip onException (removeFile tmpPath) $ do
                    (ref, npath) <- withFileWriter tmpPath $ \fw -> do
                            fileWriterOutput fw hdr
                            withFile file ReadMode $ \h -> loop h fw
                            digest <- fileWriterGetDigest fw
                            return (digest, objectPathOfRef repoPath digest)
                    exists <- isFile npath
                    when exists $ error "destination already exists"
                    rename tmpPath npath
                    return ref
        where loop h fw = do
                    r <- B.hGet h (32*1024)
                    if B.null r
                        then return ()
                        else fileWriterOutput fw r >> loop h fw

    -- | write an object to disk as a loose reference.
    -- use looseWriteBlobFromFile for efficiently writing blobs when being commited from a file.
    looseWrite repoPath obj = createDirectory True (directory path)
                           >> isFile path
                           >>= \exists -> unless exists (writeFileLazy path $ compress content)
                           >> return ref
            where
                    path    = objectPathOfRef repoPath ref
                    content = looseMarshall obj
                    ref     = hashLBS content
                    writeFileLazy p bs = withFile p WriteMode (\h -> L.hPut h bs)

    getDirectoryContents p = map (encodeString posix . filename) <$> listDirectory p