Add an ExplicitProject constructor, which reads options from a file

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    = ""
+      }

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]

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

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

Language/Haskell/GhcMod/Types.hs

@@ -143,6 +143,7 @@ data Project = CabalProject
              | SandboxProject
              | PlainProject
              | StackProject StackEnv
+             | ExplicitProject
                deriving (Eq, Show)
 
 isCabalHelperProject :: Project -> Bool

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

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"

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`)

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"]

test/data/options-cradle/ghc-mod.options

@@ -0,0 +1,2 @@
+-isrc
+-DINTERPRETED

test/data/options-cradle/ghc-mod.package-db-stack

@@ -0,0 +1,5 @@
+global
+user
+package-db-a
+package-db-b
+package-db-c

test/data/options-cradle/src/Main.hs

@@ -0,0 +1,10 @@
+module Main
+  ( main
+  , foo
+  ) where
+
+main :: IO ()
+main = return ()
+
+foo :: Int
+foo = 0

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