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     | OptimizeLogicalUnitView
   65         { lOld :: [FView]
   66         , lNew :: [FView]
   67         }
   68     | ResolveDeadlockView
   69         { newBuffer :: T.Text
   70         , changeset :: T.Text
   71         }
   72     deriving (Generic)
   73 
   74 instance UnitTag tag => Viewable (Bind tag v x) DecisionView where
   75     view (SingleBind uTag f) =
   76         SingleBindView
   77             { function = view f
   78             , pu = toText uTag
   79             }
   80     view GroupBind{bindGroup} = GroupBindView $ HM.fromList $ map (bimap toText (map view)) $ M.assocs bindGroup
   81 
   82 instance UnitTag tag => Viewable (Allocation tag) DecisionView where
   83     view Allocation{networkTag, processUnitTag} =
   84         AllocationView
   85             { networkTag = toText networkTag
   86             , processUnitTag = toText processUnitTag
   87             }
   88 
   89 instance (UnitTag tag, Var v, Time t) => Viewable (DataflowSt tag v (Interval t)) DecisionView where
   90     view DataflowSt{dfSource, dfTargets} =
   91         DataflowDecisionView
   92             { source = view' dfSource
   93             , targets = map view' dfTargets
   94             }
   95         where
   96             view' = bimap toText epdView
   97             epdView EndpointSt{epRole, epAt} =
   98                 EndpointSt
   99                     { epRole = case epRole of
  100                         Source vs -> Source $ S.map toText vs
  101                         Target v -> Target $ toText v
  102                     , epAt = fromEnum (sup epAt) ... fromEnum (inf epAt)
  103                     }
  104 
  105 instance (Var v, Val x) => Viewable (BreakLoop v x) DecisionView where
  106     view BreakLoop{loopX, loopO, loopI} =
  107         BreakLoopView
  108             { value = showText loopX
  109             , outputs = map toText $ S.elems loopO
  110             , input = toText loopI
  111             }
  112 
  113 instance Viewable (ConstantFolding v x) DecisionView where
  114     view ConstantFolding{cRefOld, cRefNew} =
  115         ConstantFoldingView
  116             { cRefOld = map view cRefOld
  117             , cRefNew = map view cRefNew
  118             }
  119 
  120 instance Viewable (OptimizeAccum v x) DecisionView where
  121     view OptimizeAccum{refOld, refNew} =
  122         OptimizeAccumView
  123             { old = map view refOld
  124             , new = map view refNew
  125             }
  126 
  127 instance Viewable (OptimizeLogicalUnit v x) DecisionView where
  128     view OptimizeLogicalUnit{rOld, rNew} =
  129         OptimizeLogicalUnitView
  130             { lOld = map view rOld
  131             , lNew = map view rNew
  132             }
  133 instance Var v => Viewable (ResolveDeadlock v x) DecisionView where
  134     view ResolveDeadlock{newBuffer, changeset} =
  135         ResolveDeadlockView
  136             { newBuffer = showText newBuffer
  137             , changeset = showText changeset
  138             }
  139 
  140 instance ToJSON DecisionView