-- | Buffer abstracts from file IO

module Pdf.Core.IO.Buffer
(
  Buffer(..),
  toInputStream,
  fromHandle,
  fromBytes,
  dropExactly
)
where

import Prelude hiding (read)
import Data.Int
import Data.IORef
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import Control.Monad
import System.IO
import qualified System.IO.Streams as Streams
import System.IO.Streams.Internal (InputStream(..))
import qualified System.IO.Streams.Internal as Streams

-- | Interface to file
data Buffer = Buffer
  { Buffer -> IO (Maybe ByteString)
read :: IO (Maybe ByteString)
  , Buffer -> IO Int64
size :: IO Int64
  , Buffer -> Int64 -> IO ()
seek :: Int64 -> IO ()
  , Buffer -> Int64 -> IO ()
back :: Int64 -> IO ()
  , Buffer -> IO Int64
tell :: IO Int64
  }

-- | Convert buffer to 'InputStream'
toInputStream :: Buffer -> InputStream ByteString
toInputStream :: Buffer -> InputStream ByteString
toInputStream Buffer
buf = InputStream :: forall a. IO (Maybe a) -> (a -> IO ()) -> InputStream a
InputStream
  { _read :: IO (Maybe ByteString)
Streams._read = Buffer -> IO (Maybe ByteString)
read Buffer
buf
  , _unRead :: ByteString -> IO ()
Streams._unRead = Buffer -> Int64 -> IO ()
back Buffer
buf (Int64 -> IO ()) -> (ByteString -> Int64) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> (ByteString -> Int) -> ByteString -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
ByteString.length
  }

-- | Make buffer from handle
--
-- Don't touch the handle while using buffer
fromHandle :: Handle -> IO Buffer
-- it is in IO in case we'll need to store intermediate state
fromHandle :: Handle -> IO Buffer
fromHandle Handle
h = Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffer -> IO Buffer) -> Buffer -> IO Buffer
forall a b. (a -> b) -> a -> b
$ Buffer :: IO (Maybe ByteString)
-> IO Int64
-> (Int64 -> IO ())
-> (Int64 -> IO ())
-> IO Int64
-> Buffer
Buffer
  { read :: IO (Maybe ByteString)
read = do
      ByteString
bs <- Handle -> Int -> IO ByteString
ByteString.hGetSome Handle
h Int
defaultSize
      if ByteString -> Bool
ByteString.null ByteString
bs
        then Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
        else Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs)
  , size :: IO Int64
size = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> IO Integer -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Integer
hFileSize Handle
h
  , seek :: Int64 -> IO ()
seek = Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek (Integer -> IO ()) -> (Int64 -> Integer) -> Int64 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  , back :: Int64 -> IO ()
back = Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
RelativeSeek (Integer -> IO ()) -> (Int64 -> Integer) -> Int64 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> (Int64 -> Integer) -> Int64 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  , tell :: IO Int64
tell = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> IO Integer -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Integer
hTell Handle
h
  }

-- | Buffer from strict 'ByteString'
--
-- That is mostly for testing
fromBytes :: ByteString -> IO Buffer
fromBytes :: ByteString -> IO Buffer
fromBytes ByteString
bs = do
  IORef Int
ref <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
  Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer :: IO (Maybe ByteString)
-> IO Int64
-> (Int64 -> IO ())
-> (Int64 -> IO ())
-> IO Int64
-> Buffer
Buffer
    { read :: IO (Maybe ByteString)
read = do
        Int
pos <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
ref
        let chunk :: ByteString
chunk = Int -> ByteString -> ByteString
ByteString.drop Int
pos ByteString
bs
        IORef Int -> (Int -> Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef Int
ref (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
ByteString.length ByteString
chunk)
        if ByteString -> Bool
ByteString.null ByteString
chunk
          then Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
          else Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
chunk)
    , seek :: Int64 -> IO ()
seek = IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
ref (Int -> IO ()) -> (Int64 -> Int) -> Int64 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    , size :: IO Int64
size = Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> IO Int64) -> Int64 -> IO Int64
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
ByteString.length ByteString
bs)
    , back :: Int64 -> IO ()
back = IORef Int -> (Int -> Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef Int
ref ((Int -> Int) -> IO ()) -> (Int64 -> Int -> Int) -> Int64 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) (Int -> Int -> Int) -> (Int64 -> Int) -> Int64 -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    , tell :: IO Int64
tell = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> IO Int -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
ref
    }

-- | Drop specified number of bytes from input stream
dropExactly :: Int -> InputStream ByteString -> IO ()
dropExactly :: Int -> InputStream ByteString -> IO ()
dropExactly Int
n = IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ByteString -> IO ())
-> (InputStream ByteString -> IO ByteString)
-> InputStream ByteString
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> InputStream ByteString -> IO ByteString
Streams.readExactly Int
n

defaultSize :: Int
defaultSize :: Int
defaultSize = Int
32752