diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index 51d2afa85..297be7968 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/Language/Haskell/GhcMod/Cradle.hs @@ -38,13 +38,14 @@ findCradle' dir = run $ msum [ stackCradle dir , cabalCradle dir , sandboxCradle dir + , explicitCradle dir , plainCradle dir ] where run a = fillTempDir =<< (fromJust <$> runMaybeT a) 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 @@ -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..89dd9b208 100644 --- a/Language/Haskell/GhcMod/Target.hs +++ b/Language/Haskell/GhcMod/Target.hs @@ -160,12 +160,22 @@ 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 -> do + opts <- explicitOpts crdl + dbStack <- maybe [] id <$> getCustomPkgDbStack + return $ opts ++ ghcDbStackOpts dbStack + _ -> 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 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/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 3bdd5ae53..0f7a1dc78 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 @@ -32,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" @@ -48,5 +46,7 @@ spec = do res <- runD' tdir $ info "ImportsTH.hs" $ Expression "bar" res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`) -getDistDir :: IO FilePath -getDistDir = takeDirectory . takeDirectory . takeDirectory <$> getExecutablePath + 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"] 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 000000000..b3cae5cf0 Binary files /dev/null and b/test/data/options-cradle/package-db-a/package.cache differ diff --git a/test/data/options-cradle/package-db-b/package.cache b/test/data/options-cradle/package-db-b/package.cache new file mode 100644 index 000000000..b3cae5cf0 Binary files /dev/null and b/test/data/options-cradle/package-db-b/package.cache differ diff --git a/test/data/options-cradle/package-db-c/package.cache b/test/data/options-cradle/package-db-c/package.cache new file mode 100644 index 000000000..b3cae5cf0 Binary files /dev/null and b/test/data/options-cradle/package-db-c/package.cache differ diff --git a/test/data/options-cradle/src/Main.hs b/test/data/options-cradle/src/Main.hs new file mode 100644 index 000000000..086db61c1 --- /dev/null +++ b/test/data/options-cradle/src/Main.hs @@ -0,0 +1,10 @@ +module Main + ( main + , foo + ) where + +main :: IO () +main = return () + +foo :: Int +foo = 0 diff --git a/test/data/options-cradle/src/Main2.hs b/test/data/options-cradle/src/Main2.hs new file mode 100644 index 000000000..ce7c2ddcf --- /dev/null +++ b/test/data/options-cradle/src/Main2.hs @@ -0,0 +1,10 @@ +module Main2 + ( main + , foo + ) where + +main :: IO () +main = return () + +foo :: Int +foo = 0 + id