-- | Miscellaneous utilities provided for convenience.
--
-- These can be used for general purpose and are not directly related to FUSE.
module System.LibFuse3.Utils
  ( -- * Bitsets
    testBitSet

  , -- * Errno
    unErrno, ioErrorToErrno, throwErrnoOf, tryErrno, tryErrno_, tryErrno', tryErrno_'

  , -- * File I/O
    pread, pwrite, c_pread, c_pwrite

  , -- * Marshalling strings
    pokeCStringLen0

  , -- * TimeSpec
    timeSpecToPOSIXTime
  )
  where

import Control.Exception (SomeException, try, tryJust)
import Data.Bits ((.&.), Bits)
import Data.ByteString (ByteString)
import Data.Ratio ((%))
import Data.Time.Clock.POSIX (POSIXTime)
import Foreign (Ptr, allocaBytes, copyArray, pokeElemOff)
import Foreign.C (CInt(CInt), CSize(CSize), CStringLen, Errno(Errno), eIO, eOK, errnoToIOError, getErrno, throwErrno, throwErrnoIfMinus1, withCStringLen)
import GHC.IO.Exception (IOException(IOError, ioe_errno))
import System.Clock (TimeSpec)
import System.Posix.Types (ByteCount, COff(COff), CSsize(CSsize), Fd(Fd), FileOffset)

import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as BU
import qualified System.Clock as TimeSpec

-- | Identical to @extra@'s @try_@
try_ :: IO a -> IO (Either SomeException a)
try_ :: forall a. IO a -> IO (Either SomeException a)
try_ = forall e a. Exception e => IO a -> IO (Either e a)
try

-- | Unwraps the newtype `Errno`.
unErrno :: Errno -> CInt
unErrno :: Errno -> CInt
unErrno (Errno CInt
errno) = CInt
errno

-- | Attempts to extract an `Errno` from an t`IOError` assuming it is
-- constructed with `errnoToIOError` (typically via `throwErrno`).
ioErrorToErrno :: IOError -> Maybe Errno
ioErrorToErrno :: IOError -> Maybe Errno
ioErrorToErrno IOError{ioe_errno :: IOError -> Maybe CInt
ioe_errno=Just CInt
e} = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CInt -> Errno
Errno CInt
e
ioErrorToErrno IOError
_ = forall a. Maybe a
Nothing

-- | Like `throwErrno` but takes an `Errno` as a parameter instead of reading from `getErrno`.
--
-- This is an inverse of `tryErrno`:
--
-- @
-- tryErrno (throwErrnoOf _ e) ≡ pure (Left e)
-- @
throwErrnoOf
  :: String -- ^ textual description of the error location
  -> Errno
  -> IO a
throwErrnoOf :: forall a. String -> Errno -> IO a
throwErrnoOf String
loc Errno
errno = forall a. IOError -> IO a
ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
loc Errno
errno forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
  where
  _dummyToSuppressWarnings :: t
_dummyToSuppressWarnings = forall a. HasCallStack => String -> a
error String
"dummy" IO Errno
getErrno forall a. String -> IO a
throwErrno

-- | Catches an exception constructed with `errnoToIOError` and extracts `Errno` from it.
tryErrno :: IO a -> IO (Either Errno a)
tryErrno :: forall a. IO a -> IO (Either Errno a)
tryErrno = forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust IOError -> Maybe Errno
ioErrorToErrno

-- | Like `tryErrno` but discards the result of the original action.
--
-- If no exceptions, returns `eOK`.
tryErrno_ :: IO a -> IO Errno
tryErrno_ :: forall a. IO a -> IO Errno
tryErrno_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id (forall a b. a -> b -> a
const Errno
eOK)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO (Either Errno a)
tryErrno

-- | Like `tryErrno` but also catches non-Errno errors to return `eIO`.
tryErrno' :: IO a -> IO (Either Errno a)
tryErrno' :: forall a. IO a -> IO (Either Errno a)
tryErrno' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Errno
eIO) forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO (Either SomeException a)
try_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO (Either Errno a)
tryErrno

