module HaskellWorks.Polysemy.Data.ByteString.Strict
  ( -- * Strict @ByteString@
    ByteString,

    -- * Introducing and eliminating 'ByteString's
    BS.empty,
    BS.singleton,
    BS.pack,
    BS.unpack,
    BS.fromStrict,
    BS.toStrict,
    fromFilePath,
    toFilePath,

    -- * Basic interface
    BS.cons,
    BS.snoc,
    BS.append,
    BS.head,
    BS.uncons,
    BS.unsnoc,
    BS.last,
    BS.tail,
    BS.init,
    BS.null,
    BS.length,

    -- * Transforming ByteStrings
    BS.map,
    BS.reverse,
    BS.intersperse,
    BS.intercalate,
    BS.transpose,

    -- * Reducing 'ByteString's (folds)
    BS.foldl,
    BS.foldl',
    BS.foldl1,
    BS.foldl1',

    BS.foldr,
    BS.foldr',
    BS.foldr1,
    BS.foldr1',

    -- ** Special folds
    BS.concat,
    BS.concatMap,
    BS.any,
    BS.all,
    BS.maximum,
    BS.minimum,

    -- * Building ByteStrings
    -- ** Scans
    BS.scanl,
    BS.scanl1,
    BS.scanr,
    BS.scanr1,

    -- ** Accumulating maps
    BS.mapAccumL,
    BS.mapAccumR,

    -- ** Generating and unfolding ByteStrings
    BS.replicate,
    BS.unfoldr,
    BS.unfoldrN,

    -- * Substrings

    -- ** Breaking strings
    BS.take,
    BS.takeEnd,
    BS.drop,
    BS.dropEnd,
    BS.splitAt,
    BS.takeWhile,
    BS.takeWhileEnd,
    BS.dropWhile,
    BS.dropWhileEnd,
    BS.span,
    BS.spanEnd,
    BS.break,
    BS.breakEnd,
    BS.group,
    BS.groupBy,
    BS.inits,
    BS.tails,
    BS.initsNE,
    BS.tailsNE,
    BS.stripPrefix,
    BS.stripSuffix,

    -- ** Breaking into many substrings
    BS.split,
    BS.splitWith,

    -- * Predicates
    BS.isPrefixOf,
    BS.isSuffixOf,
    BS.isInfixOf,

    -- ** Encoding validation
    BS.isValidUtf8,

    -- ** Search for arbitrary substrings
    BS.breakSubstring,

    -- * Searching ByteStrings

    -- ** Searching by equality
    BS.elem,
    BS.notElem,

    -- ** Searching with a predicate
    BS.find,
    BS.filter,
    BS.partition,

    -- * Indexing ByteStrings
    BS.index,
    BS.indexMaybe,
    (BS.!?),
    BS.elemIndex,
    BS.elemIndices,
    BS.elemIndexEnd,
    BS.findIndex,
    BS.findIndices,
    BS.findIndexEnd,
    BS.count,

    -- * Zipping and unzipping ByteStrings
    BS.zip,
    BS.zipWith,
    BS.packZipWith,
    BS.unzip,

    -- * Ordered ByteStrings
    BS.sort,

    -- * Low level conversions
    -- ** Copying ByteStrings
    BS.copy,

    -- ** Packing 'CString's and pointers
    packCString,
    packCStringLen,

    -- * I\/O with 'ByteString's

    -- ** Standard input and output
    getContents,
    putStr,
    interact,

    -- ** Files
    readFile,
    writeFile,
    appendFile,

    -- ** I\/O with Handles
    hGetContents,
    hGet,
    hGetSome,
    hGetNonBlocking,
    hPut,
    hPutNonBlocking,
  ) where

import qualified Control.Exception             as CE
import qualified Data.ByteString               as BS
import qualified Data.Text                     as Text
import qualified Data.Text.Encoding            as Text
import           GHC.Foreign                   (CString, CStringLen)
import           GHC.IO.Handle                 (Handle)
import           HaskellWorks.Polysemy.Prelude

import           Polysemy
import           Polysemy.Error
import           Polysemy.Log

fromFilePath :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => FilePath
  -> Sem r ByteString
fromFilePath :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
FilePath -> Sem r ByteString
fromFilePath FilePath
filePath = (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ByteString) -> Sem r ByteString)
-> (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
debug (Text -> Sem r ()) -> Text -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text
"Call to: fromFilePath " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack FilePath
filePath
  Either IOException ByteString
r <- IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException ByteString)
 -> Sem r (Either IOException ByteString))
-> IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException (IO ByteString -> IO (Either IOException ByteString))
-> IO ByteString -> IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
BS.fromFilePath FilePath
filePath
  Either IOException ByteString -> Sem r ByteString
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException ByteString
r

toFilePath :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => ByteString
  -> Sem r FilePath
