module Storage.Hashed.Plain( readPlainTree, writePlainTree,
plainTreeIO
) where
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BL
import System.FilePath( (</>) )
import System.Directory( getDirectoryContents
, createDirectoryIfMissing )
import Bundled.Posix( getFileStatus, isDirectory, FileStatus )
import Control.Monad( forM_ )
import Storage.Hashed.AnchoredPath
import Storage.Hashed.Utils
import Storage.Hashed.Hash( Hash( NoHash) )
import Storage.Hashed.Tree( Tree(), TreeItem(..)
, Blob(..), makeTree
, list, readBlob, find, modifyTree )
import Storage.Hashed.Monad( TreeIO, runTreeMonad, initialState, tree )
import qualified Data.Set as S
import Control.Monad.State( liftIO, gets, modify )
readPlainDir :: FilePath -> IO [(FilePath, FileStatus)]
readPlainDir dir =
withCurrentDirectory dir $ do
items <- getDirectoryContents "."
sequence [ do st <- getFileStatus s
return (s, st)
| s <- items, s `notElem` [ ".", ".." ] ]
readPlainTree :: FilePath -> IO (Tree IO)
readPlainTree dir = do
items <- readPlainDir dir
let subs = [
let name = Name (BS8.pack name')
in if isDirectory status
then (name,
Stub (readPlainTree (dir </> name')) NoHash)
else (name, File $
Blob (readBlob' name) NoHash)
| (name', status) <- items ]
return $ makeTree subs
where readBlob' (Name name) = readSegment (dir </> BS8.unpack name, Nothing)
writePlainTree :: Tree IO -> FilePath -> IO ()
writePlainTree t dir = do
createDirectoryIfMissing True dir
forM_ (list t) write
where write (p, File b) = write' p b
write (p, SubTree _) =
createDirectoryIfMissing True (anchorPath dir p)
write _ = return ()
write' p b = readBlob b >>= BL.writeFile (anchorPath dir p)
plainTreeIO :: TreeIO a -> Tree IO -> FilePath -> IO (a, Tree IO)
plainTreeIO action t dir = runTreeMonad action $ initialState t syncPlain
where syncPlain ch = do
current <- gets tree
forM_ (S.toList ch) $ \c -> do
let path = anchorPath dir c
case find current c of
Just (File b) -> do
liftIO $ readBlob b >>= BL.writeFile path
let nblob = File $ Blob (BL.readFile path) NoHash
modify $ \st -> st { tree = modifyTree (tree st) c
(Just nblob) }
Just (SubTree _) ->
liftIO $ createDirectoryIfMissing False path
_ -> fail $ "Foo at " ++ path