1{-# LANGUAGE CApiFFI #-}
2#if __GLASGOW_HASKELL__ >= 709
3{-# LANGUAGE Safe #-}
4#else
5{-# LANGUAGE Trustworthy #-}
6#endif
7-----------------------------------------------------------------------------
8-- |
9-- Module      :  System.Posix.Fcntl
10-- Copyright   :  (c) The University of Glasgow 2014
11-- License     :  BSD-style (see the file LICENSE)
12--
13-- Maintainer  :  libraries@haskell.org
14-- Stability   :  provisional
15-- Portability :  non-portable (requires POSIX)
16--
17-- POSIX file control support
18--
19-- @since 2.7.1.0
20-----------------------------------------------------------------------------
21
22#include "HsUnix.h"
23
24module System.Posix.Fcntl (
25    -- * File allocation
26    Advice(..), fileAdvise,
27    fileAllocate,
28  ) where
29
30#if HAVE_POSIX_FALLOCATE || HAVE_POSIX_FADVISE
31import Foreign.C
32#endif
33import System.Posix.Types
34
35#if !HAVE_POSIX_FALLOCATE
36import System.IO.Error ( ioeSetLocation )
37import GHC.IO.Exception ( unsupportedOperation )
38#endif
39
40-- -----------------------------------------------------------------------------
41-- File control
42
43-- | Advice parameter for 'fileAdvise' operation.
44--
45-- For more details, see documentation of @posix_fadvise(2)@.
46--
47-- @since 2.7.1.0
48data Advice
49  = AdviceNormal
50  | AdviceRandom
51  | AdviceSequential
52  | AdviceWillNeed
53  | AdviceDontNeed
54  | AdviceNoReuse
55  deriving Eq
56
57-- | Performs @posix_fadvise(2)@ operation on file-descriptor.
58--
59-- If platform does not provide @posix_fadvise(2)@ 'fileAdvise'
60-- becomes a no-op.
61--
62-- (use @#if HAVE_POSIX_FADVISE@ CPP guard to detect availability)
63--
64-- @since 2.7.1.0
65fileAdvise :: Fd -> FileOffset -> FileOffset -> Advice -> IO ()
66#if HAVE_POSIX_FADVISE
67fileAdvise fd off len adv = do
68  throwErrnoIfMinus1_ "fileAdvise" (c_posix_fadvise (fromIntegral fd) (fromIntegral off) (fromIntegral len) (packAdvice adv))
69
70foreign import capi safe "fcntl.h posix_fadvise"
71  c_posix_fadvise :: CInt -> COff -> COff -> CInt -> IO CInt
72
73packAdvice :: Advice -> CInt
74packAdvice AdviceNormal     = (#const POSIX_FADV_NORMAL)
75packAdvice AdviceRandom     = (#const POSIX_FADV_RANDOM)
76packAdvice AdviceSequential = (#const POSIX_FADV_SEQUENTIAL)
77packAdvice AdviceWillNeed   = (#const POSIX_FADV_WILLNEED)
78packAdvice AdviceDontNeed   = (#const POSIX_FADV_DONTNEED)
79packAdvice AdviceNoReuse    = (#const POSIX_FADV_NOREUSE)
80#else
81fileAdvise _ _ _ _ = return ()
82#endif
83
84-- | Performs @posix_fallocate(2)@ operation on file-descriptor.
85--
86-- Throws 'IOError' (\"unsupported operation\") if platform does not
87-- provide @posix_fallocate(2)@.
88--
89-- (use @#if HAVE_POSIX_FALLOCATE@ CPP guard to detect availability).
90--
91-- @since 2.7.1.0
92fileAllocate :: Fd -> FileOffset -> FileOffset -> IO ()
93#if HAVE_POSIX_FALLOCATE
94fileAllocate fd off len = do
95  throwErrnoIfMinus1_ "fileAllocate" (c_posix_fallocate (fromIntegral fd) (fromIntegral off) (fromIntegral len))
96
97foreign import capi safe "fcntl.h posix_fallocate"
98  c_posix_fallocate :: CInt -> COff -> COff -> IO CInt
99#else
100{-# WARNING fileAllocate
101    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_POSIX_FALLOCATE@)" #-}
102fileAllocate _ _ _ = ioError (ioeSetLocation unsupportedOperation
103                              "fileAllocate")
104#endif
105