cautious-file 0.1.2 → 0.1.3

raw patch · 5 files changed

+108/−60 lines, 5 filesdep +bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring

API changes (from Hackage documentation)

Files

• System/IO/Cautious.hs +0/−58
• cautious-file.cabal +4/−2
• src/System/IO/Cautious.hs +56/−0
• src/System/Posix/ByteLevel.hsc +34/−0
• src/System/Posix/Fsync.hsc +14/−0

@@ -1,58 +0,0 @@-{-# LANGUAGE CPP #-}--- | It is recommended to write------ import Prelude hiding (writeFile)------ when importing this module.-module System.IO.Cautious-  ( writeFile-  , writeFileWithBackup-  ) where--import Prelude hiding (writeFile)--import System.Directory (canonicalizePath, renameFile)-import System.FilePath (splitFileName)-import System.IO (openTempFile)-#ifdef _POSIX-import Control.Monad (unless)-import Data.Function (fix)-import Data.List (genericDrop)-import System.Posix.IO (closeFd, FdOption (SynchronousWrites), fdWrite, handleToFd, setFdOption)-import System.Posix.Types (Fd)---- | Don't bother to split into two writes if the string to write is shorter than this-splitLimit :: Int-splitLimit = 65536---- | Write the entire contents of a string to a file descriptor. Assumes blocking mode.-writeAll :: Fd -> String -> IO ()-writeAll fd = fix $ \me s -> unless (null s) $ do-    count <- fdWrite fd s-    me $ genericDrop count s-#else-import System.IO (hPutStr, hClose)-#endif--writeFile :: FilePath -> String -> IO ()-writeFile = writeFileWithBackup $ return ()---- | Backs up the old version of the file with "backup". "backup" must not fail if there is no--- old version of the file.-writeFileWithBackup :: IO () -> FilePath -> String -> IO ()-writeFileWithBackup backup fp text = do-    cfp <- canonicalizePath fp-    (tempFP, handle) <- uncurry openTempFile $ splitFileName cfp-#ifdef _POSIX-    fd <- handleToFd handle-    let writeSync = (setFdOption fd SynchronousWrites True >>) . writeAll fd-    if null $ drop splitLimit text-      then writeSync text-      else writeAll fd (init text) >> writeSync [last text]-    closeFd fd-#else-    hPutStr handle text-    hClose handle-#endif-    backup-    renameFile tempFP cfp

@@ -1,5 +1,5 @@ name:                cautious-file-version:             0.1.2+version:             0.1.3 Cabal-Version:	     >= 1.6 synopsis:            Ways to write a file cautiously, to reduce the chances of problems such as data loss due to crashes or power failures description:         If the posix flag is enabled, posix-specific functions are used to reduce the chance of data loss further@@ -24,9 +24,11 @@     default: True  Library-  build-Depends:	base >= 4, base < 5, directory, filepath+  hs-source-dirs:       src+  build-Depends:	base >= 4, base < 5, directory, filepath, bytestring   if flag(posix)     cpp-options: -D_POSIX     build-Depends: unix+    exposed-modules:    System.Posix.ByteLevel, System.Posix.Fsync   exposed-modules:      System.IO.Cautious   ghc-options:          -Wall

@@ -0,0 +1,56 @@+{-# LANGUAGE CPP #-}+-- | It is recommended to write+--+-- import Prelude hiding (writeFile)+--+-- when importing this module.+module System.IO.Cautious+  ( writeFile+  , writeFileL+  , writeFileWithBackup+  , writeFileWithBackupL+  ) where++import Prelude hiding (writeFile)++import Data.ByteString.Lazy.Char8 (ByteString, pack)+import System.Directory (canonicalizePath, renameFile)+import System.FilePath (splitFileName)+import System.IO (openTempFile)+#ifdef _POSIX+import System.Posix.ByteLevel (writeAllL)+import System.Posix.Fsync (fsync)+import System.Posix.IO (closeFd, handleToFd)+#else+import Data.ByteString.Lazy (hPut)+import System.IO (hClose)+#endif++writeFile :: FilePath -> String -> IO ()+writeFile = writeFileWithBackup $ return ()++writeFileL :: FilePath -> ByteString -> IO ()+writeFileL = writeFileWithBackupL $ return ()++-- | Backs up the old version of the file with "backup". "backup" must not fail if there is no+-- old version of the file.+writeFileWithBackup :: IO () -> FilePath -> String -> IO ()+writeFileWithBackup backup fp = writeFileWithBackupL backup fp . pack++-- | Backs up the old version of the file with "backup". "backup" must not fail if there is no+-- old version of the file.+writeFileWithBackupL :: IO () -> FilePath -> ByteString -> IO ()+writeFileWithBackupL backup fp bs = do+    cfp <- canonicalizePath fp+    (tempFP, handle) <- uncurry openTempFile $ splitFileName cfp+#ifdef _POSIX+    fd <- handleToFd handle+    writeAllL fd bs+    fsync fd+    closeFd fd+#else+    hPut handle bs+    hClose handle+#endif+    backup+    renameFile tempFP cfp

@@ -0,0 +1,34 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module System.Posix.ByteLevel (fdWrite, fdWriteB, writeAllB, writeAllL) where++import Control.Applicative ((<$>))+import Control.Monad (unless)+import qualified Data.ByteString as Strict+import Data.ByteString.Lazy (ByteString, toChunks)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.Function (fix)+import Foreign.C.Error (throwErrnoIfMinus1Retry)+import Foreign.C.String (CString, CStringLen)+import Foreign.C.Types (CInt, CSize)+import System.Posix.Types (ByteCount, Fd(..))++#include <unistd.h>++foreign import ccall "write"+       c_write :: CInt -> CString -> CSize -> IO CSize++fdWrite :: Fd -> CStringLen -> IO ByteCount+fdWrite (Fd fd) (cs, l) =  throwErrnoIfMinus1Retry "write" . c_write fd cs $ fromIntegral l++fdWriteB :: Fd -> Strict.ByteString -> IO Int+fdWriteB fd bs = fromIntegral <$> unsafeUseAsCStringLen bs (fdWrite fd)++-- | Write the entire contents of the strict bytestring. Assumes blocking mode.+writeAllB :: Fd -> Strict.ByteString -> IO ()+writeAllB fd = fix $ \me s -> unless (Strict.null s) $ do+    count <- fdWriteB fd s+    me $ Strict.drop (fromIntegral count) s++-- | Write the entire contents of the lazy bytestring. Assumes blocking mode.+writeAllL :: Fd -> ByteString -> IO ()+writeAllL fd = mapM_ (writeAllB fd) . toChunks

@@ -0,0 +1,14 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module System.Posix.Fsync (fsync) where++import Foreign.C.Error (throwErrnoIfMinus1_)+import Foreign.C.Types (CInt)+import System.Posix.Types (Fd(..))++#include <unistd.h>++foreign import ccall "fsync"+       c_fsync :: CInt -> IO CInt++fsync :: Fd -> IO ()+fsync (Fd fd) =  throwErrnoIfMinus1_ "fsync" $ c_fsync fd