diff options
Diffstat (limited to 'src/Storage.hs')
| -rw-r--r-- | src/Storage.hs | 49 |
1 files changed, 1 insertions, 48 deletions
diff --git a/src/Storage.hs b/src/Storage.hs index 25c7a75..caf9d30 100644 --- a/src/Storage.hs +++ b/src/Storage.hs @@ -51,7 +51,6 @@ import qualified Codec.MIME.Type as MIME import qualified Codec.MIME.Parse as MIME import Control.Arrow -import Control.Exception import Control.Monad import Control.Monad.Except import Control.Monad.Reader @@ -86,16 +85,10 @@ import Data.Time.Format import Data.Time.LocalTime import System.Directory -import System.FilePath -import System.IO import System.IO.Unsafe -import System.Posix.Files -import System.Posix.IO -import System.Posix.Types +import Storage.Internal -data Storage = Storage FilePath - deriving (Eq, Ord) openStorage :: FilePath -> IO Storage openStorage path = do @@ -325,46 +318,6 @@ replaceHead obj prev = do showRefL ref = showRef ref `B.append` BC.singleton '\n' -openFdParents :: FilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd -openFdParents path omode fmode flags = do - createDirectoryIfMissing True (takeDirectory path) - openFd path omode fmode flags - -writeFileOnce :: FilePath -> BL.ByteString -> IO () -writeFileOnce file content = bracket - (fdToHandle =<< openFdParents locked WriteOnly (Just $ unionFileModes ownerReadMode ownerWriteMode) (defaultFileFlags { exclusive = True })) - hClose $ \h -> do - fileExist file >>= \case - True -> removeLink locked - False -> do BL.hPut h content - rename locked file - where locked = file ++ ".lock" - -writeFileChecked :: FilePath -> Maybe ByteString -> ByteString -> IO (Either (Maybe ByteString) ()) -writeFileChecked file prev content = bracket - (fdToHandle =<< openFdParents locked WriteOnly (Just $ unionFileModes ownerReadMode ownerWriteMode) (defaultFileFlags { exclusive = True })) - hClose $ \h -> do - (prev,) <$> fileExist file >>= \case - (Nothing, True) -> do - current <- B.readFile file - removeLink locked - return $ Left $ Just current - (Nothing, False) -> do B.hPut h content - rename locked file - return $ Right () - (Just expected, True) -> do - current <- B.readFile file - if current == expected then do B.hPut h content - rename locked file - return $ return () - else do removeLink locked - return $ Left $ Just current - (Just _, False) -> do - removeLink locked - return $ Left Nothing - where locked = file ++ ".lock" - - class Storable a where store' :: a -> Store load' :: Load a |