-- | Provides a dynamic effect for writing to a handle.
--
-- @since 0.1
module Effectful.FileSystem.HandleWriter.Dynamic
  ( -- * Effect
    HandleWriter (..),
    openBinaryFile,
    withBinaryFile,
    hClose,
    hFlush,
    hSetFileSize,
    hSetBuffering,
    hSeek,
    hTell,
    hSetEcho,
    hPut,
    hPutNonBlocking,
    hLockRaw,
    hTryLockRaw,
    hUnlockRaw,

    -- ** Handlers
    runHandleWriter,

    -- * File handles
    Handle,
    HandleMode (HandleModeWrite),
    CanWrite,

    -- * Locking
    -- $locking
    LockedHandle,
    Internal.liftLocked,
    withLockedFile,
    withTryLockedFile,
    hLock,
    hTryLock,
    hUnlock,

    -- ** Raw
    withLockedFileRaw,
    withTryLockedFileRaw,

    -- * UTF-8 Utils
    hPutUtf8,
    hPutNonBlockingUtf8,

    -- * Misc
    die,

    -- * Re-exports
    BufferMode (..),
    ByteString,
    IOMode (..),
    OsPath,
    SeekMode (..),
    Text,
  )
where

import Control.Exception.Utils (exitFailure)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as Char8
import Data.Text (Text)
import Effectful
  ( Dispatch (Dynamic),
    DispatchOf,
    Eff,
    Effect,
    IOE,
    type (:>),
  )
import Effectful.Dispatch.Dynamic
  ( HasCallStack,
    localSeqUnlift,
    reinterpret,
    send,
  )
import Effectful.Dynamic.Utils (ShowEffect (showEffectCons))
import Effectful.Exception (bracket, bracket_)
import Effectful.FileSystem.Handle qualified as Handle
import Effectful.FileSystem.Handle.Internal
  ( CanWrite,
    Handle,
    HandleMode (HandleModeWrite),
    LockedHandle,
  )
import Effectful.FileSystem.Handle.Internal qualified as Internal
import Effectful.FileSystem.HandleWriter.Static qualified as Static
import FileSystem.OsPath (OsPath)
import FileSystem.UTF8 qualified as FS.UTF8
import System.IO
  ( BufferMode (BlockBuffering, LineBuffering, NoBuffering),
    IOMode (AppendMode, ReadMode, ReadWriteMode, WriteMode),
    SeekMode (AbsoluteSeek, RelativeSeek, SeekFromEnd),
  )

-- | @since 0.1
type instance DispatchOf HandleWriter = Dynamic

-- | Dynamic effect for writing to a handle.
--
-- @since 0.1
data HandleWriter :: Effect where
  OpenBinaryFile :: OsPath -> Bool -> HandleWriter m (Handle HandleModeWrite)
  WithBinaryFile :: OsPath -> Bool -> (Handle HandleModeWrite -> m a) -> HandleWriter m a
  HClose :: (CanWrite p) => Handle p -> HandleWriter m ()
  HFlush :: (CanWrite p) => Handle p -> HandleWriter m ()
  HSetFileSize :: (CanWrite p) => Handle p -> Integer -> HandleWriter m ()
  HSetBuffering :: (CanWrite p) => Handle p -> BufferMode -> HandleWriter m ()
  HSeek :: (CanWrite p) => Handle p -> SeekMode -> Integer -> HandleWriter m ()
  HTell :: (CanWrite p) => Handle p -> HandleWriter m Integer
  HSetEcho :: (CanWrite p) => Handle p -> Bool -> HandleWriter m ()
  HPut :: (CanWrite p) => Handle p -> ByteString -> HandleWriter m ()
  HPutNonBlocking :: (CanWrite p) => Handle p -> ByteString -> HandleWriter m ByteString
  HLockRaw :: (CanWrite p) => Handle p -> HandleWriter m ()
  HTryLockRaw :: (CanWrite p) => Handle p -> HandleWriter m Bool
  HUnlockRaw :: (CanWrite p) => Handle p -> HandleWriter m ()

