Remove Alternative class constraint from withGhc

This commit is contained in:
Daniel Gröber 2014-04-18 03:55:49 +02:00
parent e3798ac82a
commit dc43d600dc

View File

@ -16,7 +16,7 @@ import Language.Haskell.GhcMod.ErrMsg
import Language.Haskell.GhcMod.GHCChoice import Language.Haskell.GhcMod.GHCChoice
import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.GhcPkg
import Control.Applicative (Alternative, (<$>)) import Control.Applicative ((<$>))
import Control.Monad (void, forM) import Control.Monad (void, forM)
import CoreMonad (liftIO) import CoreMonad (liftIO)
import Data.Maybe (isJust, fromJust) import Data.Maybe (isJust, fromJust)
@ -44,21 +44,21 @@ getSystemLibDir = do
---------------------------------------------------------------- ----------------------------------------------------------------
-- | Converting the 'Ghc' monad to the 'IO' monad. -- | Converting the 'Ghc' monad to the 'IO' monad.
withGHCDummyFile :: Alternative m => Ghc (m a) -- ^ 'Ghc' actions created by the Ghc utilities. withGHCDummyFile :: Ghc a -- ^ 'Ghc' actions created by the Ghc utilities.
-> IO (m a) -> IO a
withGHCDummyFile = withGHC "Dummy" withGHCDummyFile = withGHC "Dummy"
-- | Converting the 'Ghc' monad to the 'IO' monad. -- | Converting the 'Ghc' monad to the 'IO' monad.
withGHC :: Alternative m => FilePath -- ^ A target file displayed in an error message. withGHC :: FilePath -- ^ A target file displayed in an error message.
-> Ghc (m a) -- ^ 'Ghc' actions created by the Ghc utilities. -> Ghc a -- ^ 'Ghc' actions created by the Ghc utilities.
-> IO (m a) -> IO a
withGHC file body = do withGHC file body = do
mlibdir <- getSystemLibDir mlibdir <- getSystemLibDir
ghandle ignore $ G.runGhc mlibdir $ do ghandle ignore $ G.runGhc mlibdir $ do
dflags <- G.getSessionDynFlags dflags <- G.getSessionDynFlags
G.defaultCleanupHandler dflags body G.defaultCleanupHandler dflags body
where where
ignore :: Alternative m => SomeException -> IO (m a) ignore :: SomeException -> IO a
ignore e = do ignore e = do
hPutStr stderr $ file ++ ":0:0:Error:" hPutStr stderr $ file ++ ":0:0:Error:"
hPrint stderr e hPrint stderr e