{-# LANGUAGE FlexibleInstances,FlexibleContexts,MultiParamTypeClasses,CPP #-}
module Data.Encoding.ByteSource where

import Data.Encoding.Exception

import Data.Bits
import Data.Binary.Get
import Data.Char
import Data.Maybe
import Data.Word
import Control.Applicative as A
import Control.Monad.State
import Control.Monad.Identity
import Control.Monad.Reader
import Control.Exception.Extensible
import Control.Throws
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import System.IO

class (Monad m,Throws DecodingException m) => ByteSource m where
    sourceEmpty :: m Bool
    fetchWord8 :: m Word8
    -- 'fetchAhead act' should return the same thing 'act' does, but should
    -- only consume input if 'act' returns a 'Just' value
    fetchAhead :: m (Maybe a) -> m (Maybe a)
    fetchWord16be :: m Word16
    fetchWord16be = do
      Word8
w1 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w2 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word16 -> m Word16
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> m Word16) -> Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ ((Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w1) Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
                 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w2)
    fetchWord16le :: m Word16
    fetchWord16le = do
      Word8
w1 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w2 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word16 -> m Word16
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> m Word16) -> Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ ((Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w2) Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
                 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w1)
    fetchWord32be :: m Word32
    fetchWord32be = do
      Word8
w1 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w2 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w3 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w4 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word32 -> m Word32
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> m Word32) -> Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ ((Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w1) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
                 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w2) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
                 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w3) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL`  Int
8)
                 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w4)
    fetchWord32le :: m Word32
    fetchWord32le = do
      Word8
w1 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w2 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w3 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w4 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word32 -> m Word32
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> m Word32) -> Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ ((Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w4) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
                 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w3) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
                 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w2) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL`  Int
8)
                 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w1)
    fetchWord64be :: m Word64
    fetchWord64be = do
      Word8
w1 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w2 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w3 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w4 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w5 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w6 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w7 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w8 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word64 -> m Word64
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> m Word64) -> Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ ((Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w1) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
56)
                 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w2) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
48)
                 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w3) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
40)
                 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w4) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
                 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w5) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
                 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w6) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
                 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w7) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL`  Int
8)
                 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8)
    fetchWord64le :: m Word64
    fetchWord64le = do
      Word8
w1 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w2 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w3 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w4 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w5 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w6 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w7 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word8
w8 <- m Word8
forall (m :: * -> *). ByteSource m => m Word8
fetchWord8
      Word64 -> m Word64
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> m Word64) -> Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ ((Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
56)
                 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w7) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
48)
                 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w6) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
40)
                 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w5) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
                 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w4) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
                 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w3) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
                 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w2) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL`  Int
8)
                 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w1)

instance Throws DecodingException Get where
    throwException :: forall a. DecodingException -> Get a
throwException = DecodingException -> Get a
forall a e. Exception e => e -> a
throw

instance ByteSource Get where
    sourceEmpty :: Get Bool
sourceEmpty = Get Bool
isEmpty
    fetchWord8 :: Get Word8
fetchWord8 = Get Word8
getWord8
#if MIN_VERSION_binary(0,6,0)
    fetchAhead :: forall a. Get (Maybe a) -> Get (Maybe a)
fetchAhead Get (Maybe a)
act = (do
        Maybe a
res <- Get (Maybe a)
act
        case Maybe a
res of
            Maybe a
Nothing -> Get (Maybe a)
forall a. Get a
forall (f :: * -> *) a. Alternative f => f a
A.empty
            Just a
a  -> Maybe a -> Get (Maybe a)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
res
        ) Get (Maybe a) -> Get (Maybe a) -> Get (Maybe a)
forall a. Get a -> Get a -> Get a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a -> Get (Maybe a)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
#else
    fetchAhead act = do
        res <- lookAhead act
        case res of
            Nothing -> return Nothing
            Just a  -> act
#endif
    fetchWord16be :: Get Word16
fetchWord16be = Get Word16
getWord16be
    fetchWord16le :: Get Word16
fetchWord16le = Get Word16
getWord16le
    fetchWord32be :: Get Word32
fetchWord32be = Get Word32
getWord32be
    fetchWord32le :: Get Word32
