module Holumbus.FileSystem.Storage.FileStorage
(
FileStorage
, newFileStorage
)
where
import Data.Binary
import System.Directory
import System.Log.Logger
import qualified Data.Map as Map
import Holumbus.Common.Utils ( handleAll )
import Holumbus.Common.FileHandling
import qualified Holumbus.FileSystem.Storage as S
localLogger :: String
localLogger = "Holumbus.FileSystem.Storage.FileStorage"
type StorageFileDirectory = Map.Map S.FileId S.FileData
data FileStorage = MkFileStorage {
fs_Path :: FilePath
, fs_DirfilePath :: FilePath
, fs_Directory :: StorageFileDirectory
} deriving (Show)
addFileData :: StorageFileDirectory -> S.FileData -> StorageFileDirectory
addFileData dir new
= Map.insert fn dat dir
where
fn = (S.fd_FileId new)
dat = maybe new (S.updateFileData new) (Map.lookup fn dir)
deleteFileData :: StorageFileDirectory -> S.FileId -> StorageFileDirectory
deleteFileData dir i = Map.delete i dir
lookupFileData :: StorageFileDirectory -> S.FileId -> (Maybe S.FileData)
lookupFileData dir i = Map.lookup i dir
getIds :: StorageFileDirectory -> [S.FileId]
getIds dir = Map.keys dir
isMember :: StorageFileDirectory -> S.FileId -> Bool
isMember dir i = Map.member i dir
newFileStorage
:: FilePath
-> FilePath
-> FileStorage
newFileStorage path name
= MkFileStorage path (path ++ name) Map.empty
readDirectory :: FileStorage -> IO (FileStorage)
readDirectory stor
= do
handleAll (\_ -> writeDirectory stor) $ do
infoM localLogger ("opening filestorage directory: " ++ (fs_DirfilePath stor))
file <- decodeFile (fs_DirfilePath stor)
file `seq` return (stor {fs_Directory = file})
writeDirectory :: FileStorage -> IO (FileStorage)
writeDirectory stor
= do
infoM localLogger ("writing filestorage directory: " ++ (fs_DirfilePath stor))
createDirectoryIfMissing True (fs_Path stor)
encodeFile (fs_DirfilePath stor) (fs_Directory stor)
return stor
writeSingleFile :: FileStorage -> S.FileId -> S.FileContent -> IO FileStorage
writeSingleFile stor fn c = do
debugM localLogger "write to bin file .. "
writeToBinFile path c
debugM localLogger "create file metadata"
dat <- S.createFileData fn c
return $ stor {fs_Directory = newdir dat}
where
path = (fs_Path stor) ++ fn
newdir d = addFileData (fs_Directory stor) d
instance S.Storage FileStorage where
openStorage = readDirectory
closeStorage = writeDirectory
createFile stor fn c
= do
stor' <- writeSingleFile stor fn c
debugM localLogger "write directory"
writeDirectory stor'
createFiles stor l
= do
debugM localLogger "write to bin file .. "
stor' <- writeFiles stor l
debugM localLogger "write directory"
writeDirectory stor'
where
writeFiles :: FileStorage -> [(S.FileId,S.FileContent)] -> IO FileStorage
writeFiles stor'' [] = return stor''
writeFiles stor'' ((fn,c):xs) = do
stor''' <- writeSingleFile stor'' fn c
writeFiles stor''' xs
deleteFile stor i
= do
stor' <-
if isMember (fs_Directory stor) i
then do
removeFile path
return (stor {fs_Directory = newdir})
else
return stor
writeDirectory $ stor'
where
path = (fs_Path stor) ++ i
newdir = deleteFileData (fs_Directory stor) i
appendFile stor i c
= do
if isMember (fs_Directory stor) i
then do
appendToBinFile path c
dat <- S.createFileData i c
writeDirectory $ stor { fs_Directory = newdir dat }
else do
S.createFile stor i c
where
path = (fs_Path stor) ++ i
newdir d = addFileData (fs_Directory stor) d
containsFile stor i
= do
return (isMember (fs_Directory stor) i)
getFileContent stor i
= do
infoM localLogger $ "getFileContent: reading " ++ show i
if (isMember (fs_Directory stor) i)
then do
handleAll (\e -> do
errorM localLogger $ "getFileContent: " ++ show e
return Nothing
) $
do
c <- readFromBinFile path
debugM localLogger $ "getFileContent: content: " ++ show c
infoM localLogger $ "getFileContent: finished "
return (Just c)
else do return Nothing
where
path = (fs_Path stor) ++ i
getFileData stor i
= do
return (lookupFileData (fs_Directory stor) i)
getFileIds stor
= do
return (getIds (fs_Directory stor))