toFilePath :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
ByteString -> Sem r FilePath
toFilePath ByteString
bs = (HasCallStack => Sem r FilePath) -> Sem r FilePath
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r FilePath) -> Sem r FilePath)
-> (HasCallStack => Sem r FilePath) -> Sem r FilePath
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
debug (Text -> Sem r ()) -> Text -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text
"Call to: toFilePath " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
Text.decodeUtf8 ByteString
bs
  Either IOException FilePath
r <- IO (Either IOException FilePath)
-> Sem r (Either IOException FilePath)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException FilePath)
 -> Sem r (Either IOException FilePath))
-> IO (Either IOException FilePath)
-> Sem r (Either IOException FilePath)
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException (IO FilePath -> IO (Either IOException FilePath))
-> IO FilePath -> IO (Either IOException FilePath)
forall a b. (a -> b) -> a -> b
$ ByteString -> IO FilePath
BS.toFilePath ByteString
bs
  Either IOException FilePath -> Sem r FilePath
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException FilePath
r

packCString :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => CString
  -> Sem r ByteString
packCString :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
CString -> Sem r ByteString
packCString CString
cs = (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ByteString) -> Sem r ByteString)
-> (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
debug (Text -> Sem r ()) -> Text -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text
"Call to: packCString " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CString -> Text
forall a. Show a => a -> Text
tshow CString
cs
  Either IOException ByteString
r <- IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException ByteString)
 -> Sem r (Either IOException ByteString))
-> IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException (IO ByteString -> IO (Either IOException ByteString))
-> IO ByteString -> IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ CString -> IO ByteString
BS.packCString CString
cs
  Either IOException ByteString -> Sem r ByteString
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException ByteString
r

packCStringLen :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => CStringLen
  -> Sem r ByteString
packCStringLen :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
CStringLen -> Sem r ByteString
packCStringLen CStringLen
csl = (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ByteString) -> Sem r ByteString)
-> (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
debug (Text -> Sem r ()) -> Text -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text
"Call to: packCStringLen " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CStringLen -> Text
forall a. Show a => a -> Text
tshow CStringLen
csl
  Either IOException ByteString
r <- IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException ByteString)
 -> Sem r (Either IOException ByteString))
-> IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException (IO ByteString -> IO (Either IOException ByteString))
-> IO ByteString -> IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ByteString
BS.packCStringLen CStringLen
csl
  Either IOException ByteString -> Sem r ByteString
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException ByteString
r

getContents :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => Sem r ByteString
getContents :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
Sem r ByteString
getContents = (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ByteString) -> Sem r ByteString)
-> (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
debug Text
"Call to: getContents"
  Either IOException ByteString
r <- IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException ByteString)
 -> Sem r (Either IOException ByteString))
-> IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException IO ByteString
BS.getContents
  Either IOException ByteString -> Sem r ByteString
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException ByteString
r

putStr :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => ByteString
  -> Sem r ()
putStr :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
ByteString -> Sem r ()
putStr ByteString
bs = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
debug (Text -> Sem r ()) -> Text -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text
"Call to: putStr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
Text.decodeUtf8 ByteString
bs
  Either IOException ()
r <- IO (Either IOException ()) -> Sem r (Either IOException ())
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException ()) -> Sem r (Either IOException ()))
-> IO (Either IOException ()) -> Sem r (Either IOException ())
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStr ByteString
bs
  Either IOException () -> Sem r ()
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException ()
r

interact :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => (ByteString -> ByteString)
  -> Sem r ()
interact :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
(ByteString -> ByteString) -> Sem r ()
interact ByteString -> ByteString
f = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
debug Text
"Call to: interact"
  Either IOException ()
r <- IO (Either IOException ()) -> Sem r (Either IOException ())
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException ()) -> Sem r (Either IOException ()))
-> IO (Either IOException ()) -> Sem r (Either IOException ())
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> IO ()
BS.interact ByteString -> ByteString
f
  Either IOException () -> Sem r ()
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException ()
r

readFile :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => FilePath
  -> Sem r ByteString
readFile :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
FilePath -> Sem r ByteString
readFile FilePath
filePath = (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ByteString) -> Sem r ByteString)
-> (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
info (Text -> Sem r ()) -> Text -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text
"Reading bytestring from file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack FilePath
filePath
  Either IOException ByteString
r <- IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException ByteString)
 -> Sem r (Either IOException ByteString))
-> IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException (IO ByteString -> IO (Either IOException ByteString))
-> IO ByteString -> IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
BS.readFile FilePath
filePath
  Either IOException ByteString -> Sem r ByteString
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException ByteString
r

writeFile :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => FilePath
  -> ByteString
  -> Sem r ()
writeFile :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
FilePath -> ByteString -> Sem r ()
writeFile FilePath
filePath ByteString
bs = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
info (Text -> Sem r ()) -> Text -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text
"Writing bytestring to file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack FilePath
filePath
  Either IOException ()
