{-# LANGUAGE CPP, RankNTypes #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
-- -----------------------------------------------------------------------------
--
-- (c) The University of Glasgow, 2010
--
-- The Session type and related functionality
--
-- -----------------------------------------------------------------------------

module GhcMonad (
        -- * 'Ghc' monad stuff
        GhcMonad(..),
        Ghc(..),
        GhcT(..), liftGhcT,
        reflectGhc, reifyGhc,
        getSessionDynFlags,
        liftIO,
        Session(..), withSession, modifySession, withTempSession,

        -- ** Warnings
        logWarnings, printException,
        WarnErrLogger, defaultWarnErrLogger
  ) where

import GhcPrelude

import MonadUtils
import HscTypes
import DynFlags
import Exception
import ErrUtils

import Control.Monad
import Data.IORef

-- -----------------------------------------------------------------------------
-- | A monad that has all the features needed by GHC API calls.
--
-- In short, a GHC monad
--
--   - allows embedding of IO actions,
--
--   - can log warnings,
--
--   - allows handling of (extensible) exceptions, and
--
--   - maintains a current session.
--
-- If you do not use 'Ghc' or 'GhcT', make sure to call 'GHC.initGhcMonad'
-- before any call to the GHC API functions can occur.
--
class (Functor m, MonadIO m, ExceptionMonad m, HasDynFlags m) => GhcMonad m where
  getSession :: m HscEnv
  setSession :: HscEnv -> m ()

-- | Call the argument with the current session.
withSession :: GhcMonad m => (HscEnv -> m a) -> m a
withSession :: (HscEnv -> m a) -> m a
withSession f :: HscEnv -> m a
f = m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession m HscEnv -> (HscEnv -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HscEnv -> m a
f

-- | Grabs the DynFlags from the Session
getSessionDynFlags :: GhcMonad m => m DynFlags
getSessionDynFlags :: m DynFlags
getSessionDynFlags = (HscEnv -> m DynFlags) -> m DynFlags
forall (m :: * -> *) a. GhcMonad m => (HscEnv -> m a) -> m a
withSession (DynFlags -> m DynFlags
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags -> m DynFlags)
-> (HscEnv -> DynFlags) -> HscEnv -> m DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> DynFlags
hsc_dflags)

-- | Set the current session to the result of applying the current session to
-- the argument.
modifySession :: GhcMonad m => (HscEnv -> HscEnv) -> m ()
modifySession :: (HscEnv -> HscEnv) -> m ()
modifySession f :: HscEnv -> HscEnv
f = do HscEnv
h <- m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
                     HscEnv -> m ()
forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
setSession (HscEnv -> m ()) -> HscEnv -> m ()
forall a b. (a -> b) -> a -> b
$! HscEnv -> HscEnv
f HscEnv
h

withSavedSession :: GhcMonad m => m a -> m a
withSavedSession :: m a -> m a
withSavedSession m :: m a
m = do
  HscEnv
saved_session <- m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
  m a
m m a -> m () -> m a
forall (m :: * -> *) a b. ExceptionMonad m => m a -> m b -> m a
`gfinally` HscEnv -> m ()
forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
setSession HscEnv
saved_session

-- | Call an action with a temporarily modified Session.
withTempSession :: GhcMonad m => (HscEnv -> HscEnv) -> m a -> m a
withTempSession :: (HscEnv -> HscEnv) -> m a -> m a
withTempSession f :: HscEnv -> HscEnv
f m :: m a
m =
  m a -> m a
forall (m :: * -> *) a. GhcMonad m => m a -> m a
withSavedSession (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ (HscEnv -> HscEnv) -> m ()
forall (m :: * -> *). GhcMonad m => (HscEnv -> HscEnv) -> m ()
modifySession HscEnv -> HscEnv
f m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m a
m

-- -----------------------------------------------------------------------------
-- | A monad that allows logging of warnings.

logWarnings :: GhcMonad m => WarningMessages -> m ()
logWarnings :: WarningMessages -> m ()
logWarnings warns :: WarningMessages
warns = do
  DynFlags
dflags <- m DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> WarningMessages -> IO ()
printOrThrowWarnings DynFlags
dflags WarningMessages
warns

-- -----------------------------------------------------------------------------
-- | A minimal implementation of a 'GhcMonad'.  If you need a custom monad,
-- e.g., to maintain additional state consider wrapping this monad or using
-- 'GhcT'.
newtype Ghc a = Ghc { Ghc a -> Session -> IO a
unGhc :: Session -> IO a }

-- | The Session is a handle to the complete state of a compilation
-- session.  A compilation session consists of a set of modules
-- constituting the current program or library, the context for
-- interactive evaluation, and various caches.
data Session = Session !(IORef HscEnv)

instance Functor Ghc where
  fmap :: (a -> b) -> Ghc a -> Ghc b
fmap f :: a -> b
f m :: Ghc a
m = (Session -> IO b) -> Ghc b
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO b) -> Ghc b) -> (Session -> IO b) -> Ghc b
forall a b. (a -> b) -> a -> b
$ \s :: Session
s -> a -> b
f (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ghc a -> Session -> IO a
forall a. Ghc a -> Session -> IO a
unGhc Ghc a
m Session
s

instance Applicative Ghc where
  pure :: a -> Ghc a
pure a :: a
a = (Session -> IO a) -> Ghc a
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO a) -> Ghc a) -> (Session -> IO a) -> Ghc a
forall a b. (a -> b) -> a -> b
$ \_ -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  g :: Ghc (a -> b)
g <*> :: Ghc (a -> b) -> Ghc a -> Ghc b
<*> m :: Ghc a
m = do a -> b
f <- Ghc (a -> b)
g; a
a <- Ghc a
m; b -> Ghc b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
a)

