-- | Provides a dynamic effect for reading files.
--
-- @since 0.1
module Effectful.FileSystem.FileReader.Dynamic
  ( -- * Effect
    FileReader (..),
    readBinaryFile,

    -- ** Handlers
    runFileReader,

    -- * UTF-8 Utils
    readFileUtf8,
    readFileUtf8Lenient,
    readFileUtf8ThrowM,
    FS.UTF8.decodeUtf8,
    FS.UTF8.decodeUtf8Lenient,
    FS.UTF8.decodeUtf8ThrowM,

    -- * Re-exports
    ByteString,
    OsPath,
    Text,
    UnicodeException,
  )
where

import Control.Monad ((>=>))
import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.Text.Encoding.Error (UnicodeException)
import Effectful
  ( Dispatch (Dynamic),
    DispatchOf,
    Eff,
    Effect,
    IOE,
    type (:>),
  )
import Effectful.Dispatch.Dynamic (HasCallStack, reinterpret_, send)
import Effectful.Dynamic.Utils (ShowEffect (showEffectCons))
import Effectful.FileSystem.FileReader.Static qualified as Static
import FileSystem.OsPath (OsPath)
import FileSystem.UTF8 qualified as FS.UTF8

-- | Dynamic effect for reading files.
--
-- @since 0.1
data FileReader :: Effect where
  ReadBinaryFile :: OsPath -> FileReader m ByteString

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

-- | @since 0.1
instance ShowEffect FileReader where
  showEffectCons :: forall (m :: * -> *) a. FileReader m a -> String
showEffectCons = \case
    ReadBinaryFile OsPath
_ -> String
"ReadBinaryFile"

-- | Runs 'FileReader' in 'IO'.
--
-- @since 0.1
runFileReader ::
  ( HasCallStack,
    IOE :> es
  ) =>
  Eff (FileReader : es) a ->
  Eff es a
runFileReader :: forall (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, IOE :> es) =>
Eff (FileReader : es) a -> Eff es a
runFileReader = (Eff (FileReader : es) a -> Eff es a)
-> EffectHandler_ FileReader (FileReader : es)
-> Eff (FileReader : 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 (FileReader : es) a -> Eff es a
forall (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, IOE :> es) =>
Eff (FileReader : es) a -> Eff es a
Static.runFileReader (EffectHandler_ FileReader (FileReader : es)
 -> Eff (FileReader : es) a -> Eff es a)
-> EffectHandler_ FileReader (FileReader : es)
-> Eff (FileReader : es) a
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \case
  ReadBinaryFile OsPath
p -> OsPath -> Eff (FileReader : es) ByteString
forall (es :: [(* -> *) -> * -> *]).
(FileReader :> es, HasCallStack) =>
OsPath -> Eff es ByteString
Static.readBinaryFile OsPath
p

-- | @since 0.1
readBinaryFile ::
  ( FileReader :> es,
    HasCallStack
  ) =>
  OsPath ->
  Eff es ByteString
readBinaryFile :: forall (es :: [(* -> *) -> * -> *]).
(FileReader :> es, HasCallStack) =>
OsPath -> Eff es ByteString
readBinaryFile = FileReader (Eff es) ByteString -> Eff es ByteString
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (FileReader (Eff es) ByteString -> Eff es ByteString)
-> (OsPath -> FileReader (Eff es) ByteString)
-> OsPath
-> Eff es ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> FileReader (Eff es) ByteString
forall (m :: * -> *). OsPath -> FileReader m ByteString
ReadBinaryFile

-- | Reads a file as UTF-8.
--
-- @since 0.1
readFileUtf8 ::
  ( FileReader :> es,
    HasCallStack
  ) =>
  OsPath ->
  Eff es (Either UnicodeException Text)
readFileUtf8 :: forall (es :: [(* -> *) -> * -> *]).
(FileReader :> es, HasCallStack) =>
OsPath -> Eff es (Either UnicodeException Text)
readFileUtf8 = (ByteString -> Either UnicodeException Text)
-> Eff es ByteString -> Eff es (Either UnicodeException Text)
forall a b. (a -> b) -> Eff es a -> Eff es b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Either UnicodeException Text
FS.UTF8.decodeUtf8 (Eff es ByteString -> Eff es (Either UnicodeException Text))
-> (OsPath -> Eff es ByteString)
-> OsPath
-> Eff es (Either UnicodeException Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Eff es ByteString
forall (es :: [(* -> *) -> * -> *]).
(FileReader :> es, HasCallStack) =>
OsPath -> Eff es ByteString
readBinaryFile

-- | Reads a file as UTF-8 in lenient mode.
--
-- @since 0.1
readFileUtf8Lenient ::
  ( FileReader :> es,
    HasCallStack
  ) =>
  OsPath ->
  Eff es Text
readFileUtf8Lenient :: forall (es :: [(* -> *) -> * -> *]).
(FileReader :> es, HasCallStack) =>
OsPath -> Eff es Text
readFileUtf8Lenient = (ByteString -> Text) -> Eff es ByteString -> Eff es Text
forall a b. (a -> b) -> Eff es a -> Eff es b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
FS.UTF8.decodeUtf8Lenient (Eff es ByteString -> Eff es Text)
-> (OsPath -> Eff es ByteString) -> OsPath -> Eff es Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Eff es ByteString
forall (es :: [(* -> *) -> * -> *]).
(FileReader :> es, HasCallStack) =>
OsPath -> Eff es ByteString
readBinaryFile

-- | Decodes a file as UTF-8. Throws 'UnicodeException' for decode errors.
--
-- @since 0.1
readFileUtf8ThrowM ::
  ( FileReader :> es,
    HasCallStack
  ) =>
  OsPath ->
  Eff es Text
readFileUtf8ThrowM :: forall (es :: [(* -> *) -> * -> *]).
(FileReader :> es, HasCallStack) =>
OsPath -> Eff es Text
readFileUtf8ThrowM = OsPath -> Eff es ByteString
forall (es :: [(* -> *) -> * -> *]).
(FileReader :> es, HasCallStack) =>
OsPath -> Eff es ByteString
readBinaryFile (OsPath -> Eff es ByteString)
-> (ByteString -> Eff es Text) -> OsPath -> Eff es Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Eff es Text
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
ByteString -> m Text
FS.UTF8.decodeUtf8ThrowM