Give readProcess' more sensible error messages.

Also a bunch of refactoring for GhcModError
This commit is contained in:
Daniel Gröber 2014-08-28 11:54:01 +02:00
parent a7f00931c5
commit a0ae09a3e6
18 changed files with 161 additions and 101 deletions

View File

@ -17,7 +17,8 @@ script:
- rm -rf /tmp/test && mkdir -p /tmp/test
- cd /tmp/test
- tar -xf $SRC_TGZ && cd ghc-mod*/
- cabal configure --enable-tests
- if [ -n "$(ghc --version | awk '{ print $8 }' | sed -n '/^7.8/p')" ]; then export WERROR="--ghc-option=-Werror"; fi
- cabal configure --enable-tests $WERROR
- cabal build
- cabal test

View File

@ -14,7 +14,7 @@ import qualified GHC as G
import Language.Haskell.GhcMod.Convert
import Language.Haskell.GhcMod.Doc (showPage, styleUnqualified)
import Language.Haskell.GhcMod.Gap
import Language.Haskell.GhcMod.Monad (IOish, GhcModT, options)
import Language.Haskell.GhcMod.Monad (GhcModT, options)
import Language.Haskell.GhcMod.Target (setTargetFiles)
import Language.Haskell.GhcMod.Types
import Name (getOccString)

View File

