From 19b3de356928f7c1a7aa3a59430beae08a883e7b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= <dxld@darkboxed.org>
Date: Thu, 24 Sep 2015 05:27:20 +0200
Subject: [PATCH] Preserve cabal flags when reconfiguring project

---
 Language/Haskell/GhcMod/CabalHelper.hs | 29 +++++++++++++++++++-------
 test/CabalHelperSpec.hs                | 23 +++++++++++++++-----
 2 files changed, 40 insertions(+), 12 deletions(-)

diff --git a/Language/Haskell/GhcMod/CabalHelper.hs b/Language/Haskell/GhcMod/CabalHelper.hs
index 8aa0f19..34f277d 100644
--- a/Language/Haskell/GhcMod/CabalHelper.hs
+++ b/Language/Haskell/GhcMod/CabalHelper.hs
@@ -172,13 +172,16 @@ withCabal action = do
     mCabalConfig        <- liftIO $ timeMaybe (setupConfigFile crdl)
     mCabalSandboxConfig <- liftIO $ timeMaybe (sandboxConfigFile crdl)
 
+    let haveSetupConfig = isJust mCabalConfig
+
     cusPkgDb <- getCustomPkgDbStack
-    pkgDbStackOutOfSync <- do
-      if isJust mCabalConfig
+    (flgs, pkgDbStackOutOfSync) <- do
+      if haveSetupConfig
         then runCHQuery $ do
+          flgs <- nonDefaultConfigFlags
           pkgDb <- map chPkgToGhcPkg <$> packageDbStack
-          return $ fromMaybe False $ (pkgDb /=) <$> cusPkgDb
-        else return False
+          return (flgs, fromMaybe False $ (pkgDb /=) <$> cusPkgDb)
+        else return ([], False)
 
     when (isSetupConfigOutOfDate mCabalFile mCabalConfig) $
       gmLog GmDebug "" $ strDoc $ "setup configuration is out of date"
@@ -197,9 +200,16 @@ withCabal action = do
           case proj of
             CabalProject -> do
                 gmLog GmDebug "" $ strDoc "reconfiguring Cabal project"
-                cabalReconfigure (optPrograms opts) crdl
+                cabalReconfigure (optPrograms opts) crdl flgs
             StackProject {} -> do
                 gmLog GmDebug "" $ strDoc "reconfiguring Stack project"
+                -- TODO: we could support flags for stack too, but it seems
+                -- you're supposed to put those in stack.yaml so detecting which
+                -- flags to pass down would be more difficult
+
+                -- "--flag PACKAGE:[-]FLAG Override flags set in stack.yaml
+                -- (applies to local packages and extra-deps)"
+
                 stackReconfigure crdl (optPrograms opts)
             _ ->
                 error $ "withCabal: unsupported project type: " ++ show proj
@@ -207,7 +217,7 @@ withCabal action = do
     action
 
  where
-   cabalReconfigure progs crdl = do
+   cabalReconfigure progs crdl flgs = do
      readProc <- gmReadProcess
      withDirectory_ (cradleRootDir crdl) $ do
         cusPkgStack <- maybe [] ((PackageDb "clear"):) <$> getCustomPkgDbStack
@@ -219,8 +229,13 @@ withCabal action = do
                      then [ "--with-ghc-pkg=" ++ T.ghcPkgProgram progs ]
                      else []
                 ++ map pkgDbArg cusPkgStack
-        liftIO $ void $ readProc (T.cabalProgram progs) ("configure":progOpts) ""
+                ++ flagOpt
 
+            toFlag (f, True) = f
+            toFlag (f, False) = '-':f
+            flagOpt = ["--flags", unwords $ map toFlag flgs]
+
+        liftIO $ void $ readProc (T.cabalProgram progs) ("configure":progOpts) ""
    stackReconfigure crdl progs = do
      withDirectory_ (cradleRootDir crdl) $ do
        supported <- haveStackSupport
diff --git a/test/CabalHelperSpec.hs b/test/CabalHelperSpec.hs
index a400fc6..8b9851b 100644
--- a/test/CabalHelperSpec.hs
+++ b/test/CabalHelperSpec.hs
@@ -70,12 +70,25 @@ spec = do
                 pkgs = pkgOptions ghcOpts
             pkgs `shouldBe` ["Cabal","base","template-haskell"]
 
-        it "uses non default flags" $ do
+        it "uses non default flags and preserves them across reconfigures" $ do
             let tdir = "test/data/cabal-flags"
             _ <- withDirectory_ tdir $
                 readProcess "cabal" ["configure", "-ftest-flag"] ""
 
-            opts <- map gmcGhcOpts <$> runD' tdir getComponents
-            let ghcOpts = head opts
-                pkgs = pkgOptions ghcOpts
-            pkgs `shouldBe` ["Cabal","base"]
+            let test = do
+                  opts <- map gmcGhcOpts <$> runD' tdir getComponents
+                  let ghcOpts = head opts
+                      pkgs = pkgOptions ghcOpts
+                  pkgs `shouldBe` ["Cabal","base"]
+
+            test
+
+            touch $ tdir </> "cabal-flags.cabal"
+
+            test
+
+touch :: FilePath -> IO ()
+touch fn = do
+  f <- readFile fn
+  writeFile (fn <.> "tmp") f
+  renameFile (fn <.> "tmp") fn