diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index dede047..ecd298b 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/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) - parse = head . filter ("package-db:" `isPrefixOf`) . lines - extractValue = fst . break isSpace . dropWhile isSpace . drop pkgDbKeyLen + getPkgDb = getPackageDbDir (cdir configFile) 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. -- diff --git a/test/CradleSpec.hs b/test/CradleSpec.hs index 8d3320e..2c6d12e 100644 --- a/test/CradleSpec.hs +++ b/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 { diff --git a/test/data/bad.config b/test/data/bad.config new file mode 100644 index 0000000..57f89ed --- /dev/null +++ b/test/data/bad.config @@ -0,0 +1 @@ +broken