From e61aaed023a3f593234de2f9cb615df1a1425202 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Thu, 17 Jul 2014 15:52:33 +0200 Subject: [PATCH 1/7] Make `readProcess'`more generic --- Language/Haskell/GhcMod/Utils.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Language/Haskell/GhcMod/Utils.hs b/Language/Haskell/GhcMod/Utils.hs index 365f1b9..9937e78 100644 --- a/Language/Haskell/GhcMod/Utils.hs +++ b/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 From 15e288decf703a2db57fb4118d4ed6dbdc85c677 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Thu, 17 Jul 2014 15:53:04 +0200 Subject: [PATCH 2/7] Remove some redundant stuff from test suite --- test/CheckSpec.hs | 1 - test/InfoSpec.hs | 7 ------- 2 files changed, 8 deletions(-) diff --git a/test/CheckSpec.hs b/test/CheckSpec.hs index 8b9334e..5fee185 100644 --- a/test/CheckSpec.hs +++ b/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 diff --git a/test/InfoSpec.hs b/test/InfoSpec.hs index caba4da..adfcb32 100644 --- a/test/InfoSpec.hs +++ b/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`) From 4f0f5f09a6acbadd6e5b3ca2f0e2402d39a901a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Thu, 17 Jul 2014 15:54:59 +0200 Subject: [PATCH 3/7] Remove `type Db` it's only used once and makes things less clear --- Language/Haskell/GhcMod/Find.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/Language/Haskell/GhcMod/Find.hs b/Language/Haskell/GhcMod/Find.hs index cd0a6aa..403b7bc 100644 --- a/Language/Haskell/GhcMod/Find.hs +++ b/Language/Haskell/GhcMod/Find.hs @@ -46,9 +46,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,7 +80,7 @@ lookupSymbol opt sym db = convert opt $ lookupSymbol' sym db loadSymbolDb :: IO SymbolDb loadSymbolDb = SymbolDb <$> readSymbolDb -readSymbolDb :: IO Db +readSymbolDb :: IO (Map Symbol [ModuleString]) readSymbolDb = handle (\(SomeException _) -> return M.empty) $ do file <- chop <$> readProcess "ghc-mod" ["dumpsym"] [] M.fromAscList . map conv . lines <$> readFile file From 0e17e8e15af08cbd9e927c80b0b04b4d0a669d8d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Thu, 17 Jul 2014 16:14:35 +0200 Subject: [PATCH 4/7] Add a CPP macro when compiling modules for the test suite --- ghc-mod.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/ghc-mod.cabal b/ghc-mod.cabal index 228e2d5..0ce7704 100644 --- a/ghc-mod.cabal +++ b/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 From 3c1b560068c98afb6c021e744970f1d84152ed85 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Thu, 17 Jul 2014 16:15:02 +0200 Subject: [PATCH 5/7] Short circuit export list when compiling spec --- Language/Haskell/GhcMod/Find.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/Language/Haskell/GhcMod/Find.hs b/Language/Haskell/GhcMod/Find.hs index 403b7bc..818e652 100644 --- a/Language/Haskell/GhcMod/Find.hs +++ b/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 ((<$>)) From c3b959a8e5872db67f539f87ed5b770adebf50b8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Thu, 17 Jul 2014 16:16:12 +0200 Subject: [PATCH 6/7] Add FindSpec --- test/FindSpec.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 test/FindSpec.hs diff --git a/test/FindSpec.hs b/test/FindSpec.hs new file mode 100644 index 0000000..0eedcb4 --- /dev/null +++ b/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"] From 3c04e78ba779dfbc7e1bf3e1e8a75646df55814e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Thu, 17 Jul 2014 16:17:17 +0200 Subject: [PATCH 7/7] Don't rely on ghc-mod being in PATH --- Language/Haskell/GhcMod/Find.hs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/Language/Haskell/GhcMod/Find.hs b/Language/Haskell/GhcMod/Find.hs index 818e652..e1a8570 100644 --- a/Language/Haskell/GhcMod/Find.hs +++ b/Language/Haskell/GhcMod/Find.hs @@ -27,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 @@ -84,9 +85,18 @@ lookupSymbol opt sym db = convert opt $ lookupSymbol' sym db loadSymbolDb :: IO SymbolDb loadSymbolDb = SymbolDb <$> readSymbolDb +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])