816cc4b9224de3cea2a8a3237b1952b26c3cddae
[ghc.git] / 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 MonadFix Ghc where
109 mfix f = Ghc $ \s -> mfix (\x -> unGhc (f x) s)
110
111 instance ExceptionMonad Ghc where
112 gcatch act handle =
113 Ghc $ \s -> unGhc act s `gcatch` \e -> unGhc (handle e) s
114 gblock (Ghc m) = Ghc $ \s -> gblock (m s)
115 gunblock (Ghc m) = Ghc $ \s -> gunblock (m s)
116 gmask f =
117 Ghc $ \s -> gmask $ \io_restore ->
118 let
119 g_restore (Ghc m) = Ghc $ \s -> io_restore (m s)
120 in
121 unGhc (f g_restore) s
122
123 instance GhcMonad Ghc where
124 getSession = Ghc $ \(Session r) -> readIORef r
125 setSession s' = Ghc $ \(Session r) -> writeIORef r s'
126
127 -- | Reflect a computation in the 'Ghc' monad into the 'IO' monad.
128 --
129 -- You can use this to call functions returning an action in the 'Ghc' monad
130 -- inside an 'IO' action. This is needed for some (too restrictive) callback
131 -- arguments of some library functions:
132 --
133 -- > libFunc :: String -> (Int -> IO a) -> IO a
134 -- > ghcFunc :: Int -> Ghc a
135 -- >
136 -- > ghcFuncUsingLibFunc :: String -> Ghc a -> Ghc a
137 -- > ghcFuncUsingLibFunc str =
138 -- > reifyGhc $ \s ->
139 -- > libFunc $ \i -> do
140 -- > reflectGhc (ghcFunc i) s
141 --
142 reflectGhc :: Ghc a -> Session -> IO a
143 reflectGhc m = unGhc m
144
145 -- > Dual to 'reflectGhc'. See its documentation.
146 reifyGhc :: (Session -> IO a) -> Ghc a
147 reifyGhc act = Ghc $ act
148
149 -- -----------------------------------------------------------------------------
150 -- | A monad transformer to add GHC specific features to another monad.
151 --
152 -- Note that the wrapped monad must support IO and handling of exceptions.
153 newtype GhcT m a = GhcT { unGhcT :: Session -> m a }
154 liftGhcT :: Monad m => m a -> GhcT m a
155 liftGhcT m = GhcT $ \_ -> m
156
157 instance Functor m => Functor (GhcT m) where
158 fmap f m = GhcT $ \s -> f `fmap` unGhcT m s
159
160 instance Monad m => Monad (GhcT m) where
161 return x = GhcT $ \_ -> return x
162 m >>= k = GhcT $ \s -> do a <- unGhcT m s; unGhcT (k a) s
163
164 instance MonadIO m => MonadIO (GhcT m) where
165 liftIO ioA = GhcT $ \_ -> liftIO ioA
166
167 instance ExceptionMonad m => ExceptionMonad (GhcT m) where
168 gcatch act handle =
169 GhcT $ \s -> unGhcT act s `gcatch` \e -> unGhcT (handle e) s
170 gblock (GhcT m) = GhcT $ \s -> gblock (m s)
171 gunblock (GhcT m) = GhcT $ \s -> gunblock (m s)
172 gmask f =
173 GhcT $ \s -> gmask $ \io_restore ->
174 let
175 g_restore (GhcT m) = GhcT $ \s -> io_restore (m s)
176 in
177 unGhcT (f g_restore) s
178
179 instance (Functor m, ExceptionMonad m, MonadIO m) => GhcMonad (GhcT m) where
180 getSession = GhcT $ \(Session r) -> liftIO $ readIORef r
181 setSession s' = GhcT $ \(Session r) -> liftIO $ writeIORef r s'
182
183
184 -- | Print the error message and all warnings. Useful inside exception
185 -- handlers. Clears warnings after printing.
186 printException :: GhcMonad m => SourceError -> m ()
187 printException err = do
188 dflags <- getSessionDynFlags
189 liftIO $ printBagOfErrors dflags (srcErrorMessages err)
190
191 {-# DEPRECATED printExceptionAndWarnings "use printException instead" #-}
192 printExceptionAndWarnings :: GhcMonad m => SourceError -> m ()
193 printExceptionAndWarnings = printException
194
195 -- | A function called to log warnings and errors.
196 type WarnErrLogger = GhcMonad m => Maybe SourceError -> m ()
197
198 defaultWarnErrLogger :: WarnErrLogger
199 defaultWarnErrLogger Nothing = return ()
200 defaultWarnErrLogger (Just e) = printException e
201