Review early cutoff fingerprints

ghcide/src/Development/IDE/Core/Compile.hs

@@ -114,8 +114,6 @@ import           Control.Concurrent.Extra
 import           Control.Concurrent.STM            hiding (orElse)
 import           Data.Aeson                        (toJSON)
 import           Data.Binary
-import           Data.Binary.Put
-import qualified Data.ByteString.Lazy              as LBS
 import           Data.Coerce
 import           Data.Functor
 import qualified Data.HashMap.Strict               as HashMap
@@ -242,7 +240,7 @@ mkHiFileResultNoCompile session tcm = do
   (iface, _) <- mkIfaceTc hsc_env_tmp Nothing sf details tcGblEnv
 #endif
   let mod_info = HomeModInfo iface details Nothing
-  pure $! HiFileResult ms mod_info
+  pure $! mkHiFileResult ms mod_info
 
 mkHiFileResultCompile
     :: HscEnv
@@ -277,7 +275,7 @@ mkHiFileResultCompile session' tcm simplified_guts ltype = catchErrs $ do
   (final_iface,_) <- mkIface session Nothing details simplified_guts
 #endif
   let mod_info = HomeModInfo final_iface details linkable
-  pure (diags, Just $! HiFileResult ms mod_info)
+  pure (diags, Just $! mkHiFileResult ms mod_info)
 
   where
     dflags = hsc_dflags session'
@@ -750,13 +748,12 @@ getModSummaryFromImports env fp modTime contents = do
         -- Compute a fingerprint from the contents of `ModSummary`,
         -- eliding the timestamps, the preprocessed source and other non relevant fields
         computeFingerprint opts ModSummary{..} = do
-            let moduleUniques = runPut $ do
+            fingerPrintImports <- fingerprintFromPut $ do
                   put $ uniq $ moduleNameFS $ moduleName ms_mod
                   forM_ (ms_srcimps ++ ms_textual_imps) $ \(mb_p, m) -> do
                     put $ uniq $ moduleNameFS $ unLoc m
                     whenJust mb_p $ put . uniq
-            fingerPrintImports <- fingerprintFromByteString $ LBS.toStrict moduleUniques
-            return $ fingerprintFingerprints $
+            return $! fingerprintFingerprints $
                     [ fingerprintString fp
                     , fingerPrintImports
                     ] ++ map fingerprintString opts
@@ -927,7 +924,7 @@ loadInterface session ms sourceMod linkableNeeded regen = do
              if objUpToDate
              then do
                hmi <- liftIO $ mkDetailsFromIface sessionWithMsDynFlags iface linkable
-               return ([], Just $ HiFileResult ms hmi)
+               return ([], Just $ mkHiFileResult ms hmi)
              else regen linkableNeeded
           (_reason, _) -> regen linkableNeeded
 

ghcide/src/Development/IDE/Core/FileStore.hs

@@ -27,7 +27,7 @@ import           Control.Concurrent.STM                       (atomically)
 import           Control.Concurrent.STM.TQueue                (writeTQueue)
 import           Control.Exception
 import           Control.Monad.Extra
-import qualified Data.ByteString.Char8                        as BS
+import qualified Data.ByteString                              as BS
 import           Data.Either.Extra
 import qualified Data.HashMap.Strict                          as HM
 import           Data.Int                                     (Int64)
@@ -46,7 +46,6 @@ import           Development.IDE.Types.Diagnostics
 import           Development.IDE.Types.Location
 import           Development.IDE.Types.Options
 import           Development.Shake
-import           Development.Shake.Classes
 import           HieDb.Create                                 (deleteMissingRealFiles)
 import           Ide.Plugin.Config                            (CheckParents (..))
 import           System.IO.Error
@@ -66,12 +65,13 @@ import qualified System.Posix.Error                           as Posix
 
 import qualified Development.IDE.Types.Logger                 as L
 
+import qualified Data.Binary                                  as B
+import qualified Data.ByteString.Lazy                         as LBS
 import           Language.LSP.Server                          hiding
                                                               (getVirtualFile)
 import qualified Language.LSP.Server                          as LSP
 import           Language.LSP.Types                           (FileChangeType (FcChanged),
                                                                FileEvent (FileEvent),
-                                                               NormalizedFilePath (NormalizedFilePath),
                                                                toNormalizedFilePath,
                                                                uriToFilePath)
 import           Language.LSP.VFS
@@ -102,8 +102,16 @@ makeLSPVFSHandle lspEnv = VFSHandle
 isFileOfInterestRule :: Rules ()
 isFileOfInterestRule = defineEarlyCutoff $ RuleNoDiagnostics $ \IsFileOfInterest f -> do
     filesOfInterest <- getFilesOfInterest
-    let res = maybe NotFOI IsFOI $ f `HM.lookup` filesOfInterest
-    return (Just $ BS.pack $ show $ hash res, Just res)
+    let foi = maybe NotFOI IsFOI $ f `HM.lookup` filesOfInterest
+        fp  = summarize foi
+        res = (Just fp, Just foi)
+    return res
+    where
+    summarize NotFOI                   = BS.singleton 0
+    summarize (IsFOI OnDisk)           = BS.singleton 1
+    summarize (IsFOI (Modified False)) = BS.singleton 2
+    summarize (IsFOI (Modified True))  = BS.singleton 3
+
 
 getModificationTimeRule :: VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules ()
 getModificationTimeRule vfs isWatched = defineEarlyCutoff $ Rule $ \(GetModificationTime_ missingFileDiags) file ->