instance Monad Ghc where
  m :: Ghc a
m >>= :: Ghc a -> (a -> Ghc b) -> Ghc b
>>= g :: a -> Ghc b
g  = (Session -> IO b) -> Ghc b
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO b) -> Ghc b) -> (Session -> IO b) -> Ghc b
forall a b. (a -> b) -> a -> b
$ \s :: Session
s -> do a
a <- Ghc a -> Session -> IO a
forall a. Ghc a -> Session -> IO a
unGhc Ghc a
m Session
s; Ghc b -> Session -> IO b
forall a. Ghc a -> Session -> IO a
unGhc (a -> Ghc b
g a
a) Session
s

instance MonadIO Ghc where
  liftIO :: IO a -> Ghc a
liftIO ioA :: IO a
ioA = (Session -> IO a) -> Ghc a
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO a) -> Ghc a) -> (Session -> IO a) -> Ghc a
forall a b. (a -> b) -> a -> b
$ \_ -> IO a
ioA

instance MonadFix Ghc where
  mfix :: (a -> Ghc a) -> Ghc a
mfix f :: a -> Ghc a
f = (Session -> IO a) -> Ghc a
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO a) -> Ghc a) -> (Session -> IO a) -> Ghc a
forall a b. (a -> b) -> a -> b
$ \s :: Session
s -> (a -> IO a) -> IO a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (\x :: a
x -> Ghc a -> Session -> IO a
forall a. Ghc a -> Session -> IO a
unGhc (a -> Ghc a
f a
x) Session
s)

instance ExceptionMonad Ghc where
  gcatch :: Ghc a -> (e -> Ghc a) -> Ghc a
