Skip to content

Commit 3127a8a

Browse files
wavewavewavewave
authored
withStage helper (#253)
* withStage helper * remove stale code * a few cosmetic changes
1 parent 9415000 commit 3127a8a

File tree

6 files changed

+39
-46
lines changed

6 files changed

+39
-46
lines changed

‎daemon/app/ghc-specter-daemon/Render/BlockerView.hs‎

Lines changed: 4 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ where
99
import Control.Monad.Extra (whenM)
1010
import Control.Monad.IO.Class (liftIO)
1111
import Control.Monad.Trans.State.Strict (StateT, get)
12-
import Data.Foldable (for_, traverse_)
12+
import Data.Foldable (traverse_)
1313
import Data.List qualified as L
1414
import Data.Maybe (fromMaybe)
1515
import Data.Time.Clock (secondsToNominalDiffTime)
@@ -18,10 +18,7 @@ import Foreign.Marshal.Utils (fromBool, toBool)
1818
import GHCSpecter.Channel.Outbound.Types (ModuleGraphInfo (..))
1919
import GHCSpecter.Data.Map (backwardLookup)
2020
import GHCSpecter.Data.Timing.Types (PipelineInfo (..), TimingTable (..))
21-
import GHCSpecter.Graphics.DSL
22-
( Scene (..),
23-
Stage (..),
24-
)
21+
import GHCSpecter.Graphics.DSL (Scene (..))
2522
import GHCSpecter.Server.Types
2623
( ModuleGraphState (..),
2724
ServerState (..),
@@ -37,7 +34,7 @@ import GHCSpecter.UI.Types.Event
3734
)
3835
import Handler (sendToControl)
3936
import ImGui qualified
40-
import Render.Common (renderComponent)
37+
import Render.Common (renderComponent, withStage)
4138
import Util.Render
4239
( SharedState (..),
4340
mkRenderState,
@@ -66,8 +63,7 @@ render _ui ss = do
6663
Nothing -> pure ()
6764
Just blockerGraphViz -> do
6865
renderState <- mkRenderState
69-
let Stage stage = shared.sharedStage
70-
for_ (L.find ((== "blocker-module-graph") . sceneId) stage) $ \stageBlocker -> do
66+
withStage "blocker-module-graph" $ \stageBlocker -> do
7167
runImRender renderState $
7268
renderComponent
7369
True

‎daemon/app/ghc-specter-daemon/Render/Common.hs‎

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,15 +3,21 @@
33

44
module Render.Common
55
( renderComponent,
6+
withStage,
67
)
78
where
89

910
import Control.Monad (when)
1011
import Control.Monad.IO.Class (liftIO)
12+
import Control.Monad.Trans.State.Strict (StateT, get)
13+
import Data.Foldable (traverse_)
1114
import Data.Functor.Identity (runIdentity)
15+
import Data.List qualified as L
16+
import Data.Text (Text)
1217
import GHCSpecter.Graphics.DSL
1318
( Primitive,
1419
Scene (..),
20+
Stage (..),
1521
ViewPort (..),
1622
)
1723
import GHCSpecter.Layouter.Text (MonadTextLayout (..))
@@ -25,6 +31,7 @@ import ImGui
2531
import STD.Deletable (delete)
2632
import Util.Render
2733
( ImRender,
34+
SharedState (..),
2835
addEventMap,
2936
buildEventMap,
3037
renderScene,
@@ -61,3 +68,12 @@ renderComponent doesHandleScroll toEv buildScene = do
6168
(vx1, vy1) = scene.sceneGlobalViewPort.bottomRight
6269
totalW = vx1 - vx0
6370
totalH = vy1 - vy0
71+
72+
withStage ::
73+
Text ->
74+
(Scene () -> StateT (SharedState UserEvent) IO a) ->
75+
StateT (SharedState UserEvent) IO ()
76+
withStage scene_name action = do
77+
shared <- get
78+
let Stage stage = shared.sharedStage
79+
traverse_ action (L.find ((== scene_name) . sceneId) stage)

‎daemon/app/ghc-specter-daemon/Render/ModuleGraph.hs‎

Lines changed: 5 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -10,20 +10,16 @@ where
1010
import Control.Error.Util (note)
1111
import Control.Monad.Extra (whenM)
1212
import Control.Monad.IO.Class (liftIO)
13-
import Control.Monad.Trans.State.Strict (StateT, get)
13+
import Control.Monad.Trans.State.Strict (StateT)
1414
import Data.Bits ((.|.))
15-
import Data.Foldable (for_)
1615
import Data.List qualified as L
1716
import Data.Maybe (fromMaybe)
1817
import Data.Text qualified as T
1918
import Foreign.C.String (CString)
2019
import Foreign.Marshal.Utils (fromBool, toBool)
2120
import GHCSpecter.Channel.Outbound.Types (ModuleGraphInfo (..))
2221
import GHCSpecter.Data.Timing.Util (isModuleCompilationDone)
23-
import GHCSpecter.Graphics.DSL
24-
( Scene (..),
25-
Stage (..),
26-
)
22+
import GHCSpecter.Graphics.DSL (Scene (..))
2723
import GHCSpecter.Server.Types
2824
( ModuleGraphState (..),
2925
ServerState (..),
@@ -41,7 +37,7 @@ import GHCSpecter.UI.Types.Event
4137
)
4238
import ImGui qualified
4339
import ImGui.Enum (ImGuiTableFlags_ (..))
44-
import Render.Common (renderComponent)
40+
import Render.Common (renderComponent, withStage)
4541
import STD.Deletable (delete)
4642
import Text.Printf (printf)
4743
import Util.GUI (windowFlagsNoScroll)
@@ -88,9 +84,7 @@ renderMainModuleGraph ui ss = do
8884
mainModuleClicked = mgrui._modGraphUIClick
8985
mainModuleHovered = mgrui._modGraphUIHover
9086
renderState <- mkRenderState
91-
shared <- get
92-
let Stage stage = shared.sharedStage
93-
for_ (L.find ((== "main-module-graph") . sceneId) stage) $ \stageMain -> do
87+
withStage "main-module-graph" $ \stageMain -> do
9488
runImRender renderState $
9589
renderComponent
9690
True
@@ -134,9 +128,7 @@ renderSubModuleGraph ui ss = do
134128
| isModuleCompilationDone drvModMap timing name = 1
135129
| otherwise = 0
136130
renderState <- mkRenderState
137-
shared <- get
138-
let Stage stage = shared.sharedStage
139-
for_ (L.find ((== "sub-module-graph") . sceneId) stage) $ \stageSub -> do
131+
withStage "sub-module-graph" $ \stageSub -> do
140132
runImRender renderState $
141133
renderComponent
142134
True

‎daemon/app/ghc-specter-daemon/Render/SourceView.hs‎

Lines changed: 9 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ import Data.Text qualified as T
1919
import Foreign.C.String (CString)
2020
import Foreign.Marshal.Utils (fromBool, toBool)
2121
import GHCSpecter.Data.GHC.Hie (ModuleHieInfo (..))
22-
import GHCSpecter.Graphics.DSL (Scene (..), Stage (..))
22+
import GHCSpecter.Graphics.DSL (Scene (..))
2323
import GHCSpecter.Server.Types
2424
( HieState (..),
2525
ServerState (..),
@@ -39,7 +39,7 @@ import GHCSpecter.UI.Types.Event
3939
import GHCSpecter.Worker.CallGraph (getReducedTopLevelDecls)
4040
import Handler (sendToControl)
4141
import ImGui qualified
42-
import Render.Common (renderComponent)
42+
import Render.Common (renderComponent, withStage)
4343
import STD.Deletable (delete)
4444
import Util.GUI
4545
( defTableFlags,
@@ -55,33 +55,29 @@ import Util.Render
5555

5656
render :: UIState -> ServerState -> StateT (SharedState UserEvent) IO ()
5757
render ui ss = do
58-
vec1 <- liftIO $ ImGui.newImVec2 400 0
59-
vec2 <- liftIO $ ImGui.newImVec2 400 0
60-
vec3 <- liftIO $ ImGui.newImVec2 400 0
58+
zero <- liftIO $ ImGui.newImVec2 0 0
6159
whenM (toBool <$> liftIO (ImGui.beginTable ("##table" :: CString) 3 defTableFlags)) $ do
6260
liftIO $ ImGui.tableSetupColumn_ ("graph" :: CString)
6361
liftIO $ ImGui.tableNextRow 0
6462
liftIO $ ImGui.tableSetColumnIndex 0
65-
_ <- liftIO $ ImGui.beginChild ("#module-tree" :: CString) vec1 (fromBool False) windowFlagsNoScrollbar
63+
_ <- liftIO $ ImGui.beginChild ("#module-tree" :: CString) zero (fromBool False) windowFlagsNoScrollbar
6664
renderModuleTree srcUI ss
6765
liftIO ImGui.endChild
6866
--
6967
liftIO $ ImGui.tableSetColumnIndex 1
70-
_ <- liftIO $ ImGui.beginChild ("#source-view" :: CString) vec2 (fromBool False) windowFlagsNoScroll
68+
_ <- liftIO $ ImGui.beginChild ("#source-view" :: CString) zero (fromBool False) windowFlagsNoScroll
7169
for_ mexpandedModu $ \modu ->
7270
renderSourceTextView modu ss
7371
liftIO ImGui.endChild
7472
--
7573
liftIO $ ImGui.tableSetColumnIndex 2
76-
_ <- liftIO $ ImGui.beginChild ("#supp-view" :: CString) vec3 (fromBool False) windowFlagsNoScroll
74+
_ <- liftIO $ ImGui.beginChild ("#supp-view" :: CString) zero (fromBool False) windowFlagsNoScroll
7775
for_ mexpandedModu $ \modu ->
7876
renderSuppViewPanel modu srcUI ss
7977
liftIO ImGui.endChild
8078
--
8179
liftIO ImGui.endTable
82-
liftIO $ delete vec1
83-
liftIO $ delete vec2
84-
liftIO $ delete vec3
80+
liftIO $ delete zero
8581
where
8682
srcUI = ui._uiModel._modelSourceView
8783
mexpandedModu = srcUI._srcViewExpandedModule
@@ -102,9 +98,7 @@ renderSourceTextView modu ss = do
10298
let topLevelDecls = getReducedTopLevelDecls modHieInfo
10399
src = modHieInfo._modHieSource
104100
renderState <- mkRenderState
105-
shared <- get
106-
let Stage stage = shared.sharedStage
107-
for_ (L.find ((== "source-view") . sceneId) stage) $ \stage_source ->
101+
withStage "source-view" $ \stage_source ->
108102
runImRender renderState $
109103
renderComponent
110104
True
@@ -149,9 +143,7 @@ renderSuppViewPanel modu srcUI ss = do
149143
renderSuppViewContents :: Text -> SourceViewUI -> ServerState -> StateT (SharedState UserEvent) IO ()
150144
renderSuppViewContents modu srcUI ss = do
151145
renderState <- mkRenderState
152-
shared <- get
153-
let Stage stage = shared.sharedStage
154-
for_ (L.find ((== "supple-view-contents") . sceneId) stage) $ \stage_supp -> do
146+
withStage "supple-view-contents" $ \stage_supp ->
155147
runImRender renderState $ do
156148
renderComponent
157149
True

‎daemon/app/ghc-specter-daemon/Render/TimingView.hs‎

Lines changed: 4 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,6 @@ import Control.Monad.Extra (whenM)
1010
import Control.Monad.IO.Class (liftIO)
1111
import Control.Monad.Trans.State.Strict (StateT, get)
1212
import Data.Foldable (for_)
13-
import Data.List qualified as L
1413
import Data.Maybe (fromMaybe, isNothing)
1514
import Foreign.C.String (CString)
1615
import Foreign.Marshal.Alloc (alloca)
@@ -22,7 +21,6 @@ import GHCSpecter.Data.Timing.Types
2221
)
2322
import GHCSpecter.Graphics.DSL
2423
( Scene (..),
25-
Stage (..),
2624
ViewPort (..),
2725
)
2826
import GHCSpecter.Server.Types
@@ -46,7 +44,7 @@ import GHCSpecter.UI.Types.Event
4644
import Handler (sendToControl)
4745
import ImGui qualified
4846
import ImGui.ImVec2.Implementation (imVec2_x_get, imVec2_y_get)
49-
import Render.Common (renderComponent)
47+
import Render.Common (renderComponent, withStage)
5048
import STD.Deletable (delete)
5149
import Util.GUI (windowFlagsNoScroll)
5250
import Util.Render
@@ -72,10 +70,9 @@ render ui ss = do
7270
sendToControl shared (TimingEv (snd freezeOrThaw))
7371

7472
renderState <- mkRenderState
75-
let Stage stage = shared.sharedStage
76-
for_ (L.find ((== "timing-chart") . sceneId) stage) $ \stageTiming ->
77-
for_ (L.find ((== "mem-chart") . sceneId) stage) $ \stageMemory ->
78-
for_ (L.find ((== "timing-range") . sceneId) stage) $ \stageRange -> do
73+
withStage "timing-chart" $ \stageTiming ->
74+
withStage "mem-chart" $ \stageMemory ->
75+
withStage "timing-range" $ \stageRange -> do
7976
let ViewPort (_, vy0) (_, vy1) = stageTiming.sceneLocalViewPort
8077
runImRender renderState $ do
8178
renderComponent

‎daemon/src/GHCSpecter/UI/Components/TextView.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ rowSize :: Double
3636
rowSize = 8
3737

3838
ratio :: Double
39-
ratio = 1.3 -- 0.625
39+
ratio = 0.9
4040

4141
charSize :: Double
4242
charSize = rowSize * ratio

0 commit comments

Comments
 (0)