module Effectful.FileSystem.HandleWriter.Dynamic
(
HandleWriter (..),
openBinaryFile,
withBinaryFile,
hClose,
hFlush,
hSetFileSize,
hSetBuffering,
hSeek,
hTell,
hSetEcho,
hPut,
hPutNonBlocking,
runHandleWriter,
hPutUtf8,
hPutNonBlockingUtf8,
die,
BufferMode (..),
ByteString,
Handle,
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.FileSystem.HandleWriter.Static qualified as Static
import FileSystem.OsPath (OsPath)
import FileSystem.UTF8 qualified as FS.UTF8
import System.IO
( BufferMode (BlockBuffering, LineBuffering, NoBuffering),
Handle,
IOMode (AppendMode, ReadMode, ReadWriteMode, WriteMode),
SeekMode (AbsoluteSeek, RelativeSeek, SeekFromEnd),
)
import System.IO qualified as IO
type instance DispatchOf HandleWriter = Dynamic
data HandleWriter :: Effect where
OpenBinaryFile :: OsPath -> IOMode -> HandleWriter m Handle
WithBinaryFile :: OsPath -> IOMode -> (Handle -> m a) -> HandleWriter m a
HClose :: Handle -> HandleWriter m ()
HFlush :: Handle -> HandleWriter m ()
HSetFileSize :: Handle -> Integer -> HandleWriter m ()
HSetBuffering :: Handle -> BufferMode -> HandleWriter m ()
HSeek :: Handle -> SeekMode -> Integer -> HandleWriter m ()
HTell :: Handle -> HandleWriter m Integer
HSetEcho :: Handle -> Bool -> HandleWriter m ()
HPut :: Handle -> ByteString -> HandleWriter m ()
HPutNonBlocking :: Handle -> ByteString -> HandleWriter m ByteString
instance ShowEffect HandleWriter where
showEffectCons :: forall (m :: * -> *) a. HandleWriter m a -> String
showEffectCons = \case
OpenBinaryFile OsPath
_ IOMode
_ -> String
"OpenBinaryFile"
WithBinaryFile OsPath
_ IOMode
_ Handle -> m a
_ -> String
"WithBinaryFile"
HClose Handle
_ -> String
"HClose"
HFlush Handle
_ -> String
"HFlush"
HSetFileSize Handle
_ Integer
_ -> String
"HSetFileSize"
HSetBuffering Handle
_ BufferMode
_ -> String
"HSetBuffering"
HSeek Handle
_ SeekMode
_ Integer
_ -> String
"HSeek"
HTell Handle
_ -> String
"HTell"
HSetEcho Handle
_ Bool
_ -> String
"HSetEcho"
HPut Handle
_ ByteString
_ -> String
"HPut"
HPutNonBlocking Handle
_ ByteString
_ -> String
"HPutNonBlocking"
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 (HandleWriter : es)
env -> \case
OpenBinaryFile OsPath
p IOMode
m -> OsPath -> IOMode -> Eff (HandleWriter : es) Handle
forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
OsPath -> IOMode -> Eff es Handle
Static.openBinaryFile OsPath
p IOMode
m
WithBinaryFile OsPath
p IOMode
m Handle -> Eff localEs a
f -> LocalEnv localEs (HandleWriter : es)
-> ((forall r. Eff localEs r -> Eff (HandleWriter : es) r)
-> Eff (HandleWriter : es) a)
-> Eff (HandleWriter : es) a
forall (es :: [(* -> *) -> * -> *])
(handlerEs :: [(* -> *) -> * -> *])
(localEs :: [(* -> *) -> * -> *]) a.
(HasCallStack, SharedSuffix es handlerEs) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs (HandleWriter : es)
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
-> IOMode
-> (Handle -> Eff (HandleWriter : es) a)
-> Eff (HandleWriter : es) a
forall (es :: [(* -> *) -> * -> *]) a.
(HandleWriter :> es, HasCallStack) =>
OsPath -> IOMode -> (Handle -> Eff es a) -> Eff es a
Static.withBinaryFile OsPath
p IOMode
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 -> Eff localEs a) -> Handle -> Eff (HandleWriter : es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Eff localEs a
f)
HClose Handle
h -> Handle -> Eff (HandleWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Eff es ()
Static.hClose Handle
h
HFlush Handle
h -> Handle -> Eff (HandleWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Eff es ()
Static.hFlush Handle
h
HSetFileSize Handle
h Integer
i -> Handle -> Integer -> Eff (HandleWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Integer -> Eff es ()
Static.hSetFileSize Handle
h Integer
i
HSetBuffering Handle
h BufferMode
m -> Handle -> BufferMode -> Eff (HandleWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> BufferMode -> Eff es ()
Static.hSetBuffering Handle
h BufferMode
m
HSeek Handle
h SeekMode
m Integer
i -> Handle -> SeekMode -> Integer -> Eff (HandleWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> SeekMode -> Integer -> Eff es ()
Static.hSeek Handle
h SeekMode
m Integer
i
HTell Handle
h -> Handle -> Eff (HandleWriter : es) Integer
forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Eff es Integer
Static.hTell Handle
h
HSetEcho Handle
h Bool
b -> Handle -> Bool -> Eff (HandleWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Bool -> Eff es ()
Static.hSetEcho Handle
h Bool
b
HPut Handle
h ByteString
bs -> Handle -> ByteString -> Eff (HandleWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> ByteString -> Eff es ()
Static.hPut Handle
h ByteString
bs
HPutNonBlocking Handle
h ByteString
bs -> Handle -> ByteString -> Eff (HandleWriter : es) ByteString
forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> ByteString -> Eff es ByteString
Static.hPutNonBlocking Handle
h ByteString
bs
openBinaryFile ::
( HandleWriter :> es,
HasCallStack
) =>
OsPath ->
IOMode ->
Eff es Handle
openBinaryFile :: forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
OsPath -> IOMode -> Eff es Handle
openBinaryFile OsPath
p = HandleWriter (Eff es) Handle -> Eff es Handle
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (HandleWriter (Eff es) Handle -> Eff es Handle)
-> (IOMode -> HandleWriter (Eff es) Handle)
-> IOMode
-> Eff es Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IOMode -> HandleWriter (Eff es) Handle
forall (m :: * -> *). OsPath -> IOMode -> HandleWriter m Handle
OpenBinaryFile OsPath
p
withBinaryFile ::
( HandleWriter :> es,
HasCallStack
) =>
OsPath ->
IOMode ->
(Handle -> Eff es a) ->
Eff es a
withBinaryFile :: forall (es :: [(* -> *) -> * -> *]) a.
(HandleWriter :> es, HasCallStack) =>
OsPath -> IOMode -> (Handle -> Eff es a) -> Eff es a
withBinaryFile OsPath
p IOMode
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 -> Eff es a) -> HandleWriter (Eff es) a)
-> (Handle -> Eff es a)
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IOMode -> (Handle -> Eff es a) -> HandleWriter (Eff es) a
forall (m :: * -> *) a.
OsPath -> IOMode -> (Handle -> m a) -> HandleWriter m a
WithBinaryFile OsPath
p IOMode
m
hClose ::
( HandleWriter :> es,
HasCallStack
) =>
Handle ->
Eff es ()
hClose :: forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> 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 -> HandleWriter (Eff es) ()) -> Handle -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> HandleWriter (Eff es) ()
forall (m :: * -> *). Handle -> HandleWriter m ()
HClose
hFlush ::
( HandleWriter :> es,
HasCallStack
) =>
Handle ->
Eff es ()
hFlush :: forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> 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 -> HandleWriter (Eff es) ()) -> Handle -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> HandleWriter (Eff es) ()
forall (m :: * -> *). Handle -> HandleWriter m ()
HFlush
hSetFileSize ::
( HandleWriter :> es,
HasCallStack
) =>
Handle ->
Integer ->
Eff es ()
hSetFileSize :: forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Integer -> Eff es ()
hSetFileSize Handle
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 -> Integer -> HandleWriter (Eff es) ()
forall (m :: * -> *). Handle -> Integer -> HandleWriter m ()
HSetFileSize Handle
h
hSetBuffering ::
( HandleWriter :> es,
HasCallStack
) =>
Handle ->
BufferMode ->
Eff es ()
hSetBuffering :: forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> BufferMode -> Eff es ()
hSetBuffering Handle
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 -> BufferMode -> HandleWriter (Eff es) ()
forall (m :: * -> *). Handle -> BufferMode -> HandleWriter m ()
HSetBuffering Handle
h
hSeek ::
( HandleWriter :> es,
HasCallStack
) =>
Handle ->
SeekMode ->
Integer ->
Eff es ()
hSeek :: forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> SeekMode -> Integer -> Eff es ()
hSeek Handle
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 -> SeekMode -> Integer -> HandleWriter (Eff es) ()
forall (m :: * -> *).
Handle -> SeekMode -> Integer -> HandleWriter m ()
HSeek Handle
h SeekMode
m
hTell ::
( HandleWriter :> es,
HasCallStack
) =>
Handle ->
Eff es Integer
hTell :: forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> 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 -> HandleWriter (Eff es) Integer)
-> Handle
-> Eff es Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> HandleWriter (Eff es) Integer
forall (m :: * -> *). Handle -> HandleWriter m Integer
HTell
hSetEcho ::
( HandleWriter :> es,
HasCallStack
) =>
Handle ->
Bool ->
Eff es ()
hSetEcho :: forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Bool -> Eff es ()
hSetEcho Handle
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 -> Bool -> HandleWriter (Eff es) ()
forall (m :: * -> *). Handle -> Bool -> HandleWriter m ()
HSetEcho Handle
h
hPut ::
( HandleWriter :> es,
HasCallStack
) =>
Handle ->
ByteString ->
Eff es ()
hPut :: forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> ByteString -> Eff es ()
hPut Handle
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 -> ByteString -> HandleWriter (Eff es) ()
forall (m :: * -> *). Handle -> ByteString -> HandleWriter m ()
HPut Handle
h
hPutNonBlocking ::
( HandleWriter :> es,
HasCallStack
) =>
Handle ->
ByteString ->
Eff es ByteString
hPutNonBlocking :: forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> ByteString -> Eff es ByteString
hPutNonBlocking Handle
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 -> ByteString -> HandleWriter (Eff es) ByteString
forall (m :: * -> *).
Handle -> ByteString -> HandleWriter m ByteString
HPutNonBlocking Handle
h
hPutUtf8 ::
( HandleWriter :> es,
HasCallStack
) =>
Handle ->
Text ->
Eff es ()
hPutUtf8 :: forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Text -> Eff es ()
hPutUtf8 Handle
h = Handle -> ByteString -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> ByteString -> Eff es ()
hPut Handle
h (ByteString -> Eff es ())
-> (Text -> ByteString) -> Text -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
FS.UTF8.encodeUtf8
hPutNonBlockingUtf8 ::
( HandleWriter :> es,
HasCallStack
) =>
Handle ->
Text ->
Eff es ByteString
hPutNonBlockingUtf8 :: forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Text -> Eff es ByteString
hPutNonBlockingUtf8 Handle
h = Handle -> ByteString -> Eff es ByteString
forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> ByteString -> Eff es ByteString
hPutNonBlocking Handle
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
die ::
( HandleWriter :> es,
HasCallStack
) =>
String ->
Eff es a
die :: forall (es :: [(* -> *) -> * -> *]) a.
(HandleWriter :> es, HasCallStack) =>
String -> Eff es a
die String
err = Handle -> ByteString -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HandleWriter :> es, HasCallStack) =>
Handle -> ByteString -> Eff es ()
hPut Handle
IO.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