fetchWord32le = Get Word32
getWord32le
    fetchWord64be :: Get Word64
fetchWord64be = Get Word64
getWord64be
    fetchWord64le :: Get Word64
fetchWord64le = Get Word64
getWord64le

fetchAheadState :: m (Maybe a) -> m (Maybe a)
fetchAheadState m (Maybe a)
act = do
    s
chs <- m s
forall s (m :: * -> *). MonadState s m => m s
get
    Maybe a
res <- m (Maybe a)
act
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
res) (s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
chs)
    Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
res

instance ByteSource (StateT [Char] Identity) where
    sourceEmpty :: StateT [Char] Identity Bool
sourceEmpty = ([Char] -> Bool) -> StateT [Char] Identity Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
    fetchWord8 :: StateT [Char] Identity Word8
fetchWord8 = do
      [Char]
chs <- StateT [Char] Identity [Char]
forall s (m :: * -> *). MonadState s m => m s
get
      case [Char]
chs of
        [] -> DecodingException -> StateT [Char] Identity Word8
forall a. DecodingException -> StateT [Char] Identity a
forall e (m :: * -> *) a. Throws e m => e -> m a
throwException DecodingException
UnexpectedEnd
        Char
c:[Char]
cs -> do
          [Char] -> StateT [Char] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Char]
cs
          Word8 -> StateT [Char] Identity Word8
forall a. a -> StateT [Char] Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c)
    fetchAhead :: forall a.
StateT [Char] Identity (Maybe a)
-> StateT [Char] Identity (Maybe a)
fetchAhead = StateT [Char] Identity (Maybe a)
-> StateT [Char] Identity (Maybe a)
forall {m :: * -> *} {s} {a}.
MonadState s m =>
m (Maybe a) -> m (Maybe a)
fetchAheadState

#if MIN_VERSION_base(4,3,0)
#else
instance Monad (Either DecodingException) where
    return = Right
    (Left err) >>= g = Left err
    (Right x) >>= g = g x
#endif

instance ByteSource (StateT [Char] (Either DecodingException)) where
    sourceEmpty :: StateT [Char] (Either DecodingException) Bool
sourceEmpty = ([Char] -> Bool) -> StateT [Char] (Either DecodingException) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
    fetchWord8 :: StateT [Char] (Either DecodingException) Word8
fetchWord8 = do
      [Char]
chs <- StateT [Char] (Either DecodingException) [Char]
forall s (m :: * -> *). MonadState s m => m s
get
      case [Char]
chs of
        [] -> DecodingException -> StateT [Char] (Either DecodingException) Word8
forall a.
DecodingException -> StateT [Char] (Either DecodingException) a
forall e (m :: * -> *) a. Throws e m => e -> m a
throwException DecodingException
UnexpectedEnd
        Char
c:[Char]
cs -> do
          [Char] -> StateT [Char] (Either DecodingException) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Char]
cs
          Word8 -> StateT [Char] (Either DecodingException) Word8
forall a. a -> StateT [Char] (Either DecodingException) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c)
    fetchAhead :: forall a.
StateT [Char] (Either DecodingException) (Maybe a)
-> StateT [Char] (Either DecodingException) (Maybe a)
fetchAhead = StateT [Char] (Either DecodingException) (Maybe a)
-> StateT [Char] (Either DecodingException) (Maybe a)
forall {m :: * -> *} {s} {a}.
MonadState s m =>
m (Maybe a) -> m (Maybe a)
fetchAheadState

instance (Monad m,Throws DecodingException m) => ByteSource (StateT BS.ByteString m) where
    sourceEmpty :: StateT ByteString m Bool
sourceEmpty = (ByteString -> Bool) -> StateT ByteString m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ByteString -> Bool
BS.null
    fetchWord8 :: StateT ByteString m Word8
fetchWord8 = (ByteString -> m (Word8, ByteString)) -> StateT ByteString m Word8
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (\ByteString
str -> case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
str of
                                  Maybe (Word8, ByteString)
Nothing -> DecodingException -> m (Word8, ByteString)
forall a. DecodingException -> m a
forall e (m :: * -> *) a. Throws e m => e -> m a
throwException DecodingException
UnexpectedEnd
                                  Just (Word8
c,ByteString
cs) -> (Word8, ByteString) -> m (Word8, ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
c,ByteString
cs))
    fetchAhead :: forall a.
