compiler/main/GhcMonad.hs

   1 {-# OPTIONS_GHC -funbox-strict-fields #-}
   2 -- -----------------------------------------------------------------------------
   3 --
   4 -- (c) The University of Glasgow, 2010
   5 --
   6 -- The Session type and related functionality
   7 --
   8 -- -----------------------------------------------------------------------------
   9
  10 module GhcMonad (
  11         -- * 'Ghc' monad stuff
  12         GhcMonad(..),
  13         Ghc(..),
  14         GhcT(..), liftGhcT,
  15         reflectGhc, reifyGhc,
  16         getSessionDynFlags,
  17         liftIO,
  18         Session(..), withSession, modifySession, withTempSession,
  19
  20         -- ** Warnings
  21         logWarnings, printException, printExceptionAndWarnings,
  22         WarnErrLogger, defaultWarnErrLogger
  23   ) where
  24
  25 import MonadUtils
  26 import HscTypes
  27 import DynFlags
  28 import Exception
  29 import ErrUtils
  30
  31 import Data.IORef
  32
  33 -- -----------------------------------------------------------------------------
  34 -- | A monad that has all the features needed by GHC API calls.
  35 --
  36 -- In short, a GHC monad
  37 --
  38 --   - allows embedding of IO actions,
  39 --
  40 --   - can log warnings,
  41 --
  42 --   - allows handling of (extensible) exceptions, and
  43 --
  44 --   - maintains a current session.
  45 --
  46 -- If you do not use 'Ghc' or 'GhcT', make sure to call 'GHC.initGhcMonad'
  47 -- before any call to the GHC API functions can occur.
  48 --
  49 class (Functor m, MonadIO m, ExceptionMonad m) => GhcMonad m where
  50   getSession :: m HscEnv
  51   setSession :: HscEnv -> m ()
  52
  53
  54 -- | Call the argument with the current session.
  55 withSession :: GhcMonad m => (HscEnv -> m a) -> m a
  56 withSession f = getSession >>= f
  57
  58 -- | Grabs the DynFlags from the Session
  59 getSessionDynFlags :: GhcMonad m => m DynFlags
  60 getSessionDynFlags = withSession (return . hsc_dflags)
  61
  62 -- | Set the current session to the result of applying the current session to
  63 -- the argument.
  64 modifySession :: GhcMonad m => (HscEnv -> HscEnv) -> m ()
  65 modifySession f = do h <- getSession
  66                      setSession $! f h
  67
  68 withSavedSession :: GhcMonad m => m a -> m a
  69 withSavedSession m = do
  70   saved_session <- getSession
  71   m `gfinally` setSession saved_session
  72
  73 -- | Call an action with a temporarily modified Session.
  74 withTempSession :: GhcMonad m => (HscEnv -> HscEnv) -> m a -> m a
  75 withTempSession f m =
  76   withSavedSession $ modifySession f >> m
  77
  78 -- -----------------------------------------------------------------------------
  79 -- | A monad that allows logging of warnings.
  80
  81 logWarnings :: GhcMonad m => WarningMessages -> m ()
  82 logWarnings warns = do
  83   dflags <- getSessionDynFlags
  84   liftIO $ printOrThrowWarnings dflags warns
  85
  86 -- -----------------------------------------------------------------------------
  87 -- | A minimal implementation of a 'GhcMonad'.  If you need a custom monad,
  88 -- e.g., to maintain additional state consider wrapping this monad or using
  89 -- 'GhcT'.
  90 newtype Ghc a = Ghc { unGhc :: Session -> IO a }
  91
  92 -- | The Session is a handle to the complete state of a compilation
  93 -- session.  A compilation session consists of a set of modules
  94 -- constituting the current program or library, the context for
  95 -- interactive evaluation, and various caches.
  96 data Session = Session !(IORef HscEnv)
  97
  98 instance Functor Ghc where
  99   fmap f m = Ghc $ \s -> f `fmap` unGhc m s
 100
 101 instance Monad Ghc where
 102   return a = Ghc $ \_ -> return a
 103   m >>= g  = Ghc $ \s -> do a <- unGhc m s; unGhc (g a) s
 104
 105 instance MonadIO Ghc where
 106   liftIO ioA = Ghc $ \_ -> ioA
 107
 108 instance ExceptionMonad Ghc where
 109   gcatch act handle =
 110       Ghc $ \s -> unGhc act s `gcatch` \e -> unGhc (handle e) s
 111   gblock (Ghc m)   = Ghc $ \s -> gblock (m s)
 112   gunblock (Ghc m) = Ghc $ \s -> gunblock (m s)
 113   gmask f =
 114       Ghc $ \s -> gmask $ \io_restore ->
 115                              let
 116                                 g_restore (Ghc m) = Ghc $ \s -> io_restore (m s)
 117                              in
 118                                 unGhc (f g_restore) s
 119
 120 instance GhcMonad Ghc where
 121   getSession = Ghc $ \(Session r) -> readIORef r
 122   setSession s' = Ghc $ \(Session r) -> writeIORef r s'
 123
 124 -- | Reflect a computation in the 'Ghc' monad into the 'IO' monad.
 125 --
 126 -- You can use this to call functions returning an action in the 'Ghc' monad
 127 -- inside an 'IO' action.  This is needed for some (too restrictive) callback
 128 -- arguments of some library functions:
 129 --
 130 -- > libFunc :: String -> (Int -> IO a) -> IO a
 131 -- > ghcFunc :: Int -> Ghc a
 132 -- >
 133 -- > ghcFuncUsingLibFunc :: String -> Ghc a -> Ghc a
 134 -- > ghcFuncUsingLibFunc str =
 135 -- >   reifyGhc $ \s ->
 136 -- >     libFunc $ \i -> do
 137 -- >       reflectGhc (ghcFunc i) s
 138 --
 139 reflectGhc :: Ghc a -> Session -> IO a
 140 reflectGhc m = unGhc m
 141
 142 -- > Dual to 'reflectGhc'.  See its documentation.
 143 reifyGhc :: (Session -> IO a) -> Ghc a
 144 reifyGhc act = Ghc $ act
 145
 146 -- -----------------------------------------------------------------------------
 147 -- | A monad transformer to add GHC specific features to another monad.
 148 --
 149 -- Note that the wrapped monad must support IO and handling of exceptions.
 150 newtype GhcT m a = GhcT { unGhcT :: Session -> m a }
 151 liftGhcT :: Monad m => m a -> GhcT m a
 152 liftGhcT m = GhcT $ \_ -> m
 153
 154 instance Functor m => Functor (GhcT m) where
 155   fmap f m = GhcT $ \s -> f `fmap` unGhcT m s
 156
 157 instance Monad m => Monad (GhcT m) where
 158   return x = GhcT $ \_ -> return x
 159   m >>= k  = GhcT $ \s -> do a <- unGhcT m s; unGhcT (k a) s
 160
 161 instance MonadIO m => MonadIO (GhcT m) where
 162   liftIO ioA = GhcT $ \_ -> liftIO ioA
 163
 164 instance ExceptionMonad m => ExceptionMonad (GhcT m) where
 165   gcatch act handle =
 166       GhcT $ \s -> unGhcT act s `gcatch` \e -> unGhcT (handle e) s
 167   gblock (GhcT m) = GhcT $ \s -> gblock (m s)
 168   gunblock (GhcT m) = GhcT $ \s -> gunblock (m s)
 169   gmask f =
 170       GhcT $ \s -> gmask $ \io_restore ->
 171                            let
 172                               g_restore (GhcT m) = GhcT $ \s -> io_restore (m s)
 173                            in
 174                               unGhcT (f g_restore) s
 175
 176 instance (Functor m, ExceptionMonad m, MonadIO m) => GhcMonad (GhcT m) where
 177   getSession = GhcT $ \(Session r) -> liftIO $ readIORef r
 178   setSession s' = GhcT $ \(Session r) -> liftIO $ writeIORef r s'
 179
 180
 181 -- | Print the error message and all warnings.  Useful inside exception
 182 --   handlers.  Clears warnings after printing.
 183 printException :: GhcMonad m => SourceError -> m ()
 184 printException err = do
 185   dflags <- getSessionDynFlags
 186   liftIO $ printBagOfErrors dflags (srcErrorMessages err)
 187
 188 {-# DEPRECATED printExceptionAndWarnings "use printException instead" #-}
 189 printExceptionAndWarnings :: GhcMonad m => SourceError -> m ()
 190 printExceptionAndWarnings = printException
 191
 192 -- | A function called to log warnings and errors.
 193 type WarnErrLogger = GhcMonad m => Maybe SourceError -> m ()
 194
 195 defaultWarnErrLogger :: WarnErrLogger
 196 defaultWarnErrLogger Nothing  = return ()
 197 defaultWarnErrLogger (Just e) = printException e
 198