pinned-warnings 0.1.0.7 → 0.1.0.8
raw patch · 4 files changed
+64/−72 lines, 4 files
Files
- pinned-warnings.cabal +1/−1
- src/Internal/FixWarnings.hs +42/−50
- src/Internal/Types.hs +2/−3
- src/PinnedWarnings.hs +19/−18
pinned-warnings.cabal view
@@ -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 <https://github.com/aaronallen8455/pinned-warnings#readme> homepage: https://github.com/aaronallen8455/pinned-warnings#readme
src/Internal/FixWarnings.hs view
@@ -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.
src/Internal/Types.hs view
@@ -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)
src/PinnedWarnings.hs view
@@ -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 =