{-# LANGUAGE CPP #-}

module System.FS.BlockIO.Internal (
    ioHasBlockIO
  ) where

import qualified System.FS.API as FS
import           System.FS.API (FsPath, Handle (..), HasFS)
import qualified System.FS.BlockIO.API as FS
import           System.FS.BlockIO.API (Advice (..), FileOffset, HasBlockIO,
                     IOCtxParams)
import           System.FS.IO (HandleIO)
import qualified System.FS.IO.Handle as FS
import qualified System.Posix.Fcntl as Fcntl
import qualified System.Posix.Fcntl.NoCache as Unix
import qualified System.Posix.Files as Unix
import qualified System.Posix.Unistd as Unix

#if SERIALBLOCKIO
import qualified System.FS.BlockIO.Serial as Serial
#else
import qualified System.FS.BlockIO.Async as Async
#endif

ioHasBlockIO ::
     HasFS IO HandleIO
  -> IOCtxParams
  -> IO (HasBlockIO IO HandleIO)
#if SERIALBLOCKIO
ioHasBlockIO hfs _params =
    Serial.serialHasBlockIO
      hSetNoCache
      hAdvise
      hAllocate
      (FS.tryLockFileIO hfs)
      hSynchronise
      (synchroniseDirectory hfs)
      (FS.createHardLinkIO hfs Unix.createLink)
      hfs
#else
ioHasBlockIO :: HasFS IO HandleIO -> IOCtxParams -> IO (HasBlockIO IO HandleIO)
ioHasBlockIO HasFS IO HandleIO
hfs  IOCtxParams
params =
    (Handle HandleIO -> Bool -> IO ())
-> (Handle HandleIO -> FileOffset -> FileOffset -> Advice -> IO ())
-> (Handle HandleIO -> FileOffset -> FileOffset -> IO ())
-> (FsPath -> LockMode -> IO (Maybe (LockFileHandle IO)))
-> (Handle HandleIO -> IO ())
-> (FsPath -> IO ())
-> (FsPath -> FsPath -> IO ())
-> HasFS IO HandleIO
-> IOCtxParams
-> IO (HasBlockIO IO HandleIO)
Async.asyncHasBlockIO
      Handle HandleIO -> Bool -> IO ()
hSetNoCache
      Handle HandleIO -> FileOffset -> FileOffset -> Advice -> IO ()
hAdvise
      Handle HandleIO -> FileOffset -> FileOffset -> IO ()
hAllocate
      (HasFS IO HandleIO
-> FsPath -> LockMode -> IO (Maybe (LockFileHandle IO))
FS.tryLockFileIO HasFS IO HandleIO
hfs)
      Handle HandleIO -> IO ()
hSynchronise
      (HasFS IO HandleIO -> FsPath -> IO ()
synchroniseDirectory HasFS IO HandleIO
hfs)
      (HasFS IO HandleIO
-> (FilePath -> FilePath -> IO ()) -> FsPath -> FsPath -> IO ()
FS.createHardLinkIO HasFS IO HandleIO
hfs FilePath -> FilePath -> IO ()
Unix.createLink)
      HasFS IO HandleIO
hfs
      IOCtxParams
params
#endif

hSetNoCache :: Handle HandleIO -> Bool -> IO ()
hSetNoCache :: Handle HandleIO -> Bool -> IO ()
hSetNoCache Handle HandleIO
h Bool
b =
  FilePath -> HandleIO -> (Fd -> IO ()) -> IO ()
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
FS.withOpenHandle FilePath
"hSetNoCache" (Handle HandleIO -> HandleIO
forall h. Handle h -> h
handleRaw Handle HandleIO
h) ((Fd -> Bool -> IO ()) -> Bool -> Fd -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Fd -> Bool -> IO ()
Unix.writeFcntlNoCache Bool
b)

hAdvise :: Handle HandleIO -> FileOffset -> FileOffset -> Advice -> IO ()
hAdvise :: Handle HandleIO -> FileOffset -> FileOffset -> Advice -> IO ()
hAdvise Handle HandleIO
h FileOffset
off FileOffset
len Advice
advice = FilePath -> HandleIO -> (Fd -> IO ()) -> IO ()
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
FS.withOpenHandle FilePath
"hAdvise" (Handle HandleIO -> HandleIO
forall h. Handle h -> h
handleRaw Handle HandleIO
h) ((Fd -> IO ()) -> IO ()) -> (Fd -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    Fd -> FileOffset -> FileOffset -> Advice -> IO ()
Fcntl.fileAdvise Fd
fd FileOffset
off FileOffset
len Advice
advice'
  where
    advice' :: Advice
advice' = case Advice
advice of
      Advice
AdviceNormal     -> Advice
Fcntl.AdviceNormal
      Advice
AdviceRandom     -> Advice
Fcntl.AdviceRandom
      Advice
AdviceSequential -> Advice
Fcntl.AdviceSequential
      Advice
AdviceWillNeed   -> Advice
Fcntl.AdviceWillNeed
      Advice
AdviceDontNeed   -> Advice
Fcntl.AdviceDontNeed
      Advice
AdviceNoReuse    -> Advice
Fcntl.AdviceNoReuse

hAllocate :: Handle HandleIO -> FileOffset -> FileOffset -> IO ()
hAllocate :: Handle HandleIO -> FileOffset -> FileOffset -> IO ()
hAllocate Handle HandleIO
h FileOffset
off FileOffset
len = FilePath -> HandleIO -> (Fd -> IO ()) -> IO ()
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
FS.withOpenHandle FilePath
"hAllocate" (Handle HandleIO -> HandleIO
forall h. Handle h -> h
handleRaw Handle HandleIO
h) ((Fd -> IO ()) -> IO ()) -> (Fd -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    Fd -> FileOffset -> FileOffset -> IO ()
Fcntl.fileAllocate Fd
fd FileOffset
off FileOffset
len

hSynchronise :: Handle HandleIO -> IO ()
hSynchronise :: Handle HandleIO -> IO ()
hSynchronise Handle HandleIO
h = FilePath -> HandleIO -> (Fd -> IO ()) -> IO ()
forall osHandle a.
FilePath -> HandleOS osHandle -> (osHandle -> IO a) -> IO a
FS.withOpenHandle FilePath
"hSynchronise" (Handle HandleIO -> HandleIO
forall h. Handle h -> h
handleRaw Handle HandleIO
h) ((Fd -> IO ()) -> IO ()) -> (Fd -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    Fd -> IO ()
Unix.fileSynchronise Fd
fd

synchroniseDirectory :: HasFS IO HandleIO -> FsPath -> IO ()
synchroniseDirectory :: HasFS IO HandleIO -> FsPath -> IO ()
synchroniseDirectory HasFS IO HandleIO
hfs FsPath
path =
    HasFS IO HandleIO
-> FsPath -> OpenMode -> (Handle HandleIO -> IO ()) -> IO ()
forall (m :: * -> *) h a.
(HasCallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
FS.withFile HasFS IO HandleIO
hfs FsPath
path OpenMode
FS.ReadMode ((Handle HandleIO -> IO ()) -> IO ())
-> (Handle HandleIO -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle HandleIO -> IO ()
hSynchronise