@@ -117,15 +125,15 @@ getModificationTimeImpl :: VFSHandle
         (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion))
 getModificationTimeImpl vfs isWatched missingFileDiags file = do
         let file' = fromNormalizedFilePath file
-        let wrap time@(l,s) = (Just $ BS.pack $ show time, ([], Just $ ModificationTime l s))
+        let wrap time@(l,s) = (Just $ LBS.toStrict $ B.encode time, ([], Just $ ModificationTime l s))
         mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri' file
         -- we use 'getVirtualFile' to discriminate FOIs so make that
         -- dependency explicit by using the IsFileOfInterest rule
         _ <- use_ IsFileOfInterest file
         case mbVirtual of
             Just (virtualFileVersion -> ver) -> do
                 alwaysRerun
-                pure (Just $ BS.pack $ show ver, ([], Just $ VFSVersion ver))
+                pure (Just $ LBS.toStrict $ B.encode ver, ([], Just $ VFSVersion ver))
             Nothing -> do
                 isWF <- isWatched file
                 unless (isWF || isInterface file) alwaysRerun

ghcide/src/Development/IDE/Core/OfInterest.hs

@@ -18,7 +18,6 @@ import           Control.DeepSeq
 import           Control.Exception
 import           Control.Monad
 import           Data.Binary
-import qualified Data.ByteString.UTF8                         as BS
 import           Data.HashMap.Strict                          (HashMap)
 import qualified Data.HashMap.Strict                          as HashMap
 import           Data.Hashable
@@ -30,6 +29,7 @@ import           GHC.Generics
 
 import           Control.Monad.Trans.Class
 import           Control.Monad.Trans.Maybe
+import qualified Data.ByteString.Lazy                         as LBS
 import           Data.List.Extra                              (nubOrd)
 import           Data.Maybe                                   (catMaybes)
 import           Development.IDE.Core.RuleTypes
@@ -59,15 +59,13 @@ ofInterestRules = do
     defineEarlyCutoff $ RuleNoDiagnostics $ \GetFilesOfInterest _file -> assert (null $ fromNormalizedFilePath _file) $ do
         alwaysRerun
         filesOfInterest <- getFilesOfInterestUntracked
-        pure (Just $ BS.fromString $ show filesOfInterest, Just filesOfInterest)
-
+        let !cutoff = LBS.toStrict $ encode $ HashMap.toList filesOfInterest
+        pure (Just cutoff, Just filesOfInterest)
 
 -- | Get the files that are open in the IDE.
 getFilesOfInterest :: Action (HashMap NormalizedFilePath FileOfInterestStatus)
 getFilesOfInterest = useNoFile_ GetFilesOfInterest
 
-
-
 ------------------------------------------------------------
 -- Exposed API
 

ghcide/src/Development/IDE/Core/RuleTypes.hs

@@ -36,10 +36,12 @@ import           HscTypes                                     (HomeModInfo,
                                                                hm_iface,
                                                                hm_linkable)
 
+import qualified Data.Binary                                  as B
 import           Data.ByteString                              (ByteString)
-import qualified Data.ByteString.Char8                        as BS
+import qualified Data.ByteString.Lazy                         as LBS
 import           Data.Int                                     (Int64)
 import           Data.Text                                    (Text)
+import           Data.Time
 import           Development.IDE.Import.FindImports           (ArtifactsLocation)
 import           Development.IDE.Spans.Common
 import           Development.IDE.Spans.LocalBindings
@@ -156,15 +158,23 @@ data HiFileResult = HiFileResult
     -- a reference to a typechecked module
     , hirHomeMod    :: !HomeModInfo
     -- ^ Includes the Linkable iff we need object files
+    , hirIfaceFp    :: ByteString
+    -- ^ Fingerprint for the ModIface
+    , hirLinkableFp :: ByteString
+    -- ^ Fingerprint for the Linkable
     }
 
 hiFileFingerPrint :: HiFileResult -> ByteString
-hiFileFingerPrint hfr = ifaceBS <> linkableBS
+hiFileFingerPrint HiFileResult{..} = hirIfaceFp <> hirLinkableFp
+
+mkHiFileResult :: ModSummary -> HomeModInfo -> HiFileResult
+mkHiFileResult hirModSummary hirHomeMod = HiFileResult{..}
   where
-    ifaceBS = fingerprintToBS . getModuleHash . hirModIface $ hfr -- will always be two bytes
-    linkableBS = case hm_linkable $ hirHomeMod hfr of
+    hirIfaceFp = fingerprintToBS . getModuleHash . hm_iface $ hirHomeMod -- will always be two bytes
+    hirLinkableFp = case hm_linkable hirHomeMod of
       Nothing -> ""
-      Just l  -> BS.pack $ show $ linkableTime l
+      Just (linkableTime -> l)  -> LBS.toStrict $
+        B.encode (fromEnum $ utctDay l, fromEnum $ utctDayTime l)
 
 hirModIface :: HiFileResult -> ModIface
 hirModIface = hm_iface . hirHomeMod