FileStorage.hs

-- ----------------------------------------------------------------------------

{- |
  Module     : Holumbus.FileSystem.Storage.FileStorage
  Copyright  : Copyright (C) 2008 Stefan Schmidt
  License    : MIT

  Maintainer : Stefan Schmidt (stefanschmidt@web.de)
  Stability  : experimental
  Portability: portable
  Version    : 0.1

  Implementation of the storage class.
  The FileStorage saves each file in a single physical file. The metadata of
  the files is hold in an extra directory an saved on disk.

-}

-- ----------------------------------------------------------------------------

module Holumbus.FileSystem.Storage.FileStorage
    (
      -- * datatypes
      FileStorage

      -- * storage initialisation
    , newFileStorage 
    )
where

import           Control.Monad
import           Control.Exception
import qualified Data.ByteString.Lazy as B
import           Data.Binary
import           Data.Maybe
import           System.IO
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"

-- | The directory of the files in the storage. 
type StorageFileDirectory = Map.Map S.FileId S.FileData

-- | The filestorage datatype.
--   Every file is physically saved in one file on the harddisk
data FileStorage = MkFileStorage {
    fs_Path        :: FilePath             -- ^ path to the storage directory
  , fs_DirfilePath :: FilePath             -- ^ path to the directory file
  , fs_Directory   :: StorageFileDirectory -- ^ the directory with the metadata
  } deriving (Show)

-- -----------------------------------------------------------------------------
-- internal operations - adding and deleting files to the directory
-- -----------------------------------------------------------------------------

-- | Add or update a new file to the directory. 
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)

-- | Delete a new file to the directory.
deleteFileData :: StorageFileDirectory -> S.FileId -> StorageFileDirectory
deleteFileData dir i = Map.delete i dir

-- | Lookup the metadata from the directory.
lookupFileData :: StorageFileDirectory -> S.FileId -> (Maybe S.FileData)
lookupFileData dir i = Map.lookup i dir

-- | Get all fileIds from the directory
getIds :: StorageFileDirectory -> [S.FileId]
getIds dir = Map.keys dir

-- | Check, if a fileId is a member of the storage
isMember :: StorageFileDirectory -> S.FileId -> Bool
isMember dir i = Map.member i dir



-- -----------------------------------------------------------------------------
-- file storage operations and typeclass 
-- -----------------------------------------------------------------------------



-- | Create a new filestorage, which is empty an contains no files 
newFileStorage 
  :: FilePath           -- ^ the path of the filestorage on disk 
  -> FilePath           -- ^ the name of the directory file
  -> FileStorage
newFileStorage path name 
  = MkFileStorage path (path ++ name) Map.empty


-- | Loads the filestorage from disk      
readDirectory :: FileStorage -> IO (FileStorage)
readDirectory stor
  = do
    handleAll (\_ -> writeDirectory stor) $
      bracket
        (do
         infoM localLogger ("opening filestorage directory: " ++ (fs_DirfilePath stor))
         openFile (fs_DirfilePath stor) ReadMode
        )
        (hClose)
        (\hdl -> 
          do
          pkg <- liftM words $ hGetLine hdl
          raw <- B.hGet hdl (read $ head pkg)
          dir <- return (decode raw)
          return (stor {fs_Directory = dir})
        )


-- | Saves the filestorage on disk  
writeDirectory :: FileStorage -> IO (FileStorage)
writeDirectory stor
  = do
    bracket 
      (do
       infoM localLogger ("writing filestorage directory: " ++ (fs_DirfilePath stor))
       createDirectoryIfMissing True (fs_Path stor)
       openFile (fs_DirfilePath stor) WriteMode)
      (hClose) 
      (\hdl ->
        do 
        enc <- return (encode $ fs_Directory stor)
        hPutStrLn hdl ((show $ B.length enc) ++ " ")
        B.hPut hdl enc    
        return stor
      )


-- | deriving FileStorage from the class Storage
instance S.Storage FileStorage where

  openStorage = readDirectory


  closeStorage = writeDirectory


  createFile stor fn c 
    = do
      writeToBinFile path c
      -- case c of
      --  (S.TextFile t) -> writeToTextFile path t
      --  (S.ListFile l) -> writeToListFile path l
      --  (S.BinFile  b) -> writeToBinFile path b
      dat <- S.createFileData fn c
      writeDirectory $ stor {fs_Directory = newdir dat} 
      where
        path = (fs_Path stor) ++ fn
        newdir d = addFileData (fs_Directory stor) d 


  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
              -- case c of
              --  (S.TextFile t) -> appendToTextFile path t
              --  (S.ListFile l) -> appendToListFile path l
              --  (S.BinFile  b) -> appendToBinFile path b
          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
            -- metaData <- S.getFileData stor i
            c <- readFromBinFile path
            {-
            c <- case (S.fd_Type $ fromJust metaData) of
              (S.FTText) -> 
                 do
                 t <- readFromTextFile path
                 return $ S.TextFile t
              (S.FTList) ->
                 do
                 l <- readFromListFile path
                 return $ S.ListFile l
              (S.FTBin)  -> 
                 do
                 b <- readFromBinFile path
                 return $ S.BinFile b
            -}
            debugM localLogger $ "getFileContent: content: " ++ show c
            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))