Horrible hack to identify changed DynFlags

core/GhcMod/DynFlags.hs

@@ -103,6 +103,7 @@ deferErrors df = return $
 ----------------------------------------------------------------
 
 deriveEqDynFlags [d|
-  eqDynFlags :: DynFlags -> DynFlags -> Bool
+  eqDynFlags :: DynFlags -> DynFlags -> [[(Bool, String)]]
+  -- eqDynFlags :: DynFlags -> DynFlags -> ([Bool], [String])
   eqDynFlags = undefined
  |]

core/GhcMod/DynFlagsTH.hs

@@ -14,18 +14,53 @@
 -- You should have received a copy of the GNU Affero General Public License
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE CPP, TemplateHaskell #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 module GhcMod.DynFlagsTH where
 
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax
 import Control.Applicative
+import Data.Data
 import Data.Maybe
 import Data.Generics.Aliases
 import Data.Generics.Schemes
+import BasicTypes
 import DynFlags
 import Prelude
 
+deriving instance Data GhcMode
+deriving instance Data GhcLink
+deriving instance Data HscTarget
+deriving instance Data Way
+deriving instance Data DynLibLoader
+deriving instance Data Option
+deriving instance Data IgnorePackageFlag
+deriving instance Data PackageFlag
+deriving instance Data ModRenaming
+deriving instance Data PackageArg
+deriving instance Data TrustFlag
+deriving instance Data SafeHaskellMode
+-- deriving instance Data SseVersion
+
+-- -------------------------------------
+
+-- instance Data SseVersion where
+--   toConstr _ = toConstr SseVersionD
+
+-- data SseVersionData = SseVersionD deriving Data
+
+-- -------------------------------------
+
+instance Data IntWithInf where
+  toConstr _ = toConstr IntWithInfD
+
+data IntWithInfData = IntWithInfD deriving Data
+
+-- -------------------------------------
+
 deriveEqDynFlags :: Q [Dec] -> Q [Dec]
 deriveEqDynFlags qds = do
 #if __GLASGOW_HASKELL__ <= 710
@@ -39,7 +74,11 @@ deriveEqDynFlags qds = do
   a <- newName "a"
   b <- newName "b"
 
