Add a class HasDynFlags(getDynFlags)
[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, HasDynFlags m) => GhcMonad m where
50 getSession :: m HscEnv
51 setSession :: HscEnv -> m ()
52
53 -- | Call the argument with the current session.
54 withSession :: GhcMonad m => (HscEnv -> m a) -> m a
55 withSession f = getSession >>= f
56
57 -- | Grabs the DynFlags from the Session
58 getSessionDynFlags :: GhcMonad m => m DynFlags
59 getSessionDynFlags = withSession (return . hsc_dflags)
60
61 -- | Set the current session to the result of applying the current session to
62 -- the argument.
63 modifySession :: GhcMonad m => (HscEnv -> HscEnv) -> m ()
64 modifySession f = do h <- getSession
65 setSession $! f h
66
67 withSavedSession :: GhcMonad m => m a -> m a
68 withSavedSession m = do
69 saved_session <- getSession
70 m `gfinally` setSession saved_session
71
72 -- | Call an action with a temporarily modified Session.
73 withTempSession :: GhcMonad m => (HscEnv -> HscEnv) -> m a -> m a
74 withTempSession f m =
75 withSavedSession $ modifySession f >> m
76
77 -- -----------------------------------------------------------------------------
78 -- | A monad that allows logging of warnings.
79
80 logWarnings :: GhcMonad m => WarningMessages -> m ()
81 logWarnings warns = do
82 dflags <- getSessionDynFlags
83 liftIO $ printOrThrowWarnings dflags warns
84
85 -- -----------------------------------------------------------------------------
86 -- | A minimal implementation of a 'GhcMonad'. If you need a custom monad,
87 -- e.g., to maintain additional state consider wrapping this monad or using
88 -- 'GhcT'.
89 newtype Ghc a = Ghc { unGhc :: Session -> IO a }
90
91 -- | The Session is a handle to the complete state of a compilation
92 -- session. A compilation session consists of a set of modules
93 -- constituting the current program or library, the context for
94 -- interactive evaluation, and various caches.
95 data Session = Session !(IORef HscEnv)
96
97 instance Functor Ghc where
98 fmap f m = Ghc $ \s -> f `fmap` unGhc m s
99
100 instance Monad Ghc where
101 return a = Ghc $ \_ -> return a
102 m >>= g = Ghc $ \s -> do a <- unGhc m s; unGhc (g a) s
103
104 instance MonadIO Ghc where
105 liftIO ioA = Ghc $ \_ -> ioA
106
107 instance MonadFix Ghc where
108 mfix f = Ghc $ \s -> mfix (\x -> unGhc (f x) s)
109
110 instance ExceptionMonad Ghc where
111 gcatch act handle =
112 Ghc $ \s -> unGhc act s `gcatch` \e -> unGhc (handle e) s
113 gblock (Ghc m) = Ghc $ \s -> gblock (m s)
114 gunblock (Ghc m) = Ghc $ \s -> gunblock (m s)
115 gmask f =
116 Ghc $ \s -> gmask $ \io_restore ->
117 let
118 g_restore (Ghc m) = Ghc $ \s -> io_restore (m s)
119 in
120 unGhc (f g_restore) s
121
122 instance HasDynFlags Ghc where
123 getDynFlags = getSessionDynFlags
124
125 instance GhcMonad Ghc where
126 getSession = Ghc $ \(Session r) -> readIORef r
127 setSession s' = Ghc $ \(Session r) -> writeIORef r s'
128
129 -- | Reflect a computation in the 'Ghc' monad into the 'IO' monad.
130 --
131 -- You can use this to call functions returning an action in the 'Ghc' monad
132 -- inside an 'IO' action. This is needed for some (too restrictive) callback
133 -- arguments of some library functions:
134 --
135 -- > libFunc :: String -> (Int -> IO a) -> IO a
136 -- > ghcFunc :: Int -> Ghc a
137 -- >
138 -- > ghcFuncUsingLibFunc :: String -> Ghc a -> Ghc a
139 -- > ghcFuncUsingLibFunc str =
140 -- > reifyGhc $ \s ->
141 -- > libFunc $ \i -> do
142 -- > reflectGhc (ghcFunc i) s
143 --
144 reflectGhc :: Ghc a -> Session -> IO a
145 reflectGhc m = unGhc m
146
147 -- > Dual to 'reflectGhc'. See its documentation.
148 reifyGhc :: (Session -> IO a) -> Ghc a
149 reifyGhc act = Ghc $ act
150
151 -- -----------------------------------------------------------------------------
152 -- | A monad transformer to add GHC specific features to another monad.
153 --
154 -- Note that the wrapped monad must support IO and handling of exceptions.
155 newtype GhcT m a = GhcT { unGhcT :: Session -> m a }
156 liftGhcT :: Monad m => m a -> GhcT m a
157 liftGhcT m = GhcT $ \_ -> m
158
159 instance Functor m => Functor (GhcT m) where
160 fmap f m = GhcT $ \s -> f `fmap` unGhcT m s
161
162 instance Monad m => Monad (GhcT m) where
163 return x = GhcT $ \_ -> return x
164 m >>= k = GhcT $ \s -> do a <- unGhcT m s; unGhcT (k a) s
165
166 instance MonadIO m => MonadIO (GhcT m) where
167 liftIO ioA = GhcT $ \_ -> liftIO ioA
168
169 instance ExceptionMonad m => ExceptionMonad (GhcT m) where
170 gcatch act handle =
171 GhcT $ \s -> unGhcT act s `gcatch` \e -> unGhcT (handle e) s
172 gblock (GhcT m) = GhcT $ \s -> gblock (m s)
173 gunblock (GhcT m) = GhcT $ \s -> gunblock (m s)
174 gmask f =
175 GhcT $ \s -> gmask $ \io_restore ->
176 let
177 g_restore (GhcT m) = GhcT $ \s -> io_restore (m s)
178 in
179 unGhcT (f g_restore) s
180
181 instance (Functor m, ExceptionMonad m, MonadIO m) => HasDynFlags (GhcT m) where
182 getDynFlags = getSessionDynFlags
183
184 instance (Functor m, ExceptionMonad m, MonadIO m) => GhcMonad (GhcT m) where
185 getSession = GhcT $ \(Session r) -> liftIO $ readIORef r
186 setSession s' = GhcT $ \(Session r) -> liftIO $ writeIORef r s'
187
188
189 -- | Print the error message and all warnings. Useful inside exception
190 -- handlers. Clears warnings after printing.
191 printException :: GhcMonad m => SourceError -> m ()
192 printException err = do
193 dflags <- getSessionDynFlags
194 liftIO $ printBagOfErrors dflags (srcErrorMessages err)
195
196 {-# DEPRECATED printExceptionAndWarnings "use printException instead" #-}
197 printExceptionAndWarnings :: GhcMonad m => SourceError -> m ()
198 printExceptionAndWarnings = printException
199
200 -- | A function called to log warnings and errors.
201 type WarnErrLogger = GhcMonad m => Maybe SourceError -> m ()
202
203 defaultWarnErrLogger :: WarnErrLogger
204 defaultWarnErrLogger Nothing = return ()
205 defaultWarnErrLogger (Just e) = printException e
206