-- | @since 0.1
instance ShowEffect HandleWriter where
  showEffectCons :: forall (m :: * -> *) a. HandleWriter m a -> String
showEffectCons = \case
    OpenBinaryFile OsPath
_ Bool
_ -> String
"OpenBinaryFile"
    WithBinaryFile {} -> String
"WithBinaryFile"
    HClose Handle p
_ -> String
"HClose"
    HFlush Handle p
_ -> String
"HFlush"
    HSetFileSize Handle p
_ Integer
_ -> String
"HSetFileSize"
    HSetBuffering Handle p
_ BufferMode
_ -> String
"HSetBuffering"
    HSeek {} -> String
"HSeek"
    HTell Handle p
_ -> String
"HTell"
    HSetEcho Handle p
_ Bool
_ -> String
"HSetEcho"
    HPut Handle p
_ ByteString
_ -> String
"HPut"
    HPutNonBlocking Handle p
_ ByteString
_ -> String
"HPutNonBlocking"
    HLockRaw Handle p
_ -> String
"HLockRaw"
    HTryLockRaw Handle p
_ -> String
"HTryLockRaw"
    HUnlockRaw Handle p
_ -> String
"HUnlockRaw"

-- | Runs 'HandleWriter' in 'IO'.
--
-- @since 0.1
runHandleWriter ::
  ( HasCallStack,
    IOE :> es
  ) =>
  Eff (HandleWriter : es) a ->
  Eff es a
runHandleWriter :: forall (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, IOE :> es) =>
Eff (HandleWriter : es) a -> Eff es a
runHandleWriter = (Eff (HandleWriter : es) a -> Eff es a)
-> EffectHandler HandleWriter (HandleWriter : es)
-> Eff (HandleWriter : es) a
-> Eff es a
forall (e :: (* -> *) -> * -> *)
       (handlerEs :: [(* -> *) -> * -> *]) a (es :: [(* -> *) -> * -> *])
       b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret Eff (HandleWriter : es) a -> Eff es a
forall (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, IOE :> es) =>
Eff (HandleWriter : es) a -> Eff es a
Static.runHandleWriter (EffectHandler HandleWriter (HandleWriter : es)
 -> Eff (HandleWriter : es) a -> Eff es a)
-> EffectHandler HandleWriter (HandleWriter : es)
-> Eff (HandleWriter : es) a
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs
env -> \case
  OpenBinaryFile OsPath
