Bring test suite up to date

.travis.yml

@@ -5,12 +5,13 @@ ghc:
   - 7.8
 
 install:
+  - sudo apt-get install zlib1g-dev
   - cabal update
 #  - ( $CABAL122 && cabal install cabal-install --constraint "Cabal >= 1.22" && ghc-pkg unregister Cabal ) || true
   - echo $PATH
   - which cabal
-  - cabal install happy --constraint 'transformers <= 0.3.0.0'
-  - cabal install Cabal --constraint "Cabal == $(cabal --version | grep 'Cabal library' | awk '{ print $3 }' | awk -vFS=. '{ print $1 "." $2 }' | tail -n1).*"
+  - cabal install cabal-install --constraint "Cabal == $(cabal --version | grep 'Cabal library' | awk '{ print $3 }' | awk -vFS=. '{ print $1 "." $2 }' | tail -n1).*"
+#  - cabal install Cabal --constraint "Cabal == $(cabal --version | grep 'Cabal library' | awk '{ print $3 }' | tail -n1)"
   - happy --version
   - cabal install -j --only-dependencies --enable-tests
 
@@ -25,6 +26,8 @@ script:
   - 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
+  - export ghc_mod_libexecdir=$PWD/dist/build/cabal-helper-wrapper
+  - export ghc_mod_datadir=$PWD
   - cabal test
 
 matrix:

CabalHelper/Common.hs

@@ -18,7 +18,7 @@
 module CabalHelper.Common where
 
 import Control.Applicative
-import Control.Exception
+import Control.Exception as E
 import Control.Monad
 import Data.List
 import Data.Maybe
@@ -40,7 +40,7 @@ panic msg = throw $ Panic msg
 
 handlePanic :: IO a -> IO a
 handlePanic action =
-    action `catch` \(Panic msg) -> errMsg msg >> exitFailure
+    action `E.catch` \(Panic msg) -> errMsg msg >> exitFailure
 
 errMsg :: String -> IO ()
 errMsg str = do

CabalHelper/Main.hs

@@ -114,7 +114,7 @@ main = do
          errMsg $ "distdir '"++distdir++"' does not exist"
          exitFailure
 
-  v <- maybe silent (const deafening) <$> lookupEnv "GHC_MOD_DEBUG"
+  v <- maybe silent (const deafening) . lookup  "GHC_MOD_DEBUG" <$> getEnvironment
   lbi <- unsafeInterleaveIO $ getPersistBuildConfig distdir
   let pd = localPkgDescr lbi
 

CabalHelper/Wrapper.hs

@@ -19,6 +19,7 @@ module Main where
 
 import Control.Applicative
 import Control.Arrow
+import Control.Exception as E
 import Control.Monad
 import Control.Monad.Trans.Maybe
 import Data.Char
@@ -133,7 +134,8 @@ compileHelper cabalVer = do
             else do
               -- otherwise compile the requested cabal version into an isolated
               -- package-db
-              db <- installCabal cabalVer
+              db <- installCabal cabalVer `E.catch`
+                  \(SomeException _) -> errorInstallCabal cabalVer
               compileWithPkg chdir (Just db)
         Just _ ->
           compileWithPkg chdir Nothing
@@ -149,12 +151,27 @@ compileHelper cabalVer = do
 
 -- errorNoCabal :: Version -> a
 -- errorNoCabal cabalVer = panic $ printf "\
--- \No appropriate Cabal package found, wanted version %s.\n\
--- \- Check output of: $ ghc-pkg list Cabal\n\
--- \- Maybe try: $ cabal install Cabal --constraint 'Cabal == %s'" sver sver
+-- \No appropriate Cabal package found, wanted version %s.\n"
 --  where
 --    sver = showVersion cabalVer
 
+errorInstallCabal :: Version -> a
+errorInstallCabal cabalVer = panic $ printf "\
+\Installing Cabal version %s failed.\n\
+\n\
+\You have two choices now:\n\
+\- Either you install this version of Cabal in your globa/luser package-db\n\
+\  somehow\n\
+\n\
+\- Or you can see if you can update your cabal-install to use a different\n\
+\  version of the Cabal library that we can build with:\n\
+\    $ cabal install cabal-install --constraint 'Cabal > %s'\n\
+\n\
+\To check the version cabal-install is currently using try:\n\
+\    $ cabal --version\n" sver sver
+ where
+   sver = showVersion cabalVer
+
 errorNoMain :: FilePath -> a
 errorNoMain datadir = panic $ printf "\
 \Could not find $datadir/CabalHelper/Main.hs!\n\

Language/Haskell/GhcMod/CabalHelper.hs

@@ -29,7 +29,7 @@ import Data.Monoid
 import Data.List
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Monad.Types
-import Language.Haskell.GhcMod.Error
+import Language.Haskell.GhcMod.Error as E
 import Language.Haskell.GhcMod.Utils
 import Language.Haskell.GhcMod.World
 import Language.Haskell.GhcMod.PathsAndFiles
