never executed always true always false
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE ConstraintKinds #-}
3 {-# LANGUAGE DataKinds #-}
4 {-# LANGUAGE DuplicateRecordFields #-}
5 {-# LANGUAGE OverloadedStrings #-}
6
7 {-# OPTIONS -fno-warn-orphans #-}
8
9 {- |
10 Module : NITTA.UIBackend.ViewHelper
11 Description : Types for marshaling data for REST API
12 Copyright : (c) Aleksandr Penskoi, 2021
13 License : BSD3
14 Maintainer : aleksandr.penskoi@gmail.com
15 Stability : experimental
16
17 We can not autogenerate ToJSON implementation for some types, so we add helper
18 types for doing that automatically. Why do we need to generate `ToJSON`
19 automatically? We don't want to achieve consistency between client and server
20 manually.
21 -}
22 module NITTA.UIBackend.ViewHelper (
23 module NITTA.UIBackend.ViewHelperCls,
24 module NITTA.Model.Problems.ViewHelper,
25 FView (..),
26 Viewable (..),
27 viewNodeTree,
28 TreeView,
29 ShortNodeView,
30 NodeView,
31 StepInfoView (..),
32 VarValTimeJSON,
33 ) where
34
35 import Control.Concurrent.STM
36 import Data.Aeson
37 import Data.HashMap.Strict qualified as HM
38 import Data.Maybe
39 import Data.Set qualified as S
40 import Data.Text qualified as T
41 import Data.Typeable
42 import GHC.Generics
43 import NITTA.Intermediate.Types
44 import NITTA.Model.Problems
45 import NITTA.Model.Problems.ViewHelper
46 import NITTA.Model.ProcessorUnits
47 import NITTA.Model.TargetSystem
48 import NITTA.Project.TestBench
49 import NITTA.Synthesis.Analysis
50 import NITTA.Synthesis.Steps
51 import NITTA.Synthesis.Types
52 import NITTA.UIBackend.ViewHelperCls
53 import NITTA.Utils.Base
54 import Numeric.Interval.NonEmpty
55 import Servant.Docs
56
57 -- Synthesis tree
58
59 data TreeView a = TreeNodeView
60 { rootLabel :: a
61 , subForest :: [TreeView a]
62 }
63 deriving (Generic, Show)
64
65 instance ToJSON a => ToJSON (TreeView a)
66
67 instance ToSample (TreeView ShortNodeView) where
68 toSamples _ =
69 singleSample $
70 TreeNodeView
71 { rootLabel =
72 ShortNodeView
73 { sid = showText $ Sid []
74 , isTerminal = False
75 , isFinish = False
76 , isProcessed = True
77 , duration = 0
78 , score = 0 / 0
79 , decsionType = "-"
80 }
81 , subForest =
82 [ TreeNodeView
83 { rootLabel =
84 ShortNodeView
85 { sid = showText $ Sid [0]
86 , isTerminal = False
87 , isFinish = False
88 , isProcessed = False
89 , duration = 0
90 , score = 4052
91 , decsionType = "Bind"
92 }
93 , subForest = []
94 }
95 , TreeNodeView
96 { rootLabel =
97 ShortNodeView
98 { sid = showText $ Sid [1]
99 , isTerminal = False
100 , isFinish = False
101 , isProcessed = False
102 , duration = 0
103 , score = 3021
104 , decsionType = "Bind"
105 }
106 , subForest = []
107 }
108 ]
109 }
110
111 instance ToSample Integer where
112 toSamples _ =
113 singleSample 0
114
115 data ShortNodeView = ShortNodeView
116 { sid :: T.Text
117 , isTerminal :: Bool
118 , isFinish :: Bool
119 , isProcessed :: Bool
120 , duration :: Int
121 , score :: Float
122 , decsionType :: T.Text
123 }
124 deriving (Generic, Show)
125
126 data NodeInfo = NodeInfo
127 { sid :: String
128 , isTerminal :: Bool
129 , isProcessed :: Bool
130 , duration :: Int
131 , score :: Float
132 , decsionType :: String
133 }
134 deriving (Generic, Show)
135
136 instance ToJSON ShortNodeView
137 instance ToJSON TreeInfo
138
139 instance ToSample TreeInfo where
140 toSamples _ =
141 singleSample mempty
142
143 viewNodeTree tree@Tree{sID = sid, sDecision, sSubForestVar} = do
144 subForestM <- atomically $ tryReadTMVar sSubForestVar
145 subForest <- maybe (return []) (mapM viewNodeTree) subForestM
146 return
147 TreeNodeView
148 { rootLabel =
149 ShortNodeView
150 { sid = showText sid
151 , isTerminal = isLeaf tree
152 , isFinish = isComplete tree
153 , isProcessed = isJust subForestM
154 , duration = (fromEnum . processDuration . sTarget . sState) tree
155 , score = read "NaN" -- maybe (read "NaN") eObjectiveFunctionValue nOrigin
156 , decsionType = case sDecision of
157 Root{} -> "root"
158 SynthesisDecision{metrics}
159 | Just AllocationMetrics{} <- cast metrics -> "Allocation"
160 | Just SingleBindMetrics{} <- cast metrics -> "SingleBind"
161 | Just GroupBindMetrics{} <- cast metrics -> "GroupBind"
162 | Just BreakLoopMetrics{} <- cast metrics -> "Refactor"
163 | Just ConstantFoldingMetrics{} <- cast metrics -> "Refactor"
164 | Just DataflowMetrics{} <- cast metrics -> "Transport"
165 | Just OptimizeAccumMetrics{} <- cast metrics -> "Refactor"
166 | Just OptimizeLogicalUnitMetrics{} <- cast metrics -> "Refactor"
167 | Just ResolveDeadlockMetrics{} <- cast metrics -> "Refactor"
168 _ -> "?"
169 }
170 , subForest = subForest
171 }
172
173 data NodeView tag v x t = NodeView
174 { sid :: T.Text
175 , isTerminal :: Bool
176 , isFinish :: Bool
177 , duration :: Int
178 , parameters :: Value
179 , decision :: DecisionView
180 , score :: Float
181 , scores :: Value
182 }
183 deriving (Generic)
184
185 instance (UnitTag tag, VarValTimeJSON v x t) => Viewable (DefTree tag v x t) (NodeView tag v x t) where
186 view tree@Tree{sID, sDecision} =
187 NodeView
188 { sid = showText sID
189 , isTerminal = isLeaf tree
190 , isFinish = isComplete tree
191 , duration = fromEnum $ processDuration $ sTarget $ sState tree
192 , decision =
193 ( \case
194 SynthesisDecision{decision} -> view decision
195 _ -> RootView
196 )
197 sDecision
198 , parameters =
199 ( \case
200 SynthesisDecision{metrics} -> toJSON metrics
201 _ -> String "root"
202 )
203 sDecision
204 , score =
205 ( \case
206 -- TODO: add support for "scores" field in UI, remove that field (or rename to default_score/effective_score?)
207 sd@SynthesisDecision{} -> defScore sd
208 _ -> 0
209 )
210 sDecision
211 , scores =
212 ( \case
213 SynthesisDecision{scores} -> toJSON scores
214 _ -> object ["default" .= (0 :: Float)]
215 )
216 sDecision
217 }
218
219 instance (VarValTimeJSON v x t, ToJSON tag) => ToJSON (NodeView tag v x t)
220
221 instance ToSample (NodeView tag v x t) where
222 toSamples _ =
223 samples
224 [ NodeView
225 { sid = showText $ Sid [0, 1, 3, 1]
226 , isTerminal = False
227 , isFinish = False
228 , duration = 0
229 , parameters =
230 toJSON $
231 SingleBindMetrics
232 { pCritical = False
233 , pAlternative = 1
234 , pRestless = 0
235 , pOutputNumber = 2
236 , pAllowDataFlow = 1
237 , pPossibleDeadlock = False
238 , pNumberOfBoundFunctions = 1
239 , pPercentOfBoundInputs = 0.2
240 , pWave = Just 2
241 }
242 , decision = SingleBindView (FView "buffer(a) = b = c" []) "pu"
243 , score = 1032
244 , scores = object ["default" .= (1032 :: Float)]
245 }
246 , NodeView
247 { sid = showText $ Sid [0, 1, 3, 1, 5]
248 , isTerminal = False
249 , isFinish = False
250 , duration = 0
251 , parameters =
252 toJSON $
253 DataflowMetrics
254 { pWaitTime = 1
255 , pRestrictedTime = False
256 , pNotTransferableInputs = [0, 0]
257 , pFirstWaveOfTargetUse = 0
258 }
259 , decision =
260 DataflowDecisionView
261 { source = ("PU1", EndpointSt{epRole = Source $ S.fromList ["a1", "a2"], epAt = 1 ... 1})
262 , targets =
263 [("PU2", EndpointSt{epRole = Target "a2", epAt = 1 ... 1})]
264 }
265 , score = 1999
266 , scores = object ["default" .= (1999 :: Float)]
267 }
268 , NodeView
269 { sid = showText $ Sid [0, 1, 3, 1, 6]
270 , isTerminal = False
271 , isFinish = False
272 , duration = 0
273 , parameters = toJSON BreakLoopMetrics
274 , decision = BreakLoopView{value = "12.5", outputs = ["a", "b"], input = "c"}
275 , score = 5000
276 , scores = object ["default" .= (5000 :: Float)]
277 }
278 , NodeView
279 { sid = showText $ Sid [0, 1, 3, 1, 5]
280 , isTerminal = False
281 , isFinish = False
282 , duration = 0
283 , parameters = toJSON OptimizeAccumMetrics
284 , decision =
285 OptimizeAccumView
286 { old = [FView "a + b = c" [], FView "c + d = e" []]
287 , new = [FView "a + b + d = e" []]
288 }
289 , score = 1999
290 , scores = object ["default" .= (1999 :: Float)]
291 }
292 , NodeView
293 { sid = showText $ Sid [0, 1, 3, 1, 5]
294 , isTerminal = False
295 , isFinish = False
296 , duration = 0
297 , parameters = toJSON $ OptimizeLogicalUnitMetrics 0
298 , decision =
299 OptimizeLogicalUnitView
300 { lOld = [FView "a and b = c" [], FView "d = not c" []]
301 , lNew = [FView "LogicalUnit" []]
302 }
303 , score = 1999
304 , scores = object ["default" .= (1999 :: Float)]
305 }
306 , NodeView
307 { sid = showText $ Sid [0, 1, 3, 1, 5]
308 , isTerminal = False
309 , isFinish = False
310 , duration = 0
311 , parameters = toJSON ConstantFoldingMetrics
312 , decision =
313 ConstantFoldingView
314 { cRefOld = [FView "a = 1" [], FView "b = 2" [], FView "a + b = r" []]
315 , cRefNew = [FView "r = 3" []]
316 }
317 , score = 1999
318 , scores = object ["default" .= (1999 :: Float)]
319 }
320 , NodeView
321 { sid = showText $ Sid [0, 1, 3, 1, 5]
322 , isTerminal = False
323 , isFinish = False
324 , duration = 0
325 , parameters =
326 toJSON $
327 ResolveDeadlockMetrics
328 { pNumberOfLockedVariables = 1
329 , pBufferCount = 0
330 , pNumberOfTransferableVariables = 0
331 }
332 , decision =
333 ResolveDeadlockView
334 { newBuffer = "buffer(x#0@buf) = x#0"
335 , changeset = "Changeset {changeI = fromList [], changeO = fromList [(\"x#0\",fromList [\"x#0@buf\"])]}"
336 }
337 , score = 1999
338 , scores = object ["default" .= (1999 :: Float)]
339 }
340 ]
341
342 newtype StepInfoView = StepInfoView T.Text
343 deriving (Generic)
344
345 instance (Var v, Time t) => Viewable (StepInfo v x t) StepInfoView where
346 view = StepInfoView . showText
347
348 instance ToJSON StepInfoView
349
350 instance (Var v, Time t) => Viewable (Process t (StepInfo v x t)) (Process t StepInfoView) where
351 view p@Process{steps} = p{steps = map (\s@Step{pDesc} -> s{pDesc = view pDesc}) steps}
352
353 -- Testbench
354
355 instance (ToJSONKey v, ToJSON v, ToJSON x) => ToJSON (TestbenchReport v x)
356
357 instance ToSample (TestbenchReport String Int) where
358 toSamples _ =
359 singleSample
360 TestbenchReport
361 { tbStatus = True
362 , tbCompilerDump = "stdout:\n" <> "stderr:\n"
363 , tbSimulationDump =
364 T.unlines
365 [ "stdout:"
366 , "VCD info: dumpfile web_ui_net_tb.vcd opened for output."
367 , "0:0\tactual: 0.000 0\t"
368 , "0:1\tactual: 0.000 0 \texpect: 0.000 0 \tvar: x#0\t"
369 , "0:2\tactual: 0.000 0\t"
370 , "0:3\tactual: 0.000 0\t"
371 , "0:4\tactual: 0.000 0 \texpect: 0.000 0 \tvar: tmp_0#0\t"
372 , "0:5\tactual: 0.000 0\t"
373 , "1:0\tactual: 0.000 0\t"
374 , "1:1\tactual: 0.000 0 \texpect: 0.000 0 \tvar: x#0\t"
375 , "1:2\tactual: 0.000 0\t"
376 , "1:3\tactual: 0.000 0\t"
377 , "1:4\tactual: 0.000 0 \texpect: 0.000 0 \tvar: tmp_0#0\t"
378 , "1:5\tactual: 0.000 0\t"
379 , "stderr:"
380 ]
381 , tbPath = "/Users/penskoi/Documents/nitta-corp/nitta/gen/web_ui"
382 , tbFiles =
383 [ "web_ui_net/web_ui_net.v"
384 , "lib/div/div_mock.v"
385 , "lib/div/pu_div.v"
386 , "lib/i2c/bounce_filter.v"
387 , "lib/i2c/buffer.v"
388 , "lib/multiplier/mult_mock.v"
389 , "lib/multiplier/pu_multiplier.v"
390 , "lib/spi/pu_slave_spi_driver.v"
391 , "lib/spi/spi_slave_driver.v"
392 , "lib/spi/i2n_splitter.v"
393 , "lib/spi/spi_master_driver.v"
394 , "lib/spi/n2i_splitter.v"
395 , "lib/spi/pu_slave_spi.v"
396 , "lib/spi/pu_master_spi.v"
397 , "lib/pu_accum.v"
398 , "lib/pu_fram.v"
399 , "lib/pu_shift.v"
400 , "lib/pu_simple_control.v"
401 , "web_ui_net_tb.v"
402 ]
403 , tbFunctions =
404 [ "buffer(x#0) = tmp_0#0"
405 , "LoopEnd (Loop (X 0.000000) (O [x#0]) (I tmp_0#0)) (I tmp_0#0)"
406 , "LoopBegin (Loop (X 0.000000) (O [x#0]) (I tmp_0#0)) (O [x#0])"
407 ]
408 , tbSynthesisSteps =
409 [ "Step {pID = 19, pInterval = 0 ... 0, pDesc = Nested fram2: Step {pID = 0, pInterval = 0 ... 0, pDesc = bind Loop (X 0.000000) (O [x#0]) (I tmp_0#0)}}"
410 , "Step {pID = 18, pInterval = 0 ... 0, pDesc = Nested fram2: Step {pID = 1, pInterval = 0 ... 0, pDesc = revoke Loop (X 0.000000) (O [x#0]) (I tmp_0#0)}}"
411 , "Step {pID = 17, pInterval = 0 ... 0, pDesc = Nested fram2: Step {pID = 2, pInterval = 0 ... 0, pDesc = bind LoopBegin (Loop (X 0.000000) (O [x#0]) (I tmp_0#0)) (O [x#0])}}"
412 , "Step {pID = 16, pInterval = 0 ... 0, pDesc = Nested fram2: Step {pID = 3, pInterval = 0 ... 0, pDesc = bind LoopEnd (Loop (X 0.000000) (O [x#0]) (I tmp_0#0)) (I tmp_0#0)}}"
413 , "Step {pID = 15, pInterval = 1 ... 1, pDesc = Nested fram2: Step {pID = 4, pInterval = 1 ... 1, pDesc = Source x#0}}"
414 , "Step {pID = 14, pInterval = 0 ... 0, pDesc = Nested fram2: Step {pID = 5, pInterval = 0 ... 0, pDesc = PrepareRead 0}}"
415 , "Step {pID = 13, pInterval = 0 ... 1, pDesc = Nested fram2: Step {pID = 6, pInterval = 0 ... 1, pDesc = LoopBegin (Loop (X 0.000000) (O [x#0]) (I tmp_0#0)) (O [x#0])}}"
416 , "Step {pID = 12, pInterval = 4 ... 4, pDesc = Nested fram2: Step {pID = 7, pInterval = 4 ... 4, pDesc = Target tmp_0#0}}"
417 , "Step {pID = 11, pInterval = 4 ... 4, pDesc = Nested fram2: Step {pID = 8, pInterval = 4 ... 4, pDesc = Write 0}}"
418 , "Step {pID = 10, pInterval = 4 ... 4, pDesc = Nested fram2: Step {pID = 9, pInterval = 4 ... 4, pDesc = LoopEnd (Loop (X 0.000000) (O [x#0]) (I tmp_0#0)) (I tmp_0#0)}}"
419 , "Step {pID = 9, pInterval = 0 ... 0, pDesc = Nested fram1: Step {pID = 0, pInterval = 0 ... 0, pDesc = bind buffer(x#0) = tmp_0#0}}"
420 , "Step {pID = 8, pInterval = 1 ... 1, pDesc = Nested fram1: Step {pID = 1, pInterval = 1 ... 1, pDesc = Target x#0}}"
421 , "Step {pID = 7, pInterval = 1 ... 1, pDesc = Nested fram1: Step {pID = 2, pInterval = 1 ... 1, pDesc = Write 0}}"
422 , "Step {pID = 6, pInterval = 4 ... 4, pDesc = Nested fram1: Step {pID = 3, pInterval = 4 ... 4, pDesc = Source tmp_0#0}}"
423 , "Step {pID = 5, pInterval = 3 ... 3, pDesc = Nested fram1: Step {pID = 4, pInterval = 3 ... 3, pDesc = PrepareRead 0}}"
424 , "Step {pID = 4, pInterval = 1 ... 4, pDesc = Nested fram1: Step {pID = 5, pInterval = 1 ... 4, pDesc = buffer(x#0) = tmp_0#0}}"
425 , "Step {pID = 3, pInterval = 4 ... 4, pDesc = Transport \"tmp_0#0\" \"fram1\" \"fram2\"}"
426 , "Step {pID = 2, pInterval = 1 ... 1, pDesc = Transport \"x#0\" \"fram2\" \"fram1\"}"
427 , "Step {pID = 1, pInterval = 0 ... 0, pDesc = bind reg(x#0) = tmp_0#0}"
428 , "Step {pID = 0, pInterval = 0 ... 0, pDesc = bind Loop (X 0.000000) (O [x#0]) (I tmp_0#0)}"
429 ]
430 , tbFunctionalSimulationLog =
431 replicate 2 $
432 HM.fromList
433 [ ("tmp_0#0", 0)
434 , ("u#0", 0)
435 , ("x#0", 0)
436 ]
437 , tbLogicalSimulationLog =
438 replicate 2 $
439 HM.fromList
440 [ ("tmp_0#0", 0)
441 , ("u#0", 0)
442 , ("x#0", 0)
443 ]
444 }