{-# 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. IntervalView -> Rep IntervalView x)
-> (forall x. Rep IntervalView x -> IntervalView)
-> Generic IntervalView
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
$cfrom :: forall x. IntervalView -> Rep IntervalView x
from :: forall x. IntervalView -> Rep IntervalView x
$cto :: forall x. Rep IntervalView x -> IntervalView
to :: forall x. Rep IntervalView x -> IntervalView
Generic)

instance Time t => Viewable (Interval t) IntervalView where
    view :: Interval t -> IntervalView
view = Text -> IntervalView
IntervalView (Text -> IntervalView)
-> (Interval t -> Text) -> Interval t -> IntervalView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace (t -> Text
forall {a}. Show a => a -> Text
showText (t
forall a. Bounded a => a
maxBound :: t)) Text
"INF" (Text -> Text) -> (Interval t -> Text) -> Interval t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interval t -> Text
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. DecisionView -> Rep DecisionView x)
-> (forall x. Rep DecisionView x -> DecisionView)
-> Generic DecisionView
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
$cfrom :: forall x. DecisionView -> Rep DecisionView x
from :: forall x. DecisionView -> Rep DecisionView x
$cto :: forall x. Rep DecisionView x -> DecisionView
to :: forall x. Rep DecisionView x -> DecisionView
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
            { function :: FView
function = F v x -> FView
forall t v. Viewable t v => t -> v
view F v x
f
            , pu :: Text
pu = tag -> Text
forall {a}. ToString a => a -> Text
toText tag
uTag
            }
    view GroupBind{Map tag [F v x]
bindGroup :: Map tag [F v x]
bindGroup :: forall tag v x. Bind tag v x -> Map tag [F v x]
bindGroup} = HashMap Text [FView] -> DecisionView
GroupBindView (HashMap Text [FView] -> DecisionView)
-> HashMap Text [FView] -> DecisionView
forall a b. (a -> b) -> a -> b
$ [(Text, [FView])] -> HashMap Text [FView]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, [FView])] -> HashMap Text [FView])
-> [(Text, [FView])] -> HashMap Text [FView]
forall a b. (a -> b) -> a -> b
$ ((tag, [F v x]) -> (Text, [FView]))
-> [(tag, [F v x])] -> [(Text, [FView])]
forall a b. (a -> b) -> [a] -> [b]
map ((tag -> Text)
-> ([F v x] -> [FView]) -> (tag, [F v x]) -> (Text, [FView])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap tag -> Text
forall {a}. ToString a => a -> Text
toText ((F v x -> FView) -> [F v x] -> [FView]
forall a b. (a -> b) -> [a] -> [b]
map F v x -> FView
forall t v. Viewable t v => t -> v
view)) ([(tag, [F v x])] -> [(Text, [FView])])
-> [(tag, [F v x])] -> [(Text, [FView])]
forall a b. (a -> b) -> a -> b
$ Map tag [F v x] -> [(tag, [F v x])]
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 :: tag
networkTag :: forall tag. Allocation tag -> tag
networkTag, tag
processUnitTag :: tag
processUnitTag :: forall tag. Allocation tag -> tag
processUnitTag} =
        AllocationView
            { networkTag :: Text
networkTag = tag -> Text
forall {a}. ToString a => a -> Text
toText tag
networkTag
            , processUnitTag :: Text
processUnitTag = tag -> Text
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 :: (tag, EndpointSt v (Interval t))
dfSource :: forall tag v tp. DataflowSt tag v tp -> (tag, EndpointSt v tp)
dfSource, [(tag, EndpointSt v (Interval t))]
dfTargets :: [(tag, EndpointSt v (Interval t))]
dfTargets :: forall tag v tp. DataflowSt tag v tp -> [(tag, EndpointSt v tp)]
dfTargets} =
        DataflowDecisionView
            { source :: (Text, EndpointSt Text (Interval Int))
source = (tag, EndpointSt v (Interval t))
-> (Text, EndpointSt Text (Interval Int))
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
            , targets :: [(Text, EndpointSt Text (Interval Int))]
targets = ((tag, EndpointSt v (Interval t))
 -> (Text, EndpointSt Text (Interval Int)))
-> [(tag, EndpointSt v (Interval t))]
-> [(Text, EndpointSt Text (Interval Int))]
forall a b. (a -> b) -> [a] -> [b]
map (tag, EndpointSt v (Interval t))
-> (Text, EndpointSt Text (Interval Int))
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' = (a -> Text)
-> (EndpointSt a (Interval a) -> EndpointSt Text (Interval Int))
-> p a (EndpointSt a (Interval a))
-> p Text (EndpointSt Text (Interval Int))
forall a b c d. (a -> b) -> (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> Text
forall {a}. ToString a => a -> Text
toText EndpointSt a (Interval a) -> EndpointSt Text (Interval Int)
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 :: EndpointRole a
epRole :: forall v tp. EndpointSt v tp -> EndpointRole v
epRole, Interval a
epAt :: Interval a
epAt :: forall v tp. EndpointSt v tp -> tp
epAt} =
                EndpointSt
                    { epRole :: EndpointRole Text
epRole = case EndpointRole a
epRole of
                        Source Set a
vs -> Set Text -> EndpointRole Text
forall v. Set v -> EndpointRole v
Source (Set Text -> EndpointRole Text) -> Set Text -> EndpointRole Text
forall a b. (a -> b) -> a -> b
$ (a -> Text) -> Set a -> Set Text
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map a -> Text
forall {a}. ToString a => a -> Text
toText Set a
vs
                        Target a
v -> Text -> EndpointRole Text
forall v. v -> EndpointRole v
Target (Text -> EndpointRole Text) -> Text -> EndpointRole Text
forall a b. (a -> b) -> a -> b
$ a -> Text
forall {a}. ToString a => a -> Text
toText a
v
                    , epAt :: Interval Int
epAt = a -> Int
forall a. Enum a => a -> Int
fromEnum (Interval a -> a
forall a. Interval a -> a
sup Interval a
epAt) Int -> Int -> Interval Int
forall a. Ord a => a -> a -> Interval a
... a -> Int
forall a. Enum a => a -> Int
fromEnum (Interval a -> a
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 :: x
loopX :: forall v x. BreakLoop v x -> x
loopX, Set v
loopO :: Set v
loopO :: forall v x. BreakLoop v x -> Set v
loopO, v
loopI :: v
loopI :: forall v x. BreakLoop v x -> v
loopI} =
        BreakLoopView
            { value :: Text
value = x -> Text
forall {a}. Show a => a -> Text
showText x
loopX
            , outputs :: [Text]
outputs = (v -> Text) -> [v] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map v -> Text
forall {a}. ToString a => a -> Text
toText ([v] -> [Text]) -> [v] -> [Text]
forall a b. (a -> b) -> a -> b
$ Set v -> [v]
forall a. Set a -> [a]
S.elems Set v
loopO
            , input :: Text
input = v -> Text
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 :: [F v x]
cRefOld :: forall v x. ConstantFolding v x -> [F v x]
cRefOld, [F v x]
cRefNew :: [F v x]
cRefNew :: forall v x. ConstantFolding v x -> [F v x]
cRefNew} =
        ConstantFoldingView
            { cRefOld :: [FView]
cRefOld = (F v x -> FView) -> [F v x] -> [FView]
forall a b. (a -> b) -> [a] -> [b]
map F v x -> FView
forall t v. Viewable t v => t -> v
view [F v x]
cRefOld
            , cRefNew :: [FView]
cRefNew = (F v x -> FView) -> [F v x] -> [FView]
forall a b. (a -> b) -> [a] -> [b]
map F v x -> FView
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 :: [F v x]
refOld :: forall v x. OptimizeAccum v x -> [F v x]
refOld, [F v x]
refNew :: [F v x]
refNew :: forall v x. OptimizeAccum v x -> [F v x]
refNew} =
        OptimizeAccumView
            { old :: [FView]
old = (F v x -> FView) -> [F v x] -> [FView]
forall a b. (a -> b) -> [a] -> [b]
map F v x -> FView
forall t v. Viewable t v => t -> v
view [F v x]
refOld
            , new :: [FView]
new = (F v x -> FView) -> [F v x] -> [FView]
forall a b. (a -> b) -> [a] -> [b]
map F v x -> FView
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 :: [F v x]
rOld :: forall v x. OptimizeLogicalUnit v x -> [F v x]
rOld, [F v x]
rNew :: [F v x]
rNew :: forall v x. OptimizeLogicalUnit v x -> [F v x]
rNew} =
        OptimizeLogicalUnitView
            { lOld :: [FView]
lOld = (F v x -> FView) -> [F v x] -> [FView]
forall a b. (a -> b) -> [a] -> [b]
map F v x -> FView
forall t v. Viewable t v => t -> v
view [F v x]
rOld
            , lNew :: [FView]
lNew = (F v x -> FView) -> [F v x] -> [FView]
forall a b. (a -> b) -> [a] -> [b]
map F v x -> FView
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 :: F v x
newBuffer :: forall v x. ResolveDeadlock v x -> F v x
newBuffer, Changeset v
changeset :: Changeset v
changeset :: forall v x. ResolveDeadlock v x -> Changeset v
changeset} =
        ResolveDeadlockView
            { newBuffer :: Text
newBuffer = F v x -> Text
forall {a}. Show a => a -> Text
showText F v x
newBuffer
            , changeset :: Text
changeset = Changeset v -> Text
forall {a}. Show a => a -> Text
showText Changeset v
changeset
            }

instance ToJSON DecisionView