module Storage.Archive.Immutable.Tree
     ( readFile, readItem, writeFile, writeItem )
     where

import Prelude hiding ( readFile, writeFile )

import Codec.Compression.GZip ( compress, decompress )
import Control.Applicative ( (<$>) )
import Control.Monad ( unless, liftM )
import Control.Monad.Trans ( lift, MonadIO(liftIO) )
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import Storage.Hashed.Darcs
     ( readDarcsHashed, writeDarcsHashed, darcsUpdateHashes )
import Storage.Hashed.Hash ( Hash(..), encodeBase16, sha256 )
import Storage.Hashed.Tree
     ( ItemType(..), makeBlob, TreeItem(..), Blob(..) )
import System.Directory ( doesFileExist )
import System.FilePath ( (</>) )

import Storage.Archive.Immutable.Monad

readFile :: (MonadIO m, MonadImmArch m) => Hash -> m BL.ByteString
readFile hash = do
   archive <- getCurrentArchive
   let loc = archive </> "data" </> BC.unpack (encodeBase16 hash)
   liftIO $ decompress <$> BL.readFile loc

readItem :: (MonadIO m, MonadImmArch m) => (ItemType, Hash) -> m (TreeItem IO)
readItem (BlobType, h) =
   (File . makeBlob) `liftM` readFile h
readItem (TreeType, h) = do
   archive <- getCurrentArchive
   let readIt = readDarcsHashed (archive </> "data") (Nothing, h)
   return $ Stub readIt h

writeFile :: (MonadIO m, MonadImmArch m) => BL.ByteString -> Hash -> m Hash
writeFile contents hashIn = do
    archive <- getCurrentArchive
    let hash = case hashIn of
                 NoHash -> sha256 contents
                 _ -> hashIn
    let loc = archive </> "data" </> BC.unpack (encodeBase16 hash)
    exist <- liftIO $ doesFileExist loc
    liftIO $ unless exist $ BL.writeFile loc (compress contents)
    return hash

writeItem :: (MonadIO m, MonadImmArch m) => TreeItem IO -> m (ItemType, Hash)
writeItem (Stub comp _) = do
    tree <- liftIO comp
    writeItem (SubTree tree)
writeItem (File (Blob contentsIO hash)) = do
    contents <- liftIO contentsIO
    hash <- writeFile contents hash
    return (BlobType, hash)
writeItem (SubTree tree) = do
    archive <- getCurrentArchive
    tree <- liftIO $ darcsUpdateHashes tree
    hash <- liftIO $ writeDarcsHashed tree (archive </> "data")
    return (TreeType, hash)