Introducing strict getPackageDbDir.

Language/Haskell/GhcMod/Cradle.hs

@@ -1,4 +1,6 @@
-module Language.Haskell.GhcMod.Cradle (findCradle) where
+{-# LANGUAGE BangPatterns #-}
+
+module Language.Haskell.GhcMod.Cradle (findCradle, getPackageDbDir) where
 
 import Data.Char (isSpace)
 import Control.Applicative ((<$>))
@@ -80,16 +82,25 @@ pkgDbKey = "package-db:"
 pkgDbKeyLen :: Int
 pkgDbKeyLen = length pkgDbKey
 
--- | Extract a package db directory from the sandbox config file.
+-- | Obtaining GHC options relating to a package db directory
 getPackageDbOpts :: FilePath -> IO [GHCOption]
-getPackageDbOpts cdir = (sandboxArguments <$> getPkgDb ) `E.catch` handler
+getPackageDbOpts cdir = (sandboxArguments <$> getPkgDb) `E.catch` handler
   where
-    getPkgDb = extractValue . parse <$> readFile (cdir </> configFile)
+    getPkgDb = getPackageDbDir (cdir </> configFile)
-    parse = head . filter ("package-db:" `isPrefixOf`) . lines
-    extractValue = fst . break isSpace . dropWhile isSpace . drop pkgDbKeyLen
     handler :: SomeException -> IO [GHCOption]
     handler _ = return []
 
+-- | Extract a package db directory from the sandbox config file.
+--   Exception is thrown if the sandbox config file is broken.
+getPackageDbDir :: FilePath -> IO FilePath
+getPackageDbDir sconf = do
+    -- Be strict to ensure that an error can be caught.
+    !path <- extractValue . parse <$> readFile sconf
+    return path
+  where
+    parse = head . filter ("package-db:" `isPrefixOf`) . lines
+    extractValue = fst . break isSpace . dropWhile isSpace . drop pkgDbKeyLen
+
 -- | Adding necessary GHC options to the package db.
 --   Exception is thrown if the string argument is incorrect.
 --

test/CradleSpec.hs

@@ -1,7 +1,8 @@
 module CradleSpec where
 
 import Control.Applicative
-import Language.Haskell.GhcMod
+import Language.Haskell.GhcMod.Cradle
+import Language.Haskell.GhcMod.Types
 import System.Directory (canonicalizePath)
 import System.FilePath ((</>))
 import Test.Hspec
@@ -31,6 +32,13 @@ spec = do
                   , cradleCabalFile     = Just ("test" </> "data" </> "cabalapi.cabal")
                   , cradlePackageDbOpts = ["-no-user-package-db", "-package-db", "test" </> "data" </> ".cabal-sandbox" </> "i386-osx-ghc-7.6.3-packages.conf.d"]
                   }
+    describe "getPackageDbDir" $ do
+        it "parses a config file and extracts package db" $ do
+            pkgDb <- getPackageDbDir "test/data/cabal.sandbox.config"
+            pkgDb `shouldBe` "/Users/kazu/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"
+
+        it "throws an error if a config file is broken" $ do
+            getPackageDbDir "test/data/bad.config" `shouldThrow` anyException
 
 relativeCradle :: FilePath -> Cradle -> Cradle
 relativeCradle dir cradle = Cradle {

test/data/bad.config

@@ -0,0 +1 @@
+broken