@@ -93,7 +93,7 @@ cabalHelper = withCabal $ do
 
   res <- liftIO $ cached cradleRootDir (cabalHelperCache cmds) $ do
            out <- readProcess exe (distdir:cmds) ""
-           evaluate (read out) `catch`
+           evaluate (read out) `E.catch`
                \(SomeException _) -> error "cabalHelper: read failed"
 
   let [ Just (GmCabalHelperEntrypoints eps),

Language/Haskell/GhcMod/Doc.hs

@@ -11,10 +11,10 @@ showPage dflag style = showDocWith dflag PageMode . withStyle dflag style
 showOneLine :: DynFlags -> PprStyle -> SDoc -> String
 showOneLine dflag style = showDocWith dflag OneLineMode . withStyle dflag style
 
-showForUser :: DynFlags -> PrintUnqualified -> SDoc -> String
-showForUser dflags unqual sdoc =
-    showDocWith dflags PageMode $
-      runSDoc sdoc $ initSDocContext dflags $ mkUserStyle unqual AllTheWay
+-- showForUser :: DynFlags -> PrintUnqualified -> SDoc -> String
+-- showForUser dflags unqual sdoc =
+--     showDocWith dflags PageMode $
+--       runSDoc sdoc $ initSDocContext dflags $ mkUserStyle unqual AllTheWay
 
 getStyle :: GhcMonad m => m PprStyle
 getStyle = do

Language/Haskell/GhcMod/Find.hs

@@ -38,8 +38,8 @@ import System.IO
 #endif
 
 #if MIN_VERSION_containers(0,5,0)
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
+import Data.Map (Map)
+import qualified Data.Map as M
 #else
 import Data.Map (Map)
 import qualified Data.Map as M

Language/Haskell/GhcMod/Gap.hs

@@ -39,6 +39,7 @@ module Language.Haskell.GhcMod.Gap (
   , listVisibleModuleNames
   , listVisibleModules
   , Language.Haskell.GhcMod.Gap.isSynTyCon
+  , parseModuleHeader
   ) where
 
 import Control.Applicative hiding (empty)
@@ -96,6 +97,13 @@ import PackageConfig (PackageConfig, packageConfigId)
 import qualified Data.IntSet as I (IntSet, empty)
 #endif
 
+
+import Bag
+import Lexer as L
+import Parser
+import SrcLoc
+
+
 ----------------------------------------------------------------
 ----------------------------------------------------------------
 --
@@ -487,3 +495,27 @@ isSynTyCon = GHC.isTypeSynonymTyCon
 #else
 isSynTyCon = GHC.isSynTyCon
 #endif
+
+
+parseModuleHeader
+    :: String         -- ^ Haskell module source text (full Unicode is supported)
+    -> DynFlags
+    -> FilePath       -- ^ the filename (for source locations)
+    -> Either ErrorMessages (WarningMessages, Located (HsModule RdrName))
+parseModuleHeader str dflags filename =
+   let
+       loc  = mkRealSrcLoc (mkFastString filename) 1 1
+       buf  = stringToStringBuffer str
+   in
+   case L.unP Parser.parseHeader (mkPState dflags buf loc) of
+
+     PFailed sp err   ->
+#if __GLASGOW_HASKELL__ >= 706
+         Left (unitBag (mkPlainErrMsg dflags sp err))
+#else
+         Left (unitBag (mkPlainErrMsg sp err))
+#endif
+
+     POk pst rdr_module ->
+         let (warns,_) = getMessages pst in
+         Right (warns, rdr_module)

Language/Haskell/GhcMod/HomeModuleGraph.hs

@@ -30,19 +30,13 @@ module Language.Haskell.GhcMod.HomeModuleGraph (
  , moduleGraphToDot
  ) where
 
-import Bag
-import DriverPipeline hiding (unP)
+import DriverPipeline
 import ErrUtils
 import Exception
-import FastString
 import Finder
 import GHC
 import HscTypes
-import Lexer
 import MonadUtils hiding (foldrM)
-import Parser
-import SrcLoc
-import StringBuffer
 
 import Control.Arrow ((&&&))
 import Control.Monad
@@ -51,8 +45,8 @@ import Control.Monad.State.Strict (execStateT)
 import Control.Monad.State.Class
 import Data.Maybe
 import Data.Monoid
-import Data.Map.Strict  (Map)
-import qualified Data.Map.Strict  as Map
+import Data.Map  (Map)
+import qualified Data.Map  as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
 import System.FilePath
@@ -61,6 +55,7 @@ import Language.Haskell.GhcMod.Logging
 import Language.Haskell.GhcMod.Logger
 import Language.Haskell.GhcMod.Monad.Types
 import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Gap (parseModuleHeader)
 
 -- | Turn module graph into a graphviz dot file
 --
@@ -249,22 +244,3 @@ fileModuleName env fn = handle (\(_ :: SomeException) -> return $ Right Nothing)
       Right (_, lmdl) -> do
         let HsModule {..} = unLoc lmdl
         return $ Right $ unLoc <$> hsmodName
-
-parseModuleHeader
-    :: String         -- ^ Haskell module source text (full Unicode is supported)
-    -> DynFlags
-    -> FilePath       -- ^ the filename (for source locations)
-    -> Either ErrorMessages (WarningMessages, Located (HsModule RdrName))
-parseModuleHeader str dflags filename =
-   let
-       loc  = mkRealSrcLoc (mkFastString filename) 1 1
-       buf  = stringToStringBuffer str
-   in
-   case unP Parser.parseHeader (mkPState dflags buf loc) of
-
-     PFailed sp err   ->
-         Left (unitBag (mkPlainErrMsg dflags sp err))
-
-     POk pst rdr_module ->
-         let (warns,_) = getMessages pst in
-         Right (warns, rdr_module)

Language/Haskell/GhcMod/Monad/Types.hs

@@ -17,7 +17,7 @@
 {-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, RankNTypes #-}
 {-# LANGUAGE TypeFamilies, UndecidableInstances, BangPatterns #-}
-{-# LANGUAGE StandaloneDeriving, InstanceSigs #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Language.Haskell.GhcMod.Monad.Types (

Language/Haskell/GhcMod/Target.hs

@@ -36,13 +36,14 @@ import Language.Haskell.GhcMod.GhcPkg
 import Language.Haskell.GhcMod.Error
 import Language.Haskell.GhcMod.Logging
 import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Utils
 
 import Data.Maybe
 import Data.Either
 import Data.Foldable (foldrM)
 import Data.IORef
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict  as Map
+import Data.Map (Map)
+import qualified Data.Map  as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
 
@@ -51,8 +52,7 @@ import System.FilePath
 
 withLightHscEnv :: forall m a. IOish m
     => [GHCOption] -> (HscEnv -> m a) -> m a
-withLightHscEnv opts action = gbracket initEnv teardownEnv (action)
-
+withLightHscEnv opts action = gbracket initEnv teardownEnv action
  where
    teardownEnv :: HscEnv -> m ()
    teardownEnv env = liftIO $ do
@@ -241,7 +241,7 @@ resolveEntrypoints env srcDirs ms =
    resolve :: Either FilePath ModuleName -> IO (Maybe ModulePath)
    resolve (Right mn) = findModulePath env mn
    resolve (Left fn') = do
-       mfn <- findFile srcDirs fn'
+       mfn <- findFile' srcDirs fn'
        case mfn of
          Nothing -> return Nothing
          Just fn'' -> do
@@ -253,6 +253,8 @@ resolveEntrypoints env srcDirs ms =
                      case mmn of
                        Nothing -> mkMainModulePath fn
                        Just mn -> ModulePath mn fn
+   findFile' dirs file =
+       mconcat <$> mapM (mightExist . (</>file)) dirs
 
 resolveGmComponents :: (IOish m, GmState m, GmLog m, GmEnv m)
                     => Maybe [Either FilePath ModuleName]

Language/Haskell/GhcMod/Utils.hs

@@ -128,7 +128,7 @@ libexecNotExitsError exe dir = printf
 
 tryFindGhcModTreeLibexecDir :: IO (Maybe FilePath)
 tryFindGhcModTreeLibexecDir  = do
-  exe <- getExecutablePath
+  exe <- getExecutablePath'
   dir <- case takeFileName exe of
     "ghc" -> do -- we're probably in ghci; try CWD
         getCurrentDirectory

NotCPP/Declarations.hs

@@ -22,7 +22,7 @@ module NotCPP.Declarations where
 import Control.Arrow
 import Control.Applicative
 import Data.Maybe
-import Language.Haskell.TH.Syntax hiding (lookupName)
+import Language.Haskell.TH.Syntax
 
 import NotCPP.LookupValueName
 
@@ -39,10 +39,10 @@ recUpdE' :: Q Exp -> Name -> Exp -> Q Exp
 recUpdE' ex name assign = do
   RecUpdE <$> ex <*> pure [(name, assign)]
 
-lookupName :: (NameSpace, String) -> Q (Maybe Name)
-lookupName (VarName, n) = lookupValueName n
-lookupName (DataName, n) = lookupValueName n
-lookupName (TcClsName, n) = lookupTypeName n
+lookupName' :: (NameSpace, String) -> Q (Maybe Name)
+lookupName' (VarName, n) = lookupValueName n
+lookupName' (DataName, n) = lookupValueName n
+lookupName' (TcClsName, n) = lookupTypeName n
 
 -- Does this even make sense?
 ifelseD :: Q [Dec] -> Q [Dec] -> Q [Dec]
@@ -90,14 +90,16 @@ ifD decls' = do
       _ -> return [])
 
 definedNames :: [(NameSpace, Name)] -> Q [Name]
-definedNames ns = catMaybes <$> (lookupName . second nameBase) `mapM` ns
+definedNames ns = catMaybes <$> (lookupName' . second nameBase) `mapM` ns
 
 boundNames :: Dec -> [(NameSpace, Name)]
 boundNames decl =
     case decl of
       SigD n _ -> [(VarName, n)]
       FunD n _cls -> [(VarName, n)]
+#if __GLASGOW_HASKELL__ >= 706
       InfixD _ n -> [(VarName, n)]
+#endif
       ValD p _ _ -> map ((,) VarName) $ patNames p
 
       TySynD n _ _ -> [(TcClsName, n)]

ghc-mod.cabal

@@ -37,6 +37,7 @@ Extra-Source-Files:     ChangeLog
                         test/data/cabal-flags/cabal-flags.cabal
                         test/data/cabal-project/*.cabal
                         test/data/cabal-project/*.hs
+                        test/data/cabal-project/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/Cabal-1.18.1.3-2b161c6bf77657aa17e1681d83cb051b.conf
                         test/data/cabal-project/cabal.sandbox.config.in
                         test/data/cabal-project/subdir1/subdir2/dummy
                         test/data/case-split/*.hs
@@ -44,6 +45,8 @@ Extra-Source-Files:     ChangeLog
                         test/data/check-packageid/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c.conf
                         test/data/check-test-subdir/*.cabal
                         test/data/check-test-subdir/src/Check/Test/*.hs
+                        test/data/check-test-subdir/test/*.hs
+                        test/data/check-test-subdir/test/Bar/*.hs
                         test/data/duplicate-pkgver/cabal.sandbox.config.in
                         test/data/duplicate-pkgver/duplicate-pkgver.cabal
                         test/data/duplicate-pkgver/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-1.0-7c59d13f32294d1ef6dc6233c24df961.conf
@@ -195,9 +198,10 @@ Executable cabal-helper-wrapper
                       , bytestring
                       , binary
                       , containers
-                      , Cabal >= 1.16
+                      , Cabal >= 1.14
                       , directory
                       , filepath
+                      , old-time
                       , process
                       , transformers
                       , template-haskell
@@ -210,6 +214,8 @@ Test-Suite doctest
   Ghc-Options:          -Wall
   Default-Extensions:   ConstraintKinds, FlexibleContexts
   Main-Is:              doctests.hs
+  if impl(ghc == 7.4.*)
+    Buildable:          False
   Build-Depends:        base
                       , doctest >= 0.9.3
 

test/CabalHelperSpec.hs

@@ -0,0 +1,70 @@
+module CabalHelperSpec where
+
+import Control.Arrow
+import Control.Applicative
+import Language.Haskell.GhcMod.CabalHelper
+import Language.Haskell.GhcMod.PathsAndFiles
+import Language.Haskell.GhcMod.Error
+import Test.Hspec
+import System.Directory
+import System.FilePath
+import System.Process (readProcess)
+
+import Dir
+import TestUtils
+import Data.List
+
+import Config (cProjectVersionInt)
+
+ghcVersion :: Int
+ghcVersion = read cProjectVersionInt
+
+gmeProcessException :: GhcModError -> Bool
+gmeProcessException GMEProcess {} = True
+gmeProcessException _ = False
+
+pkgOptions :: [String] -> [String]
+pkgOptions [] = []
+pkgOptions (_:[]) = []
+pkgOptions (x:y:xs) | x == "-package-id" = [name y] ++ pkgOptions xs
+                    | otherwise = pkgOptions (y:xs)
+ where
+   stripDash s = maybe s id $ (flip drop s . (+1) <$> findIndex (=='-') s)
+   name s = reverse $ stripDash $ stripDash $ reverse s
+
+idirOpts :: [(c, [String])] -> [(c, [String])]
+idirOpts = map (second $ map (drop 2) . filter ("-i"`isPrefixOf`))
+
+spec :: Spec
+spec = do
+    describe "getGhcOptions" $ do
+        it "throws an exception if the cabal file is broken" $ do
+            let tdir = "test/data/broken-caba"
+            runD' tdir getGhcOptions `shouldThrow` anyIOException
+
+        it "handles sandboxes correctly" $ do
+            let tdir = "test/data/cabal-project"
+            cwd <- getCurrentDirectory
+
+            opts <- runD' tdir getGhcOptions
+
+            if ghcVersion < 706
+              then forM_ opts (\(_, o) -> o `shouldContain` ["-no-user-package-conf","-package-conf", cwd </> "test/data/cabal-project/.cabal-sandbox/"++ghcSandboxPkgDbDir])
+              else forM_ opts (\(_, o) -> o `shouldContain` ["-no-user-package-db","-package-db",cwd </> "test/data/cabal-project/.cabal-sandbox/"++ghcSandboxPkgDbDir])
+
+        it "extracts build dependencies" $ do
+            let tdir = "test/data/cabal-project"
+            opts <- runD' tdir getGhcOptions
+            let ghcOpts = snd $ head opts
+                pkgs = pkgOptions ghcOpts
+            pkgs `shouldBe` ["Cabal","base","template-haskell"]
+
+        it "uses non default flags" $ do
+            let tdir = "test/data/cabal-flags"
+            _ <- withDirectory_ tdir $
+                readProcess "cabal" ["configure", "-ftest-flag"] ""
+
+            opts <- runD' tdir getGhcOptions
+            let ghcOpts = snd $ head opts
+                pkgs = pkgOptions ghcOpts
+            pkgs `shouldBe` ["Cabal","base"]

test/CheckSpec.hs

@@ -1,9 +1,10 @@
 {-# LANGUAGE CPP #-}
 module CheckSpec where
 
-import Data.List (isInfixOf, isPrefixOf) --isSuffixOf,
 import Language.Haskell.GhcMod
---import System.FilePath
+
+import Data.List
+import System.Process
 import Test.Hspec
 
 import TestUtils
@@ -20,6 +21,7 @@ spec = do
 
         it "works even if a module imports another module from a different directory" $ do
             withDirectory_ "test/data/check-test-subdir" $ do
+                _ <- system "cabal configure --enable-tests"
                 res <- runD $ checkSyntax ["test/Bar/Baz.hs"]
                 res `shouldSatisfy` (("test" </> "Foo.hs:3:1:Warning: Top-level binding with no type signature: foo :: [Char]\n") `isSuffixOf`)
 

test/HomeModuleGraphSpec.hs

@@ -0,0 +1,180 @@
+-- ghc-mod: Making Haskell development *more* fun
+-- Copyright (C) 2015  Daniel Gröber <dxld ÄT darkboxed DOT org>
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module HomeModuleGraphSpec where
+
+import Language.Haskell.GhcMod.HomeModuleGraph
+import Language.Haskell.GhcMod.Target
+import TestUtils
+
+import GHC
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Data.Maybe
+
+import Test.Hspec
+
+runAGhc :: [GHCOption] -> (HscEnv -> LightGhc a) -> IO a
+runAGhc opts action = withLightHscEnv opts $ \env -> do
+  runLightGhc env $ getSession >>= action
+
+hmGraph :: FilePath -> [String] -> String -> IO GmModuleGraph
+hmGraph dir opts mn = runAGhc opts $ \env -> liftIO $ do
+    runD' dir $ do
+      smp <- liftIO $ findModulePathSet env [mkModuleName mn]
+      homeModuleGraph env smp
+
+uhmGraph :: FilePath -> [String] -> String -> String -> GmModuleGraph -> IO GmModuleGraph
+uhmGraph dir opts mn umn g = runAGhc opts $ \env -> liftIO $ do
+    runD' dir $ do
+      smp <- liftIO $ findModulePathSet env [mkModuleName mn]
+      usmp <- liftIO $ findModulePathSet env [mkModuleName umn]
+      updateHomeModuleGraph env g smp usmp
+
+mapMap :: (Ord k, Ord k')
+  => (k -> k') -> (a -> a') -> Map.Map k a -> Map.Map k' a'
+mapMap fk fa = Map.mapKeys fk . Map.map fa
+
+mapMpFn :: (FilePath -> FilePath) -> ModulePath -> ModulePath
+mapMpFn f (ModulePath mn fn) = ModulePath mn (f fn)
+
+mp :: ModuleName -> ModulePath
+mp mn = ModulePath mn $ moduleNameString mn ++ ".hs"
+
+spec :: Spec
+spec = do
+    describe "reachable" $ do
+        let
+            smp =
+              Set.fromList
+                [ mp "A"
+                , mp "B"
+                , mp "C"
+                , mp "D"
+                , mp "E"
+                , mp "F"
+                , mp "G"
+                , mp "H"
+                , mp "I"
+                ]
+            fileMap = mkFileMap smp
+            moduleMap = mkModuleMap smp
+
+            completeGraph =
+                Map.map (Set.map lookupMM) . Map.mapKeys lookupMM
+
+            lookupMM = fromJust . flip Map.lookup moduleMap
+
+            graph = completeGraph $
+              Map.fromList
+                [ ("A", Set.fromList ["B"])
+                , ("B", Set.fromList ["C", "D"])
+                , ("C", Set.fromList ["F"])
+                , ("D", Set.fromList ["E"])
+                , ("E", Set.fromList [])
+                , ("F", Set.fromList [])
+                , ("G", Set.fromList [])
+                , ("H", Set.fromList [])
+                , ("I", Set.fromList [])
+                ]
+
+            really_reachable =
+              Set.fromList
+                [ mp "A"
+                , mp "B"
+                , mp "C"
+                , mp "D"
+                , mp "E"
+                , mp "F"
+                ]
+
+            g = GmModuleGraph {
+               gmgFileMap   = fileMap,
+               gmgModuleMap = moduleMap,
+               gmgGraph     = graph
+             }
+
+        it "reachable Set.empty g == Set.empty" $ do
+            reachable Set.empty g `shouldBe` Set.empty
+
+        it "lists only reachable nodes" $ do
+            reachable (Set.fromList [mp "A"]) g `shouldBe` really_reachable
+
+
+    describe "homeModuleGraph" $ do
+        it "cycles don't break it" $ do
+            let tdir = "test/data/home-module-graph/cycle"
+            g <- hmGraph tdir [] "A"
+            gmgGraph g `shouldBe`
+              Map.fromList
+                [ (mp "A",  Set.fromList [mp "B"])
+                , (mp "B",  Set.fromList [mp "A"])
+                ]
+
+        it "follows imports" $ do
+            let tdir = "test/data/home-module-graph/indirect"
+            g <- hmGraph tdir [] "A"
+            gmgGraph g `shouldBe`
+              Map.fromList
+                [ (mp "A",  Set.fromList [mp "A1", mp "A2", mp "A3"])
+                , (mp "A1", Set.fromList [mp "B"])
+                , (mp "A2", Set.fromList [mp "C"])
+                , (mp "A3", Set.fromList [mp "B"])
+                , (mp "B",  Set.fromList [])
+                , (mp "C",  Set.fromList [])
+                ]
+
+        it "returns partial results on parse errors" $ do
+            let tdir = "test/data/home-module-graph/errors"
+            g <- hmGraph tdir [] "A"
+            gmgGraph g `shouldBe`
+              Map.fromList
+                [ (mp "A",  Set.fromList [mp "A1", mp "A2", mp "A3"])
+                , (mp "A1", Set.fromList [])  -- parse error here
+                , (mp "A2", Set.fromList [])
+                , (mp "A3", Set.fromList [mp "B"])
+                , (mp "B",  Set.fromList [])
+                ]
+
+        it "returns partial results on CPP errors" $ do
+            let tdir = "test/data/home-module-graph/cpp"
+            g <- hmGraph tdir [] "A"
+            gmgGraph g `shouldBe`
+              Map.fromList
+                [ (mp "A",  Set.fromList [mp "A1", mp "A2", mp "A3"])
+                , (mp "A1", Set.fromList [])  -- CPP error here
+                , (mp "A2", Set.fromList [])
+                , (mp "A3", Set.fromList [mp "B"])
+                , (mp "B",  Set.fromList [])
+                ]
+
+    describe "updateHomeModuleGraph" $ do
+        it "removes unreachable nodes" $ do
+            let tdir = "test/data/home-module-graph/indirect"
+            let tdir' = "test/data/home-module-graph/indirect-update"
+            ig <- hmGraph tdir [] "A"
+            g <- uhmGraph tdir' [] "A" "A2" ig
+            gmgGraph g `shouldBe`
+              Map.fromList
+                [ (mp "A",  Set.fromList [mp "A1", mp "A2", mp "A3"])
+                , (mp "A1", Set.fromList [mp "B"])
+                , (mp "A2", Set.fromList [])
+                , (mp "A3", Set.fromList [mp "B"])
+                , (mp "B",  Set.fromList [])
+                -- C was removed
+                ]

test/TargetSpec.hs

@@ -0,0 +1,35 @@
+{-# LANGUAGE OverloadedStrings #-}
+module TargetSpec where
+
+import Language.Haskell.GhcMod.Target
+import Language.Haskell.GhcMod.Gap
+import Test.Hspec
+
+import TestUtils
+
+import GHC
+import Data.List
+import Data.Maybe
+
+spec :: Spec
+spec = do
+    describe "runLightGhc" $ do
+        it "works at all" $ do
+            withLightHscEnv [] $ \env ->
+              runLightGhc env (return ()) `shouldReturn` ()
+
+        it "has modules in scope" $ do
+            withLightHscEnv [] $ \env ->
+              runLightGhc env $ do
+               dflags <- getSessionDynFlags
+               let i = intersect (listVisibleModuleNames dflags)
+                                 ["Control.Applicative", "Control.Arrow"
+                                 ,"Control.Exception", "GHC.Exts", "GHC.Float"]
+               liftIO $ i `shouldSatisfy` not . null
+
+        it "can get module info" $ do
+            withLightHscEnv [] $ \env ->
+              runLightGhc env $ do
+                mdl <- findModule "Data.List" Nothing
+                mmi <- getModuleInfo mdl
+                liftIO $ isJust mmi `shouldBe` True

test/data/annotations/With.hs

@@ -0,0 +1,6 @@
+module Main where
+
+{-# ANN module ["this", "can", "be", "anything"] #-}
+
+main :: IO ()
+main = putStrLn "Hello world!"

test/data/cabal-project/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/Cabal-1.18.1.3-2b161c6bf77657aa17e1681d83cb051b.conf

@@ -0,0 +1,4 @@
+name: Cabal
+version: 1.18.1.3
+id: Cabal-1.18.1.3-2b161c6bf77657aa17e1681d83cb051b
+exposed: True

test/data/cabal-project/Baz.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Baz (baz) where
+import Foo (fooQ)
+
+baz = [fooQ| foo bar baz |]

test/data/cabal-project/Foo.hs

@@ -0,0 +1,9 @@
+module Foo (foo, fooQ) where
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote (QuasiQuoter(..))
+
+foo :: ExpQ
+foo = stringE "foo"
+
+fooQ :: QuasiQuoter
+fooQ = QuasiQuoter (litE . stringL) undefined undefined undefined

test/data/cabal-project/Info.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-} -- for HscInterpreted
+
+module Info () where
+
+fib :: Int -> Int
+fib 0 = 0
+fib 1 = 1
+fib n = fib (n - 1) + fib (n - 2)

test/data/cabal-project/Main.hs

@@ -0,0 +1,3 @@
+import Bar (bar)
+
+main = putStrLn bar

test/data/cabal-project/cabal.sandbox.config.in

@@ -0,0 +1,25 @@
+-- This is a Cabal package environment file.
+-- THIS FILE IS AUTO-GENERATED. DO NOT EDIT DIRECTLY.
+-- Please create a 'cabal.config' file in the same directory
+-- if you want to change the default settings for this sandbox.
+
+
+local-repo: @CWD@/test/data/cabal-project/.cabal-sandbox/packages
+logs-dir: @CWD@/test/data/cabal-project/.cabal-sandbox/logs
+world-file: @CWD@/test/data/cabal-project/.cabal-sandbox/world
+user-install: False
+package-db: @CWD@/test/data/cabal-project/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d
+build-summary: @CWD@/test/data/cabal-project/.cabal-sandbox/logs/build.log
+
+install-dirs
+  prefix: @CWD@/test/data/cabal-project/.cabal-sandbox
+  bindir: $prefix/bin
+  libdir: $prefix/lib
+  libsubdir: $arch-$os-$compiler/$pkgid
+  libexecdir: $prefix/libexec
+  datadir: $prefix/share
+  datasubdir: $arch-$os-$compiler/$pkgid
+  docdir: $datadir/doc/$arch-$os-$compiler/$pkgid
+  htmldir: $docdir/html
+  haddockdir: $htmldir
+  sysconfdir: $prefix/etc

test/data/cabal-project/cabalapi.cabal

@@ -0,0 +1,67 @@
+Name:                   ghc-mod
+Version:                1.11.3
+Author:                 Kazu Yamamoto <kazu@iij.ad.jp>
+Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp>
+License:                BSD3
+License-File:           LICENSE
+Homepage:               http://www.mew.org/~kazu/proj/ghc-mod/
+Synopsis:               Happy Haskell programming on Emacs/Vim
+Description:            This packages includes Elisp files
+			and a Haskell command, "ghc-mod".
+			"ghc*.el" enable completion of
+			Haskell symbols on Emacs.
+                        Flymake is also integrated.
+			"ghc-mod" is a backend of "ghc*.el".
+			It lists up all installed modules
+                        or extracts names of functions, classes,
+                        and data declarations.
+                        To use "ghc-mod" on Vim,
+                        see <https://github.com/eagletmt/ghcmod-vim> or
+                        <https://github.com/scrooloose/syntastic>
+Category:               Development
+Cabal-Version:          >= 1.6
+Build-Type:             Simple
+Data-Dir:               elisp
+Data-Files:             Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el
+                        ghc-flymake.el ghc-command.el ghc-info.el
+                        ghc-ins-mod.el ghc-indent.el
+Executable ghc-mod
+  Main-Is:              GHCMod.hs
+  Other-Modules:        Browse
+                        CabalApi
+                        Cabal
+                        CabalDev
+                        Check
+                        ErrMsg
+                        Flag
+                        GHCApi
+                        GHCChoice
+                        Gap
+                        Info
+                        Lang
+                        Lint
+                        List
+                        Paths_ghc_mod
+                        Types
+  GHC-Options:          -Wall
+  Build-Depends:        base >= 4.0 && < 5
+                      , Cabal >= 1.10
+                      , template-haskell
+
+Test-Suite spec
+  Main-Is:              Spec.hs
+  Hs-Source-Dirs:       test, .
+  Type:                 exitcode-stdio-1.0
+  Other-Modules:        Expectation
+                        BrowseSpec
+                        CabalApiSpec
+                        FlagSpec
+                        LangSpec
+                        LintSpec
+                        ListSpec
+  Build-Depends:        base >= 4.0 && < 5
+                      , Cabal >= 1.10
+
+Source-Repository head
+  Type:                 git
+  Location:             git://github.com/kazu-yamamoto/ghc-mod.git

test/data/cabal-project/subdir1/subdir2/dummy

@@ -0,0 +1 @@
+dummy

test/data/foreign-export/ForeignExport.hs

@@ -0,0 +1,10 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module ForeignExport where
+
+import Foreign.C.Types
+
+foreign export ccall foo :: CUInt
+
+foo :: CUInt
+foo = 123

test/data/ghc-mod-check/lib/Data/Foo.hs

@@ -0,0 +1,11 @@
+module Data.Foo where
+
+foo :: Int
+foo = undefined
+
+fibonacci :: Int -> Integer
+fibonacci n = fib 1 0 1
+  where
+    fib m x y
+      | n == m    = y
+      | otherwise = fib (m+1) y (x + y)

test/data/hlint/hlint.hs

@@ -0,0 +1,5 @@
+module Hlist where
+
+main :: IO ()
+main = do
+    putStrLn "Hello, world!"

test/data/home-module-graph/cpp/A.hs

@@ -0,0 +1,4 @@
+module A where
+import A1
+import A2
+import A3

test/data/home-module-graph/cpp/A1.hs

@@ -0,0 +1,4 @@
+{-# LANGUAGE CPP #-}
+module A1 where
+#elif
+import B

test/data/home-module-graph/cpp/A2.hs

@@ -0,0 +1 @@
+module A2 where

test/data/home-module-graph/cpp/A3.hs

@@ -0,0 +1,2 @@
+module A3 where
+import B

test/data/home-module-graph/cpp/B.hs

@@ -0,0 +1 @@
+module B where

test/data/home-module-graph/cycle/A.hs

@@ -0,0 +1,2 @@
+module A where
+import B

test/data/home-module-graph/cycle/B.hs

@@ -0,0 +1,2 @@
+module B where
+import A

test/data/home-module-graph/errors/A.hs

@@ -0,0 +1,4 @@
+module A where
+import A1
+import A2
+import A3

test/data/home-module-graph/errors/A1.hs

@@ -0,0 +1,4 @@
+module A1 where
+psogduapzsü9
+import B
+lxäö,vLMCks

test/data/home-module-graph/errors/A2.hs

@@ -0,0 +1 @@
+module A2 where

test/data/home-module-graph/errors/A3.hs

@@ -0,0 +1,2 @@
+module A3 where
+import B

test/data/home-module-graph/errors/B.hs

@@ -0,0 +1 @@
+module B where

test/data/home-module-graph/indirect-update/A.hs

@@ -0,0 +1,4 @@
+module A where
+import A1
+import A2
+import A3

test/data/home-module-graph/indirect-update/A1.hs

@@ -0,0 +1,2 @@
+module A1 where
+import B

test/data/home-module-graph/indirect-update/A2.hs

@@ -0,0 +1 @@
+module A2 where

test/data/home-module-graph/indirect-update/A3.hs

@@ -0,0 +1,2 @@
+module A3 where
+import B

test/data/home-module-graph/indirect-update/B.hs

@@ -0,0 +1 @@
+module B where

test/data/home-module-graph/indirect-update/C.hs

@@ -0,0 +1 @@
+module C where

test/data/home-module-graph/indirect/A.hs

@@ -0,0 +1,4 @@
+module A where
+import A1
+import A2
+import A3

test/data/home-module-graph/indirect/A1.hs

@@ -0,0 +1,2 @@
+module A1 where
+import B

test/data/home-module-graph/indirect/A2.hs

@@ -0,0 +1,2 @@
+module A2 where
+import C

test/data/home-module-graph/indirect/A3.hs

@@ -0,0 +1,2 @@
+module A3 where
+import B

test/data/home-module-graph/indirect/B.hs

@@ -0,0 +1 @@
+module B where

test/data/home-module-graph/indirect/C.hs

@@ -0,0 +1 @@
+module C where

test/data/import-cycle/Mutual1.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-} -- for HscInterpreted
+
+module Mutual1 where
+
+import Mutual2

test/data/import-cycle/Mutual2.hs

@@ -0,0 +1,3 @@
+module Mutual2 where
+
+import Mutual1

test/data/non-exported/Fib.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-} -- for HscInterpreted
+
+module Fib () where
+
+fib :: Int -> Int
+fib 0 = 0
+fib 1 = 1
+fib n = fib (n - 1) + fib (n - 2)

test/data/quasi-quotes/FooQ.hs

@@ -0,0 +1,6 @@
+module FooQ (fooQ) where
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote (QuasiQuoter(..))
+
+fooQ :: QuasiQuoter
+fooQ = QuasiQuoter (litE . stringL) undefined undefined undefined

test/data/quasi-quotes/QuasiQuotes.hs

@@ -0,0 +1,6 @@
+{-# LANGUAGE QuasiQuotes #-}
+module QuasiQuotes where
+
+import FooQ
+
+bar = [fooQ| foo bar baz |]

test/data/template-haskell/Bar.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Bar (bar) where
+import Foo (foo)
+
+bar = $foo ++ "bar"

test/data/template-haskell/Foo.hs

@@ -0,0 +1,9 @@
+module Foo (foo, fooQ) where
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote (QuasiQuoter(..))
+
+foo :: ExpQ
+foo = stringE "foo"
+
+fooQ :: QuasiQuoter
+fooQ = QuasiQuoter (litE . stringL) undefined undefined undefined

test/data/template-haskell/ImportsTH.hs

@@ -0,0 +1,3 @@
+import Bar (bar)
+
+main = putStrLn bar

test/doctests.hs

@@ -1,11 +1,13 @@
+{-# LANGUAGE CPP #-}
 module Main where
 
 import Test.DocTest
 
 main :: IO ()
-main = doctest [
-    "-package"
-  , "ghc"
+main = doctest
+  [ "-package", "ghc"
+  , "-package", "transformers-" ++ VERSION_transformers
+  , "-package", "directory-" ++ VERSION_directory
   , "-XConstraintKinds", "-XFlexibleContexts", "-XScopedTypeVariables", "-XRecordWildCards", "-XNamedFieldPuns"
   , "-idist/build/autogen/"
   , "-optP-include"