@@ -6,6 +6,7 @@
66{-# LANGUAGE MultiParamTypeClasses #-}
77{-# LANGUAGE PackageImports #-}
88{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9+{-# LANGUAGE RankNTypes #-}
910
1011module Text.Libyaml
1112 ( -- * The event stream
@@ -39,6 +40,7 @@ import Foreign.ForeignPtr
3940import Foreign.Marshal.Alloc
4041import "transformers" Control.Monad.Trans
4142import Control.Failure
43+import qualified Control.Monad.Trans.Error as ErrorT
4244import Control.Monad.Trans.Reader
4345import Control.Applicative
4446
@@ -167,16 +169,22 @@ foreign import ccall unsafe "fclose"
167169 -> IO ()
168170
169171class MonadIO m => With m where
170− with :: ((a -> IO b) -> IO b) -> (a -> m b) -> m b
172+ with :: (forall b'. (a -> IO b') -> IO b') -> (a -> m b) -> m b
171173
172174instance With IO where
173175 with = id
176+instance With m => With (ReaderT r m) where
177+ with orig f = ReaderT $ \r -> do
178+ let f' a = (runReaderT $ f a) r
179+ with orig f'
180+instance (ErrorT.Error e, With m) => With (ErrorT.ErrorT e m) where
181+ with orig f = ErrorT.ErrorT $ with orig $ ErrorT.runErrorT . f
174182
175183allocaBytesR :: With m => Int -> (Ptr a -> m b) -> m b
176−allocaBytesR = with . allocaBytes
184+allocaBytesR i = with (allocaBytes i)
177185
178186withCStringR :: With m => String -> (Ptr CChar -> m a) -> m a
179−withCStringR = with . withCString
187+withCStringR s = with (withCString s)
180188
181189withFileParser :: (MonadFailure YamlException m, With m)
182190 => FilePath
@@ -211,7 +219,7 @@ withParser bs f = allocaBytesR parserSize $ \p -> do
211219 return ret
212220
213221withForeignPtrR :: With m => ForeignPtr a -> (Ptr a -> m b) -> m b
214−withForeignPtrR = with . withForeignPtr
222+withForeignPtrR fp = with (withForeignPtr fp)
215223
216224foreign import ccall unsafe "yaml_parser_parse"
217225 c_yaml_parser_parse :: Parser -> EventRaw -> IO CInt
@@ -414,11 +422,6 @@ parseEvent = MyReaderT ask >>= parserParseOne
414422runMyReaderT :: MyReaderT r m a -> r -> m a
415423runMyReaderT (MyReaderT (ReaderT f)) = f
416424
417−instance With m => With (ReaderT r m) where
418− with orig f = ReaderT $ \r -> do
419− let f' a = (runReaderT $ f a) r
420− with orig f'
421−
422425newtype MyReaderT r m a = MyReaderT (ReaderT r m a)
423426 deriving (MonadTrans, MonadIO, Functor, Applicative,
424427 Alternative, Monad, MonadPlus, With)