[commit: packages/unix] master: Wrap posix_fadvise(2) and posix_fallocate(2) (e14fbe2)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/unix

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/e14fbe2cb3bbd604dadcc3847882ca37edf548b3/unix

>---------------------------------------------------------------

commit e14fbe2cb3bbd604dadcc3847882ca37edf548b3
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date:   Mon Dec 15 23:25:26 2014 +0100

    Wrap posix_fadvise(2) and posix_fallocate(2)
    
    This adds two new functions in `System.Posix.Unistd`
    
     - `fileAdvise` (aka `posix_fadvise(2)`), and
     - `fileAllocate` (aka `posix_fallocate(2)`)
    
    This is based in part on #7 and has been heavily refactored from its
    original patch submission by Ricardo Catalinas Jiménez.
    
    Signed-off-by: Herbert Valerio Riedel <hvr at gnu.org>


>---------------------------------------------------------------

e14fbe2cb3bbd604dadcc3847882ca37edf548b3
 System/Posix/Fcntl.hsc | 99 ++++++++++++++++++++++++++++++++++++++++++++++++++
 changelog.md           |  4 ++
 configure.ac           |  1 +
 unix.cabal             |  2 +
 4 files changed, 106 insertions(+)

diff --git a/System/Posix/Fcntl.hsc b/System/Posix/Fcntl.hsc
new file mode 100644
index 0000000..a45f559
--- /dev/null
+++ b/System/Posix/Fcntl.hsc
@@ -0,0 +1,99 @@
+{-# LANGUAGE CApiFFI #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.Fcntl
+-- Copyright   :  (c) The University of Glasgow 2014
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  libraries at haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires POSIX)
+--
+-- POSIX file control support
+--
+-----------------------------------------------------------------------------
+
+#include "HsUnix.h"
+
+module System.Posix.Fcntl (
+    -- * File allocation
+    Advice(..), fileAdvise,
+    fileAllocate,
+  ) where
+
+#if HAVE_POSIX_FALLOCATE || HAVE_POSIX_FADVISE
+import Foreign.C
+#endif
+import System.Posix.Types
+
+#if !HAVE_POSIX_FALLOCATE
+import System.IO.Error ( ioeSetLocation )
+import GHC.IO.Exception ( unsupportedOperation )
+#endif
+
+-- -----------------------------------------------------------------------------
+-- File control
+
+-- | Advice parameter for 'fileAdvise' operation.
+--
+-- For more details, see documentation of @posix_fadvise(2)@.
+data Advice
+  = AdviceNormal
+  | AdviceRandom
+  | AdviceSequential
+  | AdviceWillNeed
+  | AdviceDontNeed
+  | AdviceNoReuse
+  deriving Eq
+
+-- | Performs @posix_fadvise(2)@ operation on file-descriptor.
+--
+-- If platform does not provide @posix_fadvise(2)@ 'fileAdvise'
+-- becomes a no-op.
+--
+-- (use @#if HAVE_POSIX_FADVISE@ CPP guard to detect availability)
+--
+-- /Since: 2.7.1.0/
+fileAdvise :: Fd -> FileOffset -> FileOffset -> Advice -> IO ()
+#if HAVE_POSIX_FADVISE
+fileAdvise fd off len adv = do
+  throwErrnoIfMinus1_ "fileAdvise" (c_posix_fadvise (fromIntegral fd) (fromIntegral off) (fromIntegral len) (packAdvice adv))
+
+foreign import capi safe "fcntl.h 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)
+#else
+fileAdvise _ _ _ _ = return ()
+#endif
+
+-- | Performs @posix_fallocate(2)@ operation on file-descriptor.
+--
+-- Throws 'IOError' (\"unsupported operation\") if platform does not
+-- provide @posix_fallocate(2)@.
+--
+-- (use @#if HAVE_POSIX_FALLOCATE@ CPP guard to detect availability).
+--
+-- /Since: 2.7.1.0/
+fileAllocate :: Fd -> FileOffset -> FileOffset -> IO ()
+#if HAVE_POSIX_FALLOCATE
+fileAllocate fd off len = do
+  throwErrnoIfMinus1_ "fileAllocate" (c_posix_fallocate (fromIntegral fd) (fromIntegral off) (fromIntegral len))
+
+foreign import capi safe "fcntl.h posix_fallocate"
+  c_posix_fallocate :: CInt -> COff -> COff -> IO CInt
+#else
+{-# WARNING fileAllocate
+    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_POSIX_FALLOCATE@)" #-}
+fileAllocate _ _ _ = ioError (ioeSetLocation unsupportedOperation
+                              "fileAllocate")
+#endif
diff --git a/changelog.md b/changelog.md
index 1be0f35..db6bb48 100644
--- a/changelog.md
+++ b/changelog.md
@@ -21,6 +21,10 @@
      - `fileSynchronise` (aka `fsync(2)`), and
      - `fileSynchroniseDataOnly` (aka `fdatasync(2)`)
 
+  * New module `System.Posix.Fcntl` providing
+     - `fileAdvise` (aka `posix_fadvise(2)`), and
+     - `fileAllocate` (aka `posix_fallocate(2)`)
+
 ## 2.7.0.1  *Mar 2014*
 
   * Bundled with GHC 7.8.1
diff --git a/configure.ac b/configure.ac
index 94d9d77..1c82c36 100644
--- a/configure.ac
+++ b/configure.ac
@@ -69,6 +69,7 @@ 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
diff --git a/unix.cabal b/unix.cabal
index 7bcf0d9..cc9c646 100644
--- a/unix.cabal
+++ b/unix.cabal
@@ -96,6 +96,8 @@ library
         System.Posix.Env
         System.Posix.Env.ByteString
 
+        System.Posix.Fcntl
+
         System.Posix.Process
         System.Posix.Process.Internals
         System.Posix.Process.ByteString