-- The following directives make GHC do some menial work on our
-- behalf.

{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}

-- We export our RangedIO monad's type constructor, but not its value
-- constructor.  This keeps the implementation abstract.
module ReadHelper
    (
     RangedIO,
     runRangedIO,
     rangedRead
    ) where

import Data.ByteString.Lazy (ByteString, hGet)
import Data.Typeable (Typeable)
import Control.Exception (Exception, throwIO)
import Control.Monad.Reader
import System.IO (Handle, hTell)

-- A shiny new GHC 6.10 extensible exception.  We'll throw an
-- exception of this type if rangedRead tries to read outside of its
-- intended range.
data RangeError = RangeError
                  deriving (Show, Typeable)

instance Exception RangeError

-- | A special-purpose monad that can only perform ranged file reads.
newtype RangedIO a = RangedIO { runRIO :: ReaderT (Handle,Integer) IO a }
    deriving (Monad, MonadIO, MonadReader (Handle,Integer))

-- | Our monad's execution function.
runRangedIO :: RangedIO a -> Handle -> Integer -> IO a
runRangedIO = curry . runReaderT . runRIO

-- | Given a number of bytes to read, return a ByteString of at most
-- that length, within the given limit.
rangedRead :: Integer -> RangedIO ByteString
rangedRead k = do
    (h,limit) <- ask
    off <- liftIO (hTell h)
    when (off >= limit) $
        liftIO (throwIO RangeError)
    liftIO $ hGet h (fromIntegral (min k (limit - off)))