never executed always true always false

    1 {-# LANGUAGE DuplicateRecordFields #-}
    2 {-# LANGUAGE OverloadedStrings #-}
    3 {-# LANGUAGE NoMonomorphismRestriction #-}
    4 
    5 {-# OPTIONS -fno-warn-orphans #-}
    6 
    7 module NITTA.Model.Problems.ViewHelper (
    8     DecisionView (..),
    9     IntervalView (..),
   10 ) where
   11 
   12 import Data.Aeson
   13 import Data.Bifunctor (Bifunctor (bimap))
   14 import Data.HashMap.Strict qualified as HM
   15 import Data.Map.Strict qualified as M
   16 import Data.Set qualified as S
   17 import Data.Text qualified as T
   18 import GHC.Generics
   19 import NITTA.Intermediate.Types
   20 import NITTA.Model.Problems
   21 import NITTA.Model.ProcessorUnits
   22 import NITTA.UIBackend.ViewHelperCls
   23 import NITTA.Utils
   24 import Numeric.Interval.NonEmpty
   25 
   26 newtype IntervalView = IntervalView T.Text
   27     deriving (Generic)
   28 
   29 instance Time t => Viewable (Interval t) IntervalView where
   30     view = IntervalView . T.replace (showText (maxBound :: t)) "INF" . showText
   31 
   32 instance ToJSON IntervalView
   33 
   34 data DecisionView
   35     = RootView
   36     | SingleBindView
   37         { function :: FView
   38         , pu :: T.Text
   39         }
   40     | GroupBindView
   41         { bindGroup :: HM.HashMap T.Text [FView]
   42         }
   43     | AllocationView
   44         { networkTag :: T.Text
   45         , processUnitTag :: T.Text
   46         }
   47     | DataflowDecisionView
   48         { source :: (T.Text, EndpointSt T.Text (Interval Int))
   49         , targets :: [(T.Text, EndpointSt T.Text (Interval Int))]
   50         }
   51     | BreakLoopView
   52         { value :: T.Text
   53         , outputs :: [T.Text]
   54         , input :: T.Text
   55         }
   56     | ConstantFoldingView
   57         { cRefOld :: [FView]
   58         , cRefNew :: [FView]
   59         }
   60     | OptimizeAccumView
   61         { old :: [FView]
   62         , new :: [FView]
   63         }
   64     | ResolveDeadlockView
   65         { newBuffer :: T.Text
   66         , changeset :: T.Text
   67         }
   68     deriving (Generic)
   69 
   70 instance UnitTag tag => Viewable (Bind tag v x) DecisionView where
   71     view (SingleBind uTag f) =
   72         SingleBindView
   73             { function = view f
   74             , pu = toText uTag
   75             }
   76     view GroupBind{bindGroup} = GroupBindView $ HM.fromList $ map (bimap toText (map view)) $ M.assocs bindGroup
   77 
   78 instance UnitTag tag => Viewable (Allocation tag) DecisionView where
   79     view Allocation{networkTag, processUnitTag} =
   80         AllocationView
   81             { networkTag = toText networkTag
   82             , processUnitTag = toText processUnitTag
   83             }
   84 
   85 instance (UnitTag tag, Var v, Time t) => Viewable (DataflowSt tag v (Interval t)) DecisionView where
   86     view DataflowSt{dfSource, dfTargets} =
   87         DataflowDecisionView
   88             { source = view' dfSource
   89             , targets = map view' dfTargets
   90             }
   91         where
   92             view' = bimap toText epdView
   93             epdView EndpointSt{epRole, epAt} =
   94                 EndpointSt
   95                     { epRole = case epRole of
   96                         Source vs -> Source $ S.map toText vs
   97                         Target v -> Target $ toText v
   98                     , epAt = fromEnum (sup epAt) ... fromEnum (inf epAt)
   99                     }
  100 
  101 instance (Var v, Val x) => Viewable (BreakLoop v x) DecisionView where
  102     view BreakLoop{loopX, loopO, loopI} =
  103         BreakLoopView
  104             { value = showText loopX
  105             , outputs = map toText $ S.elems loopO
  106             , input = toText loopI
  107             }
  108 
  109 instance Viewable (ConstantFolding v x) DecisionView where
  110     view ConstantFolding{cRefOld, cRefNew} =
  111         ConstantFoldingView
  112             { cRefOld = map view cRefOld
  113             , cRefNew = map view cRefNew
  114             }
  115 
  116 instance Viewable (OptimizeAccum v x) DecisionView where
  117     view OptimizeAccum{refOld, refNew} =
  118         OptimizeAccumView
  119             { old = map view refOld
  120             , new = map view refNew
  121             }
  122 
  123 instance Var v => Viewable (ResolveDeadlock v x) DecisionView where
  124     view ResolveDeadlock{newBuffer, changeset} =
  125         ResolveDeadlockView
  126             { newBuffer = showText newBuffer
  127             , changeset = showText changeset
  128             }
  129 
  130 instance ToJSON DecisionView