From 5a0fd46ed992fc1613043082ceae0f7b30951c69 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Mon, 19 Jun 2023 16:30:45 +0200 Subject: [PATCH] Upgrade to GHC 9.2 and drop support for earlier GHCs. --- CHANGELOG.md | 4 +++ bin/viewprof.hs | 60 ++++++++++++++++++------------------- viewprof.cabal | 79 ++++++++++++++++++++++++------------------------- 3 files changed, 72 insertions(+), 71 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8acfff4..2c61810 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for viewprof +## 0.0.1.0 - 2023-06-? + +* Upgrade to GHC 9.2. + ## 0.0.0.33 - 2020-05-05 * Relax upper version bound for base, brick, lens, and vty diff --git a/bin/viewprof.hs b/bin/viewprof.hs index adba65c..df39047 100644 --- a/bin/viewprof.hs +++ b/bin/viewprof.hs @@ -122,98 +122,98 @@ app = App { appDraw = drawProfile , appChooseCursor = neverShowCursor , appHandleEvent = handleProfileEvent - , appStartEvent = return + , appStartEvent = pure () , appAttrMap = const $ attrMap defAttr [ (selectedAttr, black `Brick.on` white) ] } -handleProfileEvent :: Profile -> BrickEvent Name e -> EventM Name (Next Profile) -handleProfileEvent prof@Profile {..} ev = case ev of +handleProfileEvent :: BrickEvent Name e -> EventM Name Profile () +handleProfileEvent ev = get >>= \prof@Profile {..} -> case ev of VtyEvent vtyEv -> case vtyEv of EvResize {} -> do invalidateCache - continue prof + put prof EvKey key [] | key `elem` [KEsc, KChar 'q'] -> if | Just _ <- prof ^. modalView -> do invalidateCache - continue $! prof & modalView .~ Nothing - | null (NE.tail (prof ^. views)) -> halt prof + put $! prof & modalView .~ Nothing + | null (NE.tail (prof ^. views)) -> halt | otherwise -> do invalidateCache - continue $! popView prof + put $! popView prof | key `elem` [KUp, KChar 'k'] -> do let !pos = prof ^. currentFocus for_ [pos, pos-1] $ invalidateCacheEntry . currentCacheEntry prof - continue $! moveUp prof + put $! moveUp prof | key `elem` [KDown, KChar 'j'] -> do let !pos = prof ^. currentFocus for_ [pos, pos+1] $ invalidateCacheEntry . currentCacheEntry prof - continue $! moveDown prof + put $! moveDown prof | key `elem` [KChar 'C'] -> do invalidateCache - continue $! displayCostCentres prof + put $! displayCostCentres prof | key `elem` [KChar 'M'] -> do invalidateCache - continue $! displayModules prof + put $! displayModules prof | key `elem` [KChar 'g'] -> if prof ^. lastKeyEvent == Just (KChar 'g', []) then do invalidateCache - continue $! moveToTop $ prof & lastKeyEvent .~ Nothing + put $! moveToTop $ prof & lastKeyEvent .~ Nothing else - continue $! prof & lastKeyEvent .~ Just (key, []) + put $! prof & lastKeyEvent .~ Just (key, []) | key `elem` [KChar 'G'] -> do invalidateCache - continue $! moveToEnd prof + put $! moveToEnd prof | key `elem` [KChar 'i'] -> - continue $! prof & modalView ?~ InfoView + put $! prof & modalView ?~ InfoView | key `elem` [KChar 'h', KChar '?'] -> - continue $! prof & modalView ?~ HelpView + put $! prof & modalView ?~ HelpView _ -> case NE.head _views of AggregatesView {} -> case vtyEv of EvKey (KChar 't') [] -> do invalidateCache - continue $! sortCostCentresBy + put $! sortCostCentresBy (Prof.aggregatedCostCentreTime &&& Prof.aggregatedCostCentreAlloc) prof EvKey (KChar 'a') [] -> do invalidateCache - continue $! sortCostCentresBy + put $! sortCostCentresBy (Prof.aggregatedCostCentreAlloc &&& Prof.aggregatedCostCentreTime) prof EvKey (KChar 'e') [] -> do invalidateCache - continue $! sortCostCentresBy + put $! sortCostCentresBy Prof.aggregatedCostCentreEntries prof EvKey key [] | key `elem` [KEnter] -> do invalidateCache - continue $! displayCallers prof - _ -> continue prof + put $! displayCallers prof + _ -> put prof CallSitesView {} -> case vtyEv of EvKey (KChar 't') [] -> do invalidateCache - continue $! sortCallSitesBy + put $! sortCallSitesBy (Prof.callSiteContribTime &&& Prof.callSiteContribAlloc) prof EvKey (KChar 'a') [] -> do invalidateCache - continue $! sortCallSitesBy + put $! sortCallSitesBy (Prof.callSiteContribAlloc &&& Prof.callSiteContribTime) prof EvKey (KChar 'e') [] -> do invalidateCache - continue $! sortCallSitesBy + put $! sortCallSitesBy Prof.callSiteContribEntries prof - _ -> continue prof - ModulesView {} -> continue prof - _ -> continue prof + _ -> put prof + ModulesView {} -> put prof + _ -> put prof where - popView p = case NE.nonEmpty (NE.tail _views) of + popView p = case NE.nonEmpty (NE.tail $ _views p) of Nothing -> p Just xs -> p & views .~ xs moveUp p = p & currentFocus %~ (\i -> max 0 (i - 1)) @@ -272,10 +272,10 @@ currentCacheEntry p n = case p ^. topView of ModulesView {} -> ModulesCache n profileAttr :: AttrName -profileAttr = "profile" +profileAttr = attrName "profile" selectedAttr :: AttrName -selectedAttr = "selected" +selectedAttr = attrName "selected" drawProfile :: Profile -> [Widget Name] drawProfile prof = diff --git a/viewprof.cabal b/viewprof.cabal index 9c6be1a..792aa1b 100644 --- a/viewprof.cabal +++ b/viewprof.cabal @@ -1,51 +1,48 @@ -name: viewprof -version: 0.0.0.33 -synopsis: Text-based interactive GHC .prof viewer +cabal-version: 3.0 +name: viewprof +version: 0.0.1.0 +synopsis: Text-based interactive GHC .prof viewer description: - viewprof is a text-based interactive GHC .prof viewer. - . - You can find a screenshot and some explanation in - . -homepage: https://github.com/maoe/viewprof -bug-reports: https://github.com/maoe/viewprof/issues -license: BSD3 -license-file: LICENSE -author: Mitsutoshi Aoe -maintainer: Mitsutoshi Aoe -copyright: Copyright (C) 2016-2020 Mitsutoshi Aoe -category: Development -build-type: Simple -extra-source-files: + viewprof is a text-based interactive GHC .prof viewer. + . + You can find a screenshot and some explanation in + . + +homepage: https://github.com/maoe/viewprof +bug-reports: https://github.com/maoe/viewprof/issues +license-file: LICENSE +license: BSD-3-Clause +author: Mitsutoshi Aoe +maintainer: Mitsutoshi Aoe +copyright: Copyright (C) 2016-2020 Mitsutoshi Aoe +category: Development +build-type: Simple +extra-doc-files: CHANGELOG.md - README.md img/screenshot.png -cabal-version: >= 1.10 -tested-with: - GHC == 8.0.2 - || == 8.2.2 - || == 8.4.4 - || == 8.6.5 - || == 8.8.3 - || == 8.10.1 + README.md + +tested-with: GHC ==9.2.8 executable viewprof - main-is: viewprof.hs + main-is: viewprof.hs build-depends: - base >= 4.9 && < 4.15 - , brick > 0.26.1 && < 0.54 - , containers >= 0.5.7 && < 0.7 - , directory >= 1.3 && < 1.4 - , ghc-prof >= 1.4 && < 1.5 - , lens >= 4.14 && < 4.20 - , scientific >= 0.3.4.4 && < 0.4 - , text >= 1.2.2.0 && < 1.3 - , vector >= 0.10.12.3 && < 0.13 - , vector-algorithms >= 0.6.0.4 && < 0.9 - , vty >= 5.13 && < 5.29 - hs-source-dirs: bin + , base ^>=4.16 + , brick ^>=1.9 + , containers ^>=0.6.5 + , directory ^>=1.3.6 + , ghc-prof ^>=1.4.1 + , lens ^>=5.2.2 + , scientific ^>=0.3.7 + , text ^>=1.2.5 + , vector ^>=0.13.0 + , vector-algorithms ^>=0.9.0 + , vty ^>=5.38 + + hs-source-dirs: bin default-language: Haskell2010 - ghc-options: -Wall -threaded + ghc-options: -Wall -threaded source-repository head - type: git + type: git location: https://github.com/maoe/viewprof.git