From 08c6dfa5c2768222214a62779d92496127f7df4e Mon Sep 17 00:00:00 2001 From: Alex Lang Date: Tue, 8 Sep 2015 16:52:27 -0700 Subject: [PATCH 1/5] Add an ExplicitProject constructor, which reads options from a file --- Language/Haskell/GhcMod/Cradle.hs | 13 +++++++++++++ Language/Haskell/GhcMod/GhcPkg.hs | 1 + Language/Haskell/GhcMod/PathsAndFiles.hs | 9 +++++++++ Language/Haskell/GhcMod/Target.hs | 13 ++++++++++--- Language/Haskell/GhcMod/Types.hs | 1 + 5 files changed, 34 insertions(+), 3 deletions(-) diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index 51d2afa85..37910a60d 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/Language/Haskell/GhcMod/Cradle.hs @@ -38,6 +38,7 @@ findCradle' dir = run $ msum [ stackCradle dir , cabalCradle dir , sandboxCradle dir + , explicitCradle dir , plainCradle dir ] where run a = fillTempDir =<< (fromJust <$> runMaybeT a) @@ -135,3 +136,15 @@ plainCradle wdir = do , cradleCabalFile = Nothing , cradleDistDir = "dist" } + +explicitCradle :: IOish m => FilePath -> MaybeT m Cradle +explicitCradle wdir = do + optionsFile <- MaybeT $ liftIO $ findExplicitOptionsFile wdir + return $ Cradle { + cradleProject = ExplicitProject + , cradleCurrentDir = wdir + , cradleRootDir = takeDirectory optionsFile + , cradleTempDir = error "tmpDir" + , cradleCabalFile = Just optionsFile + , cradleDistDir = "" + } diff --git a/Language/Haskell/GhcMod/GhcPkg.hs b/Language/Haskell/GhcMod/GhcPkg.hs index db2581d2e..0bd62af24 100644 --- a/Language/Haskell/GhcMod/GhcPkg.hs +++ b/Language/Haskell/GhcMod/GhcPkg.hs @@ -87,6 +87,7 @@ getPackageDbStack = do getCabalPackageDbStack (StackProject StackEnv {..}) -> return $ map PackageDb [seSnapshotPkgDb, seLocalPkgDb] + ExplicitProject -> return [] return $ fromMaybe stack mCusPkgStack getPackageCachePaths :: IOish m => FilePath -> GhcModT m [FilePath] diff --git a/Language/Haskell/GhcMod/PathsAndFiles.hs b/Language/Haskell/GhcMod/PathsAndFiles.hs index 7f0aadf52..fe258f2f5 100644 --- a/Language/Haskell/GhcMod/PathsAndFiles.hs +++ b/Language/Haskell/GhcMod/PathsAndFiles.hs @@ -80,6 +80,15 @@ findStackConfigFile dir = do Just (d, Just a) -> return $ Just $ d a Just (_, Nothing) -> error "findStackConfigFile" +findExplicitOptionsFile :: FilePath -> IO (Maybe FilePath) +findExplicitOptionsFile dir = do + dss <- findFileInParentsP (==explicitOptionsFile) dir + return $ case find (not . null . snd) $ dss of + Just (expDir, _:_) -> Just (expDir explicitOptionsFile) + _ -> Nothing + where + explicitOptionsFile = "ghc-mod.options" + -- | Get path to sandbox config file getSandboxDb :: Cradle -> IO (Maybe GhcPkgDb) getSandboxDb crdl = do diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs index 11decbe0c..f9dfdea97 100644 --- a/Language/Haskell/GhcMod/Target.hs +++ b/Language/Haskell/GhcMod/Target.hs @@ -160,12 +160,19 @@ targetGhcOptions crdl sefnmn = do when (Set.null sefnmn) $ error "targetGhcOptions: no targets given" case cradleProject crdl of - proj - | isCabalHelperProject proj -> cabalOpts crdl - | otherwise -> sandboxOpts crdl + proj | isCabalHelperProject proj -> cabalOpts crdl + ExplicitProject -> explicitOpts crdl + _ -> sandboxOpts crdl where zipMap f l = l `zip` (f `map` l) + explicitOpts :: Cradle -> GhcModT m [String] + explicitOpts Cradle {..} = case cradleCabalFile of + Nothing -> return [] + Just optionsFile -> do + contents <- liftIO $ readFile optionsFile + return $ lines contents + cabalOpts :: Cradle -> GhcModT m [String] cabalOpts Cradle{..} = do mcs <- cabalResolvedComponents diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index ec1418daa..88f1a8c24 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -143,6 +143,7 @@ data Project = CabalProject | SandboxProject | PlainProject | StackProject StackEnv + | ExplicitProject deriving (Eq, Show) isCabalHelperProject :: Project -> Bool From 7b8ee8c5f72b94adfd72fdbc36988dbb0c62e8d3 Mon Sep 17 00:00:00 2001 From: Alex Lang Date: Wed, 16 Sep 2015 15:18:02 -0700 Subject: [PATCH 2/5] in ExplicitProject, add db stack options generated from ghc-mod.package-db-stack file --- Language/Haskell/GhcMod/Target.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs index f9dfdea97..89dd9b208 100644 --- a/Language/Haskell/GhcMod/Target.hs +++ b/Language/Haskell/GhcMod/Target.hs @@ -161,7 +161,10 @@ targetGhcOptions crdl sefnmn = do case cradleProject crdl of proj | isCabalHelperProject proj -> cabalOpts crdl - ExplicitProject -> explicitOpts crdl + ExplicitProject -> do + opts <- explicitOpts crdl + dbStack <- maybe [] id <$> getCustomPkgDbStack + return $ opts ++ ghcDbStackOpts dbStack _ -> sandboxOpts crdl where zipMap f l = l `zip` (f `map` l) From 4857b341ff5da2e72fd8f420de8d290707432ab2 Mon Sep 17 00:00:00 2001 From: Alex Lang Date: Thu, 17 Sep 2015 21:05:19 -0700 Subject: [PATCH 3/5] Remove dead code from test/InfoSpec.hs --- test/InfoSpec.hs | 9 --------- 1 file changed, 9 deletions(-) diff --git a/test/InfoSpec.hs b/test/InfoSpec.hs index 3bdd5ae53..498c0ae1d 100644 --- a/test/InfoSpec.hs +++ b/test/InfoSpec.hs @@ -1,15 +1,8 @@ {-# LANGUAGE CPP #-} module InfoSpec where -import Control.Applicative import Data.List (isPrefixOf) import Language.Haskell.GhcMod -#if __GLASGOW_HASKELL__ < 706 -import System.Environment.Executable (getExecutablePath) -#else -import System.Environment (getExecutablePath) -#endif -import System.FilePath import Test.Hspec import TestUtils import Prelude @@ -48,5 +41,3 @@ spec = do res <- runD' tdir $ info "ImportsTH.hs" $ Expression "bar" res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`) -getDistDir :: IO FilePath -getDistDir = takeDirectory . takeDirectory . takeDirectory <$> getExecutablePath From e233871fc22da3f55efefc3674998636b4ed4c6c Mon Sep 17 00:00:00 2001 From: Alex Lang Date: Thu, 17 Sep 2015 21:11:45 -0700 Subject: [PATCH 4/5] Add tests for modules, check, type and info with an Explicit project --- Language/Haskell/GhcMod/Cradle.hs | 2 +- test/CheckSpec.hs | 10 ++++++++++ test/InfoSpec.hs | 9 +++++++++ test/ListSpec.hs | 7 +++++++ 4 files changed, 27 insertions(+), 1 deletion(-) diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index 37910a60d..297be7968 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/Language/Haskell/GhcMod/Cradle.hs @@ -45,7 +45,7 @@ findCradle' dir = run $ findSpecCradle :: (IOish m, GmOut m) => FilePath -> m Cradle findSpecCradle dir = do - let cfs = [stackCradleSpec, cabalCradle, sandboxCradle] + let cfs = [stackCradleSpec, cabalCradle, sandboxCradle, explicitCradle] cs <- catMaybes <$> mapM (runMaybeT . ($ dir)) cfs gcs <- filterM isNotGmCradle cs fillTempDir =<< case gcs of diff --git a/test/CheckSpec.hs b/test/CheckSpec.hs index 1ff26e2e9..0877ba418 100644 --- a/test/CheckSpec.hs +++ b/test/CheckSpec.hs @@ -76,3 +76,13 @@ spec = do #else res `shouldBe` "NiceQualification.hs:4:8:Couldn't match expected type `IO ()' with actual type `[Char]'\NULIn the expression: \"wrong type\"\NULIn an equation for `main': main = \"wrong type\"\n" #endif + + it "works with explicit options" $ do + withDirectory_ "test/data/options-cradle" $ do + res <- runD $ checkSyntax ["src/Main.hs"] + res `shouldBe` "" + + it "emits error with explicit options" $ do + withDirectory_ "test/data/options-cradle" $ do + res <- runD $ checkSyntax ["src/Main2.hs"] + res `shouldBe` "src/Main2.hs:10:11:Couldn't match expected type \8216Int\8217 with actual type \8216a0 -> a0\8217\NULProbable cause: \8216id\8217 is applied to too few arguments\NULIn the second argument of \8216(+)\8217, namely \8216id\8217\NULIn the expression: 0 + id\n" diff --git a/test/InfoSpec.hs b/test/InfoSpec.hs index 498c0ae1d..0f7a1dc78 100644 --- a/test/InfoSpec.hs +++ b/test/InfoSpec.hs @@ -25,6 +25,11 @@ spec = do res <- runD' tdir $ types "ImportsTH.hs" 3 8 res `shouldBe` unlines ["3 8 3 16 \"String -> IO ()\"", "3 8 3 20 \"IO ()\"", "3 1 3 20 \"IO ()\""] + it "works with a module in Explicit project type" $ do + let tdir = "test/data/options-cradle" + res <- runD' tdir $ types "src/Main.hs" 7 10 + res `shouldBe` unlines ["7 8 7 14 \"() -> IO ()\"\n7 8 7 17 \"IO ()\"\n7 1 7 17 \"IO ()\""] + describe "info" $ do it "works for non exported functions" $ do let tdir = "test/data/non-exported" @@ -41,3 +46,7 @@ spec = do res <- runD' tdir $ info "ImportsTH.hs" $ Expression "bar" res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`) + it "works with a module in Explicit project type" $ do + let tdir = "test/data/options-cradle" + res <- runD' tdir $ info "src/Main.hs" $ Expression "foo" + res `shouldSatisfy` ("foo :: Int" `isPrefixOf`) diff --git a/test/ListSpec.hs b/test/ListSpec.hs index 828b08e03..49f81168d 100644 --- a/test/ListSpec.hs +++ b/test/ListSpec.hs @@ -1,6 +1,7 @@ module ListSpec where import Control.Applicative +import Dir import Language.Haskell.GhcMod import Test.Hspec import TestUtils @@ -12,3 +13,9 @@ spec = do it "contains at least `Data.Map'" $ do mdls <- runD $ lines <$> modules mdls `shouldContain` ["Data.Map"] + + describe "modules" $ do + it "contains at least `Main'" $ do + withDirectory_ "test/data/options-cradle" $ do + mdls <- runD $ lines <$> modules + mdls `shouldContain` ["Data.Map"] From 502d5a21f250b1d6ba33a376ef75ffafb4381bc4 Mon Sep 17 00:00:00 2001 From: Alex Lang Date: Thu, 17 Sep 2015 21:33:58 -0700 Subject: [PATCH 5/5] Add missing test data files for Explicit tests --- ghc-mod.cabal | 6 ++++++ test/data/options-cradle/ghc-mod.options | 2 ++ test/data/options-cradle/ghc-mod.package-db-stack | 5 +++++ .../data/options-cradle/package-db-a/package.cache | Bin 0 -> 40 bytes .../data/options-cradle/package-db-b/package.cache | Bin 0 -> 40 bytes .../data/options-cradle/package-db-c/package.cache | Bin 0 -> 40 bytes test/data/options-cradle/src/Main.hs | 10 ++++++++++ test/data/options-cradle/src/Main2.hs | 10 ++++++++++ 8 files changed, 33 insertions(+) create mode 100644 test/data/options-cradle/ghc-mod.options create mode 100644 test/data/options-cradle/ghc-mod.package-db-stack create mode 100644 test/data/options-cradle/package-db-a/package.cache create mode 100644 test/data/options-cradle/package-db-b/package.cache create mode 100644 test/data/options-cradle/package-db-c/package.cache create mode 100644 test/data/options-cradle/src/Main.hs create mode 100644 test/data/options-cradle/src/Main2.hs diff --git a/ghc-mod.cabal b/ghc-mod.cabal index ac660bf87..c909a8132 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -92,6 +92,12 @@ Extra-Source-Files: ChangeLog test/data/stack-project/app/*.hs test/data/stack-project/src/*.hs test/data/stack-project/test/*.hs + test/data/options-cradle/ghc-mod.options + test/data/options-cradle/ghc-mod.package-db-stack + test/data/options-cradle/package-db-a/package.cache + test/data/options-cradle/package-db-b/package.cache + test/data/options-cradle/package-db-c/package.cache + test/data/options-cradle/src/*.hs Library Default-Language: Haskell2010 diff --git a/test/data/options-cradle/ghc-mod.options b/test/data/options-cradle/ghc-mod.options new file mode 100644 index 000000000..bf11cfa3b --- /dev/null +++ b/test/data/options-cradle/ghc-mod.options @@ -0,0 +1,2 @@ +-isrc +-DINTERPRETED diff --git a/test/data/options-cradle/ghc-mod.package-db-stack b/test/data/options-cradle/ghc-mod.package-db-stack new file mode 100644 index 000000000..ce2d74166 --- /dev/null +++ b/test/data/options-cradle/ghc-mod.package-db-stack @@ -0,0 +1,5 @@ +global +user +package-db-a +package-db-b +package-db-c diff --git a/test/data/options-cradle/package-db-a/package.cache b/test/data/options-cradle/package-db-a/package.cache new file mode 100644 index 0000000000000000000000000000000000000000..b3cae5cf028ad4728b344193a7c6fe4e76e36af3 GIT binary patch literal 40 ZcmZQb&qyxFPG