StateT ByteString m (Maybe a) -> StateT ByteString m (Maybe a)
fetchAhead = StateT ByteString m (Maybe a) -> StateT ByteString m (Maybe a)
forall {m :: * -> *} {s} {a}.
MonadState s m =>
m (Maybe a) -> m (Maybe a)
fetchAheadState

instance ByteSource (StateT LBS.ByteString (Either DecodingException)) where
    sourceEmpty :: StateT ByteString (Either DecodingException) Bool
sourceEmpty = (ByteString -> Bool)
-> StateT ByteString (Either DecodingException) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ByteString -> Bool
LBS.null
    fetchWord8 :: StateT ByteString (Either DecodingException) Word8
fetchWord8 = (ByteString -> Either DecodingException (Word8, ByteString))
-> StateT ByteString (Either DecodingException) Word8
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (\ByteString
str -> case ByteString -> Maybe (Word8, ByteString)
LBS.uncons ByteString
str of
                                  Maybe (Word8, ByteString)
Nothing -> DecodingException -> Either DecodingException (Word8, ByteString)
forall a b. a -> Either a b
Left DecodingException
UnexpectedEnd
                                  Just (Word8, ByteString)
ns -> (Word8, ByteString) -> Either DecodingException (Word8, ByteString)
forall a b. b -> Either a b
Right (Word8, ByteString)
ns)
    fetchAhead :: forall a.
StateT ByteString (Either DecodingException) (Maybe a)
-> StateT ByteString (Either DecodingException) (Maybe a)
fetchAhead = StateT ByteString (Either DecodingException) (Maybe a)
-> StateT ByteString (Either DecodingException) (Maybe a)
forall {m :: * -> *} {s} {a}.
MonadState s m =>
m (Maybe a) -> m (Maybe a)
fetchAheadState

instance ByteSource (ReaderT Handle IO) where
    sourceEmpty :: ReaderT Handle IO Bool
sourceEmpty = do
      Handle
h <- ReaderT Handle IO Handle
forall r (m :: * -> *). MonadReader r m => m r
ask
      IO Bool -> ReaderT Handle IO Bool
forall a. IO a -> ReaderT Handle IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO Bool
hIsEOF Handle
h)
    fetchWord8 :: ReaderT Handle IO Word8
fetchWord8 = do
      Handle
h <- ReaderT Handle IO Handle
forall r (m :: * -> *). MonadReader r m => m r
ask
      IO Word8 -> ReaderT Handle IO Word8
forall a. IO a -> ReaderT Handle IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> ReaderT Handle IO Word8)
-> IO Word8 -> ReaderT Handle IO Word8
forall a b. (a -> b) -> a -> b
$ do
        Char
ch <- Handle -> IO Char
hGetChar Handle
h
        Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
ch)
    fetchAhead :: forall a.
ReaderT Handle IO (Maybe a) -> ReaderT Handle IO (Maybe a)
fetchAhead ReaderT Handle IO (Maybe a)
act = do
      Handle
h <- ReaderT Handle IO Handle
forall r (m :: * -> *). MonadReader r m => m r
ask
      HandlePosn
pos <- IO HandlePosn -> ReaderT Handle IO HandlePosn
forall a. IO a -> ReaderT Handle IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HandlePosn -> ReaderT Handle IO HandlePosn)
-> IO HandlePosn -> ReaderT Handle IO HandlePosn
forall a b. (a -> b) -> a -> b
$ Handle -> IO HandlePosn
hGetPosn Handle
h
      Maybe a
res <- ReaderT Handle IO (Maybe a)
act
      Bool -> ReaderT Handle IO () -> ReaderT Handle IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
res) (IO () -> ReaderT Handle IO ()
forall a. IO a -> ReaderT Handle IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Handle IO ()) -> IO () -> ReaderT Handle IO ()
forall a b. (a -> b) -> a -> b
$ HandlePosn -> IO ()
hSetPosn HandlePosn
pos)
      Maybe a -> ReaderT Handle IO (Maybe a)
forall a. a -> ReaderT Handle IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
res