{-# OPTIONS_GHC -Wno-redundant-constraints #-}

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

    -- ** Handlers
    runHandleWriter,

    -- * UTF-8 Utils
    hPutUtf8,
    hPutNonBlockingUtf8,

    -- * Misc
    die,

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

import Control.Exception.Utils (exitFailure)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Char8 qualified as Char8
import Data.Text (Text)
import Effectful
  ( Dispatch (Static),
    DispatchOf,
    Eff,
    Effect,
    IOE,
    type (:>),
  )
import Effectful.Dispatch.Static
  ( HasCallStack,
    SideEffects (WithSideEffects),
    StaticRep,
    evalStaticRep,
    seqUnliftIO,
    unsafeEff,
    unsafeEff_,
  )
import FileSystem.IO (openBinaryFileIO, withBinaryFileIO)
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

-- | Static effect for writing to a handle.
--
-- @since 0.1
data HandleWriter :: Effect

type instance DispatchOf HandleWriter = Static WithSideEffects

data instance StaticRep HandleWriter = MkHandleWriter

-- | Runs 'HandleWriter' in 'IO'.
--
-- @since 0.1
runHandleWriter ::
  (HasCallStack, IOE :> es) =>
  Eff (HandleWriter : es) a ->
  Eff es a
runHandleWriter :: forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
Eff (HandleWriter : es) a -> Eff es a
runHandleWriter = StaticRep HandleWriter -> Eff (HandleWriter : es) a -> Eff es a
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects,
 MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep StaticRep HandleWriter
MkHandleWriter

-- | Lifted 'IO.openBinaryFile'.
--
-- @since 0.1
openBinaryFile ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  OsPath ->
  IOMode ->
  Eff es Handle
openBinaryFile :: forall (es :: [Effect]).
(HandleWriter :> es, HasCallStack) =>
OsPath -> IOMode -> Eff es Handle
openBinaryFile OsPath
p = IO Handle -> Eff es Handle
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Handle -> Eff es Handle)
-> (IOMode -> IO Handle) -> IOMode -> Eff es Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IOMode -> IO Handle
openBinaryFileIO OsPath
p

-- | Lifted 'IO.withBinaryFile'.
--
-- @since 0.1
withBinaryFile ::
  forall es a.
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  OsPath ->
  IOMode ->
  (Handle -> Eff es a) ->
  Eff es a