@ -11,6 +11,7 @@ module Language.Haskell.GhcMod.CabalApi (
) where
import Language.Haskell.GhcMod.CabalConfig
import Language.Haskell.GhcMod.Error
import Language.Haskell.GhcMod.Gap (benchmarkBuildInfo, benchmarkTargets,
toModuleString)
import Language.Haskell.GhcMod.GhcPkg
@ -20,7 +21,6 @@ import MonadUtils (MonadIO, liftIO)
import Control.Applicative ((<$>))
import qualified Control.Exception as E
import Control.Monad (filterM)
import Control.Monad.Error.Class (Error, MonadError(..))
import Data.Maybe (maybeToList)
import Data.Set (fromList, toList)
import Distribution.Package (Dependency(Dependency)
@ -42,7 +42,7 @@ import System.FilePath ((</>))
----------------------------------------------------------------
-- | Getting necessary 'CompilerOptions' from three information sources.
getCompilerOptions :: (MonadIO m, MonadError GhcModError m, Functor m)
getCompilerOptions :: (IOish m, MonadError GhcModError m)
=> [GHCOption]
-> Cradle
-> PackageDescription

View File

@ -7,6 +7,7 @@ module Language.Haskell.GhcMod.CabalConfig (
, cabalConfigDependencies
) where
import Language.Haskell.GhcMod.Error
import Language.Haskell.GhcMod.GhcPkg
import Language.Haskell.GhcMod.Utils
import Language.Haskell.GhcMod.Read
@ -20,13 +21,12 @@ import qualified Language.Haskell.GhcMod.Cabal18 as C18
#endif
import Control.Applicative ((<$>))
import Control.Monad (mplus,void)
import Control.Monad (mplus)
#if MIN_VERSION_mtl(2,2,1)
import Control.Monad.Except ()
#else
import Control.Monad.Error ()
#endif
import Control.Monad.Error (MonadError(..))
import Data.Maybe ()
import Data.Set ()
import Data.List (find,tails,isPrefixOf,isInfixOf,nub,stripPrefix)
@ -35,7 +35,7 @@ import Distribution.Package (InstalledPackageId(..)
import Distribution.Simple.BuildPaths (defaultDistPref)
import Distribution.Simple.Configure (localBuildInfoFile)
import Distribution.Simple.LocalBuildInfo (ComponentName)
import MonadUtils (MonadIO)
import MonadUtils (liftIO)
import System.FilePath ((</>))
----------------------------------------------------------------
@ -46,16 +46,18 @@ type CabalConfig = String
-- | Get contents of the file containing 'LocalBuildInfo' data. If it doesn't
-- exist run @cabal configure@ i.e. configure with default options like @cabal
-- build@ would do.
getConfig :: (MonadIO m, MonadError GhcModError m)
getConfig :: (IOish m, MonadError GhcModError m)
=> Cradle
-> m CabalConfig
getConfig cradle = tryFix (liftIOExceptions (readFile path)) $ \_ ->
rethrowError (GMECabalConfigure . gmeMsg) configure
getConfig cradle = liftIO (readFile path) `tryFix` \_ ->
configure `modifyError'` GMECabalConfigure
where
prjDir = cradleRootDir cradle
path = prjDir </> configPath
configure = liftIOExceptions $ void $
withDirectory_ prjDir $ readProcess' "cabal" ["configure"]
configure :: (IOish m, MonadError GhcModError m) => m ()
configure =
withDirectory_ prjDir $ readProcess' "cabal" ["configure"] >> return ()
-- | Path to 'LocalBuildInfo' file, usually @dist/setup-config@
@ -63,7 +65,7 @@ configPath :: FilePath
configPath = localBuildInfoFile defaultDistPref
-- | Get list of 'Package's needed by all components of the current package
cabalConfigDependencies :: (MonadIO m, Functor m, MonadError GhcModError m)
cabalConfigDependencies :: (IOish m, MonadError GhcModError m)
=> Cradle
-> PackageIdentifier
-> m [Package]

View File

@ -0,0 +1,39 @@
{-# LANGUAGE TypeFamilies, ScopedTypeVariables #-}
module Language.Haskell.GhcMod.Error (
GhcModError(..)
, modifyError
, modifyError'
, tryFix
, module Control.Monad.Error
, module Exception
) where
import Control.Monad.Error (MonadError(..), Error(..))
import Exception
data GhcModError = GMENoMsg
-- ^ Unknown error
| GMEString String
-- ^ Some Error with a message. These are produced mostly by
-- 'fail' calls on GhcModT.
| GMECabalConfigure GhcModError
-- ^ Configuring a cabal project failed.
| GMEProcess [String] GhcModError
-- ^ Launching an operating system process failed. The first
-- field is the command.
deriving (Eq,Show)
instance Error GhcModError where
noMsg = GMENoMsg
strMsg = GMEString
modifyError :: MonadError e m => (e -> e) -> m a -> m a
modifyError f action = action `catchError` \e -> throwError $ f e
infixr 0 `modifyError'`
modifyError' :: MonadError e m => m a -> (e -> e) -> m a
modifyError' = flip modifyError
tryFix :: MonadError e m => m a -> (e -> m ()) -> m a
tryFix action fix = do
action `catchError` \e -> fix e >> action

View File

@ -16,7 +16,6 @@ module Language.Haskell.GhcMod.Find
import Config (cProjectVersion,cTargetPlatformString)
import Control.Applicative ((<$>))
import Control.Exception (handle, SomeException(..))
import Control.Monad (when, void)
import Control.Monad.Error.Class
import Data.Function (on)
@ -78,7 +77,7 @@ packageConfDir = "package.conf.d"
-- | Looking up 'SymbolDb' with 'Symbol' to \['ModuleString'\]
-- which will be concatenated. 'loadSymbolDb' is called internally.
findSymbol :: IOish m => Symbol -> GhcModT m String
findSymbol sym = liftIO loadSymbolDb >>= lookupSymbol sym
findSymbol sym = loadSymbolDb >>= lookupSymbol sym
-- | Looking up 'SymbolDb' with 'Symbol' to \['ModuleString'\]
-- which will be concatenated.
@ -91,7 +90,7 @@ lookupSym sym (SymbolDb db) = fromMaybe [] $ M.lookup sym db
---------------------------------------------------------------
-- | Loading a file and creates 'SymbolDb'.
loadSymbolDb :: IO SymbolDb
loadSymbolDb :: (IOish m, MonadError GhcModError m) => m SymbolDb
loadSymbolDb = SymbolDb <$> readSymbolDb
-- | Returns the path to the currently running ghc-mod executable. With ghc<7.6
@ -102,7 +101,9 @@ ghcModExecutable = do
dir <- getExecutablePath'
return $ dir </> "ghc-mod"
#else
ghcModExecutable = return "dist/build/ghc-mod/ghc-mod"
ghcModExecutable = do _ <- getExecutablePath' -- get rid of unused warning when
-- compiling spec
return "dist/build/ghc-mod/ghc-mod"
#endif
where
getExecutablePath' :: IO FilePath
@ -112,11 +113,11 @@ ghcModExecutable = return "dist/build/ghc-mod/ghc-mod"
getExecutablePath' = return ""
# endif
readSymbolDb :: IO (Map Symbol [ModuleString])
readSymbolDb = handle (\(SomeException _) -> return M.empty) $ do
ghcMod <- ghcModExecutable
readSymbolDb :: (IOish m, MonadError GhcModError m) => m (Map Symbol [ModuleString])
readSymbolDb = do
ghcMod <- liftIO ghcModExecutable
file <- chop <$> readProcess' ghcMod ["dumpsym"]
M.fromAscList . map conv . lines <$> readFile file
M.fromAscList . map conv . lines <$> liftIO (readFile file)
where
conv :: String -> (Symbol,[ModuleString])
conv = read

View File

@ -11,7 +11,7 @@ module Language.Haskell.GhcMod.GHCApi (
) where
import Language.Haskell.GhcMod.GhcPkg
import Language.Haskell.GhcMod.Monad (IOish, GhcModT)
import Language.Haskell.GhcMod.Monad (GhcModT)
import Language.Haskell.GhcMod.Target (setTargetFiles)
import Language.Haskell.GhcMod.Types

View File

@ -35,6 +35,7 @@ module Language.Haskell.GhcMod.Internal (
, GhcModLog
-- * Monad utilities
, runGhcModT'
, hoistGhcModT
-- ** Accessing 'GhcModEnv' and 'GhcModState'
, options
, cradle

View File

@ -18,6 +18,7 @@ module Language.Haskell.GhcMod.Monad (
-- * Monad utilities
, runGhcModT
, runGhcModT'
, hoistGhcModT
-- ** Accessing 'GhcModEnv' and 'GhcModState'
, gmsGet
, gmsPut
@ -45,6 +46,7 @@ module Language.Haskell.GhcMod.Monad (
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Error
import Language.Haskell.GhcMod.Cradle
import Language.Haskell.GhcMod.DynFlags
import Language.Haskell.GhcMod.GhcPkg
@ -52,7 +54,6 @@ import Language.Haskell.GhcMod.CabalApi
import qualified Language.Haskell.GhcMod.Gap as Gap
import DynFlags
import Exception
import GHC
import qualified GHC as G
import GHC.Paths (libdir)
@ -87,7 +88,7 @@ import Control.Monad.Reader.Class
import Control.Monad.Writer.Class (MonadWriter)
import Control.Monad.State.Class (MonadState(..))
import Control.Monad.Error (MonadError, ErrorT, runErrorT)
import Control.Monad.Error (ErrorT, runErrorT)
import Control.Monad.Reader (ReaderT, runReaderT)
import Control.Monad.State.Strict (StateT, runStateT)
import Control.Monad.Trans.Journal (JournalT, runJournalT)
@ -100,6 +101,7 @@ import Control.Monad.Journal.Class
import Data.Maybe (fromJust, isJust)
import Data.IORef (IORef, readIORef, writeIORef, newIORef)
import System.Directory (getCurrentDirectory)
import System.IO.Error (tryIOError)
----------------------------------------------------------------
@ -122,14 +124,6 @@ defaultState = GhcModState Simple
----------------------------------------------------------------
-- | A constraint alias (-XConstraintKinds) to make functions dealing with
-- 'GhcModT' somewhat cleaner.
--
-- Basicially an @IOish m => m@ is a 'Monad' supporting arbitrary 'IO' and
-- exception handling. Usually this will simply be 'IO' but we parametrise it in
-- the exported API so users have the option to use a custom inner monad.
type IOish m = (Functor m, MonadIO m, MonadBaseControl IO m)
-- | The GhcMod monad transformer data type. This is basically a newtype wrapper
-- around 'StateT', 'ErrorT', 'JournalT' and 'ReaderT' with custom instances for
-- 'GhcMonad' and it's constraints.
@ -147,7 +141,6 @@ newtype GhcModT m a = GhcModT {
, Alternative
, Monad
, MonadPlus
, MonadIO
#if DIFFERENT_MONADIO
, Control.Monad.IO.Class.MonadIO
#endif
@ -157,7 +150,16 @@ newtype GhcModT m a = GhcModT {
, MonadError GhcModError
)
instance MonadTrans GhcModT where
instance MonadIO m => MonadIO (GhcModT m) where
liftIO action = do
res <- GhcModT . liftIO . liftIO . liftIO . liftIO $ tryIOError action
case res of
Right a -> return a
Left e -> case show e of
"" -> throwError $ noMsg
msg -> throwError $ strMsg msg
instance MonadTrans (GhcModT) where
lift = GhcModT . lift . lift . lift . lift
instance MonadState s m => MonadState s (GhcModT m) where
@ -188,7 +190,7 @@ instance MonadIO m => MonadIO (MaybeT m) where
-- | Initialize the 'DynFlags' relating to the compilation of a single
-- file or GHC session according to the 'Cradle' and 'Options'
-- provided.
initializeFlagsWithCradle :: (GhcMonad m, MonadError GhcModError m)
initializeFlagsWithCradle :: (IOish m, GhcMonad m, MonadError GhcModError m)
=> Options
-> Cradle
-> m ()
@ -253,6 +255,17 @@ runGhcModT opt action = do
initializeFlagsWithCradle opt (gmCradle env)
action)
-- | @hoistGhcModT result@. Embed a GhcModT computation's result into a GhcModT
-- computation. Note that if the computation that returned @result@ modified the
-- state part of GhcModT this cannot be restored.
hoistGhcModT :: IOish m
=> (Either GhcModError a, GhcModLog)
-> GhcModT m a
hoistGhcModT (r,l) = do
GhcModT (lift $ lift $ journal l) >> case r of
Left e -> throwError e
Right a -> return a
-- | Run a computation inside @GhcModT@ providing the RWST environment and
-- initial state. This is a low level function, use it only if you know what to
-- do with 'GhcModEnv' and 'GhcModState'.
@ -293,6 +306,9 @@ overrideGhcUserOptions action = withTempSession $ do
----------------------------------------------------------------
gmeAsk :: IOish m => GhcModT m GhcModEnv
gmeAsk = ask
gmsGet :: IOish m => GhcModT m GhcModState
gmsGet = GhcModT get
@ -300,10 +316,10 @@ gmsPut :: IOish m => GhcModState -> GhcModT m ()
gmsPut = GhcModT . put
options :: IOish m => GhcModT m Options
options = gmOptions <$> ask
options = gmOptions <$> gmeAsk
cradle :: IOish m => GhcModT m Cradle
cradle = gmCradle <$> ask
cradle = gmCradle <$> gmeAsk
getCompilerMode :: IOish m => GhcModT m CompilerMode
getCompilerMode = gmCompilerMode <$> gmsGet

View File

@ -85,7 +85,10 @@ pretty dflag style = showOneLine dflag style . Gap.typeForUser
----------------------------------------------------------------
inModuleContext :: IOish m => FilePath -> (DynFlags -> PprStyle -> GhcModT m a) -> GhcModT m a
inModuleContext :: IOish m
=> FilePath
-> (DynFlags -> PprStyle -> GhcModT m a)
-> GhcModT m a
inModuleContext file action =
withDynFlags (setWarnTypedHoles . setDeferTypeErrors . setNoWarningFlags) $ do
setTargetFiles [file]

View File

@ -1,23 +1,20 @@
module Language.Haskell.GhcMod.Types where
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.List (intercalate)
import qualified Data.Map as M
import Control.Monad.Error (Error(..))
import Exception (ExceptionMonad)
import MonadUtils (MonadIO)
import PackageConfig (PackageConfig)
data GhcModError = GMENoMsg
-- ^ Unknown error
| GMEString { gmeMsg :: String }
-- ^ Some Error with a message. These are produced mostly by
-- 'fail' calls on GhcModT.
| GMECabalConfigure { gmeMsg :: String }
-- ^ Configuring a cabal project failed.
deriving (Eq,Show)
instance Error GhcModError where
noMsg = GMENoMsg
strMsg = GMEString
-- | A constraint alias (-XConstraintKinds) to make functions dealing with
-- 'GhcModT' somewhat cleaner.
--
-- Basicially an @IOish m => m@ is a 'Monad' supporting arbitrary 'IO' and
-- exception handling. Usually this will simply be 'IO' but we parametrise it in
-- the exported API so users have the option to use a custom inner monad.
type IOish m = (Functor m, MonadIO m, MonadBaseControl IO m, ExceptionMonad m)
-- | Output style.
data OutputStyle = LispStyle -- ^ S expression style.

View File

@ -1,12 +1,10 @@
module Language.Haskell.GhcMod.Utils where
import Control.Exception
import Control.Monad.Error (MonadError(..), Error(..))
import Language.Haskell.GhcMod.Error
import MonadUtils (MonadIO, liftIO)
import System.Directory (getCurrentDirectory, setCurrentDirectory)
import System.Exit (ExitCode(..))
import System.IO.Error (tryIOError)
import System.Process (readProcessWithExitCode)
-- dropWhileEnd is not provided prior to base 4.5.0.0.
@ -25,39 +23,22 @@ extractParens str = extractParens' str 0
| s `elem` "}])" = s : extractParens' ss (level-1)
| otherwise = s : extractParens' ss level
readProcess' :: (MonadIO m, Error e, MonadError e m)
readProcess' :: (MonadIO m, MonadError GhcModError m)
=> String
-> [String]
-> m String
readProcess' cmd opts = do
(rv,output,err) <- liftIO $ readProcessWithExitCode cmd opts ""
(rv,output,err) <- liftIO (readProcessWithExitCode cmd opts "")
`modifyError'` GMEProcess ([cmd] ++ opts)
case rv of
ExitFailure val -> do
throwError $ strMsg $
throwError $ GMEProcess ([cmd] ++ opts) $ strMsg $
cmd ++ " " ++ unwords opts ++ " (exit " ++ show val ++ ")"
++ "\n" ++ err
ExitSuccess ->
return output
withDirectory_ :: FilePath -> IO a -> IO a
withDirectory_ :: (MonadIO m, ExceptionMonad m) => FilePath -> m a -> m a
withDirectory_ dir action =
bracket getCurrentDirectory setCurrentDirectory
(\_ -> setCurrentDirectory dir >> action)
rethrowError :: MonadError e m => (e -> e) -> m a -> m a
rethrowError f action = action `catchError` \e -> throwError $ f e
tryFix :: MonadError e m => m a -> (e -> m ()) -> m a
tryFix action fix = do
action `catchError` \e -> fix e >> action
-- | 'IOException's thrown in the computation passed to this function will be
-- converted to 'MonadError' failures using 'throwError'.
liftIOExceptions :: (MonadIO m, Error e, MonadError e m) => IO a -> m a
liftIOExceptions action = do
res <- liftIO $ tryIOError action
case res of
Right a -> return a
Left e -> case show e of
"" -> throwError $ noMsg
msg -> throwError $ strMsg msg
gbracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory)
(\_ -> liftIO (setCurrentDirectory dir) >> action)

View File

@ -70,6 +70,7 @@ Library
Language.Haskell.GhcMod.Debug
Language.Haskell.GhcMod.Doc
Language.Haskell.GhcMod.DynFlags
Language.Haskell.GhcMod.Error
Language.Haskell.GhcMod.FillSig
Language.Haskell.GhcMod.Find
Language.Haskell.GhcMod.Flag
@ -144,6 +145,7 @@ Executable ghc-modi
Default-Extensions: ConstraintKinds, FlexibleContexts
HS-Source-Dirs: src
Build-Depends: base >= 4.0 && < 5
, async
, containers
, directory
, filepath

View File

@ -113,6 +113,7 @@ main = flip E.catches handlers $ do
cmdArg4 = cmdArg !. 4
cmdArg5 = cmdArg !. 5
remainingArgs = tail cmdArg
nArgs :: Int -> a -> a
nArgs n f = if length remainingArgs == n
then f
else E.throw (ArgumentsMismatch cmdArg0)
@ -139,6 +140,7 @@ main = flip E.catches handlers $ do
"version" -> return progVersion
"help" -> return $ O.usageInfo usage argspec
cmd -> E.throw (NoSuchCommand cmd)
case res of
Right s -> putStr s
Left (GMENoMsg) ->
@ -146,7 +148,12 @@ main = flip E.catches handlers $ do
Left (GMEString msg) ->
hPutStrLn stderr msg
Left (GMECabalConfigure msg) ->
hPutStrLn stderr $ "cabal configure failed: " ++ msg
hPutStrLn stderr $ "cabal configure failed: " ++ show msg
Left (GMEProcess cmd msg) ->
hPutStrLn stderr $
"launching operating system process `"++c++"` failed: " ++ show msg
where c = unwords cmd
where
handlers = [Handler (handleThenExit handler1), Handler (handleThenExit handler2)]
handleThenExit handler e = handler e >> exitFailure

View File

@ -20,10 +20,10 @@ module Main where
import Config (cProjectVersion)
import Control.Applicative ((<$>))
import Control.Concurrent (forkIO, MVar, newEmptyMVar, putMVar, readMVar)
import Control.Concurrent.Async (Async, async, wait)
import Control.Exception (SomeException(..), Exception)
import qualified Control.Exception as E
import Control.Monad (when, void)
import Control.Monad (when)
import CoreMonad (liftIO)
import Data.List (find, intercalate)
import Data.List.Split (splitOn)
@ -34,6 +34,7 @@ import Data.Typeable (Typeable)
import Data.Version (showVersion)
import qualified GHC as G
import Language.Haskell.GhcMod
import Language.Haskell.GhcMod.Internal
import Paths_ghc_mod
import System.Console.GetOpt
import System.Directory (setCurrentDirectory)
@ -100,14 +101,13 @@ main = E.handle cmdHandler $
let rootdir = cradleRootDir cradle0
-- c = cradle0 { cradleCurrentDir = rootdir } TODO: ?????
setCurrentDirectory rootdir
mvar <- liftIO newEmptyMVar
void $ forkIO $ setupDB mvar
(res, _) <- runGhcModT opt $ loop S.empty mvar
symDb <- async $ runGhcModT opt loadSymbolDb
(res, _) <- runGhcModT opt $ loop S.empty symDb
case res of
Right () -> return ()
Left (GMECabalConfigure msg) -> do
putStrLn $ notGood $ "cabal configure failed: " ++ msg
putStrLn $ notGood $ "cabal configure failed: " ++ show msg
exitFailure
Left e -> bug $ show e
where
@ -132,19 +132,14 @@ replace needle replacement = intercalate replacement . splitOn needle
----------------------------------------------------------------
setupDB :: MVar SymbolDb -> IO ()
setupDB mvar = loadSymbolDb >>= putMVar mvar
----------------------------------------------------------------
loop :: IOish m => Set FilePath -> MVar SymbolDb -> GhcModT m ()
loop set mvar = do
loop :: IOish m => Set FilePath -> SymDbReq -> GhcModT m ()
loop set symDbReq = do
cmdArg <- liftIO getLine
let (cmd,arg') = break (== ' ') cmdArg
arg = dropWhile (== ' ') arg'
(ret,ok,set') <- case cmd of
"check" -> checkStx set arg
"find" -> findSym set arg mvar
"find" -> findSym set arg symDbReq
"lint" -> lintStx set arg
"info" -> showInfo set arg
"type" -> showType set arg
@ -163,7 +158,7 @@ loop set mvar = do
else do
liftIO $ putStrLn $ notGood ret
liftIO $ hFlush stdout
when ok $ loop set' mvar
when ok $ loop set' symDbReq
----------------------------------------------------------------
@ -207,10 +202,12 @@ isSameMainFile file (Just x)
----------------------------------------------------------------
findSym :: IOish m => Set FilePath -> String -> MVar SymbolDb
type SymDbReq = Async (Either GhcModError SymbolDb, GhcModLog)
findSym :: IOish m => Set FilePath -> String -> SymDbReq
-> GhcModT m (String, Bool, Set FilePath)
findSym set sym mvar = do
db <- liftIO $ readMVar mvar
findSym set sym dbReq = do
db <- hoistGhcModT =<< liftIO (wait dbReq)
ret <- lookupSymbol sym db
return (ret, True, set)

View File

@ -2,10 +2,11 @@ module FindSpec where
import Language.Haskell.GhcMod.Find
import Test.Hspec
import TestUtils
spec :: Spec
spec = do
describe "db <- loadSymbolDb" $ do
it "lookupSymbol' db \"head\" contains at least `Data.List'" $ do
db <- loadSymbolDb
db <- runD loadSymbolDb
lookupSym "head" db `shouldContain` ["Data.List"]

View File

@ -5,6 +5,7 @@ import Test.Hspec
import Dir
import TestUtils
import Control.Applicative
import Control.Exception
import Control.Monad.Error.Class
spec :: Spec
@ -27,3 +28,12 @@ spec = do
it "work" $ do
(runD $ gmsPut (GhcModState Intelligent) >> gmsGet)
`shouldReturn` (GhcModState Intelligent)
describe "liftIO" $ do
it "converts user errors to GhcModError" $ do
shouldReturnError $
runD' $ liftIO $ throw (userError "hello") >> return ""
it "converts a file not found exception to GhcModError" $ do
shouldReturnError $
runD' $ liftIO $ readFile "/DOES_NOT_EXIST" >> return ""

View File

@ -1,7 +1,7 @@
module UtilsSpec where
import Language.Haskell.GhcMod.Error
import Language.Haskell.GhcMod.Utils
import Control.Exception
import TestUtils
import Test.Hspec
@ -15,7 +15,9 @@ spec = do
describe "liftMonadError" $ do
it "converts IOErrors to GhcModError" $ do
shouldReturnError $
runD' $ liftIOExceptions $ throw (userError "hello") >> return ""
runD' $ liftIO $ throw (userError "hello") >> return ""
shouldReturnError $
runD' $ liftIOExceptions $ readFile "/DOES_NOT_EXIST" >> return ""
runD' $ liftIO $ readFile "/DOES_NOT_EXIST" >> return ""
-- readProcessWithExitCode cmd opts ""