-- | Like `tryErrno_` but also catches non-Errno errors to return `eIO`.
tryErrno_' :: IO a -> IO Errno
tryErrno_' :: forall a. IO a -> IO Errno
tryErrno_' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Errno
eIO) forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO (Either SomeException a)
try_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO Errno
tryErrno_

-- | Converts a `TimeSpec` to a `POSIXTime`.
--
-- This is the same conversion as the @unix@ package does (as of writing).
timeSpecToPOSIXTime :: TimeSpec -> POSIXTime
timeSpecToPOSIXTime :: TimeSpec -> POSIXTime
timeSpecToPOSIXTime TimeSpec
ts = forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ TimeSpec -> Integer
TimeSpec.toNanoSecs TimeSpec
ts forall a. Integral a => a -> a -> Ratio a
% Integer
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
9::Int)

-- | Marshals a Haskell string into a NUL terminated C string in a locale-dependent way.
--
-- Does `withCStringLen` and copies it into the destination buffer.
--
-- The Haskell string should not contain NUL characters.
--
-- If the destination buffer is not long enough to hold the source string, it is truncated
-- and a NUL byte is inserted at the end of the buffer.
pokeCStringLen0 :: CStringLen -> String -> IO ()
pokeCStringLen0 :: CStringLen -> String -> IO ()
pokeCStringLen0 (Ptr CChar
pBuf, Int
bufSize) String
src =
  forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
src forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
pSrc, Int
srcSize) -> do
    -- withCStringLen does *not* append NUL byte at the end
    let bufSize0 :: Int
bufSize0 = Int
bufSize forall a. Num a => a -> a -> a
- Int
1
    forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr CChar
pBuf Ptr CChar
pSrc (forall a. Ord a => a -> a -> a
min Int
bufSize0 Int
srcSize)
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CChar
pBuf (forall a. Ord a => a -> a -> a
min Int
bufSize0 Int
srcSize) CChar
0

-- | @testBitSet bits mask@ is @True@ iff all bits in @mask@ are set in @bits@.
--
-- @
-- testBitSet bits mask ≡ bits .&. mask == mask
-- @
testBitSet :: Bits a => a -> a -> Bool
testBitSet :: forall a. Bits a => a -> a -> Bool
testBitSet a
bits a
mask = a
bits forall a. Bits a => a -> a -> a
.&. a
mask forall a. Eq a => a -> a -> Bool
== a
mask

-- | Reads from a file descriptor at a given offset.
--
-- Fewer bytes may be read than requested.
-- On error, throws an t`IOError` corresponding to the errno.
pread :: Fd -> ByteCount -> FileOffset -> IO ByteString
pread :: Fd -> ByteCount -> FileOffset -> IO ByteString
pread (Fd CInt
fd) ByteCount
size FileOffset
off =
  forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCount
size) forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buf -> do
    CSsize
readBytes <- forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"pread" forall a b. (a -> b) -> a -> b
$ forall a. CInt -> Ptr a -> ByteCount -> FileOffset -> IO CSsize
c_pread CInt
fd Ptr CChar
buf ByteCount
size FileOffset
off
    CStringLen -> IO ByteString
B.packCStringLen (Ptr CChar
buf, forall a b. (Integral a, Num b) => a -> b
fromIntegral CSsize
readBytes)

-- | Writes to a file descriptor at a given offset.
--
-- Returns the number of bytes written. Fewer bytes may be written than requested.
-- On error, throws an t`IOError` corresponding to the errno.
pwrite :: Fd -> ByteString -> FileOffset -> IO CSsize
pwrite :: Fd -> ByteString -> FileOffset -> IO CSsize
pwrite (Fd CInt
fd) ByteString
bs FileOffset
off =
  forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
buf, Int
size) ->
    forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"pwrite" forall a b. (a -> b) -> a -> b
$ forall a. CInt -> Ptr a -> ByteCount -> FileOffset -> IO CSsize
c_pwrite CInt
fd Ptr CChar
buf (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) FileOffset
off

-- | A foreign import of @pread(2)@
foreign import ccall "pread"
  c_pread :: CInt -> Ptr a -> CSize -> COff -> IO CSsize

-- | A foreign import of @pwrite(2)@
foreign import ccall "pwrite"
  c_pwrite :: CInt -> Ptr a -> CSize -> COff -> IO CSsize