Make parseCabalFile use MonadError

test/CabalApiSpec.hs

@@ -13,6 +13,7 @@ import System.Directory
 import System.FilePath
 
 import Dir
+import TestUtils
 
 import Config (cProjectVersionInt) -- ghc version
 
@@ -23,14 +24,16 @@ spec :: Spec
 spec = do
     describe "parseCabalFile" $ do
         it "throws an exception if the cabal file is broken" $ do
-            parseCabalFile "test/data/broken-cabal/broken.cabal" `shouldThrow` (\(_::IOException) -> True)
+            shouldReturnError $
+              runD' $ parseCabalFile "test/data/broken-cabal/broken.cabal"
+
 
     describe "getCompilerOptions" $ do
         it "gets necessary CompilerOptions" $ do
             cwd <- getCurrentDirectory
             withDirectory "test/data/subdir1/subdir2" $ \dir -> do
                 cradle <- findCradle
-                pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile cradle
+                pkgDesc <- runD $ parseCabalFile $ fromJust $ cradleCabalFile cradle
                 res <- getCompilerOptions [] cradle pkgDesc
                 let res' = res {
                         ghcOptions  = ghcOptions res
@@ -45,18 +48,18 @@ spec = do
 
     describe "cabalDependPackages" $ do
         it "extracts dependent packages" $ do
-            pkgs <- cabalDependPackages . cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal"
+            pkgs <- cabalDependPackages . cabalAllBuildInfo <$> runD (parseCabalFile "test/data/cabalapi.cabal")
             pkgs `shouldBe` ["Cabal","base","template-haskell"]
 
     describe "cabalSourceDirs" $ do
         it "extracts all hs-source-dirs" $ do
-            dirs <- cabalSourceDirs . cabalAllBuildInfo <$> parseCabalFile "test/data/check-test-subdir/check-test-subdir.cabal"
+            dirs <- cabalSourceDirs . cabalAllBuildInfo <$> runD (parseCabalFile "test/data/check-test-subdir/check-test-subdir.cabal")
             dirs `shouldBe` ["src", "test"]
         it "extracts all hs-source-dirs including \".\"" $ do
-            dirs <- cabalSourceDirs . cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal"
+            dirs <- cabalSourceDirs . cabalAllBuildInfo <$> runD (parseCabalFile "test/data/cabalapi.cabal")
             dirs `shouldBe` [".", "test"]
 
     describe "cabalAllBuildInfo" $ do
         it "extracts build info" $ do
-            info <- cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal"
+            info <- cabalAllBuildInfo <$> runD (parseCabalFile "test/data/cabalapi.cabal")
             show info `shouldBe` "[BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\".\"], otherModules = [ModuleName [\"Browse\"],ModuleName [\"CabalApi\"],ModuleName [\"Cabal\"],ModuleName [\"CabalDev\"],ModuleName [\"Check\"],ModuleName [\"ErrMsg\"],ModuleName [\"Flag\"],ModuleName [\"GHCApi\"],ModuleName [\"GHCChoice\"],ModuleName [\"Gap\"],ModuleName [\"Info\"],ModuleName [\"Lang\"],ModuleName [\"Lint\"],ModuleName [\"List\"],ModuleName [\"Paths_ghc_mod\"],ModuleName [\"Types\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [(GHC,[\"-Wall\"])], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))),Dependency (PackageName \"template-haskell\") AnyVersion]},BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\"test\",\".\"], otherModules = [ModuleName [\"Expectation\"],ModuleName [\"BrowseSpec\"],ModuleName [\"CabalApiSpec\"],ModuleName [\"FlagSpec\"],ModuleName [\"LangSpec\"],ModuleName [\"LintSpec\"],ModuleName [\"ListSpec\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []})))]}]"

test/MonadSpec.hs

@@ -3,6 +3,7 @@ module MonadSpec where
 
 import Test.Hspec
 import Dir
+import TestUtils
 import Control.Applicative
 import Control.Monad.Error.Class
 import Language.Haskell.GhcMod.Types
@@ -23,5 +24,4 @@ spec = do
 
     describe "runGhcModT" $
         it "complains if the cabal file fails to parse while a sandbox is present" $ withDirectory_ "test/data/broken-cabal" $ do
-          (a,_) <- runGhcModT defaultOptions (gmCradle <$> ask)
-          a `shouldSatisfy` (\(Left _) -> True)
+          shouldReturnError $ runD' (gmCradle <$> ask)

test/TestUtils.hs

@@ -1,10 +1,12 @@
 module TestUtils (
     run
   , runD
+  , runD'
   , runI
   , runID
   , runIsolatedGhcMod
   , isolateCradle
+  , shouldReturnError
   , module Language.Haskell.GhcMod.Monad
   , module Language.Haskell.GhcMod.Types
   ) where
@@ -12,6 +14,8 @@ module TestUtils (
 import Language.Haskell.GhcMod.Monad
 import Language.Haskell.GhcMod.Types
 
+import Test.Hspec
+
 isolateCradle :: IOish m => GhcModT m a -> GhcModT m a
 isolateCradle action =
     local modifyEnv  $ action
@@ -42,3 +46,16 @@ run opt a = extract $ runGhcModT opt a
 -- | Run GhcMod with default options
 runD :: GhcModT IO a -> IO a
 runD = extract . runGhcModT defaultOptions
+
+runD' :: GhcModT IO a -> IO (Either GhcModError a, GhcModLog)
+runD' = runGhcModT defaultOptions
+
+shouldReturnError :: Show a
+                  => IO (Either GhcModError a, GhcModLog)
+                  -> Expectation
+shouldReturnError action = do
+  (a,_) <- action
+  a `shouldSatisfy` isLeft
+ where
+   isLeft (Left _) = True
+   isLeft _ = False