lmu/uni2work.workflows.visualiser
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adjusted frontend to new data structure

Browse Source
This commit is contained in:
David Mosbach 2023-07-01 02:57:34 +02:00
parent d77e73f737
commit 695e7a4a51
5 changed files with 86 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
app/Export.hs
View File

@ -7,7 +7,7 @@ module Export where
import Data.Aeson import Data.Aeson
import Data.Map hiding (fromList) import Data.Map hiding (fromList)
import Data.Vector hiding ((!), (++)) import Data.Vector hiding ((!), (++))
import Workflow (NodeData(..), EdgeData(..), GraphData(..), Entry(..), Message(..), Label(..), Viewers (..)) import Workflow (NodeData(..), EdgeData(..), GraphData(..), Entry(..), Message(..), Label(..), Viewers (..), Actors (Actors))
import Data.Text (Text, pack) import Data.Text (Text, pack)
-- import Data.YAML (Node (..)) -- import Data.YAML (Node (..))
import Data.YAML.Event (tagToText, Pos) import Data.YAML.Event (tagToText, Pos)
@ -24,34 +24,35 @@ module Export where
toJSON (Single s) = toJSON s toJSON (Single s) = toJSON s
toJSON (Msg m) = toJSON m toJSON (Msg m) = toJSON m
toJSON (Vie v) = toJSON v toJSON (Vie v) = toJSON v
toJSON (Act a) = toJSON a
toJSON (Dict d) = toJSON d toJSON (Dict d) = toJSON d
toJSON (List l) = toJSON l toJSON (List l) = toJSON l
toJSON (Val v) = toJSON v toJSON (Val v) = toJSON v
instance ToJSON YAMLNode where -- instance ToJSON YAMLNode where
toJSON (Scalar b c a p) = object [ -- toJSON (Scalar b c a p) = object [
"content" .= show b, -- "content" .= show b,
"comment" .= c, -- "comment" .= c,
"anchor" .= a, -- "anchor" .= a,
"position" .= p -- "position" .= p
] -- ]
toJSON (Mapping ct cm a md p) = object [ -- toJSON (Mapping ct cm a md p) = object [
"content" .= ct, -- "content" .= ct,
"comment" .= cm, -- "comment" .= cm,
"anchor" .= a, -- "anchor" .= a,
"position" .= p -- "position" .= p
] -- ]
toJSON (Sequence ch cm a p) = object [ -- toJSON (Sequence ch cm a p) = object [
"content" .= ch, -- "content" .= ch,
"comment" .= cm, -- "comment" .= cm,
"anchor" .= a, -- "anchor" .= a,
"position" .= p -- "position" .= p
] -- ]
instance ToJSONKey YAMLNode where -- instance ToJSONKey YAMLNode where
toJSONKey = toJSONKeyText display where -- toJSONKey = toJSONKeyText display where
display :: YAMLNode -> Text -- display :: YAMLNode -> Text
display (Scalar bytes _ _ _) = pack $ show bytes -- display (Scalar bytes _ _ _) = pack $ show bytes
instance ToJSON AnchorData where instance ToJSON AnchorData where
toJSON (AnchorDef a) = object ["type" .= String "anchor", "name" .= a] toJSON (AnchorDef a) = object ["type" .= String "anchor", "name" .= a]
@ -78,6 +79,13 @@ module Export where
"comment" .= comment, "comment" .= comment,
"anchor" .= anchor "anchor" .= anchor
] ]
instance ToJSON Actors where
toJSON (Actors (Viewers mappings comment anchor)) = object [
"actors" .= mappings,
"comment" .= comment,
"anchor" .= anchor
]
instance ToJSON Label where instance ToJSON Label where
toJSON (Label fallback fallbackLang translations comment anchor merge) = object [ toJSON (Label fallback fallbackLang translations comment anchor merge) = object [
"fallback" .= fallback, "fallback" .= fallback,

45
app/Workflow.hs
View File

@ -8,15 +8,20 @@ module Workflow where
----------------Imports---------------- ----------------Imports----------------
import Data.YAML hiding (Scalar, Mapping, Sequence) import Data.YAML hiding (Scalar, Mapping, Sequence, encode)
import Data.Aeson(encode, ToJSON, ToJSONKey (toJSONKey))
import Control.Applicative hiding (empty) import Control.Applicative hiding (empty)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Data.Map import Data.Map
import Data.Maybe (fromMaybe, isNothing, fromJust) import Data.Maybe (fromMaybe, isNothing, fromJust)
import Data.Text (Text, pack) import Data.Text (Text, pack, unpack)
import YamlParser import YamlParser
import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Text.Lazy as TL
import Debug.Trace (trace) import Debug.Trace (trace)
import Data.Yaml (ToJSON(toJSON))
import Data.Aeson.Types (toJSONKeyText)
--------------------------------------- ---------------------------------------
@ -65,14 +70,14 @@ module Workflow where
-- | Wrapper for the `final` value of any node. -- | Wrapper for the `final` value of any node.
data Final = Final { data Final = Final {
final :: String, final :: Text,
comment :: [Comment], comment :: [Comment],
anchor :: AnchorData anchor :: AnchorData
} deriving Show } deriving Show
instance FromYAML' Final where instance FromYAML' Final where
fromYAML (Scalar bytes comment anchor _) = Final fromYAML (Scalar bytes comment anchor _) = Final
<$> pure (show $ decodeUtf8 bytes) <$> pure (decodeUtf8 bytes)
<*> pure comment <*> pure comment
<*> pure anchor <*> pure anchor
@ -105,14 +110,29 @@ module Workflow where
anchor :: AnchorData anchor :: AnchorData
} deriving Show } deriving Show
newtype Actors = Actors Viewers deriving Show
instance FromYAML' Viewers where instance FromYAML' Viewers where
fromYAML (Sequence seq comment anchor _) = Viewers fromYAML (Sequence seq comment anchor _) = Viewers
<$> pure (Prelude.map (toV empty) seq) <$> pure (Prelude.map (toV empty) seq)
<*> pure comment <*> pure comment
<*> pure anchor where <*> pure anchor where
toV :: Map Text YAMLNode -> YAMLNode -> Map Text YAMLNode toV :: Map Text YAMLNode -> YAMLNode -> Map Text YAMLNode
toV m (Mapping [] _ _ _ _) = m toV m (Mapping [] _ _ _ _) = m
toV m (Mapping ((Scalar b _ _ _,v):xs) c a md p) = insert (decodeUtf8 b) v $ toV m (Mapping xs c a md p) toV m (Mapping ((Scalar b _ _ _,v):xs) c a md p) = insert (decodeUtf8 b) v $ toV m (Mapping xs c a md p)
instance FromYAML' Actors where
fromYAML x = Actors <$> fromYAML x
instance ToJSON YAMLNode where
toJSON (Scalar b _ _ _) = toJSON $ decodeUtf8 b
toJSON (Mapping ct _ _ _ _) = toJSON $ fromList ct
toJSON (Sequence ch _ _ _) = toJSON ch
instance ToJSONKey YAMLNode where
toJSONKey = toJSONKeyText display where
display :: YAMLNode -> Text
display (Scalar bytes _ _ _) = decodeUtf8 bytes
@ -148,7 +168,7 @@ module Workflow where
mode :: Maybe Text, mode :: Maybe Text,
source :: Maybe Text, source :: Maybe Text,
name :: Maybe Label, name :: Maybe Label,
actors :: Maybe Viewers, actors :: Maybe Actors,
viewActor :: Maybe Viewers, viewActor :: Maybe Viewers,
viewers :: Maybe Viewers, viewers :: Maybe Viewers,
messages :: Maybe [Message], messages :: Maybe [Message],
@ -194,6 +214,7 @@ module Workflow where
data Entry = Single Text data Entry = Single Text
| Msg Message | Msg Message
| Vie Viewers | Vie Viewers
| Act Actors
| Dict (Map Text YAMLNode) | Dict (Map Text YAMLNode)
| List [Entry] | List [Entry]
| Val YAMLNode deriving Show | Val YAMLNode deriving Show
@ -236,7 +257,7 @@ module Workflow where
("comment", List $ Prelude.map Single s.comment), ("comment", List $ Prelude.map Single s.comment),
("anchor", Single . pack . show $ s.anchor), ("anchor", Single . pack . show $ s.anchor),
("viewers", Vie viewers), ("viewers", Vie viewers),
("final", Single $ pack final), ("final", Single final),
("messages", List $ Prelude.map Msg messages), ("messages", List $ Prelude.map Msg messages),
("payload", payload)] where ("payload", payload)] where
(name, viewers) = case s.viewers of (name, viewers) = case s.viewers of
@ -251,7 +272,7 @@ module Workflow where
payload = maybe (Val (Scalar (encodeUtf8 "null") [] NoAnchor (Pos 0 0 0 0))) Dict s.payload payload = maybe (Val (Scalar (encodeUtf8 "null") [] NoAnchor (Pos 0 0 0 0))) Dict s.payload
updateEdges :: Text -> Maybe (Map Text Action) -> EdgeData -> EdgeData updateEdges :: Text -> Maybe (Map Text Action) -> EdgeData -> EdgeData
updateEdges _ Nothing e = e updateEdges _ Nothing e = e
updateEdges targetID (Just edges) (EData e) = EData $ foldrWithKey (\ k action eData -> insert (pack $ show k ++ "_@_" ++ show targetID) (newData k action targetID) eData) e edges updateEdges targetID (Just edges) (EData e) = EData $ foldrWithKey (\ k action eData -> insert (pack $ unpack k ++ "_@_" ++ unpack targetID) (newData k action targetID) eData) e edges
newData :: Text -> Action -> Text -> Map Text Entry newData :: Text -> Action -> Text -> Map Text Entry
newData ident a targetID = fromList [("name", Single name), newData ident a targetID = fromList [("name", Single name),
("comment", List $ Prelude.map Single a.comment), ("comment", List $ Prelude.map Single a.comment),
@ -259,7 +280,7 @@ module Workflow where
("source", Single source), ("source", Single source),
("target", Single targetID), ("target", Single targetID),
("mode", Single mode), ("mode", Single mode),
("actors", Vie actors), ("actors", Act actors),
("viewers", Vie viewers), ("viewers", Vie viewers),
("view-actor", Vie viewActor), ("view-actor", Vie viewActor),
("messages", List $ Prelude.map Msg messages), ("messages", List $ Prelude.map Msg messages),
@ -271,7 +292,7 @@ module Workflow where
Just x -> x Just x -> x
source = fromMaybe initID a.source source = fromMaybe initID a.source
mode = fromMaybe "" a.mode mode = fromMaybe "" a.mode
actors = fromMaybe (Viewers [] [] NoAnchor) a.actors actors = fromMaybe (Actors $ Viewers [] [] NoAnchor) a.actors
viewers = fromMaybe (Viewers [] [] NoAnchor) a.viewers viewers = fromMaybe (Viewers [] [] NoAnchor) a.viewers
viewActor = fromMaybe (Viewers [] [] NoAnchor) a.viewActor viewActor = fromMaybe (Viewers [] [] NoAnchor) a.viewActor
messages = fromMaybe [] a.messages messages = fromMaybe [] a.messages

8
app/YamlParser.hs
View File

@ -31,8 +31,8 @@ module YamlParser where
comments :: [Comment] -- YAML comment queue for the next node. comments :: [Comment] -- YAML comment queue for the next node.
} }
data AnchorData = NoAnchor | AnchorDef Text | AnchorAlias Text deriving (Show, Eq) data AnchorData = NoAnchor | AnchorDef Text | AnchorAlias Text deriving (Show, Eq, Ord)
data MergeData = MergeData {keys :: [Text], anchor :: AnchorData} deriving (Show, Eq) data MergeData = MergeData {keys :: [Text], anchor :: AnchorData} deriving (Show, Eq, Ord)
data YAMLNode = data YAMLNode =
@ -56,6 +56,10 @@ module YamlParser where
pos :: Pos pos :: Pos
} deriving (Show, Eq) } deriving (Show, Eq)
instance Ord YAMLNode where
(Scalar b1 _ _ _) <= (Scalar b2 _ _ _) = b1 <= b2
_ <= _ = undefined
type Comment = Text type Comment = Text

