From 695e7a4a51c78f2127396745cdbece2c96cb78cf Mon Sep 17 00:00:00 2001 From: David Mosbach Date: Sat, 1 Jul 2023 02:57:34 +0200 Subject: [PATCH] adjusted frontend to new data structure --- app/Export.hs | 56 +++++++++++++++++++++++++++-------------------- app/Workflow.hs | 45 +++++++++++++++++++++++++++---------- app/YamlParser.hs | 8 +++++-- editor.js | 28 ++++++++++++------------ workflow.js | 2 +- 5 files changed, 86 insertions(+), 53 deletions(-) diff --git a/app/Export.hs b/app/Export.hs index 81d689d..ec9b6f0 100644 --- a/app/Export.hs +++ b/app/Export.hs @@ -7,7 +7,7 @@ module Export where import Data.Aeson import Data.Map hiding (fromList) 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.YAML (Node (..)) import Data.YAML.Event (tagToText, Pos) @@ -24,34 +24,35 @@ module Export where toJSON (Single s) = toJSON s toJSON (Msg m) = toJSON m toJSON (Vie v) = toJSON v + toJSON (Act a) = toJSON a toJSON (Dict d) = toJSON d toJSON (List l) = toJSON l toJSON (Val v) = toJSON v - instance ToJSON YAMLNode where - toJSON (Scalar b c a p) = object [ - "content" .= show b, - "comment" .= c, - "anchor" .= a, - "position" .= p - ] - toJSON (Mapping ct cm a md p) = object [ - "content" .= ct, - "comment" .= cm, - "anchor" .= a, - "position" .= p - ] - toJSON (Sequence ch cm a p) = object [ - "content" .= ch, - "comment" .= cm, - "anchor" .= a, - "position" .= p - ] + -- instance ToJSON YAMLNode where + -- toJSON (Scalar b c a p) = object [ + -- "content" .= show b, + -- "comment" .= c, + -- "anchor" .= a, + -- "position" .= p + -- ] + -- toJSON (Mapping ct cm a md p) = object [ + -- "content" .= ct, + -- "comment" .= cm, + -- "anchor" .= a, + -- "position" .= p + -- ] + -- toJSON (Sequence ch cm a p) = object [ + -- "content" .= ch, + -- "comment" .= cm, + -- "anchor" .= a, + -- "position" .= p + -- ] - instance ToJSONKey YAMLNode where - toJSONKey = toJSONKeyText display where - display :: YAMLNode -> Text - display (Scalar bytes _ _ _) = pack $ show bytes + -- instance ToJSONKey YAMLNode where + -- toJSONKey = toJSONKeyText display where + -- display :: YAMLNode -> Text + -- display (Scalar bytes _ _ _) = pack $ show bytes instance ToJSON AnchorData where toJSON (AnchorDef a) = object ["type" .= String "anchor", "name" .= a] @@ -78,6 +79,13 @@ module Export where "comment" .= comment, "anchor" .= anchor ] + + instance ToJSON Actors where + toJSON (Actors (Viewers mappings comment anchor)) = object [ + "actors" .= mappings, + "comment" .= comment, + "anchor" .= anchor + ] instance ToJSON Label where toJSON (Label fallback fallbackLang translations comment anchor merge) = object [ "fallback" .= fallback, diff --git a/app/Workflow.hs b/app/Workflow.hs index 42423fb..07aec96 100644 --- a/app/Workflow.hs +++ b/app/Workflow.hs @@ -8,15 +8,20 @@ module Workflow where ----------------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 GHC.Generics (Generic) import Data.Map import Data.Maybe (fromMaybe, isNothing, fromJust) - import Data.Text (Text, pack) + import Data.Text (Text, pack, unpack) import YamlParser 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 Data.Yaml (ToJSON(toJSON)) + import Data.Aeson.Types (toJSONKeyText) --------------------------------------- @@ -65,14 +70,14 @@ module Workflow where -- | Wrapper for the `final` value of any node. data Final = Final { - final :: String, + final :: Text, comment :: [Comment], anchor :: AnchorData } deriving Show instance FromYAML' Final where fromYAML (Scalar bytes comment anchor _) = Final - <$> pure (show $ decodeUtf8 bytes) + <$> pure (decodeUtf8 bytes) <*> pure comment <*> pure anchor @@ -105,14 +110,29 @@ module Workflow where anchor :: AnchorData } deriving Show + newtype Actors = Actors Viewers deriving Show + instance FromYAML' Viewers where fromYAML (Sequence seq comment anchor _) = Viewers <$> pure (Prelude.map (toV empty) seq) <*> pure comment <*> pure anchor where - toV :: Map Text YAMLNode -> YAMLNode -> Map Text YAMLNode - 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 :: Map Text YAMLNode -> YAMLNode -> Map Text YAMLNode + 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) + + 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, source :: Maybe Text, name :: Maybe Label, - actors :: Maybe Viewers, + actors :: Maybe Actors, viewActor :: Maybe Viewers, viewers :: Maybe Viewers, messages :: Maybe [Message], @@ -194,6 +214,7 @@ module Workflow where data Entry = Single Text | Msg Message | Vie Viewers + | Act Actors | Dict (Map Text YAMLNode) | List [Entry] | Val YAMLNode deriving Show @@ -236,7 +257,7 @@ module Workflow where ("comment", List $ Prelude.map Single s.comment), ("anchor", Single . pack . show $ s.anchor), ("viewers", Vie viewers), - ("final", Single $ pack final), + ("final", Single final), ("messages", List $ Prelude.map Msg messages), ("payload", payload)] where (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 updateEdges :: Text -> Maybe (Map Text Action) -> EdgeData -> EdgeData 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 ident a targetID = fromList [("name", Single name), ("comment", List $ Prelude.map Single a.comment), @@ -259,7 +280,7 @@ module Workflow where ("source", Single source), ("target", Single targetID), ("mode", Single mode), - ("actors", Vie actors), + ("actors", Act actors), ("viewers", Vie viewers), ("view-actor", Vie viewActor), ("messages", List $ Prelude.map Msg messages), @@ -271,7 +292,7 @@ module Workflow where Just x -> x source = fromMaybe initID a.source mode = fromMaybe "" a.mode - actors = fromMaybe (Viewers [] [] NoAnchor) a.actors + actors = fromMaybe (Actors $ Viewers [] [] NoAnchor) a.actors viewers = fromMaybe (Viewers [] [] NoAnchor) a.viewers viewActor = fromMaybe (Viewers [] [] NoAnchor) a.viewActor messages = fromMaybe [] a.messages diff --git a/app/YamlParser.hs b/app/YamlParser.hs index 982ce3b..db7513d 100644 --- a/app/YamlParser.hs +++ b/app/YamlParser.hs @@ -31,8 +31,8 @@ module YamlParser where comments :: [Comment] -- YAML comment queue for the next node. } - data AnchorData = NoAnchor | AnchorDef Text | AnchorAlias Text deriving (Show, Eq) - data MergeData = MergeData {keys :: [Text], anchor :: AnchorData} deriving (Show, Eq) + data AnchorData = NoAnchor | AnchorDef Text | AnchorAlias Text deriving (Show, Eq, Ord) + data MergeData = MergeData {keys :: [Text], anchor :: AnchorData} deriving (Show, Eq, Ord) data YAMLNode = @@ -56,6 +56,10 @@ module YamlParser where pos :: Pos } deriving (Show, Eq) + instance Ord YAMLNode where + (Scalar b1 _ _ _) <= (Scalar b2 _ _ _) = b1 <= b2 + _ <= _ = undefined + type Comment = Text diff --git a/editor.js b/editor.js index 3de5bc7..d9d15d3 100644 --- a/editor.js +++ b/editor.js @@ -682,8 +682,8 @@ function prepareWorkflow() { state.stateData.messages.forEach(msg => messages.push(new Message(msg))); state.stateData.messages = messages; var viewers = []; - state.stateData.viewers.forEach(v => viewers.push(new Role(v))); - state.stateData.viewers = viewers; + state.stateData.viewers.viewers.forEach(v => viewers.push(new Role(v))); + state.stateData.viewers.viewers = viewers; state.stateData.payload = new Payload(state.stateData.payload); 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 = messages; var viewers = []; - action.actionData.viewers.forEach(v => viewers.push(new Role(v))); - action.actionData.viewers = viewers; + action.actionData.viewers.viewers.forEach(v => viewers.push(new Role(v))); + action.actionData.viewers.viewers = viewers; var actors = []; - action.actionData.actors.forEach(v => actors.push(new Role(v))); - action.actionData.actors = actors; + action.actionData.actors.actors.forEach(v => actors.push(new Role(v))); + action.actionData.actors.actors = actors; var viewActors = []; - action.actionData['actor Viewers'].forEach(v => viewActors.push(new Role(v))); - action.actionData['actor Viewers'] = viewActors; + action.actionData['actor Viewers'].viewers.forEach(v => viewActors.push(new Role(v))); + action.actionData['actor Viewers'].viewers = viewActors; action.actionData.form = new Payload(action.actionData.form); 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; actors.forEach(actor => includes = includes || equalRoles(a, actor)); (!includes) && actors.push(a); @@ -725,10 +725,10 @@ function prepareWorkflow() { //Identify all viewers of every action workflow.actions.forEach(act => { - if (act.actionData.viewers.length === 0) { + if (act.actionData.viewers.viewers.length === 0) { viewableByAll.push(act.actionData); } else { - act.actionData.viewers.forEach(v => { + act.actionData.viewers.viewers.forEach(v => { var includes = false; viewers.forEach(viewer => includes = includes || equalRoles(v, viewer)); (!includes) && viewers.push(v); @@ -747,7 +747,7 @@ function prepareWorkflow() { } else if (st.stateData.viewers.length === 0) { viewableByAll.push(st.stateData); } else { - st.stateData.viewers.forEach(v => { + st.stateData.viewers.viewers.forEach(v => { var includes = false; viewers.forEach(viewer => includes = includes || equalRoles(v, viewer)); (!includes) && viewers.push(v); @@ -867,8 +867,8 @@ function getNodeColour(node) { || highlightedSources.includes(node.id) || highlightedTargets.includes(node.id) var alpha = standard ? 'ff' : '55'; var isSelected = selection === node || rightSelection === node; - if (node.stateData && node.stateData.final !== 'False' && node.stateData.final !== '') { - if (node.stateData.final === 'True' || node.stateData.final === 'ok') { + if (node.stateData && node.stateData.final !== 'false' && node.stateData.final !== '') { + if (node.stateData.final === 'true' || node.stateData.final === 'ok') { return (isSelected ? '#3ac713' : '#31a810') + alpha; } else if (node.stateData.final === 'not-ok') { return (isSelected ? '#ec4e7b' : '#e7215a') + alpha; diff --git a/workflow.js b/workflow.js index 597d0f3..5520827 100644 --- a/workflow.js +++ b/workflow.js @@ -29,7 +29,7 @@ class Message { this.translations = content.translations; this.status = json.status; this.viewers = []; - json.viewers.forEach(v => this.viewers.push(new Role(v))); + json.viewers.viewers.forEach(v => this.viewers.push(new Role(v))); }