From da25d12e54777db83a2ed0aab936c41f473cafd9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ricardo=20Catalinas=20Jim=C3=A9nez?= <jimenezrick@gmail.com>
Date: Sat, 7 Dec 2013 15:56:39 +0000
Subject: [PATCH] Add fsync(2), fdatasync(2), posix_fadvise(2) and
 posix_fallocate(2)

---
 System/Posix/Fcntl.hsc  | 69 +++++++++++++++++++++++++++++++++++++++++
 System/Posix/Unistd.hsc | 34 ++++++++++++++++++--
 changelog               |  4 +++
 configure.ac            |  4 +++
 unix.cabal              |  1 +
 5 files changed, 110 insertions(+), 2 deletions(-)
 create mode 100644 System/Posix/Fcntl.hsc

diff --git a/System/Posix/Fcntl.hsc b/System/Posix/Fcntl.hsc
new file mode 100644
index 0000000..204deea
--- /dev/null
+++ b/System/Posix/Fcntl.hsc
@@ -0,0 +1,69 @@
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.Fcntl
+-- Copyright   :  (c) The University of Glasgow 2013
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires POSIX)
+--
+-- POSIX file control support
+--
+-----------------------------------------------------------------------------
+
+#include "HsUnix.h"
+
+module System.Posix.Fcntl (
+    -- * File allocation
+#ifdef HAVE_POSIX_FADVISE
+    Advice(..), posix_fadvise,
+#endif
+#ifdef HAVE_POSIX_FALLOCATE
+    posix_fallocate,
+#endif
+  ) where
+
+import Foreign.C
+import System.Posix.Types
+
+-- -----------------------------------------------------------------------------
+-- File control
+
+#ifdef HAVE_POSIX_FADVISE
+data Advice
+  = AdviceNormal
+  | AdviceRandom
+  | AdviceSequential
+  | AdviceWillNeed
+  | AdviceDontNeed
+  | AdviceNoReuse
+  deriving Eq
+
+posix_fadvise :: Fd -> FileOffset -> FileOffset -> Advice -> IO ()
+posix_fadvise fd off len adv = do
+  throwErrnoIfMinus1_ "posix_fadvise" (c_posix_fadvise (fromIntegral fd) (fromIntegral off) (fromIntegral len) (packAdvice adv))
+
+foreign import ccall safe "posix_fadvise"
+  c_posix_fadvise :: CInt -> COff -> COff -> CInt -> IO CInt
+
+packAdvice :: Advice -> CInt
+packAdvice AdviceNormal     = (#const POSIX_FADV_NORMAL)
+packAdvice AdviceRandom     = (#const POSIX_FADV_RANDOM)
+packAdvice AdviceSequential = (#const POSIX_FADV_SEQUENTIAL)
+packAdvice AdviceWillNeed   = (#const POSIX_FADV_WILLNEED)
+packAdvice AdviceDontNeed   = (#const POSIX_FADV_DONTNEED)
+packAdvice AdviceNoReuse    = (#const POSIX_FADV_NOREUSE)
+#endif
+
+#ifdef HAVE_POSIX_FALLOCATE
+posix_fallocate :: Fd -> FileOffset -> FileOffset -> IO ()
+posix_fallocate fd off len = do
+  throwErrnoIfMinus1_ "posix_fallocate" (c_posix_fallocate (fromIntegral fd) (fromIntegral off) (fromIntegral len))
+
+foreign import ccall safe "posix_fallocate"
+  c_posix_fallocate :: CInt -> COff -> COff -> IO CInt
+#endif
diff --git a/System/Posix/Unistd.hsc b/System/Posix/Unistd.hsc
index db69bc2..7a1021b 100644
--- a/System/Posix/Unistd.hsc
+++ b/System/Posix/Unistd.hsc
@@ -16,6 +16,8 @@
 --
 -----------------------------------------------------------------------------
 
+#include "HsUnix.h"
+
 module System.Posix.Unistd (
     -- * System environment
     SystemID(..),
@@ -27,6 +29,14 @@ module System.Posix.Unistd (
     -- * Sleeping
     sleep, usleep, nanosleep,
 
+    -- * File synchronization
+#ifdef HAVE_FSYNC
+    fsync,
+#endif
+#ifdef HAVE_FDATASYNC
+    fdatasync,
+#endif
+
   {-
     ToDo from unistd.h:
       confstr, 
@@ -49,12 +59,11 @@ module System.Posix.Unistd (
 -}
   ) where
 
-#include "HsUnix.h"
-
 import Foreign.C.Error
 import Foreign.C.String ( peekCString )
 import Foreign.C.Types
 import Foreign
+import System.Posix.Types
 import System.Posix.Internals
 
 -- -----------------------------------------------------------------------------
@@ -206,3 +215,24 @@ sysconf n = do
 
 foreign import ccall unsafe "sysconf"
   c_sysconf :: CInt -> IO CLong
+
+-- -----------------------------------------------------------------------------
+-- File synchronization
+
+#ifdef HAVE_FSYNC
+fsync :: Fd -> IO ()
+fsync fd = do
+  throwErrnoIfMinus1_ "fsync" (c_fsync $ fromIntegral fd)
+
+foreign import ccall safe "fsync"
+  c_fsync :: CInt -> IO CInt
+#endif
+
+#ifdef HAVE_FDATASYNC
+fdatasync :: Fd -> IO ()
+fdatasync fd = do
+  throwErrnoIfMinus1_ "fdatasync" (c_fdatasync $ fromIntegral fd)
+
+foreign import ccall safe "fdatasync"
+  c_fdatasync :: CInt -> IO CInt
+#endif
diff --git a/changelog b/changelog
index ce72345..1b472a5 100644
--- a/changelog
+++ b/changelog
@@ -1,5 +1,9 @@
 -*-changelog-*-
 
+2.7.1.0  Dec 2013
+
+        * New functions `fsync`, `fdatasync`, `posix_fadvise` and `posix_fallocate`
+
 2.7.0.0  Nov 2013
 
         * New `forkProcessWithUnmask` function in the style of `forkIOWithUnmask`
diff --git a/configure.ac b/configure.ac
index f295061..1d5f65f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -61,6 +61,10 @@ AC_CHECK_FUNCS([lutimes futimes])
 # Additional temp functions
 AC_CHECK_FUNCS([mkstemps mkdtemp])
 
+# Functions for file synchronization and allocation control
+AC_CHECK_FUNCS([fsync fdatasync])
+AC_CHECK_FUNCS([posix_fadvise posix_fallocate])
+
 # Avoid adding rt if absent or unneeded
 # shm_open needs -lrt on linux
 AC_SEARCH_LIBS(shm_open, rt, [AC_CHECK_FUNCS([shm_open shm_unlink])])
diff --git a/unix.cabal b/unix.cabal
index 3ad3c98..b6f415a 100644
--- a/unix.cabal
+++ b/unix.cabal
@@ -71,6 +71,7 @@ library
         System.Posix.ByteString
 
         System.Posix.Error
+        System.Posix.Fcntl
         System.Posix.Resource
         System.Posix.Time
         System.Posix.Unistd