ghc-session 0.1.1.0 → 0.1.2.0
raw patch · 5 files changed
+96/−28 lines, 5 filesdep +transformers-compat
Dependencies added: transformers-compat
Files
- ghc-session.cabal +5/−3
- src/Language/Haskell/Session.hs +2/−0
- src/Language/Haskell/Session/Instances.hs +61/−0
- src/Language/Haskell/Session/Session.hs +26/−23
- test/Main.hs +2/−2
ghc-session.cabal view
@@ -1,5 +1,5 @@ name: ghc-session-version: 0.1.1.0+version: 0.1.2.0 synopsis: Simplified GHC API description: Simplified GHC API license: MIT@@ -24,7 +24,8 @@ Language.Haskell.Session.Hint.Util Language.Haskell.Session.Binding Language.Haskell.Session.Session- -- other-modules:+ other-modules:+ Language.Haskell.Session.Instances -- other-extensions: default-language: Haskell2010 build-depends: base >=4.7 && <4.9,@@ -32,7 +33,8 @@ ghc, ghc-mtl, ghc-paths,- transformers+ transformers,+ transformers-compat hs-source-dirs: src default-language: Haskell2010
src/Language/Haskell/Session.hs view
@@ -1,9 +1,11 @@ module Language.Haskell.Session ( module Language.Haskell.Session.Session, module Language.Haskell.Session.Binding,+ module Language.Haskell.Session.Instances, module Language.Haskell.Session.Hint.Typecheck, ) where import Language.Haskell.Session.Binding import Language.Haskell.Session.Hint.Typecheck+import Language.Haskell.Session.Instances import Language.Haskell.Session.Session
+ src/Language/Haskell/Session/Instances.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE StandaloneDeriving #-}++module Language.Haskell.Session.Instances (+ module Control.Monad.Ghc,+ module Exception,+ module DynFlags+) where++import Control.Monad.Ghc+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Trans.Except+import DynFlags (HasDynFlags (getDynFlags))+import Exception (ExceptionMonad (gcatch, gmask))+import Control.Monad.Trans.Identity+import Control.Monad.Trans.State+import Control.Monad.Trans.State.Lazy as StateL+import qualified Control.Monad.Catch as Catch+import Control.Monad.Catch++++instance (GhcMonad m, MonadIO m) => GhcMonad (IdentityT m) where+ getSession = lift $ getSession+ setSession = lift . setSession++instance (GhcMonad m, MonadIO m) => GhcMonad (ExceptT e m) where+ getSession = lift $ getSession+ setSession = lift . setSession++instance (GhcMonad m, MonadIO m) => GhcMonad (StateT s m) where+ getSession = lift $ getSession+ setSession = lift . setSession++instance (MonadIO m, ExceptionMonad m) => ExceptionMonad (ExceptT e m) where+ gcatch (ExceptT m) f = ExceptT $ gcatch m (runExceptT . f)+ gmask f = ExceptT $ gmask f' where+ f' g = runExceptT $ f g' where+ g' (ExceptT m)= ExceptT $ g m++instance (MonadIO m, ExceptionMonad m) => ExceptionMonad (IdentityT m) where+ gcatch (IdentityT m) f = IdentityT $ gcatch m (runIdentityT . f)+ gmask f = IdentityT $ gmask f' where+ f' g = runIdentityT $ f g' where+ g' (IdentityT m)= IdentityT $ g m++instance (MonadIO m, ExceptionMonad m) => ExceptionMonad (StateT s m) where+ gcatch m h = StateT $ \ s -> runStateT m s `gcatch` \ e -> runStateT (h e) s+ gmask a = StateT $ \s -> gmask $ \u -> runStateT (a $ q u) s+ where q :: (m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a+ q u (StateT b) = StateT (u . b)++instance (MonadIO m, HasDynFlags m) => HasDynFlags (IdentityT m) where+ getDynFlags = lift $ getDynFlags++instance (MonadIO m, HasDynFlags m) => HasDynFlags (ExceptT e m) where+ getDynFlags = lift $ getDynFlags++instance (MonadIO m, HasDynFlags m) => HasDynFlags (StateT s m) where+ getDynFlags = lift $ getDynFlags
src/Language/Haskell/Session/Session.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE ConstraintKinds #-}+ module Language.Haskell.Session.Session ( -- * Session- Session,+ SessionMonad, run, runWith, @@ -39,16 +41,17 @@ import Control.Monad.IO.Class (liftIO) import Data.Typeable (Typeable) import qualified DynFlags+import GHC (GhcMonad) import qualified GHC+import qualified GHC.Paths as Paths import qualified HscTypes-import qualified GHC.Paths as Paths import Language.Haskell.Config as Config import qualified Language.Haskell.Session.Binding as Binding import qualified Language.Haskell.Session.Hint.Eval as HEval -type Session = MGHC.Ghc+type SessionMonad m = (GhcMonad m, Catch.MonadMask m, Catch.MonadCatch m) type Import = String @@ -57,18 +60,18 @@ -------------------------------------------------------------------------------- -- | Run session with default config.-run :: Session a -> IO a-run session = MGHC.runGhc (Just Paths.libdir) $ initialize >> session+run :: (MGHC.MonadIO m, Catch.MonadMask m, Functor m) => MGHC.GhcT m a -> m a+run session = MGHC.runGhcT (Just Paths.libdir) $ initialize >> session -- | Run session with custom GHC config.-runWith :: Config -> Session a -> IO a+runWith :: Config -> MGHC.Ghc a -> IO a runWith config session = MGHC.runGhc (Just $ Config.topDir config) $ initializeWith config >> session -- | Initialize session with custom GHC config.-initializeWith :: Config -> Session ()+initializeWith :: GhcMonad m => Config -> m () initializeWith config = do initialize let globalPkgDb = Config.global $ Config.pkgDb config@@ -85,7 +88,7 @@ } -- | Initialize session with default config.-initialize :: Session ()+initialize :: GhcMonad m => m () initialize = do setStrFlags ["-fno-ghci-sandbox"] flags <- GHC.getSessionDynFlags@@ -101,7 +104,7 @@ -------------------------------------------------------------------------------- -- | Set ghc command line arguments.-setStrFlags :: [String] -> Session ()+setStrFlags :: GhcMonad m => [String] -> m () setStrFlags strFlags = do flags <- GHC.getInteractiveDynFlags (flags2, leftovers, warns) <- GHC.parseDynamicFlags flags $ map GHC.noLoc strFlags@@ -116,12 +119,12 @@ -------------------------------------------------------------------------------- -- | Set imports and replace existing ones.-setImports :: [Import] -> Session ()+setImports :: GhcMonad m => [Import] -> m () setImports = GHC.setContext . map (GHC.IIDecl . GHC.simpleImportDecl . GHC.mkModuleName) -- | Run a code with temporary imports.-withImports :: [Import] -> Session a -> Session a+withImports :: (Catch.MonadMask m, GhcMonad m) => [Import] -> m a -> m a withImports imports action = sandboxContext $ do setImports imports action@@ -135,19 +138,19 @@ -------------------------------------------------------------------------------- -- | Set GHC extension flags.-setFlags :: [DynFlags.ExtensionFlag] -> Session ()+setFlags :: GhcMonad m => [DynFlags.ExtensionFlag] -> m () setFlags flags = do current <- GHC.getSessionDynFlags void $ GHC.setSessionDynFlags $ foldl DynFlags.xopt_set current flags -- | Unset GHC extension flags.-unsetFlags :: [DynFlags.ExtensionFlag] -> Session ()+unsetFlags :: GhcMonad m => [DynFlags.ExtensionFlag] -> m () unsetFlags flags = do current <- GHC.getSessionDynFlags void $ GHC.setSessionDynFlags $ foldl DynFlags.xopt_unset current flags -- | Run a code with temporary GHC extension flags.-withExtensionFlags :: [DynFlags.ExtensionFlag] -> [DynFlags.ExtensionFlag] -> Session a -> Session a+withExtensionFlags :: (Catch.MonadMask m, GhcMonad m) => [DynFlags.ExtensionFlag] -> [DynFlags.ExtensionFlag] -> m a -> m a withExtensionFlags enable disable action = sandboxDynFlags $ do setFlags enable unsetFlags disable@@ -158,7 +161,7 @@ -------------------------------------------------------------------------------- -- | Run statement as in ghci.-runStmt :: String -> Session ()+runStmt :: (Catch.MonadCatch m, GhcMonad m) => String -> m () runStmt stmt = do result <- interceptErrors $ GHC.runStmtWithLocation location 1 stmt GHC.RunToCompletion case result of@@ -167,27 +170,27 @@ GHC.RunBreak {} -> fail $ "runStmt : RunBreak" -- | Run declaration as in Haskell source file.-runDecls :: String -> Session ()+runDecls :: (Catch.MonadCatch m, GhcMonad m) => String -> m () runDecls decls = do void $ interceptErrors $ GHC.runDeclsWithLocation location 1 decls -- | Bind expression do a variable using `let` syntax.-runAssignment :: String -> String -> Session ()+runAssignment :: (Catch.MonadCatch m, GhcMonad m) => String -> String -> m () runAssignment asigned asignee = do Binding.removeBinding asigned -- do not use runDecls here: its bindings are hard to remove and cause memory leaks! runStmt $ "let " ++ asigned ++ " = " ++ asignee -- | Bind expression to a variable using `bind` syntax. Expression must have type `IO a`.-runAssignment' :: String -> String -> Session ()+runAssignment' :: (Catch.MonadCatch m, GhcMonad m) => String -> String -> m () runAssignment' asigned asignee = do Binding.removeBinding asigned runStmt $ asigned ++ " <- " ++ asignee -- | Evaluate expression.-interpret :: Typeable a => String -> Session a+interpret :: (Catch.MonadCatch m, GhcMonad m) => Typeable a => String -> m a interpret = interceptErrors . HEval.interpret --------------------------------------------------------------------------------@@ -195,20 +198,20 @@ -------------------------------------------------------------------------------- -- | Run a code which can safely modify DynFlags - it will be restored on exit.-sandboxDynFlags :: Session a -> Session a+sandboxDynFlags :: (Catch.MonadMask m, GhcMonad m) => m a -> m a sandboxDynFlags = bracket GHC.getSessionDynFlags GHC.setSessionDynFlags . const -- | Run a code which can safely modify Context w- it will be restored on exit.-sandboxContext :: Session a -> Session a+sandboxContext :: (Catch.MonadMask m, GhcMonad m) => m a -> m a sandboxContext = bracket GHC.getContext GHC.setContext . const -- | Restore session when exception will be raised.-interceptErrors :: MGHC.Ghc a -> Session a+interceptErrors :: (Catch.MonadCatch m, GhcMonad m) => m a -> m a interceptErrors ghc = do sessionBackup <- GHC.getSession- let handler :: Catch.SomeException -> MGHC.Ghc a+ let handler ::(Catch.MonadCatch m, GhcMonad m) => Catch.SomeException -> m a handler otherErr = do GHC.setSession sessionBackup Exception.throw otherErr
test/Main.hs view
@@ -1,10 +1,10 @@ module Main where +import Control.Monad.IO.Class (liftIO) import qualified Language.Haskell.Session as Session-import Control.Monad.IO.Class (liftIO) -+main :: IO () main = Session.run $ do Session.setImports ["Prelude"] Session.runAssignment "x" "5"