2014-08-11 21:42:16 +00:00
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
2014-08-06 18:41:59 +00:00
|
|
|
module MonadSpec where
|
|
|
|
|
|
|
|
import Test.Hspec
|
2014-08-11 21:42:16 +00:00
|
|
|
import Dir
|
2014-08-12 16:11:32 +00:00
|
|
|
import TestUtils
|
2014-08-11 21:42:16 +00:00
|
|
|
import Control.Applicative
|
2014-08-28 09:54:01 +00:00
|
|
|
import Control.Exception
|
2014-08-06 18:41:59 +00:00
|
|
|
import Control.Monad.Error.Class
|
|
|
|
|
|
|
|
spec :: Spec
|
|
|
|
spec = do
|
|
|
|
describe "When using GhcModT in a do block" $
|
|
|
|
it "a pattern match failure causes a call to `fail` on ErrorT in the monad stack" $ do
|
2014-08-20 03:14:27 +00:00
|
|
|
(a, _)
|
2014-08-06 18:41:59 +00:00
|
|
|
<- runGhcModT defaultOptions $
|
|
|
|
do
|
2014-08-20 03:14:27 +00:00
|
|
|
Just _ <- return Nothing
|
2014-08-06 18:41:59 +00:00
|
|
|
return "hello"
|
|
|
|
`catchError` (const $ fail "oh noes")
|
|
|
|
a `shouldBe` (Left $ GMEString "oh noes")
|
2014-08-11 21:42:16 +00:00
|
|
|
|
|
|
|
describe "runGhcModT" $
|
|
|
|
it "complains if the cabal file fails to parse while a sandbox is present" $ withDirectory_ "test/data/broken-cabal" $ do
|
2014-08-12 16:11:32 +00:00
|
|
|
shouldReturnError $ runD' (gmCradle <$> ask)
|
2014-08-12 16:22:28 +00:00
|
|
|
|
|
|
|
describe "gmsGet/Put" $
|
|
|
|
it "work" $ do
|
|
|
|
(runD $ gmsPut (GhcModState Intelligent) >> gmsGet)
|
|
|
|
`shouldReturn` (GhcModState Intelligent)
|
2014-08-28 09:54:01 +00:00
|
|
|
|
|
|
|
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 ""
|