Merge pull request #289 from DanielG/dev-find-fork

Use `getExecutablePath` instead of relying on ghc-mod being on the PATH

Language/Haskell/GhcMod/Find.hs

@@ -1,13 +1,17 @@
 {-# LANGUAGE CPP #-}
 
-module Language.Haskell.GhcMod.Find (
+module Language.Haskell.GhcMod.Find
+#ifndef SPEC
+  (
     Symbol
   , SymbolDb
   , loadSymbolDb
   , lookupSymbol
   , dumpSymbol
   , findSymbol
-  ) where
+  )
+#endif
+  where
 
 import Config (cProjectVersion,cTargetPlatformString)
 import Control.Applicative ((<$>))
@@ -23,12 +27,13 @@ import Exception (ghandle, handleIO)
 import qualified GHC as G
 import Language.Haskell.GhcMod.Convert
 import Language.Haskell.GhcMod.Monad
+import Language.Haskell.GhcMod.Utils
 import Language.Haskell.GhcMod.Types
 import Name (getOccString)
 import System.Directory (doesDirectoryExist, getAppUserDataDirectory, doesFileExist, getModificationTime)
 import System.FilePath ((</>))
 import System.IO
-import System.Process (readProcess)
+import System.Environment (getExecutablePath)
 
 #ifndef MIN_VERSION_containers
 #define MIN_VERSION_containers(x,y,z) 1
@@ -46,9 +51,8 @@ import qualified Data.Map as M
 
 -- | Type of function and operation names.
 type Symbol = String
-type Db = Map Symbol [ModuleString]
 -- | Database from 'Symbol' to \['ModuleString'\].
-newtype SymbolDb = SymbolDb Db
+newtype SymbolDb = SymbolDb (Map Symbol [ModuleString])
 
 ----------------------------------------------------------------
 
@@ -81,9 +85,18 @@ lookupSymbol opt sym db = convert opt $ lookupSymbol' sym db
 loadSymbolDb :: IO SymbolDb
 loadSymbolDb = SymbolDb <$> readSymbolDb
 
-readSymbolDb :: IO Db
+ghcModExecutable :: IO FilePath
+ghcModExecutable =
+#ifndef SPEC
+    getExecutablePath
+#else
+    return "dist/build/ghc-mod/ghc-mod"
+#endif
+
+readSymbolDb :: IO (Map Symbol [ModuleString])
 readSymbolDb = handle (\(SomeException _) -> return M.empty) $ do
-    file <- chop <$> readProcess "ghc-mod" ["dumpsym"] []
+    ghcMod <- ghcModExecutable
+    file <- chop <$> readProcess' ghcMod ["dumpsym"]
     M.fromAscList . map conv . lines <$> readFile file
   where
     conv :: String -> (Symbol,[ModuleString])

Language/Haskell/GhcMod/Utils.hs

@@ -1,5 +1,6 @@
 module Language.Haskell.GhcMod.Utils where
 
+import MonadUtils (MonadIO, liftIO)
 import Control.Exception (bracket)
 import System.Directory (getCurrentDirectory, setCurrentDirectory)
 import System.Process (readProcessWithExitCode)
@@ -22,12 +23,12 @@ extractParens str = extractParens' str 0
        | s `elem` "}])" = s : extractParens' ss (level-1)
        | otherwise = s : extractParens' ss level
 
-readProcess' :: String -> [String] -> IO String
+readProcess' :: MonadIO m => String -> [String] -> m String
 readProcess' cmd opts = do
-  (rv,output,err) <- readProcessWithExitCode cmd opts ""
+  (rv,output,err) <- liftIO $ readProcessWithExitCode cmd opts ""
   case rv of
     ExitFailure val -> do
-        hPutStrLn stderr err
+        liftIO $ hPutStrLn stderr err
         fail $ cmd ++ " " ++ unwords opts ++ " (exit " ++ show val ++ ")"
     ExitSuccess ->
         return output

ghc-mod.cabal

@@ -197,6 +197,7 @@ Test-Suite spec
     Build-Depends:      Cabal >= 1.18
   if impl(ghc < 7.6.0)
     Build-Depends:      executable-path
+  CPP-Options:        -DSPEC=1
 
 Source-Repository head
   Type:                 git

test/CheckSpec.hs

@@ -2,7 +2,6 @@ module CheckSpec where
 
 import Data.List (isSuffixOf, isInfixOf, isPrefixOf)
 import Language.Haskell.GhcMod
-import Language.Haskell.GhcMod.Cradle
 import System.FilePath
 import Test.Hspec
 

test/FindSpec.hs

@@ -0,0 +1,16 @@
+module FindSpec where
+
+import Control.Applicative ((<$>))
+import Data.List (isPrefixOf)
+import Language.Haskell.GhcMod.Find
+import Test.Hspec
+import TestUtils
+
+import qualified Data.Map
+
+spec :: Spec
+spec = do
+    describe "db <- loadSymbolDb" $ do
+        it "lookupSymbol' db \"head\"  contains at least `Data.List'" $ do
+            db <- loadSymbolDb
+            lookupSymbol' "head" db `shouldContain` ["Data.List"]

test/InfoSpec.hs

@@ -4,7 +4,6 @@ module InfoSpec where
 import Control.Applicative ((<$>))
 import Data.List (isPrefixOf)
 import Language.Haskell.GhcMod
-import Language.Haskell.GhcMod.Cradle
 #if __GLASGOW_HASKELL__ < 706
 import System.Environment.Executable (getExecutablePath)
 #else
@@ -22,38 +21,32 @@ spec = do
     describe "types" $ do
         it "shows types of the expression and its outers" $ do
             withDirectory_ "test/data/ghc-mod-check" $ do
-                cradle <- findCradleWithoutSandbox
                 res <- runD $ types "Data/Foo.hs" 9 5
                 res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n"
 
         it "works with a module using TemplateHaskell" $ do
             withDirectory_ "test/data" $ do
-                cradle <- findCradleWithoutSandbox
                 res <- runD $ types "Bar.hs" 5 1
                 res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]
 
         it "works with a module that imports another module using TemplateHaskell" $ do
             withDirectory_ "test/data" $ do
-                cradle <- findCradleWithoutSandbox
                 res <- runD $ types "Main.hs" 3 8
                 res `shouldBe` unlines ["3 8 3 16 \"String -> IO ()\"", "3 8 3 20 \"IO ()\"", "3 1 3 20 \"IO ()\""]
 
     describe "info" $ do
         it "works for non-export functions" $ do
             withDirectory_ "test/data" $ do
-                cradle <- findCradleWithoutSandbox
                 res <- runD $ info "Info.hs" "fib"
                 res `shouldSatisfy` ("fib :: Int -> Int" `isPrefixOf`)
 
         it "works with a module using TemplateHaskell" $ do
             withDirectory_ "test/data" $ do
-                cradle <- findCradleWithoutSandbox
                 res <- runD $ info "Bar.hs" "foo"
                 res `shouldSatisfy` ("foo :: ExpQ" `isPrefixOf`)
 
         it "works with a module that imports another module using TemplateHaskell" $ do
             withDirectory_ "test/data" $ do
-                cradle <- findCradleWithoutSandbox
                 res <- runD $ info "Main.hs" "bar"
                 res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`)