{-|
Copyright   : (c) Hisaket VioletRed, 2022
License     : AGPL-3.0-or-later
Maintainer  : hisaket@outlook.jp
Stability   : experimental
Portability : POSIX
-}

module Polysemy.FS.Scoped.ByteString.Internal where
import Polysemy
    ( Member, Sem, embed, Embed, InterpretersFor, Members, interpret )
import qualified Polysemy.SequentialAccess.ByteString as SAB
import qualified Polysemy.SequentialAccess as SA
import qualified Data.ByteString as BS
import qualified GHC.IO.Handle as IO
import qualified System.IO as IO
import Control.Category ( (>>>) )
import Polysemy.FS.Scoped.Internal ( seekToEnd )
import Polysemy.Internal.Kind ( Append )
import Polysemy.Resource ( Resource )
import Polysemy.Internal.Sing ( KnownList )
import qualified Polysemy.FS.Scoped.Internal as Scoped

readToIO :: Member (Embed IO) r => IO.Handle -> Sem (SAB.ReadBytes ': SAB.ReadToEnd ': r) a -> Sem r a
readToIO :: Handle -> Sem (ReadBytes : ReadToEnd : r) a -> Sem r a
readToIO Handle
h =
        (forall (rInitial :: EffectRow) x.
 ReadBytes (Sem rInitial) x -> Sem (ReadToEnd : r) x)
-> Sem (ReadBytes : ReadToEnd : r) a -> Sem (ReadToEnd : r) a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret (\(SA.Read n) -> IO ByteString -> Sem (ReadToEnd : r) ByteString
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO ByteString -> Sem (ReadToEnd : r) ByteString)
-> IO ByteString -> Sem (ReadToEnd : r) ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO ByteString
BS.hGet Handle
h (Int -> IO ByteString) -> Int -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)
    (Sem (ReadBytes : ReadToEnd : r) a -> Sem (ReadToEnd : r) a)
-> (Sem (ReadToEnd : r) a -> Sem r a)
-> Sem (ReadBytes : ReadToEnd : r) a
-> Sem r a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (rInitial :: EffectRow) x.
 ReadToEnd (Sem rInitial) x -> Sem r x)
-> Sem (ReadToEnd : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret
            ( \(SA.Read SA.ToEnd) ->
                IO ByteString -> Sem r ByteString
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO ByteString -> Sem r ByteString)
-> IO ByteString -> Sem r ByteString
forall a b. (a -> b) -> a -> b
$ (Handle -> IO ByteString
BS.hGetContents (Handle -> IO ByteString) -> IO Handle -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO Handle
IO.hDuplicate Handle
h) IO ByteString -> IO () -> IO ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Handle -> IO ()
seekToEnd Handle
h
            )

