module StreamPatch.Stream where
import StreamPatch.Patch
import Util
import Data.Vinyl
import GHC.Natural
import Data.Kind
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy as BL
import Control.Monad.State
import Control.Monad.Reader
import System.IO ( Handle, SeekMode(..), hSeek )
import qualified Data.List as List
class Monad m => MonadFwdStream m where
type Chunk m :: Type
readahead :: Natural -> m (Chunk m)
advance :: Natural -> m ()
overwrite :: Chunk m -> m ()
instance Monad m => MonadFwdStream (StateT ([a], [a]) m) where
type Chunk (StateT ([a], [a]) m) = [a]
readahead :: Natural -> StateT ([a], [a]) m (Chunk (StateT ([a], [a]) m))
readahead Natural
n = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
List.take (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n) ([a] -> [a]) -> StateT ([a], [a]) m [a] -> StateT ([a], [a]) m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([a], [a]) -> [a]) -> StateT ([a], [a]) m [a]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([a], [a]) -> [a]
forall a b. (a, b) -> a
fst
advance :: Natural -> StateT ([a], [a]) m ()
advance Natural
n = do
([a]
src, [a]
out) <- StateT ([a], [a]) m ([a], [a])
forall s (m :: * -> *). MonadState s m => m s
get
let ([a]
bs, [a]
src') = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
List.splitAt (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n) [a]
src
([a], [a]) -> StateT ([a], [a]) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([a]
src', [a]
out [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
bs)
overwrite :: Chunk (StateT ([a], [a]) m) -> StateT ([a], [a]) m ()
overwrite Chunk (StateT ([a], [a]) m)
bs = do
([a]
src, [a]
out) <- StateT ([a], [a]) m ([a], [a])
forall s (m :: * -> *). MonadState s m => m s
get
let ([a]
_, [a]
src') = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
List.splitAt ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [a]
Chunk (StateT ([a], [a]) m)
bs) [a]
src
([a], [a]) -> StateT ([a], [a]) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([a]
src', [a]
out [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
Chunk (StateT ([a], [a]) m)
bs)
instance MonadIO m => MonadFwdStream (ReaderT Handle m) where
type Chunk (ReaderT Handle m) = BS.ByteString
readahead :: Natural -> ReaderT Handle m (Chunk (ReaderT Handle m))
readahead Natural
n = do
Handle
hdl <- ReaderT Handle m Handle
forall r (m :: * -> *). MonadReader r m => m r
ask
ByteString
bs <- IO ByteString -> ReaderT Handle m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ReaderT Handle m ByteString)
-> IO ByteString -> ReaderT Handle m ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO ByteString
BS.hGet Handle
hdl (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)
IO () -> ReaderT Handle m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Handle m ()) -> IO () -> ReaderT Handle m ()
forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
hdl SeekMode
RelativeSeek (- Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)
ByteString -> ReaderT Handle m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
advance :: Natural -> ReaderT Handle m ()
advance Natural
n = do
Handle
hdl <- ReaderT Handle m Handle
forall r (m :: * -> *). MonadReader r m => m r
ask
IO () -> ReaderT Handle m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Handle m ()) -> IO () -> ReaderT Handle m ()
forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
hdl SeekMode
RelativeSeek (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)
overwrite :: Chunk (ReaderT Handle m) -> ReaderT Handle m ()
overwrite Chunk (ReaderT Handle m)
bs = do
Handle
hdl <- ReaderT Handle m Handle
forall r (m :: * -> *). MonadReader r m => m r
ask
IO () -> ReaderT Handle m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Handle m ()) -> IO () -> ReaderT Handle m ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
BS.hPut Handle
hdl ByteString
Chunk (ReaderT Handle m)
bs
instance Monad m => MonadFwdStream (StateT (BS.ByteString, BB.Builder) m) where
type Chunk (StateT (BS.ByteString, BB.Builder) m) = BS.ByteString
readahead :: Natural
-> StateT
(ByteString, Builder) m (Chunk (StateT (ByteString, Builder) m))
readahead Natural
n = Int -> ByteString -> ByteString
BS.take (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n) (ByteString -> ByteString)
-> StateT (ByteString, Builder) m ByteString
-> StateT (ByteString, Builder) m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ByteString, Builder) -> ByteString)
-> StateT (ByteString, Builder) m ByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (ByteString, Builder) -> ByteString
forall a b. (a, b) -> a
fst
advance :: Natural -> StateT (ByteString, Builder) m ()
advance Natural
n = do
(ByteString
src, Builder
out) <- StateT (ByteString, Builder) m (ByteString, Builder)
forall s (m :: * -> *). MonadState s m => m s
get
let (ByteString
bs, ByteString
src') = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n) ByteString
src
(ByteString, Builder) -> StateT (ByteString, Builder) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ByteString
src', Builder
out Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString ByteString
bs)
overwrite :: Chunk (StateT (ByteString, Builder) m)
-> StateT (ByteString, Builder) m ()
overwrite Chunk (StateT (ByteString, Builder) m)
bs = do
(ByteString
src, Builder
out) <- StateT (ByteString, Builder) m (ByteString, Builder)
forall s (m :: * -> *). MonadState s m => m s
get
let (ByteString
_, ByteString
src') = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (ByteString -> Int
BS.length ByteString
Chunk (StateT (ByteString, Builder) m)
bs) ByteString
src
(ByteString, Builder) -> StateT (ByteString, Builder) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ByteString
src', Builder
out Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString ByteString
Chunk (StateT (ByteString, Builder) m)
bs)
class MonadFwdStream m => MonadCursorStream m where
move :: Integer -> m ()
instance MonadIO m => MonadCursorStream (ReaderT Handle m) where
move :: Integer -> ReaderT Handle m ()
move Integer
n = do
Handle
hdl <- ReaderT Handle m Handle
forall r (m :: * -> *). MonadReader r m => m r
ask
IO () -> ReaderT Handle m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Handle m ()) -> IO () -> ReaderT Handle m ()
forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
hdl SeekMode
RelativeSeek (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)