3746497 · typeable/yaml

git.iko.soy/typeable/yaml

on master help sign in

Added instance With ErrorT

3746497Michael Snoyman17 years ago

Text/Libyaml.hs+12−9

compare with master

unifiedsplit

@@ -6,6 +6,7 @@

6{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE PackageImports #-}

8{-# LANGUAGE GeneralizedNewtypeDeriving #-}

9+{-# LANGUAGE RankNTypes #-}

10module Text.Libyaml

11module Text.Libyaml

11 ( -- * The event stream

12 ( -- * The event stream

@@ -39,6 +40,7 @@ import Foreign.ForeignPtr

39import Foreign.Marshal.Alloc

40import Foreign.Marshal.Alloc

40import "transformers" Control.Monad.Trans

41import "transformers" Control.Monad.Trans

41import Control.Failure

42import Control.Failure

43+import qualified Control.Monad.Trans.Error as ErrorT

42import Control.Monad.Trans.Reader

44import Control.Monad.Trans.Reader

43import Control.Applicative

45import Control.Applicative

@@ -167,16 +169,22 @@ foreign import ccall unsafe "fclose"

167 -> IO ()

169 -> IO ()

168

170

169class MonadIO m => With m where

171class 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

171

173

172instance With IO where

174instance With IO where

173 with = id

175 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

174

182

175allocaBytesR :: With m => Int -> (Ptr a -> m b) -> m b

183allocaBytesR :: With m => Int -> (Ptr a -> m b) -> m b

176−allocaBytesR = with . allocaBytes

184+allocaBytesR i = with (allocaBytes i)

177

185

178withCStringR :: With m => String -> (Ptr CChar -> m a) -> m a

186withCStringR :: With m => String -> (Ptr CChar -> m a) -> m a

179−withCStringR = with . withCString

187+withCStringR s = with (withCString s)

180

188

181withFileParser :: (MonadFailure YamlException m, With m)

189withFileParser :: (MonadFailure YamlException m, With m)

182 => FilePath

190 => FilePath

@@ -211,7 +219,7 @@ withParser bs f = allocaBytesR parserSize $ \p -> do

211 return ret

219 return ret

212

220

213withForeignPtrR :: With m => ForeignPtr a -> (Ptr a -> m b) -> m b

221withForeignPtrR :: With m => ForeignPtr a -> (Ptr a -> m b) -> m b

214−withForeignPtrR = with . withForeignPtr

222+withForeignPtrR fp = with (withForeignPtr fp)

215

223

216foreign import ccall unsafe "yaml_parser_parse"

224foreign import ccall unsafe "yaml_parser_parse"

217 c_yaml_parser_parse :: Parser -> EventRaw -> IO CInt

225 c_yaml_parser_parse :: Parser -> EventRaw -> IO CInt

@@ -414,11 +422,6 @@ parseEvent = MyReaderT ask >>= parserParseOne

414runMyReaderT :: MyReaderT r m a -> r -> m a

422runMyReaderT :: MyReaderT r m a -> r -> m a

415runMyReaderT (MyReaderT (ReaderT f)) = f

423runMyReaderT (MyReaderT (ReaderT f)) = f

416

424

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−

422newtype MyReaderT r m a = MyReaderT (ReaderT r m a)

425newtype MyReaderT r m a = MyReaderT (ReaderT r m a)

423 deriving (MonadTrans, MonadIO, Functor, Applicative,

426 deriving (MonadTrans, MonadIO, Functor, Applicative,

424 Alternative, Monad, MonadPlus, With)

427 Alternative, Monad, MonadPlus, With)