{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# OPTIONS -fno-warn-orphans #-} module NITTA.Model.Problems.ViewHelper ( DecisionView (..), IntervalView (..), ) where import Data.Aeson import Data.Bifunctor (Bifunctor (bimap)) import Data.HashMap.Strict qualified as HM import Data.Map.Strict qualified as M import Data.Set qualified as S import Data.Text qualified as T import GHC.Generics import NITTA.Intermediate.Types import NITTA.Model.Problems import NITTA.Model.ProcessorUnits import NITTA.UIBackend.ViewHelperCls import NITTA.Utils import Numeric.Interval.NonEmpty newtype IntervalView = IntervalView T.Text deriving (forall x. Rep IntervalView x -> IntervalView forall x. IntervalView -> Rep IntervalView x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep IntervalView x -> IntervalView $cfrom :: forall x. IntervalView -> Rep IntervalView x Generic) instance Time t => Viewable (Interval t) IntervalView where view :: Interval t -> IntervalView view = Text -> IntervalView IntervalView forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Text -> Text -> Text T.replace (forall {a}. Show a => a -> Text showText (forall a. Bounded a => a maxBound :: t)) Text "INF" forall b c a. (b -> c) -> (a -> b) -> a -> c . forall {a}. Show a => a -> Text showText instance ToJSON IntervalView data DecisionView = RootView | SingleBindView { DecisionView -> FView function :: FView , DecisionView -> Text pu :: T.Text } | GroupBindView { DecisionView -> HashMap Text [FView] bindGroup :: HM.HashMap T.Text [FView] } | AllocationView { DecisionView -> Text networkTag :: T.Text , DecisionView -> Text processUnitTag :: T.Text } | DataflowDecisionView { DecisionView -> (Text, EndpointSt Text (Interval Int)) source :: (T.Text, EndpointSt T.Text (Interval Int)) , DecisionView -> [(Text, EndpointSt Text (Interval Int))] targets :: [(T.Text, EndpointSt T.Text (Interval Int))] } | BreakLoopView { DecisionView -> Text value :: T.Text , DecisionView -> [Text] outputs :: [T.Text] , DecisionView -> Text input :: T.Text } | ConstantFoldingView { DecisionView -> [FView] cRefOld :: [FView] , DecisionView -> [FView] cRefNew :: [FView] } | OptimizeAccumView { DecisionView -> [FView] old :: [FView] , DecisionView -> [FView] new :: [FView] } | OptimizeLogicalUnitView { DecisionView -> [FView] lOld :: [FView] , DecisionView -> [FView] lNew :: [FView] } | ResolveDeadlockView { DecisionView -> Text newBuffer :: T.Text , DecisionView -> Text changeset :: T.Text } deriving (forall x. Rep DecisionView x -> DecisionView forall x. DecisionView -> Rep DecisionView x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep DecisionView x -> DecisionView $cfrom :: forall x. DecisionView -> Rep DecisionView x Generic) instance UnitTag tag => Viewable (Bind tag v x) DecisionView where view :: Bind tag v x -> DecisionView view (SingleBind tag uTag F v x f) = SingleBindView { $sel:function:RootView :: FView function = forall t v. Viewable t v => t -> v view F v x f , $sel:pu:RootView :: Text pu = forall {a}. ToString a => a -> Text toText tag uTag } view GroupBind{Map tag [F v x] bindGroup :: forall tag v x. Bind tag v x -> Map tag [F v x] bindGroup :: Map tag [F v x] bindGroup} = HashMap Text [FView] -> DecisionView GroupBindView forall a b. (a -> b) -> a -> b $ forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v HM.fromList forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map (forall (p :: * -> * -> *) a b c d. Bifunctor p => (a -> b) -> (c -> d) -> p a c -> p b d bimap forall {a}. ToString a => a -> Text toText (forall a b. (a -> b) -> [a] -> [b] map forall t v. Viewable t v => t -> v view)) forall a b. (a -> b) -> a -> b $ forall k a. Map k a -> [(k, a)] M.assocs Map tag [F v x] bindGroup instance UnitTag tag => Viewable (Allocation tag) DecisionView where view :: Allocation tag -> DecisionView view Allocation{tag networkTag :: forall tag. Allocation tag -> tag networkTag :: tag networkTag, tag processUnitTag :: forall tag. Allocation tag -> tag processUnitTag :: tag processUnitTag} = AllocationView { $sel:networkTag:RootView :: Text networkTag = forall {a}. ToString a => a -> Text toText tag networkTag , $sel:processUnitTag:RootView :: Text processUnitTag = forall {a}. ToString a => a -> Text toText tag processUnitTag } instance (UnitTag tag, Var v, Time t) => Viewable (DataflowSt tag v (Interval t)) DecisionView where view :: DataflowSt tag v (Interval t) -> DecisionView view DataflowSt{(tag, EndpointSt v (Interval t)) dfSource :: forall tag v tp. DataflowSt tag v tp -> (tag, EndpointSt v tp) dfSource :: (tag, EndpointSt v (Interval t)) dfSource, [(tag, EndpointSt v (Interval t))] dfTargets :: forall tag v tp. DataflowSt tag v tp -> [(tag, EndpointSt v tp)] dfTargets :: [(tag, EndpointSt v (Interval t))] dfTargets} = DataflowDecisionView { $sel:source:RootView :: (Text, EndpointSt Text (Interval Int)) source = forall {p :: * -> * -> *} {a} {a} {a}. (Bifunctor p, ToString a, ToString a, Enum a) => p a (EndpointSt a (Interval a)) -> p Text (EndpointSt Text (Interval Int)) view' (tag, EndpointSt v (Interval t)) dfSource , $sel:targets:RootView :: [(Text, EndpointSt Text (Interval Int))] targets = forall a b. (a -> b) -> [a] -> [b] map forall {p :: * -> * -> *} {a} {a} {a}. (Bifunctor p, ToString a, ToString a, Enum a) => p a (EndpointSt a (Interval a)) -> p Text (EndpointSt Text (Interval Int)) view' [(tag, EndpointSt v (Interval t))] dfTargets } where view' :: p a (EndpointSt a (Interval a)) -> p Text (EndpointSt Text (Interval Int)) view' = forall (p :: * -> * -> *) a b c d. Bifunctor p => (a -> b) -> (c -> d) -> p a c -> p b d bimap forall {a}. ToString a => a -> Text toText forall {a} {a}. (ToString a, Enum a) => EndpointSt a (Interval a) -> EndpointSt Text (Interval Int) epdView epdView :: EndpointSt a (Interval a) -> EndpointSt Text (Interval Int) epdView EndpointSt{EndpointRole a epRole :: forall v tp. EndpointSt v tp -> EndpointRole v epRole :: EndpointRole a epRole, Interval a epAt :: forall v tp. EndpointSt v tp -> tp epAt :: Interval a epAt} = EndpointSt { epRole :: EndpointRole Text epRole = case EndpointRole a epRole of Source Set a vs -> forall v. Set v -> EndpointRole v Source forall a b. (a -> b) -> a -> b $ forall b a. Ord b => (a -> b) -> Set a -> Set b S.map forall {a}. ToString a => a -> Text toText Set a vs Target a v -> forall v. v -> EndpointRole v Target forall a b. (a -> b) -> a -> b $ forall {a}. ToString a => a -> Text toText a v , epAt :: Interval Int epAt = forall a. Enum a => a -> Int fromEnum (forall a. Interval a -> a sup Interval a epAt) forall a. Ord a => a -> a -> Interval a ... forall a. Enum a => a -> Int fromEnum (forall a. Interval a -> a inf Interval a epAt) } instance (Var v, Val x) => Viewable (BreakLoop v x) DecisionView where view :: BreakLoop v x -> DecisionView view BreakLoop{x loopX :: forall v x. BreakLoop v x -> x loopX :: x loopX, Set v loopO :: forall v x. BreakLoop v x -> Set v loopO :: Set v loopO, v loopI :: forall v x. BreakLoop v x -> v loopI :: v loopI} = BreakLoopView { $sel:value:RootView :: Text value = forall {a}. Show a => a -> Text showText x loopX , $sel:outputs:RootView :: [Text] outputs = forall a b. (a -> b) -> [a] -> [b] map forall {a}. ToString a => a -> Text toText forall a b. (a -> b) -> a -> b $ forall a. Set a -> [a] S.elems Set v loopO , $sel:input:RootView :: Text input = forall {a}. ToString a => a -> Text toText v loopI } instance Viewable (ConstantFolding v x) DecisionView where view :: ConstantFolding v x -> DecisionView view ConstantFolding{[F v x] cRefOld :: forall v x. ConstantFolding v x -> [F v x] cRefOld :: [F v x] cRefOld, [F v x] cRefNew :: forall v x. ConstantFolding v x -> [F v x] cRefNew :: [F v x] cRefNew} = ConstantFoldingView { $sel:cRefOld:RootView :: [FView] cRefOld = forall a b. (a -> b) -> [a] -> [b] map forall t v. Viewable t v => t -> v view [F v x] cRefOld , $sel:cRefNew:RootView :: [FView] cRefNew = forall a b. (a -> b) -> [a] -> [b] map forall t v. Viewable t v => t -> v view [F v x] cRefNew } instance Viewable (OptimizeAccum v x) DecisionView where view :: OptimizeAccum v x -> DecisionView view OptimizeAccum{[F v x] refOld :: forall v x. OptimizeAccum v x -> [F v x] refOld :: [F v x] refOld, [F v x] refNew :: forall v x. OptimizeAccum v x -> [F v x] refNew :: [F v x] refNew} = OptimizeAccumView { $sel:old:RootView :: [FView] old = forall a b. (a -> b) -> [a] -> [b] map forall t v. Viewable t v => t -> v view [F v x] refOld , $sel:new:RootView :: [FView] new = forall a b. (a -> b) -> [a] -> [b] map forall t v. Viewable t v => t -> v view [F v x] refNew } instance Viewable (OptimizeLogicalUnit v x) DecisionView where view :: OptimizeLogicalUnit v x -> DecisionView view OptimizeLogicalUnit{[F v x] rOld :: forall v x. OptimizeLogicalUnit v x -> [F v x] rOld :: [F v x] rOld, [F v x] rNew :: forall v x. OptimizeLogicalUnit v x -> [F v x] rNew :: [F v x] rNew} = OptimizeLogicalUnitView { $sel:lOld:RootView :: [FView] lOld = forall a b. (a -> b) -> [a] -> [b] map forall t v. Viewable t v => t -> v view [F v x] rOld , $sel:lNew:RootView :: [FView] lNew = forall a b. (a -> b) -> [a] -> [b] map forall t v. Viewable t v => t -> v view [F v x] rNew } instance Var v => Viewable (ResolveDeadlock v x) DecisionView where view :: ResolveDeadlock v x -> DecisionView view ResolveDeadlock{F v x newBuffer :: forall v x. ResolveDeadlock v x -> F v x newBuffer :: F v x newBuffer, Changeset v changeset :: forall v x. ResolveDeadlock v x -> Changeset v changeset :: Changeset v changeset} = ResolveDeadlockView { $sel:newBuffer:RootView :: Text newBuffer = forall {a}. Show a => a -> Text showText F v x newBuffer , $sel:changeset:RootView :: Text changeset = forall {a}. Show a => a -> Text showText Changeset v changeset } instance ToJSON DecisionView