gcatch act :: Ghc a
act handle :: e -> Ghc a
handle =
      (Session -> IO a) -> Ghc a
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO a) -> Ghc a) -> (Session -> IO a) -> Ghc a
forall a b. (a -> b) -> a -> b
$ \s :: Session
s -> Ghc a -> Session -> IO a
forall a. Ghc a -> Session -> IO a
unGhc Ghc a
act Session
s IO a -> (e -> IO a) -> IO a
forall (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
m a -> (e -> m a) -> m a
`gcatch` \e :: e
e -> Ghc a -> Session -> IO a
forall a. Ghc a -> Session -> IO a
unGhc (e -> Ghc a
handle e
e) Session
s
  gmask :: ((Ghc a -> Ghc a) -> Ghc b) -> Ghc b
gmask f :: (Ghc a -> Ghc a) -> Ghc b
f =
      (Session -> IO b) -> Ghc b
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO b) -> Ghc b) -> (Session -> IO b) -> Ghc b
forall a b. (a -> b) -> a -> b
$ \s :: Session
s -> ((IO a -> IO a) -> IO b) -> IO b
forall (m :: * -> *) a b.
ExceptionMonad m =>
((m a -> m a) -> m b) -> m b
gmask (((IO a -> IO a) -> IO b) -> IO b)
-> ((IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \io_restore :: IO a -> IO a
io_restore ->
                             let
                                g_restore :: Ghc a -> Ghc a
g_restore (Ghc m :: Session -> IO a
m) = (Session -> IO a) -> Ghc a
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO a) -> Ghc a) -> (Session -> IO a) -> Ghc a
forall a b. (a -> b) -> a -> b
$ \s :: Session
s -> IO a -> IO a
io_restore (Session -> IO a
m Session
s)
                             in
                                Ghc b -> Session -> IO b
forall a. Ghc a -> Session -> IO a
unGhc ((Ghc a -> Ghc a) -> Ghc b
f Ghc a -> Ghc a
g_restore) Session
s

instance HasDynFlags Ghc where
  getDynFlags :: Ghc DynFlags
getDynFlags = Ghc DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags

instance GhcMonad Ghc where
  getSession :: Ghc HscEnv
getSession = (Session -> IO HscEnv) -> Ghc HscEnv
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO HscEnv) -> Ghc HscEnv)
-> (Session -> IO HscEnv) -> Ghc HscEnv
forall a b. (a -> b) -> a -> b
$ \(Session r :: IORef HscEnv
r) -> IORef HscEnv -> IO HscEnv
forall a. IORef a -> IO a
readIORef IORef HscEnv
r
  setSession :: HscEnv -> Ghc ()
setSession s' :: HscEnv
s' = (Session -> IO ()) -> Ghc ()
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO ()) -> Ghc ()) -> (Session -> IO ()) -> Ghc ()
forall a b. (a -> b) -> a -> b
$ \(Session r :: IORef HscEnv
r) -> IORef HscEnv -> HscEnv -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef HscEnv
r HscEnv
s'

-- | Reflect a computation in the 'Ghc' monad into the 'IO' monad.
--
-- You can use this to call functions returning an action in the 'Ghc' monad
-- inside an 'IO' action.  This is needed for some (too restrictive) callback
-- arguments of some library functions:
--
-- > libFunc :: String -> (Int -> IO a) -> IO a
-- > ghcFunc :: Int -> Ghc a
-- >
-- > ghcFuncUsingLibFunc :: String -> Ghc a -> Ghc a
-- > ghcFuncUsingLibFunc str =
-- >   reifyGhc $ \s ->
-- >     libFunc $ \i -> do
-- >       reflectGhc (ghcFunc i) s
--
reflectGhc :: Ghc a -> Session -> IO a
reflectGhc :: Ghc a -> Session -> IO a
reflectGhc m :: Ghc a
m = Ghc a -> Session -> IO a
forall a. Ghc a -> Session -> IO a
unGhc Ghc a
m

-- > Dual to 'reflectGhc'.  See its documentation.
reifyGhc :: (Session -> IO a) -> Ghc a
reifyGhc :: (Session -> IO a) -> Ghc a
reifyGhc act :: Session -> IO a
act = (Session -> IO a) -> Ghc a
forall a. (Session -> IO a) -> Ghc a
Ghc ((Session -> IO a) -> Ghc a) -> (Session -> IO a) -> Ghc a
forall a b. (a -> b) -> a -> b
$ Session -> IO a
act