-  e <- AppE (VarE 'and) . ListE <$> sequence (catMaybes $ map (eq a b) fs)
+  -- let combFunc = [| \(bs,ss) -> (and bs, unwords ss) |]
+
+  -- e <- AppE (VarE 'and) . ListE <$> sequence (mapMaybe (eq a b) fs)
+  -- e <- AppE (combFunc) . ListE <$> sequence $ combFunc (catMaybes $ map (eq a b) fs)
+  e <- ListE <$> sequence (mapMaybe (eq a b) fs)
 
   tysig@(SigD n _) :_ <- qds
 
@@ -68,6 +107,7 @@ deriveEqDynFlags qds = do
 #if __GLASGOW_HASKELL__ <= 706
                       , "ways" -- 'Ways' is not exported :/
 #endif
+                      , "sseVersion"
                       ]
        ignoredTypeNames =
            [ "LogAction"
@@ -84,31 +124,42 @@ deriveEqDynFlags qds = do
        expr =
          case fon of
            "rtsOptsEnabled" -> do
-               let eqfn = [| let fn RtsOptsNone RtsOptsNone = True
+               let eqfn = [| let fn RtsOptsNone RtsOptsNone = [(True, "")]
-                                 fn RtsOptsSafeOnly RtsOptsSafeOnly = True
+                                 fn RtsOptsSafeOnly RtsOptsSafeOnly = [(True, "")]
-                                 fn RtsOptsAll RtsOptsAll = True
+                                 fn RtsOptsAll RtsOptsAll = [(True, "")]
-                                 fn _ _ = False
+                                 fn _ _ = [(False, "rtsOptsEnabled changed")]
                              in fn
                           |]
                [e| $(eqfn) $(return fa) $(return fb) |]
 
            "extraPkgConfs" -> do
-               let eqfn = [| let fn a' b' = and (zipWith eqpr (a' []) (b' []))
+               -- let eqfn = [| let fn a' b' = and (zipWith eqpr (a' []) (b' []))
-                                        && length (a' []) == length (b' [])
+               --                          && length (a' []) == length (b' [])
-                                 eqpr GlobalPkgConf GlobalPkgConf = True
+               let eqfn = [| let fn a' b' = cond a' b'
-                                 eqpr UserPkgConf UserPkgConf = True
+
-                                 eqpr (PkgConfFile pa) (PkgConfFile pb) = pa == pb
+                                 cond a' b' = zz ++ ll
-                                 eqpr _ _ = False
+                                   where
+                                    zz :: [(Bool,String)]
+                                    zz = (zipWith eqpr (a' []) (b' []))
+
+                                    ll :: [(Bool,String)]
+                                    ll = [(   length (a' []) == length (b' [])
+                                         , if length (a' []) == length (b' []) then "" else "extraPkgConfs length mismatch")]
+
+                                 eqpr GlobalPkgConf GlobalPkgConf = (True, "")
+                                 eqpr UserPkgConf UserPkgConf = (True, "")
+                                 eqpr (PkgConfFile pa) (PkgConfFile pb) = (pa == pb,if pa == pb then "" else "extraPkgConfs changed")
+                                 eqpr _ _ = (False, "extraPkgConfs changed")
                              in fn
                           |]
                [e| $(eqfn) $(return fa) $(return fb) |]
 
 #if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 800
            "sigOf" -> do
-               let eqfn = [| let fn NotSigOf NotSigOf = True
+               let eqfn = [| let fn NotSigOf NotSigOf = [(True, "")]
-                                 fn (SigOf a') (SigOf b') = a' == b'
+                                 fn (SigOf a') (SigOf b') = [(a' == b', if a' == b' then "" else "sigOf changed")]
-                                 fn (SigOfMap a') (SigOfMap b') = a' == b'
+                                 fn (SigOfMap a') (SigOfMap b') = [(a' == b', if a' == b' then "" else "sigOfMap changed")]
-                                 fn _ _ = False
+                                 fn _ _ = [(False, "sigOf changed")]
                              in fn
                           |]
                [e| $(eqfn) $(return fa) $(return fb) |]
@@ -116,12 +167,12 @@ deriveEqDynFlags qds = do
 
 #if __GLASGOW_HASKELL <= 706
            "profAuto" -> do
-               let eqfn = [| let fn NoProfAuto NoProfAuto = True
+               let eqfn = [| let fn NoProfAuto NoProfAuto = [(True, "")]
-                                 fn ProfAutoAll ProfAutoAll = True
+                                 fn ProfAutoAll ProfAutoAll = [(True, "")]
-                                 fn ProfAutoTop ProfAutoTop = True
+                                 fn ProfAutoTop ProfAutoTop = [(True, "")]
-                                 fn ProfAutoExports ProfAutoExports = True
+                                 fn ProfAutoExports ProfAutoExports = [(True, "")]
-                                 fn ProfAutoCalls ProfAutoCalls = True
+                                 fn ProfAutoCalls ProfAutoCalls = [(True, "")]
-                                 fn _ _ = False
+                                 fn _ _ = [(False, "profAuto changed")]
                              in fn
                           |]
                [e| $(eqfn) $(return fa) $(return fb) |]
@@ -129,16 +180,18 @@ deriveEqDynFlags qds = do
 
 #if __GLASGOW_HASKELL__ >= 706
            "language" -> do
-               let eqfn = [| let fn (Just Haskell98) (Just Haskell98) = True
+               let eqfn = [| let fn (Just Haskell98) (Just Haskell98) = [(True, "")]
-                                 fn (Just Haskell2010) (Just Haskell2010) = True
+                                 fn (Just Haskell2010) (Just Haskell2010) = [(True, "")]
-                                 fn Nothing Nothing = True
+                                 fn Nothing Nothing = [(True, "")]
-                                 fn _ _ = False
+                                 fn _ _ = [(False, "language changed")]
                              in fn
                           |]
                [e| $(eqfn) $(return fa) $(return fb) |]
 #endif
 
            _ ->
-               [e| $(return fa) == $(return fb)  |]
+               -- [e| $(return fa) == $(return fb)  |]
+               -- [e| [($(return fa) == $(return fb), if $(return fa) == $(return fb) then "" else "default changed")] |]
+               [e| [($(return fa) == $(return fb), if $(return fa) == $(return fb) then "" else ("default changed:" ++ fon ++ ":" ++ (show $ toConstr $(return fa)) ++ " /= " ++ (show $ toConstr $(return fa))  )     )] |]
 
 --       expr' = [e| trace (if $(expr) == True then "" else show ($(litE $ StringL fon), $(expr))) $(expr) |]

core/GhcMod/Target.hs

@@ -85,8 +85,13 @@ initSession opts mdf = do
 
          df <- liftIO $ hsc_dflags <$> readIORef hsc_env_ref
          changed <-
-             withLightHscEnv' (initDF crdl) $ \hsc_env ->
+             withLightHscEnv' (initDF crdl) $ \hsc_env -> do
-               return $ not $ hsc_dflags hsc_env `eqDynFlags` df
+               let dfEq = concat $ hsc_dflags hsc_env `eqDynFlags` df
+               gmLog GmDebug "initSession" $ text $ "dfEq=" ++ (show $ filter (\t -> not (fst t)) dfEq)
+               -- gmLog GmDebug "initSession" $ text $ "dfEq=" ++ (show  dfEq)
+               let eq = and $ map fst dfEq
+               -- return $ not $ hsc_dflags hsc_env `eqDynFlags` df
+               return $ not eq
 
          if changed
             then do