withBinaryFile :: forall (es :: [Effect]) a.
(HandleWriter :> es, HasCallStack) =>
OsPath -> IOMode -> (Handle -> Eff es a) -> Eff es a
withBinaryFile OsPath
p IOMode
m Handle -> Eff es a
onHandle =
  (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
env -> Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
env (((forall r. Eff es r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
    \forall r. Eff es r -> IO r
runInIO -> OsPath -> IOMode -> (Handle -> IO a) -> IO a
forall a. OsPath -> IOMode -> (Handle -> IO a) -> IO a
withBinaryFileIO OsPath
p IOMode
m (Eff es a -> IO a
forall r. Eff es r -> IO r
runInIO (Eff es a -> IO a) -> (Handle -> Eff es a) -> Handle -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Eff es a
onHandle)

-- | Lifted 'IO.hClose'.
--
-- @since 0.1
hClose ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  Handle ->
  Eff es ()
hClose :: forall (es :: [Effect]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Eff es ()
hClose = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> (Handle -> IO ()) -> Handle -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
IO.hClose

-- | Lifted 'IO.hFlush'.
--
-- @since 0.1
hFlush ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  Handle ->
  Eff es ()
hFlush :: forall (es :: [Effect]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Eff es ()
hFlush = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> (Handle -> IO ()) -> Handle -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
IO.hFlush

-- | Lifted 'IO.hSetFileSize'.
--
-- @since 0.1
hSetFileSize ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  Handle ->
  Integer ->
  Eff es ()
hSetFileSize :: forall (es :: [Effect]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Integer -> Eff es ()
hSetFileSize Handle
h = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> (Integer -> IO ()) -> Integer -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Integer -> IO ()
IO.hSetFileSize Handle
h

-- | Lifted 'IO.hSetBuffering'.
--
-- @since 0.1
hSetBuffering ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  Handle ->
  BufferMode ->
  Eff es ()
hSetBuffering :: forall (es :: [Effect]).
(HandleWriter :> es, HasCallStack) =>
Handle -> BufferMode -> Eff es ()
hSetBuffering Handle
h = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (BufferMode -> IO ()) -> BufferMode -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
h

-- | Lifted 'IO.hSeek'.
--
-- @since 0.1
hSeek ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  Handle ->
  SeekMode ->
  Integer ->
  Eff es ()
hSeek :: forall (es :: [Effect]).
(HandleWriter :> es, HasCallStack) =>
Handle -> SeekMode -> Integer -> Eff es ()
hSeek Handle
h SeekMode
m = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> (Integer -> IO ()) -> Integer -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> SeekMode -> Integer -> IO ()
IO.hSeek Handle
h SeekMode
m

-- | Lifted 'IO.hTell'.
--
-- @since 0.1
hTell ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  Handle ->
  Eff es Integer
hTell :: forall (es :: [Effect]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Eff es Integer
hTell = IO Integer -> Eff es Integer
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO Integer -> Eff es Integer)
-> (Handle -> IO Integer) -> Handle -> Eff es Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO Integer
IO.hTell

-- | Lifted 'IO.hSetEcho'.
--
-- @since 0.1
hSetEcho ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  Handle ->
  Bool ->
  Eff es ()
hSetEcho :: forall (es :: [Effect]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Bool -> Eff es ()
hSetEcho Handle
h = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> (Bool -> IO ()) -> Bool -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Bool -> IO ()
IO.hSetEcho Handle
h

-- | Lifted 'BS.hPut'.
--
-- @since 0.1
hPut ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  Handle ->
  ByteString ->
  Eff es ()
hPut :: forall (es :: [Effect]).
(HandleWriter :> es, HasCallStack) =>
Handle -> ByteString -> Eff es ()
hPut Handle
h = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (ByteString -> IO ()) -> ByteString -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> ByteString -> IO ()
BS.hPut Handle
h

-- | Lifted 'BS.hPutNonBlocking'.
--
-- @since 0.1
hPutNonBlocking ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  Handle ->
  ByteString ->
  Eff es ByteString
hPutNonBlocking :: forall (es :: [Effect]).
(HandleWriter :> es, HasCallStack) =>
Handle -> ByteString -> Eff es ByteString
hPutNonBlocking Handle
h = IO ByteString -> Eff es ByteString
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO ByteString -> Eff es ByteString)
-> (ByteString -> IO ByteString) -> ByteString -> Eff es ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> ByteString -> IO ByteString
BS.hPutNonBlocking Handle
h

-- | 'hPut' and 'FS.UTF8.encodeUtf8'.
--
-- @since 0.1
hPutUtf8 ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  Handle ->
  Text ->
  Eff es ()
hPutUtf8 :: forall (es :: [Effect]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Text -> Eff es ()
hPutUtf8 Handle
h = Handle -> ByteString -> Eff es ()
forall (es :: [Effect]).
(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

-- | 'hPutNonBlocking' and 'FS.UTF8.encodeUtf8'.
--
-- @since 0.1
hPutNonBlockingUtf8 ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  Handle ->
  Text ->
  Eff es ByteString
hPutNonBlockingUtf8 :: forall (es :: [Effect]).
(HandleWriter :> es, HasCallStack) =>
Handle -> Text -> Eff es ByteString
hPutNonBlockingUtf8 Handle
h = Handle -> ByteString -> Eff es ByteString
forall (es :: [Effect]).
(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

-- | Write given error message to `stderr` and terminate with `exitFailure`.
--
-- @since 0.1
die ::
  ( HandleWriter :> es,
    HasCallStack
  ) =>
  String ->
  Eff es a
die :: forall (es :: [Effect]) a.
(HandleWriter :> es, HasCallStack) =>
String -> Eff es a
die String
err = Handle -> ByteString -> Eff es ()
forall (es :: [Effect]).
(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