cursorToIO :: Member (Embed IO) r => IO.Handle -> Sem (Append SAB.Cursor r) a -> Sem r a
cursorToIO :: Handle -> Sem (Append Cursor r) a -> Sem r a
cursorToIO Handle
h =
        (forall (rInitial :: EffectRow) x.
 GetPosition Natural (Sem rInitial) x
 -> Sem
      (Seek (Absolute Natural)
         : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
      x)
-> Sem
     (GetPosition Natural
        : Seek (Absolute Natural) : Seek (Relative Integer)
        : Seek (FromEnd Integer) : r)
     a
-> Sem
     (Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret (\GetPosition Natural (Sem rInitial) x
SA.GetPosition -> IO x
-> Sem
     (Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     x
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO x
 -> Sem
      (Seek (Absolute Natural)
         : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
      x)
-> IO x
-> Sem
     (Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     x
forall a b. (a -> b) -> a -> b
$ Integer -> x
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> x) -> IO Integer -> IO x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Integer
IO.hTell Handle
h)
    (Sem
   (GetPosition Natural
      : Seek (Absolute Natural) : Seek (Relative Integer)
      : Seek (FromEnd Integer) : r)
   a
 -> Sem
      (Seek (Absolute Natural)
         : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
      a)
-> (Sem
      (Seek (Absolute Natural)
         : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
      a
    -> Sem r a)
-> Sem
     (GetPosition Natural
        : Seek (Absolute Natural) : Seek (Relative Integer)
        : Seek (FromEnd Integer) : r)
     a
-> Sem r a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (rInitial :: EffectRow) x.
 Seek (Absolute Natural) (Sem rInitial) x
 -> Sem (Seek (Relative Integer) : Seek (FromEnd Integer) : r) x)
-> Sem
     (Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
-> Sem (Seek (Relative Integer) : Seek (FromEnd Integer) : r) a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret (\(SA.Seek (SA.Absolute n)) -> IO ()
-> Sem (Seek (Relative Integer) : Seek (FromEnd Integer) : r) ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO ()
 -> Sem (Seek (Relative Integer) : Seek (FromEnd Integer) : r) ())
-> IO ()
-> Sem (Seek (Relative Integer) : Seek (FromEnd Integer) : r) ()
forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> IO ()
IO.hSeek Handle
h SeekMode
IO.AbsoluteSeek (Integer -> IO ()) -> Integer -> IO ()
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)
    (Sem
   (Seek (Absolute Natural)
      : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
   a
 -> Sem (Seek (Relative Integer) : Seek (FromEnd Integer) : r) a)
-> (Sem (Seek (Relative Integer) : Seek (FromEnd Integer) : r) a
    -> Sem r a)
-> Sem
     (Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
-> Sem r a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (rInitial :: EffectRow) x.
 Seek (Relative Integer) (Sem rInitial) x
 -> Sem (Seek (FromEnd Integer) : r) x)
-> Sem (Seek (Relative Integer) : Seek (FromEnd Integer) : r) a
-> Sem (Seek (FromEnd Integer) : r) a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret (\(SA.Seek (SA.Relative i)) -> IO () -> Sem (Seek (FromEnd Integer) : r) ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem (Seek (FromEnd Integer) : r) ())
-> IO () -> Sem (Seek (FromEnd Integer) : r) ()
forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> IO ()
IO.hSeek Handle
h SeekMode
IO.RelativeSeek Integer
i)
    (Sem (Seek (Relative Integer) : Seek (FromEnd Integer) : r) a
 -> Sem (Seek (FromEnd Integer) : r) a)
-> (Sem (Seek (FromEnd Integer) : r) a -> Sem r a)
-> Sem (Seek (Relative Integer) : Seek (FromEnd Integer) : r) a
-> Sem r a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall (rInitial :: EffectRow) x.
 Seek (FromEnd Integer) (Sem rInitial) x -> Sem r x)
-> Sem (Seek (FromEnd Integer) : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret (\(SA.Seek (SA.FromEnd i)) -> IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> IO ()
IO.hSeek Handle
h SeekMode
IO.SeekFromEnd Integer
i)

overwriteToIO :: Member (Embed IO) r => IO.Handle -> Sem (SAB.Overwrite ': r) a -> Sem r a
overwriteToIO :: Handle -> Sem (Overwrite : r) a -> Sem r a
overwriteToIO Handle
h = (forall (rInitial :: EffectRow) x.
 Overwrite (Sem rInitial) x -> Sem r x)
-> Sem (Overwrite : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \(SA.Overwrite s) -> IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
BS.hPut Handle
h ByteString
s

resizeToIO :: Member (Embed IO) r => IO.Handle -> Sem (SAB.Resize ': r) a -> Sem r a
resizeToIO :: Handle -> Sem (Resize : r) a -> Sem r a
resizeToIO Handle
h = (forall (rInitial :: EffectRow) x.
 Resize (Sem rInitial) x -> Sem r x)
-> Sem (Resize : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \(SA.Resize n) -> IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Handle -> Integer -> IO ()
IO.hSetFileSize Handle
h (Integer -> IO ()) -> Integer -> IO ()
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n

scopedBinaryFileToIO
    ::  (Members '[Embed IO, Resource] r, KnownList es)
    =>  IO.IOMode
    ->  (IO.Handle -> InterpretersFor es r)
    ->  (∀handle'. Sem (Scoped.ScopedFile mode es b handle' ': r) a)
    ->  Sem r a
scopedBinaryFileToIO :: IOMode
-> (Handle -> InterpretersFor es r)
-> (forall handle'. Sem (ScopedFile mode es b handle' : r) a)
-> Sem r a
scopedBinaryFileToIO = (FilePath -> IOMode -> IO Handle)
-> IOMode
-> (Handle -> InterpretersFor es r)
-> (forall handle'. Sem (ScopedFile mode es b handle' : r) a)
-> Sem r a
forall k (r :: EffectRow) (es :: EffectRow) (mode :: k) b a.
(Members '[Embed IO, Resource] r, KnownList es) =>
(FilePath -> IOMode -> IO Handle)
-> IOMode
-> (Handle -> InterpretersFor es r)
-> (forall handle'. Sem (ScopedFile mode es b handle' : r) a)
-> Sem r a
Scoped.scopedFileToIO FilePath -> IOMode -> IO Handle
IO.openBinaryFile