ghc-mtl-1.2.1.0/0000755000000000000000000000000012332115223011364 5ustar0000000000000000ghc-mtl-1.2.1.0/ghc-mtl.cabal0000644000000000000000000000205212332115223013702 0ustar0000000000000000name: ghc-mtl version: 1.2.1.0 description: Provides an 'mtl' compatible version of the 'GhcT' monad-transformer defined in the 'GHC-API' since version 6.10.1. synopsis: An mtl compatible version of the Ghc-Api monads and monad-transformers. category: Development license: BSD3 license-file: LICENSE author: Daniel Gorin maintainer: jcpetruzza@gmail.com homepage: http://hub.darcs.net/jcpetruzza/ghc-mtl cabal-version: >= 1.6 build-type: Simple tested-with: GHC==6.10 source-repository head type: darcs location: http://hub.darcs.net/jcpetruzza/ghc-mtl Library build-depends: base >= 4, base <= 5, ghc >= 6.10, mtl, exceptions >= 0.6, extensible-exceptions exposed-modules: Control.Monad.Ghc extensions: GeneralizedNewtypeDeriving, CPP ghc-options: -Wall -O2 ghc-mtl-1.2.1.0/LICENSE0000644000000000000000000000271312332115223012374 0ustar0000000000000000Copyright 2007, Daniel Gorin. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.ghc-mtl-1.2.1.0/Setup.lhs0000644000000000000000000000021112332115223013166 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMainWithHooks simpleUserHooks ghc-mtl-1.2.1.0/Control/0000755000000000000000000000000012332115223013004 5ustar0000000000000000ghc-mtl-1.2.1.0/Control/Monad/0000755000000000000000000000000012332115223014042 5ustar0000000000000000ghc-mtl-1.2.1.0/Control/Monad/Ghc.hs0000644000000000000000000001131112332115223015074 0ustar0000000000000000module Control.Monad.Ghc ( Ghc, runGhc, GhcT, runGhcT, GHC.GhcMonad(..), module Control.Monad.Trans ) where #if __GLASGOW_HASKELL__ < 706 import Prelude hiding ( catch ) #endif import qualified Control.Exception.Extensible as E import Control.Applicative import Control.Monad import Control.Monad.Trans import qualified Control.Monad.Trans as MTL import Control.Monad.Catch import qualified GHC ( runGhc, runGhcT ) import qualified MonadUtils as GHC import qualified Exception as GHC #if __GLASGOW_HASKELL__ >= 702 import qualified GhcMonad as GHC #else import qualified HscTypes as GHC #endif #if __GLASGOW_HASKELL__ >= 706 import qualified DynFlags as GHC #endif newtype Ghc a = Ghc{ unGhc :: GHC.Ghc a } deriving (Functor ,Monad #if __GLASGOW_HASKELL__ < 702 ,GHC.WarnLogMonad #elif __GLASGOW_HASKELL__ >= 706 ,GHC.HasDynFlags #endif ,GHC.ExceptionMonad #if __GLASGOW_HASKELL__ < 708 ,GHC.MonadIO #else ,MTL.MonadIO ,Applicative #endif ,GHC.GhcMonad) #if __GLASGOW_HASKELL__ < 708 instance Applicative Ghc where pure = return (<*>) = ap instance MTL.MonadIO Ghc where liftIO = GHC.liftIO #endif instance MonadThrow Ghc where throwM = liftIO . E.throwIO instance MonadCatch Ghc where catch = GHC.gcatch instance MonadMask Ghc where #if __GLASGOW_HASKELL__ >= 700 -- @gmask@ is available... -- ...but it doesn't have a rank-n type like @mask@, so we need -- to use @Control.Exception.mask@ directly... (sigh) -- (this is type-directed, write only code) mask f = wrap $ \s -> mask $ \io_restore -> unwrap (f $ \m -> (wrap $ \s' -> io_restore (unwrap m s'))) s where wrap = Ghc . GHC.Ghc unwrap = GHC.unGhc . unGhc #else -- this implementation, of course, offers less guarantees than the real @mask@, -- but we have no @mask@ available in the first place! mask io = GHC.gblock $ io GHC.gunblock #endif uninterruptibleMask = mask runGhc :: Maybe FilePath -> Ghc a -> IO a runGhc f (Ghc m) = GHC.runGhc f m newtype GhcT m a = GhcT { unGhcT :: GHC.GhcT (MTLAdapter m) a } deriving (Functor ,Monad #if __GLASGOW_HASKELL__ >= 706 ,GHC.HasDynFlags #endif ) instance (Functor m, Monad m) => Applicative (GhcT m) where pure = return (<*>) = ap runGhcT :: (Functor m, MonadIO m, MonadCatch m, MonadMask m) => Maybe FilePath -> GhcT m a -> m a runGhcT f = unMTLA . GHC.runGhcT f . unGhcT instance MTL.MonadTrans GhcT where lift = GhcT . GHC.liftGhcT . MTLAdapter instance MTL.MonadIO m => MTL.MonadIO (GhcT m) where liftIO = GhcT . GHC.liftIO #if __GLASGOW_HASKELL__ < 708 -- ghc started using transformers at some point instance MTL.MonadIO m => GHC.MonadIO (GhcT m) where liftIO = MTL.liftIO #endif instance MonadCatch m => MonadThrow (GhcT m) where throwM = lift . throwM instance (MonadIO m,MonadCatch m, MonadMask m) => MonadCatch (GhcT m) where m `catch` f = GhcT ((unGhcT m) `GHC.gcatch` (unGhcT . f)) instance (MonadIO m, MonadMask m) => MonadMask (GhcT m) where mask f = wrap $ \s -> mask $ \io_restore -> unwrap (f $ \m -> (wrap $ \s' -> io_restore (unwrap m s'))) s where wrap g = GhcT $ GHC.GhcT $ \s -> MTLAdapter (g s) unwrap m = \s -> unMTLA ((GHC.unGhcT $ unGhcT $ m) s) uninterruptibleMask = mask instance (MonadIO m, MonadCatch m, MonadMask m) => GHC.ExceptionMonad (GhcT m) where gcatch = catch #if __GLASGOW_HASKELL__ >= 700 gmask f = mask (\x -> f x) #else gblock = mask_ #endif #if __GLASGOW_HASKELL__ < 702 instance MTL.MonadIO m => GHC.WarnLogMonad (GhcT m) where setWarnings = GhcT . GHC.setWarnings getWarnings = GhcT GHC.getWarnings #endif instance (Functor m, MonadIO m, MonadCatch m, MonadMask m) => GHC.GhcMonad (GhcT m) where getSession = GhcT GHC.getSession setSession = GhcT . GHC.setSession -- | We use the 'MTLAdapter' to convert between similar classes -- like 'MTL'''s 'MonadIO' and 'GHC'''s 'MonadIO'. newtype MTLAdapter m a = MTLAdapter {unMTLA :: m a} deriving (Functor, Applicative, Monad) instance MTL.MonadIO m => GHC.MonadIO (MTLAdapter m) where liftIO = MTLAdapter . MTL.liftIO instance (MonadIO m, MonadCatch m, MonadMask m) => GHC.ExceptionMonad (MTLAdapter m) where m `gcatch` f = MTLAdapter $ (unMTLA m) `catch` (unMTLA . f) #if __GLASGOW_HASKELL__ >= 700 gmask io = MTLAdapter $ mask (\f -> unMTLA $ io (MTLAdapter . f . unMTLA)) #else gblock = MTLAdapter . mask_ . unMTLA -- use block instead #endif