28
editor.js
View File

@ -682,8 +682,8 @@ function prepareWorkflow() {
state.stateData.messages.forEach(msg => messages.push(new Message(msg))); state.stateData.messages.forEach(msg => messages.push(new Message(msg)));
state.stateData.messages = messages; state.stateData.messages = messages;
var viewers = []; var viewers = [];
state.stateData.viewers.forEach(v => viewers.push(new Role(v))); state.stateData.viewers.viewers.forEach(v => viewers.push(new Role(v)));
state.stateData.viewers = viewers; state.stateData.viewers.viewers = viewers;
state.stateData.payload = new Payload(state.stateData.payload); state.stateData.payload = new Payload(state.stateData.payload);
nodeIndex.add(state.id, state.name); nodeIndex.add(state.id, state.name);
}) })
@ -693,19 +693,19 @@ function prepareWorkflow() {
action.actionData.messages.forEach(msg => messages.push(new Message(msg))); action.actionData.messages.forEach(msg => messages.push(new Message(msg)));
action.actionData.messages = messages; action.actionData.messages = messages;
var viewers = []; var viewers = [];
action.actionData.viewers.forEach(v => viewers.push(new Role(v))); action.actionData.viewers.viewers.forEach(v => viewers.push(new Role(v)));
action.actionData.viewers = viewers; action.actionData.viewers.viewers = viewers;
var actors = []; var actors = [];
action.actionData.actors.forEach(v => actors.push(new Role(v))); action.actionData.actors.actors.forEach(v => actors.push(new Role(v)));
action.actionData.actors = actors; action.actionData.actors.actors = actors;
var viewActors = []; var viewActors = [];
action.actionData['actor Viewers'].forEach(v => viewActors.push(new Role(v))); action.actionData['actor Viewers'].viewers.forEach(v => viewActors.push(new Role(v)));
action.actionData['actor Viewers'] = viewActors; action.actionData['actor Viewers'].viewers = viewActors;
action.actionData.form = new Payload(action.actionData.form); action.actionData.form = new Payload(action.actionData.form);
actionIndex.add(action.id, action.name); actionIndex.add(action.id, action.name);
}) })
workflow.actions.forEach(act => act.actionData.actors.forEach(a => { workflow.actions.forEach(act => act.actionData.actors.actors.forEach(a => {
var includes = false; var includes = false;
actors.forEach(actor => includes = includes || equalRoles(a, actor)); actors.forEach(actor => includes = includes || equalRoles(a, actor));
(!includes) && actors.push(a); (!includes) && actors.push(a);
@ -725,10 +725,10 @@ function prepareWorkflow() {
//Identify all viewers of every action //Identify all viewers of every action
workflow.actions.forEach(act => { workflow.actions.forEach(act => {
if (act.actionData.viewers.length === 0) { if (act.actionData.viewers.viewers.length === 0) {
viewableByAll.push(act.actionData); viewableByAll.push(act.actionData);
} else { } else {
act.actionData.viewers.forEach(v => { act.actionData.viewers.viewers.forEach(v => {
var includes = false; var includes = false;
viewers.forEach(viewer => includes = includes || equalRoles(v, viewer)); viewers.forEach(viewer => includes = includes || equalRoles(v, viewer));
(!includes) && viewers.push(v); (!includes) && viewers.push(v);
@ -747,7 +747,7 @@ function prepareWorkflow() {
} else if (st.stateData.viewers.length === 0) { } else if (st.stateData.viewers.length === 0) {
viewableByAll.push(st.stateData); viewableByAll.push(st.stateData);
} else { } else {
st.stateData.viewers.forEach(v => { st.stateData.viewers.viewers.forEach(v => {
var includes = false; var includes = false;
viewers.forEach(viewer => includes = includes || equalRoles(v, viewer)); viewers.forEach(viewer => includes = includes || equalRoles(v, viewer));
(!includes) && viewers.push(v); (!includes) && viewers.push(v);
@ -867,8 +867,8 @@ function getNodeColour(node) {
|| highlightedSources.includes(node.id) || highlightedTargets.includes(node.id) || highlightedSources.includes(node.id) || highlightedTargets.includes(node.id)
var alpha = standard ? 'ff' : '55'; var alpha = standard ? 'ff' : '55';
var isSelected = selection === node || rightSelection === node; var isSelected = selection === node || rightSelection === node;
if (node.stateData && node.stateData.final !== 'False' && node.stateData.final !== '') { if (node.stateData && node.stateData.final !== 'false' && node.stateData.final !== '') {
if (node.stateData.final === 'True' || node.stateData.final === 'ok') { if (node.stateData.final === 'true' || node.stateData.final === 'ok') {
return (isSelected ? '#3ac713' : '#31a810') + alpha; return (isSelected ? '#3ac713' : '#31a810') + alpha;
} else if (node.stateData.final === 'not-ok') { } else if (node.stateData.final === 'not-ok') {
return (isSelected ? '#ec4e7b' : '#e7215a') + alpha; return (isSelected ? '#ec4e7b' : '#e7215a') + alpha;

2
workflow.js
View File

@ -29,7 +29,7 @@ class Message {
this.translations = content.translations; this.translations = content.translations;
this.status = json.status; this.status = json.status;
this.viewers = []; this.viewers = [];
json.viewers.forEach(v => this.viewers.push(new Role(v))); json.viewers.viewers.forEach(v => this.viewers.push(new Role(v)));
} }