-- | 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, tryErrno, tryErrno_

  , -- * Marshalling strings
    pokeCStringLen0

  , -- * TimeSpec
    timeSpecToPOSIXTime
  )
  where

import Control.Exception (tryJust)
import Data.Bits ((.&.), Bits)
import Data.Ratio ((%))
import Data.Time.Clock.POSIX (POSIXTime)
import Foreign (copyArray, pokeElemOff)
import Foreign.C (CInt, CStringLen, Errno(Errno), eOK, errnoToIOError, throwErrno, withCStringLen)
import GHC.IO.Exception (IOException(IOError, ioe_errno))
import System.Clock (TimeSpec)

import qualified System.Clock as TimeSpec

-- to have haddock link to proper entities
_dummy :: dummy
_dummy :: dummy
_dummy = [Char]
-> ([Char] -> Errno -> Maybe Handle -> Maybe [Char] -> IOError)
-> ([Char] -> IO Any)
-> dummy
forall a. HasCallStack => [Char] -> a
error [Char]
"dummy" [Char] -> Errno -> Maybe Handle -> Maybe [Char] -> IOError
errnoToIOError [Char] -> IO Any
forall a. [Char] -> IO a
throwErrno

-- | 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} = Errno -> Maybe Errno
forall a. a -> Maybe a
Just (Errno -> Maybe Errno) -> Errno -> Maybe Errno
forall a b. (a -> b) -> a -> b
$ CInt -> Errno
Errno CInt
e
ioErrorToErrno IOError
_ = Maybe Errno
forall a. Maybe a
Nothing

-- | Catches an exception constructed with `errnoToIOError` and extracts `Errno` from it.
tryErrno :: IO a -> IO (Either Errno a)
tryErrno :: IO a -> IO (Either Errno a)
tryErrno = (IOError -> Maybe Errno) -> IO a -> IO (Either Errno a)
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_ :: IO a -> IO Errno
tryErrno_ = (Either Errno a -> Errno) -> IO (Either Errno a) -> IO Errno
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Errno -> Errno) -> (a -> Errno) -> Either Errno a -> Errno
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Errno -> Errno
forall a. a -> a
id (Errno -> a -> Errno
forall a b. a -> b -> a
const Errno
eOK)) (IO (Either Errno a) -> IO Errno)
-> (IO a -> IO (Either Errno a)) -> IO a -> IO Errno
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (Either Errno a)
forall a. IO a -> IO (Either Errno a)
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 = Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> POSIXTime) -> Rational -> POSIXTime
forall a b. (a -> b) -> a -> b
$ TimeSpec -> Integer
TimeSpec.toNanoSecs TimeSpec
ts Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
10Integer -> Int -> Integer
forall 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 -> [Char] -> IO ()
pokeCStringLen0 (Ptr CChar
pBuf, Int
bufSize) [Char]
src =
  [Char] -> (CStringLen -> IO ()) -> IO ()
forall a. [Char] -> (CStringLen -> IO a) -> IO a
withCStringLen [Char]
src ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr CChar
pBuf Ptr CChar
pSrc (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
bufSize0 Int
srcSize)
    Ptr CChar -> Int -> CChar -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CChar
pBuf (Int -> Int -> Int
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 :: a -> a -> Bool
testBitSet a
bits a
mask = a
bits a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
mask a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
mask