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

-- | Provides a static effect for reading files.
--
-- @since 0.1
module Effectful.FileSystem.FileReader.Static
  ( -- * 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 (Static),
    DispatchOf,
    Eff,
    Effect,
    IOE,
    type (:>),
  )
import Effectful.Dispatch.Static
  ( HasCallStack,
    SideEffects (WithSideEffects),
    StaticRep,
    evalStaticRep,
    unsafeEff_,
  )
import FileSystem.IO (readBinaryFileIO)
import FileSystem.OsPath (OsPath)
import FileSystem.UTF8 qualified as FS.UTF8

-- | Static effect for reading files.
--
-- @since 0.1
data FileReader :: Effect

type instance DispatchOf FileReader = Static WithSideEffects

data instance StaticRep FileReader = MkFileReader

-- | Runs 'FileReader' in 'IO'.
--
-- @since 0.1
runFileReader ::
  (HasCallStack, IOE :> es) =>
  Eff (FileReader : es) a ->
  Eff es a
runFileReader :: forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
Eff (FileReader : es) a -> Eff es a
runFileReader = StaticRep FileReader -> Eff (FileReader : 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 FileReader
MkFileReader

-- | @since 0.1
readBinaryFile ::
  ( FileReader :> es,
    HasCallStack
  ) =>
  OsPath ->
  Eff es ByteString
readBinaryFile :: forall (es :: [Effect]).
(FileReader :> es, HasCallStack) =>
OsPath -> Eff es ByteString
readBinaryFile = IO ByteString -> Eff es ByteString
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO ByteString -> Eff es ByteString)
-> (OsPath -> IO ByteString) -> OsPath -> Eff es ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO ByteString
readBinaryFileIO

-- | Reads a file as UTF-8.
--
-- @since 0.1
readFileUtf8 ::
  ( FileReader :> es,
    HasCallStack
  ) =>
  OsPath ->
  Eff es (Either UnicodeException Text)
readFileUtf8 :: forall (es :: [Effect]).
(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 :: [Effect]).
(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 :: [Effect]).
(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 :: [Effect]).
(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 :: [Effect]).
(FileReader :> es, HasCallStack) =>
OsPath -> Eff es Text
readFileUtf8ThrowM = OsPath -> Eff es ByteString
forall (es :: [Effect]).
(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