From 03c7631aed9e46f1ab1f3b7658f05bb0c4f68960 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 10 Mar 2021 09:33:31 +0000 Subject: [PATCH 1/4] Review early cutoff fingerprints Some of these were unnecessary, while others were very inefficient --- ghcide/src/Development/IDE/Core/Compile.hs | 13 ++-- ghcide/src/Development/IDE/Core/FileStore.hs | 22 ++++-- ghcide/src/Development/IDE/Core/OfInterest.hs | 8 +-- ghcide/src/Development/IDE/Core/RuleTypes.hs | 14 +++- ghcide/src/Development/IDE/Core/Rules.hs | 67 +++++++++++-------- ghcide/src/Development/IDE/GHC/Util.hs | 12 ++-- 6 files changed, 82 insertions(+), 54 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 55c0cc6c65..928e2f09cf 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/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 diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 8f31c863e8..8b63a0a7f6 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/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,7 +125,7 @@ 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 @@ -125,7 +133,7 @@ getModificationTimeImpl vfs isWatched missingFileDiags file = do 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 diff --git a/ghcide/src/Development/IDE/Core/OfInterest.hs b/ghcide/src/Development/IDE/Core/OfInterest.hs index 4ea6003258..ecdae7d77a 100644 --- a/ghcide/src/Development/IDE/Core/OfInterest.hs +++ b/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 diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index d845bacc0e..61bf8d05cb 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -156,13 +156,21 @@ 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 diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 3caca775d8..eca3e24e64 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -72,7 +72,7 @@ import Control.Monad.Trans.Maybe import Data.Aeson (Result (Success), toJSON) import Data.Binary hiding (get, put) -import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString as BS import Data.Foldable import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as IntMap @@ -150,6 +150,8 @@ import TcRnMonad (tcg_dependent_fil import qualified Data.Aeson.Types as A import qualified HieDb import Ide.Plugin.Config +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Binary as B -- | This is useful for rules to convert rules that can only produce errors or -- a result into the more general IdeResult type that supports producing @@ -308,7 +310,9 @@ priorityFilesOfInterest = Priority (-2) -- and https://github.com/mpickering/ghcide/pull/22#issuecomment-625070490 -- GHC wiki about: https://gitlab.haskell.org/ghc/ghc/-/wikis/api-annotations getParsedModuleRule :: Rules () -getParsedModuleRule = defineEarlyCutoff $ Rule $ \GetParsedModule file -> do +getParsedModuleRule = + -- this rule does not have early cutoff since all its dependencies already have it + define $ \GetParsedModule file -> do ModSummaryResult{msrModSummary = ms} <- use_ GetModSummary file sess <- use_ GhcSession file let hsc = hscEnv sess @@ -318,7 +322,7 @@ getParsedModuleRule = defineEarlyCutoff $ Rule $ \GetParsedModule file -> do mainParse = getParsedModuleDefinition hsc opt file ms -- Parse again (if necessary) to capture Haddock parse errors - res@(_, (_,pmod)) <- if gopt Opt_Haddock dflags + res@(_,pmod) <- if gopt Opt_Haddock dflags then liftIO mainParse else do @@ -330,7 +334,7 @@ getParsedModuleRule = defineEarlyCutoff $ Rule $ \GetParsedModule file -> do -- If we can parse Haddocks, might as well use them -- -- HLINT INTEGRATION: might need to save the other parsed module too - ((fp,(diags,res)),(fph,(diagsh,resh))) <- liftIO $ concurrently mainParse haddockParse + ((diags,res),(diagsh,resh)) <- liftIO $ concurrently mainParse haddockParse -- Merge haddock and regular diagnostics so we can always report haddock -- parse errors @@ -338,12 +342,12 @@ getParsedModuleRule = defineEarlyCutoff $ Rule $ \GetParsedModule file -> do case resh of Just _ | HaddockParse <- optHaddockParse opt - -> pure (fph, (diagsM, resh)) + -> pure (diagsM, resh) -- If we fail to parse haddocks, report the haddock diagnostics as well and -- return the non-haddock parse. -- This seems to be the correct behaviour because the Haddock flag is added -- by us and not the user, so our IDE shouldn't stop working because of it. - _ -> pure (fp, (diagsM, res)) + _ -> pure (diagsM, res) -- Add dependencies on included files _ <- uses GetModificationTime $ map toNormalizedFilePath' (maybe [] pm_extra_src_files pmod) pure res @@ -372,26 +376,30 @@ mergeParseErrorsHaddock normal haddock = normal ++ -- | This rule provides a ParsedModule preserving all annotations, -- including keywords, punctuation and comments. -- So it is suitable for use cases where you need a perfect edit. --- FIXME this rule should probably not produce diagnostics getParsedModuleWithCommentsRule :: Rules () -getParsedModuleWithCommentsRule = defineEarlyCutoff $ Rule $ \GetParsedModuleWithComments file -> do +getParsedModuleWithCommentsRule = + -- The parse diagnostics are owned by the GetParsedModule rule + -- For this reason, this rule does not produce any diagnostics + defineNoDiagnostics $ \GetParsedModuleWithComments file -> do ModSummaryResult{msrModSummary = ms} <- use_ GetModSummary file sess <- use_ GhcSession file opt <- getIdeOptions let ms' = withoutOption Opt_Haddock $ withOption Opt_KeepRawTokenStream ms - liftIO $ getParsedModuleDefinition (hscEnv sess) opt file ms' + liftIO $ snd <$> getParsedModuleDefinition (hscEnv sess) opt file ms' -getParsedModuleDefinition :: HscEnv -> IdeOptions -> NormalizedFilePath -> ModSummary -> IO (Maybe BS.ByteString, ([FileDiagnostic], Maybe ParsedModule)) +getParsedModuleDefinition + :: HscEnv + -> IdeOptions + -> NormalizedFilePath + -> ModSummary -> IO (([FileDiagnostic], Maybe ParsedModule)) getParsedModuleDefinition packageState opt file ms = do let fp = fromNormalizedFilePath file (diag, res) <- parseModule opt packageState fp ms case res of - Nothing -> pure (Nothing, (diag, Nothing)) - Just modu -> do - mbFingerprint <- traverse (fmap fingerprintToBS . fingerprintFromStringBuffer) (ms_hspp_buf ms) - pure (mbFingerprint, (diag, Just modu)) + Nothing -> pure (diag, Nothing) + Just modu -> pure (diag, Just modu) getLocatedImportsRule :: Rules () getLocatedImportsRule = @@ -686,7 +694,7 @@ knownFilesRule :: Rules () knownFilesRule = defineEarlyCutOffNoFile $ \GetKnownTargets -> do alwaysRerun fs <- knownTargets - pure (BS.pack (show $ hash fs), unhashed fs) + pure (LBS.toStrict $ B.encode $ hash fs, unhashed fs) getModuleGraphRule :: Rules () getModuleGraphRule = defineNoFile $ \GetModuleGraph -> do @@ -737,8 +745,8 @@ loadGhcSession = do opts <- getIdeOptions res <- optGhcSession opts - let fingerprint = hash (sessionVersion res) - return (BS.pack (show fingerprint), res) + let fingerprint = LBS.toStrict $ B.encode $ hash (sessionVersion res) + return (fingerprint, res) defineEarlyCutoff $ Rule $ \GhcSession file -> do IdeGhcSession{loadSessionFun} <- useNoFile_ GhcSessionIO @@ -759,7 +767,7 @@ loadGhcSession = do Just {} -> "" -- Hash the HscEnvEq returned so cutoff if it didn't change -- from last time - Nothing -> BS.pack (show (hash (snd val))) + Nothing -> LBS.toStrict $ B.encode (hash (snd val)) return (Just cutoffHash, val) define $ \GhcSessionDeps file -> ghcSessionDepsDefinition file @@ -815,7 +823,9 @@ getModIfaceFromDiskRule = defineEarlyCutoff $ Rule $ \GetModIfaceFromDisk f -> d -- disk since we are careful to write out the `.hie` file before writing the -- `.hi` file getModIfaceFromDiskAndIndexRule :: Rules () -getModIfaceFromDiskAndIndexRule = defineEarlyCutoff $ RuleNoDiagnostics $ \GetModIfaceFromDiskAndIndex f -> do +getModIfaceFromDiskAndIndexRule = + -- doesn't need early cutoff since all its dependencies already have it + defineNoDiagnostics $ \GetModIfaceFromDiskAndIndex f -> do x <- use_ GetModIfaceFromDisk f se@ShakeExtras{hiedb} <- getShakeExtras @@ -844,8 +854,7 @@ getModIfaceFromDiskAndIndexRule = defineEarlyCutoff $ RuleNoDiagnostics $ \GetMo L.logDebug (logger se) $ "Re-indexing hie file for" <> T.pack (fromNormalizedFilePath f) indexHieFile se ms f hash hf - let fp = hiFileFingerPrint x - return (Just fp, Just x) + return (Just x) isHiFileStableRule :: Rules () isHiFileStableRule = defineEarlyCutoff $ RuleNoDiagnostics $ \IsHiFileStable f -> do @@ -866,7 +875,11 @@ isHiFileStableRule = defineEarlyCutoff $ RuleNoDiagnostics $ \IsHiFileStable f - pure $ if all (== SourceUnmodifiedAndStable) deps then SourceUnmodifiedAndStable else SourceUnmodified - return (Just (BS.pack $ show sourceModified), Just sourceModified) + return (Just (summarize sourceModified), Just sourceModified) + where + summarize SourceModified = BS.singleton 1 + summarize SourceUnmodified = BS.singleton 2 + summarize SourceUnmodifiedAndStable = BS.singleton 3 getModSummaryRule :: Rules () getModSummaryRule = do @@ -942,7 +955,7 @@ getModIfaceWithoutLinkableRule = defineEarlyCutoff $ RuleNoDiagnostics $ \GetMod mhfr <- use GetModIface f let mhfr' = fmap (\x -> x{ hirHomeMod = (hirHomeMod x){ hm_linkable = Just (error msg) } }) mhfr msg = "tried to look at linkable for GetModIfaceWithoutLinkable for " ++ show f - pure (fingerprintToBS . getModuleHash . hirModIface <$> mhfr', mhfr') + pure (hirIfaceFp <$> mhfr', mhfr') -- | Also generates and indexes the `.hie` file, along with the `.o` file if needed -- Invariant maintained is that if the `.hi` file was successfully written, then the @@ -953,12 +966,12 @@ regenerateHiFile sess f ms compNeeded = do opt <- getIdeOptions -- Embed haddocks in the interface file - (_, (diags, mb_pm)) <- liftIO $ getParsedModuleDefinition hsc opt f (withOptHaddock ms) + (diags, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f (withOptHaddock ms) (diags, mb_pm) <- case mb_pm of Just _ -> return (diags, mb_pm) Nothing -> do -- if parsing fails, try parsing again with Haddock turned off - (_, (diagsNoHaddock, mb_pm)) <- liftIO $ getParsedModuleDefinition hsc opt f ms + (diagsNoHaddock, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f ms return (mergeParseErrorsHaddock diagsNoHaddock diags, mb_pm) case mb_pm of Nothing -> return (diags, Nothing) @@ -1021,7 +1034,7 @@ getClientSettingsRule :: Rules () getClientSettingsRule = defineEarlyCutOffNoFile $ \GetClientSettings -> do alwaysRerun settings <- clientSettings <$> getIdeConfiguration - return (BS.pack . show . hash $ settings, settings) + return (LBS.toStrict $ B.encode $ hash settings, settings) -- | Returns the client configurarion stored in the IdeState. -- You can use this function to access it from shake Rules @@ -1062,7 +1075,7 @@ needsCompilationRule = defineEarlyCutoff $ RuleNoDiagnostics $ \NeedsCompilation (uses NeedsCompilation revdeps) pure $ computeLinkableType ms modsums (map join needsComps) - pure (Just $ BS.pack $ show $ hash res, Just res) + pure (Just $ LBS.toStrict $ B.encode $ hash res, Just res) where uses_th_qq (ms_hspp_opts -> dflags) = xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index 014907da7d..f50cf1e386 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -21,6 +21,7 @@ module Development.IDE.GHC.Util( fingerprintToBS, fingerprintFromByteString, fingerprintFromStringBuffer, + fingerprintFromPut, -- * General utilities readFileUtf8, hDuplicateTo', @@ -31,9 +32,11 @@ module Development.IDE.GHC.Util( import Control.Concurrent import Control.Exception +import Data.Binary.Put (Put, runPut) import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString (..)) import qualified Data.ByteString.Internal as BS +import qualified Data.ByteString.Lazy as LBS import Data.IORef import Data.List.Extra import Data.Maybe @@ -41,7 +44,8 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T import Data.Typeable -import DynFlags +import Development.IDE.GHC.Compat as GHC +import Development.IDE.Types.Location import FastString (mkFastString) import FileCleanup import Fingerprint @@ -74,9 +78,6 @@ import SrcLoc (mkRealSrcLoc) import StringBuffer import System.FilePath -import Development.IDE.GHC.Compat as GHC -import Development.IDE.Types.Location - ---------------------------------------------------------------------- -- GHC setup @@ -207,6 +208,9 @@ fingerprintFromByteString bs = do withForeignPtr fptr $ \ptr -> fingerprintData (ptr `plusPtr` offset) len +fingerprintFromPut :: Put -> IO Fingerprint +fingerprintFromPut = fingerprintFromByteString . LBS.toStrict . runPut + -- | A slightly modified version of 'hDuplicateTo' from GHC. -- Importantly, it avoids the bug listed in https://gitlab.haskell.org/ghc/ghc/merge_requests/2318. hDuplicateTo' :: Handle -> Handle -> IO () From 69d9e52585abbe6ddcb81a7a949614993328e947 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 10 Mar 2021 15:22:41 +0000 Subject: [PATCH 2/4] fix lint --- ghcide/src/Development/IDE/Core/Rules.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index eca3e24e64..6b48cc0245 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -393,7 +393,7 @@ getParsedModuleDefinition :: HscEnv -> IdeOptions -> NormalizedFilePath - -> ModSummary -> IO (([FileDiagnostic], Maybe ParsedModule)) + -> ModSummary -> IO ([FileDiagnostic], Maybe ParsedModule) getParsedModuleDefinition packageState opt file ms = do let fp = fromNormalizedFilePath file (diag, res) <- parseModule opt packageState fp ms From ea519c6323ecf813eec61c48b2e9a5ac6a9ae88a Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 10 Mar 2021 15:22:59 +0000 Subject: [PATCH 3/4] fix one more fingerprint --- ghcide/src/Development/IDE/Core/RuleTypes.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 61bf8d05cb..cb6ed72db9 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/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 @@ -168,11 +170,11 @@ hiFileFingerPrint HiFileResult{..} = hirIfaceFp <> hirLinkableFp mkHiFileResult :: ModSummary -> HomeModInfo -> HiFileResult mkHiFileResult hirModSummary hirHomeMod = HiFileResult{..} where - hirIfaceFp = - fingerprintToBS . getModuleHash . hm_iface $ hirHomeMod -- will always be two bytes + 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 LM{linkableTime} -> LBS.toStrict $ + B.encode (fromEnum $ utctDay linkableTime, fromEnum $ utctDayTime linkableTime) hirModIface :: HiFileResult -> ModIface hirModIface = hm_iface . hirHomeMod From 7a0655d57474b890789b4d8b72193415bf31a9be Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 10 Mar 2021 17:29:59 +0000 Subject: [PATCH 4/4] GHC compat. --- ghcide/src/Development/IDE/Core/RuleTypes.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index cb6ed72db9..e7601aa1df 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -173,8 +173,8 @@ mkHiFileResult hirModSummary hirHomeMod = HiFileResult{..} hirIfaceFp = fingerprintToBS . getModuleHash . hm_iface $ hirHomeMod -- will always be two bytes hirLinkableFp = case hm_linkable hirHomeMod of Nothing -> "" - Just LM{linkableTime} -> LBS.toStrict $ - B.encode (fromEnum $ utctDay linkableTime, fromEnum $ utctDayTime linkableTime) + Just (linkableTime -> l) -> LBS.toStrict $ + B.encode (fromEnum $ utctDay l, fromEnum $ utctDayTime l) hirModIface :: HiFileResult -> ModIface hirModIface = hm_iface . hirHomeMod