-- | The plain format implementation resides in this module. The plain format
-- does not use any hashing and basically just wraps a normal filesystem tree
-- in the hashed-storage API.
--
-- NB. The 'read' function on Blobs coming from a plain tree is susceptible to
-- file content changes. Since we use mmap in 'read', this will break
-- referential transparency and produce unexpected results. Please always make
-- sure that all parallel access to the underlying filesystem tree never
-- mutates files. Unlink + recreate is fine though (in other words, the
-- 'writePlainTree' and 'plainTreeIO' implemented in this module are safe in
-- this respect).
module Storage.Hashed.Plain( readPlainTree, writePlainTree,
                             plainTreeIO  -- (obsolete?  if so remove implementation!)
                           ) where

import Data.Maybe( catMaybes, fromJust )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BL
import System.Directory( getDirectoryContents
                       , createDirectoryIfMissing )
import Bundled.Posix( getFileStatus, isDirectory, isRegularFile, FileStatus )

import Data.Path
import Storage.Hashed.Utils
import Storage.Hashed.Hash( Hash( NoHash) )
import Storage.Hashed.Tree( Tree(), TreeItem(..)
                          , Blob(..), makeTree
                          , list, readBlob, find, modifyTree, expand )
import Storage.Hashed.Monad( TreeIO, runTreeMonad, initialState, replaceItem )
import qualified Data.Set as S
import Control.Monad.State( liftIO, gets, modify )

readPlainDir :: AbsRel x => Path x -> IO [(BS.ByteString, FileStatus)]
readPlainDir dir =
    withCurrentDirectory dir $ do
      items <- getDirectoryContents "."
      sequence [ do st <- getFileStatus s
                    return (BS8.pack s, st)
                 | s <- items, s `notElem` [ ".", ".." ] ]

readPlainTree :: AbsRel x => Path x -> IO (Tree IO)
readPlainTree dir' = do
  dir <- ioAbsolute dir'
  items <- readPlainDir dir
  let readBlob' name = readSegment (dir </> name, Nothing)
      subs = catMaybes [
        case status of
          _ | isDirectory status -> Just (name, Stub (readPlainTree (dir </> name)) NoHash)
          _ | isRegularFile status -> Just (name, File $ Blob (readBlob' name) NoHash)
          _ -> Nothing
        | (name, status) <- items ]
  return $ makeTree subs

-- | Write out /full/ tree to a plain directory structure. If you instead want
-- to make incremental updates, refer to "Storage.Hashed.Monad".
writePlainTree :: (AbsRel x) => Tree IO -> Path x -> IO ()
writePlainTree t dir = do
  createDirectoryIfMissing True (pathToString dir)
  expand t >>= mapM_ write . list
    where write (p, File b) = write' p b
          write (p, SubTree _) =
              createDirectoryIfMissing True (pathToString $ dir +/+ p)
          write _ = return ()
          write' p b = readBlob b >>= BL.writeFile (pathToString $ dir +/+ p)

-- | Run a 'TreeIO' action in a plain tree setting. Writes out changes to the
-- plain tree every now and then (after the action is finished, the last tree
-- state is always flushed to disk). XXX Modify the tree with filesystem
-- reading and put it back into st (ie. replace the in-memory Blobs with normal
-- ones, so the memory can be GCd).
plainTreeIO :: (AbsRel x) => TreeIO a -> Tree IO -> Path x -> IO (a, Tree IO)
plainTreeIO action t dir = runTreeMonad action $ initialState t (\_ -> return NoHash) updatePlain
    where updatePlain path (File b) =
            do liftIO $ createDirectoryIfMissing True (pathToString $ parent path)
               liftIO $ readBlob b >>= BL.writeFile (pathToString path)
               return $ File $ Blob (BL.readFile $ pathToString path) NoHash
          updatePlain _ x = return x