module HaskellWorks.Polysemy.Data.ByteString.Lazy
  ( -- * Lazy @ByteString@
    LBS.ByteString,

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

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

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

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

    LBS.foldr,
    LBS.foldr',
    LBS.foldr1,
    LBS.foldr1',

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

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

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

    -- ** Generating and unfolding ByteStrings
    LBS.replicate,
    LBS.unfoldr,

    -- * Substrings

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

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

    -- * Predicates
    LBS.isPrefixOf,
    LBS.isSuffixOf,

    -- * Searching ByteStrings

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

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

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

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

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

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

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

    -- ** Files
    readFile,
    writeFile,
    appendFile,

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

import qualified Control.Exception             as CE
import qualified Data.ByteString.Lazy          as LBS
import qualified Data.Text                     as T
import qualified Data.Text.Encoding            as T
import           GHC.IO.Handle                 (Handle)
import           HaskellWorks.Polysemy.Prelude

import           Polysemy
import           Polysemy.Error
import           Polysemy.Log

getContents :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => Sem r LBS.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
LBS.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
  => LBS.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
T.decodeUtf8 (ByteString -> ByteString
LBS.toStrict 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 ()
LBS.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
  => (LBS.ByteString -> LBS.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 ()
LBS.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 LBS.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
T.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
LBS.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
  -> LBS.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
T.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 ()
LBS.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
  -> LBS.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
T.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 ()
LBS.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 LBS.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
LBS.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 LBS.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
LBS.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

hGetNonBlocking :: ()
  => HasCallStack
  => Member (Error IOException) r
  => Member (Embed IO) r
  => Member Log r
  => Handle
  -> Int
  -> Sem r LBS.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
LBS.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
  -> LBS.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 ()
LBS.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
  -> LBS.ByteString
  -> Sem r LBS.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
LBS.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