{-# 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 (when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.State (StateT (..), get, gets, put)
import Control.Monad.Identity (Identity)
import Control.Monad.Reader (ReaderT, ask)
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