r <- IO (Either IOException ()) -> Sem r (Either IOException ())
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException ()) -> Sem r (Either IOException ()))
-> IO (Either IOException ()) -> Sem r (Either IOException ())
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
BS.writeFile FilePath
filePath ByteString
bs
  Either IOException () -> Sem r ()
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException ()
r

appendFile :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => FilePath
  -> ByteString
  -> Sem r ()
appendFile :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
FilePath -> ByteString -> Sem r ()
appendFile FilePath
filePath ByteString
bs = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
info (Text -> Sem r ()) -> Text -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text
"Appending bytestring to file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack FilePath
filePath
  Either IOException ()
r <- IO (Either IOException ()) -> Sem r (Either IOException ())
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException ()) -> Sem r (Either IOException ()))
-> IO (Either IOException ()) -> Sem r (Either IOException ())
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
BS.appendFile FilePath
filePath ByteString
bs
  Either IOException () -> Sem r ()
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException ()
r

hGetContents :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => Handle
  -> Sem r ByteString
hGetContents :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
Handle -> Sem r ByteString
hGetContents Handle
h = (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ByteString) -> Sem r ByteString)
-> (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
debug Text
"Call to: hGetContents"
  Either IOException ByteString
r <- IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException ByteString)
 -> Sem r (Either IOException ByteString))
-> IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException (IO ByteString -> IO (Either IOException ByteString))
-> IO ByteString -> IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ Handle -> IO ByteString
BS.hGetContents Handle
h
  Either IOException ByteString -> Sem r ByteString
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException ByteString
r

hGet :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => Handle
  -> Int
  -> Sem r ByteString
hGet :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
Handle -> Int -> Sem r ByteString
hGet Handle
h Int
n = (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ByteString) -> Sem r ByteString)
-> (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
debug Text
"Call to: hGet"
  Either IOException ByteString
r <- IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException ByteString)
 -> Sem r (Either IOException ByteString))
-> IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException (IO ByteString -> IO (Either IOException ByteString))
-> IO ByteString -> IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO ByteString
BS.hGet Handle
h Int
n
  Either IOException ByteString -> Sem r ByteString
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException ByteString
r

hGetSome :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => Handle
  -> Int
  -> Sem r ByteString
hGetSome :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
Handle -> Int -> Sem r ByteString
hGetSome Handle
h Int
n = (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ByteString) -> Sem r ByteString)
-> (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
debug Text
"Call to: hGetSome"
  Either IOException ByteString
r <- IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException ByteString)
 -> Sem r (Either IOException ByteString))
-> IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException (IO ByteString -> IO (Either IOException ByteString))
-> IO ByteString -> IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO ByteString
BS.hGetSome Handle
h Int
n
  Either IOException ByteString -> Sem r ByteString
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException ByteString
r

hGetNonBlocking :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => Handle
  -> Int
  -> Sem r ByteString
hGetNonBlocking :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
Handle -> Int -> Sem r ByteString
hGetNonBlocking Handle
h Int
n = (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ByteString) -> Sem r ByteString)
-> (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
debug Text
"Call to: hGetNonBlocking"
  Either IOException ByteString
r <- IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException ByteString)
 -> Sem r (Either IOException ByteString))
-> IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException (IO ByteString -> IO (Either IOException ByteString))
-> IO ByteString -> IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO ByteString
BS.hGetNonBlocking Handle
h Int
n
  Either IOException ByteString -> Sem r ByteString
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException ByteString
r

hPut :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => Handle
  -> ByteString
  -> Sem r ()
hPut :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
Handle -> ByteString -> Sem r ()
hPut Handle
h ByteString
bs = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
debug Text
"Call to: hPut"
  Either IOException ()
r <- IO (Either IOException ()) -> Sem r (Either IOException ())
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException ()) -> Sem r (Either IOException ()))
-> IO (Either IOException ()) -> Sem r (Either IOException ())
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
BS.hPut Handle
h ByteString
bs
  Either IOException () -> Sem r ()
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException ()
r

hPutNonBlocking :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => Handle
  -> ByteString
  -> Sem r ByteString
hPutNonBlocking :: forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
 Member Log r) =>
Handle -> ByteString -> Sem r ByteString
hPutNonBlocking Handle
h ByteString
bs = (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ByteString) -> Sem r ByteString)
-> (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a b. (a -> b) -> a -> b
$ do
  Text -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
debug Text
"Call to: hPutNonBlocking"
  Either IOException ByteString
r <- IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either IOException ByteString)
 -> Sem r (Either IOException ByteString))
-> IO (Either IOException ByteString)
-> Sem r (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
CE.try @IOException (IO ByteString -> IO (Either IOException ByteString))
-> IO ByteString -> IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ByteString
BS.hPutNonBlocking Handle
h ByteString
bs
  Either IOException ByteString -> Sem r ByteString
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither Either IOException ByteString
r