f27016c · typeable/yaml

git.iko.soy/typeable/yaml

on master help sign in

Replace ReaderT with MyFailureT to avoid orphan instance

f27016cMichael Snoyman17 years ago

Text/Libyaml.hs+17−9

compare with master

unifiedsplit

@@ -5,7 +5,7 @@

5{-# LANGUAGE FlexibleInstances #-}

6{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE PackageImports #-}

8−{-# LANGUAGE TypeFamilies #-}

8+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

10module Text.Libyaml

11 ( -- * The event stream

@@ -42,6 +42,7 @@ import Foreign.Marshal.Alloc

42import "transformers" Control.Monad.Trans

43import Control.Failure

44import Control.Monad.Trans.Reader

45+import Control.Applicative

46import Control.Exception (throwIO, Exception, SomeException)

47import Control.Exception (throwIO, Exception, SomeException)

47import Data.Typeable (Typeable)

48import Data.Typeable (Typeable)

@@ -414,7 +415,7 @@ emitEvent :: (MonadIO m, MonadFailure YamlException m)

414 => Event

415 => Event

415 -> YamlEncoder m ()

416 -> YamlEncoder m ()

416emitEvent e = do

417emitEvent e = do

417− emitter <- ask

418+ emitter <- MyReaderT ask

418 res <- liftIO $ toEventRaw e $ c_yaml_emitter_emit emitter

419 res <- liftIO $ toEventRaw e $ c_yaml_emitter_emit emitter

419 when (res == 0) $ do

420 when (res == 0) $ do

420 problem <- liftIO $ makeString c_get_emitter_error emitter

421 problem <- liftIO $ makeString c_get_emitter_error emitter

@@ -422,16 +423,23 @@ emitEvent e = do

422

423

423parseEvent :: (With m, MonadFailure YamlException m)

424parseEvent :: (With m, MonadFailure YamlException m)

424 => YamlDecoder m Event

425 => YamlDecoder m Event

425−parseEvent = ask >>= parserParseOne

426+parseEvent = MyReaderT ask >>= parserParseOne

426

427

427−type YamlDecoder = ReaderT Parser

428+runMyReaderT :: MyReaderT r m a -> r -> m a

428−type YamlEncoder = ReaderT Emitter

429+runMyReaderT (MyReaderT (ReaderT f)) = f

429

430

430instance With m => With (ReaderT r m) where

431instance With m => With (ReaderT r m) where

431 with orig f = ReaderT $ \r -> do

432 with orig f = ReaderT $ \r -> do

432 let f' a = (runReaderT $ f a) r

433 let f' a = (runReaderT $ f a) r

433 with orig f'

434 with orig f'

435+

436+newtype MyReaderT r m a = MyReaderT (ReaderT r m a)

437+ deriving (MonadTrans, MonadIO, Functor, Applicative,

438+ Alternative, Monad, MonadPlus, With)

439+type YamlDecoder = MyReaderT Parser

440+type YamlEncoder = MyReaderT Emitter

441+

434−instance MonadFailure e m => Failure e (ReaderT r m) where

442+instance MonadFailure e m => Failure e (MyReaderT r m) where

435 failure = lift . failure

443 failure = lift . failure

436

444

437foreign import ccall unsafe "yaml_stream_start_event_initialize"

445foreign import ccall unsafe "yaml_stream_start_event_initialize"

@@ -550,13 +558,13 @@ data EnumResult a b = More a | Done b

550encode :: (With m, MonadFailure YamlException m)

558encode :: (With m, MonadFailure YamlException m)

551 => YamlEncoder m ()

559 => YamlEncoder m ()

552 -> m B.ByteString

560 -> m B.ByteString

553−encode = withEmitter . runReaderT

561+encode = withEmitter . runMyReaderT

554

562

555encodeFile :: (With m, MonadFailure YamlException m)

563encodeFile :: (With m, MonadFailure YamlException m)

556 => FilePath

564 => FilePath

557 -> YamlEncoder m ()

565 -> YamlEncoder m ()

558 -> m ()

566 -> m ()

559−encodeFile filePath = withEmitterFile filePath . runReaderT

567+encodeFile filePath = withEmitterFile filePath . runMyReaderT

560

568

561decode :: (With m, MonadFailure YamlException m)

569decode :: (With m, MonadFailure YamlException m)

562 => B.ByteString

570 => B.ByteString

@@ -576,4 +584,4 @@ decodeFile' :: (With m, MonadFailure YamlException m)

576 => FilePath

584 => FilePath

577 -> YamlDecoder m a

585 -> YamlDecoder m a

578 -> m a

586 -> m a

579−decodeFile' fp dec = withFileParser fp $ runReaderT dec

587+decodeFile' fp dec = withFileParser fp $ runMyReaderT dec