-- -----------------------------------------------------------------------------
-- | A monad transformer to add GHC specific features to another monad.
--
-- Note that the wrapped monad must support IO and handling of exceptions.
newtype GhcT m a = GhcT { GhcT m a -> Session -> m a
unGhcT :: Session -> m a }

liftGhcT :: m a -> GhcT m a
liftGhcT :: m a -> GhcT m a
liftGhcT m :: m a
m = (Session -> m a) -> GhcT m a
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m a) -> GhcT m a) -> (Session -> m a) -> GhcT m a
forall a b. (a -> b) -> a -> b
$ \_ -> m a
m

instance Functor m => Functor (GhcT m) where
  fmap :: (a -> b) -> GhcT m a -> GhcT m b
fmap f :: a -> b
f m :: GhcT m a
m = (Session -> m b) -> GhcT m b
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m b) -> GhcT m b) -> (Session -> m b) -> GhcT m b
forall a b. (a -> b) -> a -> b
$ \s :: Session
s -> a -> b
f (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` GhcT m a -> Session -> m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT GhcT m a
m Session
s

instance Applicative m => Applicative (GhcT m) where
  pure :: a -> GhcT m a
pure x :: a
x  = (Session -> m a) -> GhcT m a
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m a) -> GhcT m a) -> (Session -> m a) -> GhcT m a
forall a b. (a -> b) -> a -> b
$ \_ -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
  g :: GhcT m (a -> b)
g <*> :: GhcT m (a -> b) -> GhcT m a -> GhcT m b
<*> m :: GhcT m a
m = (Session -> m b) -> GhcT m b
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m b) -> GhcT m b) -> (Session -> m b) -> GhcT m b
forall a b. (a -> b) -> a -> b
$ \s :: Session
s -> GhcT m (a -> b) -> Session -> m (a -> b)
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT GhcT m (a -> b)
g Session
s m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GhcT m a -> Session -> m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT GhcT m a
m Session
s

instance Monad m => Monad (GhcT m) where
  m :: GhcT m a
m >>= :: GhcT m a -> (a -> GhcT m b) -> GhcT m b
>>= k :: a -> GhcT m b
k  = (Session -> m b) -> GhcT m b
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m b) -> GhcT m b) -> (Session -> m b) -> GhcT m b
forall a b. (a -> b) -> a -> b
$ \s :: Session
s -> do a
a <- GhcT m a -> Session -> m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT GhcT m a
m Session
s; GhcT m b -> Session -> m b
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT (a -> GhcT m b
k a
a) Session
s

instance MonadIO m => MonadIO (GhcT m) where
  liftIO :: IO a -> GhcT m a
liftIO ioA :: IO a
ioA = (Session -> m a) -> GhcT m a
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m a) -> GhcT m a) -> (Session -> m a) -> GhcT m a
forall a b. (a -> b) -> a -> b
$ \_ -> IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
ioA

instance ExceptionMonad m => ExceptionMonad (GhcT m) where
  gcatch :: GhcT m a -> (e -> GhcT m a) -> GhcT m a
gcatch act :: GhcT m a
act handle :: e -> GhcT m a
handle =
      (Session -> m a) -> GhcT m a
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m a) -> GhcT m a) -> (Session -> m a) -> GhcT m a
forall a b. (a -> b) -> a -> b
$ \s :: Session
s -> GhcT m a -> Session -> m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT GhcT m a
act Session
s m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
m a -> (e -> m a) -> m a
`gcatch` \e :: e
e -> GhcT m a -> Session -> m a
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT (e -> GhcT m a
handle e
e) Session
s
  gmask :: ((GhcT m a -> GhcT m a) -> GhcT m b) -> GhcT m b
gmask f :: (GhcT m a -> GhcT m a) -> GhcT m b
f =
      (Session -> m b) -> GhcT m b
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m b) -> GhcT m b) -> (Session -> m b) -> GhcT m b
forall a b. (a -> b) -> a -> b
$ \s :: Session
s -> ((m a -> m a) -> m b) -> m b
forall (m :: * -> *) a b.
ExceptionMonad m =>
((m a -> m a) -> m b) -> m b
gmask (((m a -> m a) -> m b) -> m b) -> ((m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \io_restore :: m a -> m a
io_restore ->
                           let
                              g_restore :: GhcT m a -> GhcT m a
g_restore (GhcT m :: Session -> m a
m) = (Session -> m a) -> GhcT m a
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m a) -> GhcT m a) -> (Session -> m a) -> GhcT m a
forall a b. (a -> b) -> a -> b
$ \s :: Session
s -> m a -> m a
io_restore (Session -> m a
m Session
s)
                           in
                              GhcT m b -> Session -> m b
forall (m :: * -> *) a. GhcT m a -> Session -> m a
unGhcT ((GhcT m a -> GhcT m a) -> GhcT m b
f GhcT m a -> GhcT m a
g_restore) Session
s

instance MonadIO m => HasDynFlags (GhcT m) where
  getDynFlags :: GhcT m DynFlags
getDynFlags = (Session -> m DynFlags) -> GhcT m DynFlags
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m DynFlags) -> GhcT m DynFlags)
-> (Session -> m DynFlags) -> GhcT m DynFlags
forall a b. (a -> b) -> a -> b
$ \(Session r :: IORef HscEnv
r) -> (HscEnv -> DynFlags) -> m HscEnv -> m DynFlags
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM HscEnv -> DynFlags
hsc_dflags (IO HscEnv -> m HscEnv
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HscEnv -> m HscEnv) -> IO HscEnv -> m HscEnv
forall a b. (a -> b) -> a -> b
$ IORef HscEnv -> IO HscEnv
forall a. IORef a -> IO a
readIORef IORef HscEnv
r)

instance ExceptionMonad m => GhcMonad (GhcT m) where
  getSession :: GhcT m HscEnv
getSession = (Session -> m HscEnv) -> GhcT m HscEnv
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m HscEnv) -> GhcT m HscEnv)
-> (Session -> m HscEnv) -> GhcT m HscEnv
forall a b. (a -> b) -> a -> b
$ \(Session r :: IORef HscEnv
r) -> IO HscEnv -> m HscEnv
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HscEnv -> m HscEnv) -> IO HscEnv -> m HscEnv
forall a b. (a -> b) -> a -> b
$ IORef HscEnv -> IO HscEnv
forall a. IORef a -> IO a
readIORef IORef HscEnv
r
  setSession :: HscEnv -> GhcT m ()
setSession s' :: HscEnv
s' = (Session -> m ()) -> GhcT m ()
forall (m :: * -> *) a. (Session -> m a) -> GhcT m a
GhcT ((Session -> m ()) -> GhcT m ()) -> (Session -> m ()) -> GhcT m ()
forall a b. (a -> b) -> a -> b
$ \(Session r :: IORef HscEnv
r) -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef HscEnv -> HscEnv -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef HscEnv
r HscEnv
s'


-- | Print the error message and all warnings.  Useful inside exception
--   handlers.  Clears warnings after printing.
printException :: GhcMonad m => SourceError -> m ()
printException :: SourceError -> m ()
printException err :: SourceError
err = do
  DynFlags
dflags <- m DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> WarningMessages -> IO ()
printBagOfErrors DynFlags
dflags (SourceError -> WarningMessages
srcErrorMessages SourceError
err)

-- | A function called to log warnings and errors.
type WarnErrLogger = forall m. GhcMonad m => Maybe SourceError -> m ()

defaultWarnErrLogger :: WarnErrLogger
defaultWarnErrLogger :: Maybe SourceError -> m ()
defaultWarnErrLogger Nothing  = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
defaultWarnErrLogger (Just e :: SourceError
e) = SourceError -> m ()
forall (m :: * -> *). GhcMonad m => SourceError -> m ()
printException SourceError
e