p Bool
m -> OsPath -> Bool -> Eff (HandleWriter : es) (Handle 'HandleModeWrite)
forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
OsPath -> Bool -> Eff es (Handle 'HandleModeWrite)
Static.openBinaryFile OsPath
p Bool
m
  WithBinaryFile OsPath
p Bool
m Handle 'HandleModeWrite -> Eff localEs a
f -> LocalEnv localEs
-> ((forall r. Eff localEs r -> Eff (HandleWriter : es) r)
    -> Eff (HandleWriter : es) a)
-> Eff (HandleWriter : es) a
forall (localEs :: [(* -> *) -> * -> *])
       (es :: [(* -> *) -> * -> *]) a.
HasCallStack =>
LocalEnv localEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs
env (((forall r. Eff localEs r -> Eff (HandleWriter : es) r)
  -> Eff (HandleWriter : es) a)
 -> Eff (HandleWriter : es) a)
-> ((forall r. Eff localEs r -> Eff (HandleWriter : es) r)
    -> Eff (HandleWriter : es) a)
-> Eff (HandleWriter : es) a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff localEs r -> Eff (HandleWriter : es) r
runInStatic ->
    OsPath
-> Bool
-> (Handle 'HandleModeWrite -> Eff (HandleWriter : es) a)
-> Eff (HandleWriter : es) a
forall (es :: [(* -> *) -> * -> *]) a.
(HandleWriter :> es, HasCallStack) =>
OsPath -> Bool -> (Handle 'HandleModeWrite -> Eff es a) -> Eff es a
Static.withBinaryFile OsPath
p Bool
m (Eff localEs a -> Eff (HandleWriter : es) a
forall r. Eff localEs r -> Eff (HandleWriter : es) r
runInStatic (Eff localEs a -> Eff (HandleWriter : es) a)
-> (Handle 'HandleModeWrite -> Eff localEs a)
-> Handle 'HandleModeWrite
-> Eff (HandleWriter : es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle 'HandleModeWrite -> Eff localEs a
f)
  HClose Handle p
h -> Handle p -> Eff (HandleWriter : es) ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
Static.hClose Handle p
h
  HFlush Handle p
h -> Handle p -> Eff (HandleWriter : es) ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
Static.hFlush Handle p
h
  HSetFileSize Handle p
h Integer
i -> Handle p -> Integer -> Eff (HandleWriter : es) ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Integer -> Eff es ()
Static.hSetFileSize Handle p
h Integer
i
  HSetBuffering Handle p
h BufferMode
m -> Handle p -> BufferMode -> Eff (HandleWriter : es) ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> BufferMode -> Eff es ()
Static.hSetBuffering Handle p
h BufferMode
m
  HSeek Handle p
h SeekMode
m Integer
i -> Handle p -> SeekMode -> Integer -> Eff (HandleWriter : es) ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> SeekMode -> Integer -> Eff es ()
Static.hSeek Handle p
h SeekMode
m Integer
i
  HTell Handle p
h -> Handle p -> Eff (HandleWriter : es) Integer
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es Integer
Static.hTell Handle p
h
  HSetEcho Handle p
h Bool
b -> Handle p -> Bool -> Eff (HandleWriter : es) ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Bool -> Eff es ()
Static.hSetEcho Handle p
h Bool
b
  HPut Handle p
h ByteString
bs -> Handle p -> ByteString -> Eff (HandleWriter : es) ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> ByteString -> Eff es ()
Static.hPut Handle p
h ByteString
bs
  HPutNonBlocking Handle p
h ByteString
bs -> Handle p -> ByteString -> Eff (HandleWriter : es) ByteString
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> ByteString -> Eff es ByteString
Static.hPutNonBlocking Handle p
h ByteString
bs
  HLockRaw Handle p
h -> Handle p -> Eff (HandleWriter : es) ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
Static.hLockRaw Handle p
h
  HTryLockRaw Handle p
h -> Handle p -> Eff (HandleWriter : es) Bool
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es Bool
Static.hTryLockRaw Handle p
h
  HUnlockRaw Handle p
h -> Handle p -> Eff (HandleWriter : es) ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
Static.hUnlockRaw Handle p
h

-- | Lifted 'IO.openBinaryFile'.
--
-- @since 0.1
openBinaryFile ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  OsPath ->
  Bool ->
  Eff es (Handle HandleModeWrite)
openBinaryFile :: forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
OsPath -> Bool -> Eff es (Handle 'HandleModeWrite)
openBinaryFile OsPath
p = HandleWriter (Eff es) (Handle 'HandleModeWrite)
-> Eff es (Handle 'HandleModeWrite)
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (HandleWriter (Eff es) (Handle 'HandleModeWrite)
 -> Eff es (Handle 'HandleModeWrite))
-> (Bool -> HandleWriter (Eff es) (Handle 'HandleModeWrite))
-> Bool
-> Eff es (Handle 'HandleModeWrite)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Bool -> HandleWriter (Eff es) (Handle 'HandleModeWrite)
forall (m :: * -> *).
OsPath -> Bool -> HandleWriter m (Handle 'HandleModeWrite)
OpenBinaryFile OsPath
p

-- | Lifted 'IO.withBinaryFile'.
--
-- @since 0.1
withBinaryFile ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  OsPath ->
  Bool ->
  (Handle HandleModeWrite -> Eff es a) ->
  Eff es a
withBinaryFile :: forall (es :: [(* -> *) -> * -> *]) a.
(HandleWriter :> es, HasCallStack) =>
OsPath -> Bool -> (Handle 'HandleModeWrite -> Eff es a) -> Eff es a
withBinaryFile OsPath
p Bool
m = HandleWriter (Eff es) a -> Eff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (HandleWriter (Eff es) a -> Eff es a)
-> ((Handle 'HandleModeWrite -> Eff es a)
    -> HandleWriter (Eff es) a)
-> (Handle 'HandleModeWrite -> Eff es a)
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath
-> Bool
-> (Handle 'HandleModeWrite -> Eff es a)
-> HandleWriter (Eff es) a
forall (m :: * -> *) a.
OsPath
-> Bool -> (Handle 'HandleModeWrite -> m a) -> HandleWriter m a
WithBinaryFile OsPath
p Bool
m

-- | Lifted 'IO.hClose'.
--
-- @since 0.1
hClose ::
  ( CanWrite p,
    HandleWriter :> es,
    HasCallStack
  ) =>
  Handle p ->
  Eff es ()
hClose :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
hClose = HandleWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (HandleWriter (Eff es) () -> Eff es ())
-> (Handle p -> HandleWriter (Eff es) ()) -> Handle p -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle p -> HandleWriter (Eff es) ()
forall (p :: HandleMode) (m :: * -> *).
CanWrite p =>
Handle p -> HandleWriter m ()
HClose

-- | Lifted 'IO.hFlush'.
--
-- @since 0.1
hFlush ::
  ( CanWrite p,
    HandleWriter :> es,
    HasCallStack
  ) =>
  Handle p ->
  Eff es ()
hFlush :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
hFlush = HandleWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (HandleWriter (Eff es) () -> Eff es ())
-> (Handle p -> HandleWriter (Eff es) ()) -> Handle p -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle p -> HandleWriter (Eff es) ()
forall (p :: HandleMode) (m :: * -> *).
CanWrite p =>
Handle p -> HandleWriter m ()
HFlush

-- | Lifted 'IO.hSetFileSize'.
--
-- @since 0.1
hSetFileSize ::
  ( CanWrite p,
    HandleWriter :> es,
    HasCallStack
  ) =>
  Handle p ->
  Integer ->
  Eff es ()
hSetFileSize :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Integer -> Eff es ()
hSetFileSize Handle p
h = HandleWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (HandleWriter (Eff es) () -> Eff es ())
-> (Integer -> HandleWriter (Eff es) ()) -> Integer -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle p -> Integer -> HandleWriter (Eff es) ()
forall (p :: HandleMode) (m :: * -> *).
CanWrite p =>
Handle p -> Integer -> HandleWriter m ()
HSetFileSize Handle p
h

-- | Lifted 'IO.hSetBuffering'.
--
-- @since 0.1
hSetBuffering ::
  ( CanWrite p,
    HandleWriter :> es,
    HasCallStack
  ) =>
  Handle p ->
  BufferMode ->
  Eff es ()
hSetBuffering :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> BufferMode -> Eff es ()
hSetBuffering Handle p
h = HandleWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (HandleWriter (Eff es) () -> Eff es ())
-> (BufferMode -> HandleWriter (Eff es) ())
-> BufferMode
-> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle p -> BufferMode -> HandleWriter (Eff es) ()
forall (p :: HandleMode) (m :: * -> *).
CanWrite p =>
Handle p -> BufferMode -> HandleWriter m ()
HSetBuffering Handle p
h

-- | Lifted 'IO.hSeek'.
--
-- @since 0.1
hSeek ::
  ( CanWrite p,
    HandleWriter :> es,
    HasCallStack
  ) =>
  Handle p ->
  SeekMode ->
  Integer ->
  Eff es ()
hSeek :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> SeekMode -> Integer -> Eff es ()
hSeek Handle p
h SeekMode
m = HandleWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (HandleWriter (Eff es) () -> Eff es ())
-> (Integer -> HandleWriter (Eff es) ()) -> Integer -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle p -> SeekMode -> Integer -> HandleWriter (Eff es) ()
forall (p :: HandleMode) (m :: * -> *).
CanWrite p =>
Handle p -> SeekMode -> Integer -> HandleWriter m ()
HSeek Handle p
h SeekMode
m

-- | Lifted 'IO.hTell'.
--
-- @since 0.1
hTell ::
  ( CanWrite p,
    HandleWriter :> es,
    HasCallStack
  ) =>
  Handle p ->
  Eff es Integer
hTell :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es Integer
hTell = HandleWriter (Eff es) Integer -> Eff es Integer
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (HandleWriter (Eff es) Integer -> Eff es Integer)
-> (Handle p -> HandleWriter (Eff es) Integer)
-> Handle p
-> Eff es Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle p -> HandleWriter (Eff es) Integer
forall (p :: HandleMode) (m :: * -> *).
CanWrite p =>
Handle p -> HandleWriter m Integer
HTell

-- | Lifted 'IO.hSetEcho'.
--
-- @since 0.1
hSetEcho ::
  ( CanWrite p,
    HandleWriter :> es,
    HasCallStack
  ) =>
  Handle p ->
  Bool ->
  Eff es ()
hSetEcho :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Bool -> Eff es ()
hSetEcho Handle p
h = HandleWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (HandleWriter (Eff es) () -> Eff es ())
-> (Bool -> HandleWriter (Eff es) ()) -> Bool -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle p -> Bool -> HandleWriter (Eff es) ()
forall (p :: HandleMode) (m :: * -> *).
CanWrite p =>
Handle p -> Bool -> HandleWriter m ()
HSetEcho Handle p
h

-- | Lifted 'BS.hPut'.
--
-- @since 0.1
hPut ::
  ( CanWrite p,
    HandleWriter :> es,
    HasCallStack
  ) =>
  Handle p ->
  ByteString ->
  Eff es ()
hPut :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> ByteString -> Eff es ()
hPut Handle p
h = HandleWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (HandleWriter (Eff es) () -> Eff es ())
-> (ByteString -> HandleWriter (Eff es) ())
-> ByteString
-> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle p -> ByteString -> HandleWriter (Eff es) ()
forall (p :: HandleMode) (m :: * -> *).
CanWrite p =>
Handle p -> ByteString -> HandleWriter m ()
HPut Handle p
h

-- | Lifted 'BS.hPutNonBlocking'.
--
-- @since 0.1
hPutNonBlocking ::
  ( CanWrite p,
    HandleWriter :> es,
    HasCallStack
  ) =>
  Handle p ->
  ByteString ->
  Eff es ByteString
hPutNonBlocking :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> ByteString -> Eff es ByteString
hPutNonBlocking Handle p
h = HandleWriter (Eff es) ByteString -> Eff es ByteString
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (HandleWriter (Eff es) ByteString -> Eff es ByteString)
-> (ByteString -> HandleWriter (Eff es) ByteString)
-> ByteString
-> Eff es ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle p -> ByteString -> HandleWriter (Eff es) ByteString
forall (p :: HandleMode) (m :: * -> *).
CanWrite p =>
Handle p -> ByteString -> HandleWriter m ByteString
HPutNonBlocking Handle p
h

-- | Attempts to exclusively lock a file, blocking or throwing an exception
-- upon failure.
--
-- @since 0.1
hLockRaw ::
  ( CanWrite p,
    HandleWriter :> es,
    HasCallStack
  ) =>
  Handle p -> Eff es ()
hLockRaw :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
hLockRaw = HandleWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (HandleWriter (Eff es) () -> Eff es ())
-> (Handle p -> HandleWriter (Eff es) ()) -> Handle p -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle p -> HandleWriter (Eff es) ()
forall (p :: HandleMode) (m :: * -> *).
CanWrite p =>
Handle p -> HandleWriter m ()
HLockRaw

-- | Attempts to exclusively lock a file.
--
-- @since 0.1
hTryLockRaw ::
  ( CanWrite p,
    HandleWriter :> es,
    HasCallStack
  ) =>
  Handle p -> Eff es Bool
hTryLockRaw :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es Bool
hTryLockRaw = HandleWriter (Eff es) Bool -> Eff es Bool
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (HandleWriter (Eff es) Bool -> Eff es Bool)
-> (Handle p -> HandleWriter (Eff es) Bool)
-> Handle p
-> Eff es Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle p -> HandleWriter (Eff es) Bool
forall (p :: HandleMode) (m :: * -> *).
CanWrite p =>
Handle p -> HandleWriter m Bool
HTryLockRaw

-- | Unlocks a locked file.
--
-- @since 0.1
hUnlockRaw ::
  ( CanWrite p,
    HandleWriter :> es,
    HasCallStack
  ) =>
  Handle p -> Eff es ()
hUnlockRaw :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
hUnlockRaw = HandleWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (HandleWriter (Eff es) () -> Eff es ())
-> (Handle p -> HandleWriter (Eff es) ()) -> Handle p -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle p -> HandleWriter (Eff es) ()
forall (p :: HandleMode) (m :: * -> *).
CanWrite p =>
Handle p -> HandleWriter m ()
HUnlockRaw

-- $locking
--
-- These functions bring some type-safety to file locking. Consider:
--
-- @
-- main :: (HandleWriter :> es) => Eff es ()
-- main = withBinaryFile path False $ \\h -> do
--   hLockRaw handle
--   bs <- writeBytes @HandleModeWrite h
--   hUnlockRaw handle
--   print bs
--
-- writeBytes :: (CanWrite p, HandleWriter :> es) => Handle p -> Eff es ByteString
-- writeBytes handle = hPut handle "some bytes"
-- @
--
-- In this example, we could remove all locking logic from @main@ and
-- everything would still compile. On the other hand:
--
-- @
-- main :: (HandleWriter :> es) => Eff es ()
-- main = withBinaryFile path False $ \\h -> withLockedFile h $ \\lh -> do
--   bs <- writeBytes @HandleModeWrite lh
--   print bs
--
-- writeBytes :: (CanWrite p, HandleWriter :> es) => LockedHandle p -> Eff es ByteString
-- writeBytes lockedHandle = liftLocked (\\h -\> hPut h "some bytes") lockedHandle
-- @
--
-- Removing @withLockedFile@ would cause a compilation error, since @writeBytes@
-- requires a @LockedHandle@. The idea is to write most of the program's
-- logic in terms of @LockedHandle@, using @liftLocked@ to lift @Handle@
-- functions.

-- | Like 'hLockRaw', but returns a 'LockedHandle'.
--
-- @since 0.1
hLock ::
  ( CanWrite p,
    HasCallStack,
    HandleWriter :> es
  ) =>
  -- | Handle to lock.
  Handle p ->
  Eff es (LockedHandle p)
hLock :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HasCallStack, HandleWriter :> es) =>
Handle p -> Eff es (LockedHandle p)
hLock = (Handle p -> Eff es ()) -> Handle p -> Eff es (LockedHandle p)
forall (f :: * -> *) (p :: HandleMode).
Functor f =>
(Handle p -> f ()) -> Handle p -> f (LockedHandle p)
Internal.liftLock Handle p -> Eff es ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
hLockRaw

-- | Like 'hTryLockRaw', but returns a 'LockedHandle' if it succeeds.
--
-- @since 0.1
hTryLock ::
  ( CanWrite p,
    HasCallStack,
    HandleWriter :> es
  ) =>
  -- | Handle to lock.
  Handle p ->
  Eff es (Maybe (LockedHandle p))
hTryLock :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HasCallStack, HandleWriter :> es) =>
Handle p -> Eff es (Maybe (LockedHandle p))
hTryLock = (Handle p -> Eff es Bool)
-> Handle p -> Eff es (Maybe (LockedHandle p))
forall (f :: * -> *) (p :: HandleMode).
Functor f =>
(Handle p -> f Bool) -> Handle p -> f (Maybe (LockedHandle p))
Internal.liftTryLock Handle p -> Eff es Bool
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es Bool
hTryLockRaw

-- | Like 'hUnlockRaw', but returns the original handle.
--
-- @since 0.1
hUnlock ::
  ( CanWrite p,
    HasCallStack,
    HandleWriter :> es
  ) =>
  -- | Handle to unlock.
  LockedHandle p ->
  Eff es (Handle p)
hUnlock :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HasCallStack, HandleWriter :> es) =>
LockedHandle p -> Eff es (Handle p)
hUnlock = (Handle p -> Eff es ()) -> LockedHandle p -> Eff es (Handle p)
forall (f :: * -> *) (p :: HandleMode).
Functor f =>
(Handle p -> f ()) -> LockedHandle p -> f (Handle p)
Internal.liftUnlock Handle p -> Eff es ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
hUnlockRaw

-- | Runs a computation with an exclusively locked file.
--
-- @since 0.1
withLockedFile ::
  ( CanWrite p,
    HasCallStack,
    HandleWriter :> es
  ) =>
  -- | Handle to lock.
  Handle p ->
  -- | Callback with locked handle.
  (LockedHandle p -> Eff es a) ->
  Eff es a
withLockedFile :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]) a.
(CanWrite p, HasCallStack, HandleWriter :> es) =>
Handle p -> (LockedHandle p -> Eff es a) -> Eff es a
withLockedFile = (Handle p -> Eff es ())
-> (Handle p -> Eff es ())
-> Handle p
-> (LockedHandle p -> Eff es a)
-> Eff es a
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]) a.
HasCallStack =>
(Handle p -> Eff es ())
-> (Handle p -> Eff es ())
-> Handle p
-> (LockedHandle p -> Eff es a)
-> Eff es a
Internal.withLockedFile Handle p -> Eff es ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
hLockRaw Handle p -> Eff es ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
hUnlockRaw

-- | Like 'withSharedLockedFile', except the lock attempt does not block.
--
-- @since 0.1
withTryLockedFile ::
  forall p a es.
  ( CanWrite p,
    HasCallStack,
    HandleWriter :> es
  ) =>
  -- | Handle to lock.
  Handle p ->
  -- | Handle callback.
  (LockedHandle p -> Eff es a) ->
  Eff es (Maybe a)
withTryLockedFile :: forall (p :: HandleMode) a (es :: [(* -> *) -> * -> *]).
(CanWrite p, HasCallStack, HandleWriter :> es) =>
Handle p -> (LockedHandle p -> Eff es a) -> Eff es (Maybe a)
withTryLockedFile = (Handle p -> Eff es Bool)
-> (Handle p -> Eff es ())
-> Handle p
-> (LockedHandle p -> Eff es a)
-> Eff es (Maybe a)
forall (p :: HandleMode) a (es :: [(* -> *) -> * -> *]).
HasCallStack =>
(Handle p -> Eff es Bool)
-> (Handle p -> Eff es ())
-> Handle p
-> (LockedHandle p -> Eff es a)
-> Eff es (Maybe a)
Internal.withTryLockedFile Handle p -> Eff es Bool
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es Bool
hTryLockRaw Handle p -> Eff es ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
hUnlockRaw

-- | 'withLockedFile' without 'LockedHandle'.
--
-- @since 0.1
withLockedFileRaw ::
  ( CanWrite p,
    HasCallStack,
    HandleWriter :> es
  ) =>
  -- | Handle to lock.
  Handle p ->
  -- | Callback with locked handle.
  Eff es a ->
  Eff es a
withLockedFileRaw :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]) a.
(CanWrite p, HasCallStack, HandleWriter :> es) =>
Handle p -> Eff es a -> Eff es a
withLockedFileRaw Handle p
h = Eff es () -> Eff es () -> Eff es a -> Eff es a
forall (es :: [(* -> *) -> * -> *]) a b c.
Eff es a -> Eff es b -> Eff es c -> Eff es c
bracket_ (Handle p -> Eff es ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
hLockRaw Handle p
h) (Handle p -> Eff es ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
hUnlockRaw Handle p
h)

-- | 'withTryLockedFileRaw' without 'LockedHandle'.
--
-- @since 0.1
withTryLockedFileRaw ::
  forall p a es.
  ( CanWrite p,
    HasCallStack,
    HandleWriter :> es
  ) =>
  -- | Handle to lock.
  Handle p ->
  -- | Handle callback.
  Eff es a ->
  Eff es (Maybe a)
withTryLockedFileRaw :: forall (p :: HandleMode) a (es :: [(* -> *) -> * -> *]).
(CanWrite p, HasCallStack, HandleWriter :> es) =>
Handle p -> Eff es a -> Eff es (Maybe a)
withTryLockedFileRaw Handle p
h Eff es a
m =
  Eff es (Maybe ())
-> (Maybe () -> Eff es (Maybe ()))
-> (Maybe () -> Eff es (Maybe a))
-> Eff es (Maybe a)
forall (es :: [(* -> *) -> * -> *]) a b c.
Eff es a -> (a -> Eff es b) -> (a -> Eff es c) -> Eff es c
bracket
    ( do
        locked <- Handle p -> Eff es Bool
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es Bool
hTryLockRaw Handle p
h
        pure $
          if locked
            then Just ()
            else Nothing
    )
    ((() -> Eff es ()) -> Maybe () -> Eff es (Maybe ())
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (Eff es () -> () -> Eff es ()
forall a b. a -> b -> a
const (Handle p -> Eff es ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Eff es ()
hUnlockRaw Handle p
h)))
    ((() -> Eff es a) -> Maybe () -> Eff es (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (Eff es a -> () -> Eff es a
forall a b. a -> b -> a
const Eff es a
m))

-- | 'hPut' and 'FS.UTF8.encodeUtf8'.
--
-- @since 0.1
hPutUtf8 ::
  ( CanWrite p,
    HandleWriter :> es,
    HasCallStack
  ) =>
  Handle p ->
  Text ->
  Eff es ()
hPutUtf8 :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Text -> Eff es ()
hPutUtf8 Handle p
h = Handle p -> ByteString -> Eff es ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> ByteString -> Eff es ()
hPut Handle p
h (ByteString -> Eff es ())
-> (Text -> ByteString) -> Text -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
FS.UTF8.encodeUtf8

-- | 'hPutNonBlocking' and 'FS.UTF8.encodeUtf8'.
--
-- @since 0.1
hPutNonBlockingUtf8 ::
  ( CanWrite p,
    HandleWriter :> es,
    HasCallStack
  ) =>
  Handle p ->
  Text ->
  Eff es ByteString
hPutNonBlockingUtf8 :: forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> Text -> Eff es ByteString
hPutNonBlockingUtf8 Handle p
h = Handle p -> ByteString -> Eff es ByteString
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> ByteString -> Eff es ByteString
hPutNonBlocking Handle p
h (ByteString -> Eff es ByteString)
-> (Text -> ByteString) -> Text -> Eff es ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
FS.UTF8.encodeUtf8

-- | Write given error message to `stderr` and terminate with `exitFailure`.
--
-- @since 0.1
die ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  String ->
  Eff es a
die :: forall (es :: [(* -> *) -> * -> *]) a.
(HandleWriter :> es, HasCallStack) =>
String -> Eff es a
die String
err = Handle 'HandleModeReadWrite -> ByteString -> Eff es ()
forall (p :: HandleMode) (es :: [(* -> *) -> * -> *]).
(CanWrite p, HandleWriter :> es, HasCallStack) =>
Handle p -> ByteString -> Eff es ()
hPut Handle 'HandleModeReadWrite
Handle.stderr ByteString
err' Eff es () -> Eff es a -> Eff es a
forall a b. Eff es a -> Eff es b -> Eff es b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Eff es a
forall (m :: * -> *) a. (HasCallStack, MonadThrow m) => m a
exitFailure
  where
    err' :: ByteString
err' = String -> ByteString
Char8.pack String
err