diff --git a/pinned-warnings.cabal b/pinned-warnings.cabal --- a/pinned-warnings.cabal +++ b/pinned-warnings.cabal @@ -4,7 +4,7 @@ -- http://haskell.org/cabal/users-guide/ name: pinned-warnings -version: 0.1.0.7 +version: 0.1.0.8 synopsis: Preserve warnings in a GHCi session description: Please see the README on GitHub at homepage: https://github.com/aaronallen8455/pinned-warnings#readme diff --git a/src/Internal/FixWarnings.hs b/src/Internal/FixWarnings.hs --- a/src/Internal/FixWarnings.hs +++ b/src/Internal/FixWarnings.hs @@ -24,68 +24,60 @@ -- | Fixes applicable warning and returns 'False' if all warnings for the -- corresponding span should be removed. -fixWarning :: WarningsWithModDate -> IO WarningsWithModDate -fixWarning MkWarningsWithModDate - { lastUpdated = Alt (Just modifiedAt) +fixWarning :: ModuleFile -> WarningsWithModDate -> IO WarningsWithModDate +fixWarning modFile + warns@MkWarningsWithModDate + { lastUpdated = modifiedAt , warningsMap = MonoidMap warnMap } = do - -- State is used to keep the contents of a source file in memory while all - -- applicable warnings for that file are fixed. - (pairs, files) <- (`runStateT` M.empty) - . flip filterM (reverse $ M.toList warnMap) $ \case - ((start, _), warnSet) - | Alt (Just reWarn) -- Take the first redundancy warning parsed - <- foldMap (Alt . parseRedundancyWarn) warnSet - -> do - let file = Ghc.unpackFS $ Ghc.srcLocFile start - mCached <- gets (M.lookup file) - - -- Get the src lines from the cache or read it from the file - srcLines <- - maybe (liftIO . fmap BS.lines $ BS.readFile file) - pure - mCached + let file = Ghc.unpackFS modFile + lastModification <- liftIO $ Dir.getModificationTime file - fileModified <- liftIO $ Dir.getModificationTime file - if fileModified /= modifiedAt - then do - -- Do not attempt to edit if file has been touched since last reload - liftIO . putStrLn - $ "'" <> file - <> "' has been modified since last compiled. Reload and try again." - pure True + -- Do not attempt to edit if file has been touched since last reload + if lastModification /= modifiedAt + then do + putStrLn + $ "'" <> file + <> "' has been modified since last compiled. Reload and try again." + pure warns - -- attempt to fix the warning - else do - let startLine = Ghc.srcLocLine start - mNewSrcLines = - fixRedundancyWarning startLine reWarn srcLines + else do + curSrcLines <- liftIO . fmap BS.lines $ BS.readFile file - case mNewSrcLines of - Nothing -> pure True + -- State is used to keep the contents of the source file in memory while + -- warnings for the file are fixed. + (pairs, newFileContents) <- (`runStateT` curSrcLines) + . flip filterM (reverse $ M.toList warnMap) $ \case + ((start, _), warnSet) + | Alt (Just reWarn) -- Take the first redundancy warning parsed + <- foldMap (Alt . parseRedundancyWarn) warnSet + -> do + srcLines <- get - Just newSrcLines -> do - modify' $ M.insert file newSrcLines + -- attempt to fix the warning + let startLine = Ghc.srcLocLine start + mNewSrcLines = + fixRedundancyWarning startLine reWarn srcLines - pure False + case mNewSrcLines of + Nothing -> pure True - _ -> pure True + Just newSrcLines -> do + put newSrcLines + pure False - -- write the changes to the file - _ <- M.traverseWithKey - (\file ls -> do - BS.writeFile file $ BS.unlines ls - putStrLn $ "'" <> file <> "' has been edited" - ) - files + _ -> pure True - pure MkWarningsWithModDate - { lastUpdated = Alt Nothing - , warningsMap = MonoidMap $ M.fromList pairs - } + when (length pairs /= length warnMap) $ do + -- write the changes to the file + BS.writeFile file $ BS.unlines newFileContents + putStrLn $ "'" <> file <> "' has been edited" -fixWarning w = pure w + pure MkWarningsWithModDate + { lastUpdated = lastModification + , warningsMap = MonoidMap $ M.fromList pairs + } -- | Attempt to fix redundant import warning. -- Returns 'Nothing' if incapable of fixing. diff --git a/src/Internal/Types.hs b/src/Internal/Types.hs --- a/src/Internal/Types.hs +++ b/src/Internal/Types.hs @@ -7,7 +7,6 @@ , WarningsWithModDate(..) ) where -import Data.Monoid (Alt(..)) import qualified Data.Map.Strict as M import qualified Data.Set as S import Data.Time @@ -37,11 +36,11 @@ data WarningsWithModDate = MkWarningsWithModDate - { lastUpdated :: !(Alt Maybe UTCTime) -- Last time the module was modified + { lastUpdated :: !UTCTime -- Last time the module was modified , warningsMap :: !(MonoidMap SrcSpanKey (S.Set Warning)) } instance Semigroup WarningsWithModDate where a <> b = MkWarningsWithModDate - (lastUpdated a <> lastUpdated b) + (max (lastUpdated a) (lastUpdated b)) (warningsMap a <> warningsMap b) diff --git a/src/PinnedWarnings.hs b/src/PinnedWarnings.hs --- a/src/PinnedWarnings.hs +++ b/src/PinnedWarnings.hs @@ -8,7 +8,6 @@ import Control.Monad.IO.Class import Data.IORef import Data.List -import Data.Monoid (Alt(..)) import qualified Data.Map.Strict as M import Data.Maybe import qualified Data.Set as S @@ -135,13 +134,15 @@ -- | Remove warnings for modules that no longer exist pruneDeleted :: IO () pruneDeleted = modifyMVar_ globalState $ \warns -> do - let mods = M.keys warns + -- remove keys that have no warnings + let warns' = M.filter (not . null . warningsMap) warns + mods = M.keys warns' deletedMods <- filterM (fmap not . Dir.doesFileExist . Ghc.unpackFS) mods - pure $ foldl' (flip M.delete) warns deletedMods + pure $ foldl' (flip M.delete) warns' deletedMods -- | Removes currently pinned warnings for a module and updates the timestamp. -- This occurs before any new warnings are captured for the module. @@ -151,15 +152,9 @@ -> Ghc.Hsc Ghc.HsParsedModule resetPinnedWarnsForMod modSummary parsedModule = do let modFile = fromString $ Ghc.ms_hspp_file modSummary - modifiedTime = Alt . Just $ Ghc.ms_hs_date modSummary - -- Replace any existing pinned warnings with new ones for this module liftIO . modifyMVar_ globalState - $ pure . M.insert modFile - MkWarningsWithModDate - { lastUpdated = modifiedTime - , warningsMap = mempty - } + $ pure . M.delete modFile pure parsedModule @@ -179,13 +174,17 @@ . Warning $ Ghc.mkWarnMsg dyn srcSpan Ghc.alwaysQualify msgDoc - modifyMVar_ globalState - $ pure - . M.insertWith (<>) modFile - MkWarningsWithModDate - { lastUpdated = mempty - , warningsMap = MonoidMap warn - } + let file = Ghc.unpackFS modFile + exists <- Dir.doesFileExist file + when exists $ do + fileModifiedAt <- Dir.getModificationTime file + modifyMVar_ globalState + $ pure + . M.insertWith (<>) modFile + MkWarningsWithModDate + { lastUpdated = fileModifiedAt + , warningsMap = MonoidMap warn + } _ -> pure () } @@ -193,7 +192,9 @@ fixWarnings :: IO () fixWarnings = do pruneDeleted - modifyMVar_ globalState $ traverse FW.fixWarning + + modifyMVar_ globalState $ + M.traverseWithKey FW.fixWarning clearWarnings :: IO () clearWarnings =