adjusted frontend to new data structure

2023-07-01 02:57:34 +02:00 · 2023-07-01 02:57:34 +02:00 · 695e7a4a51
commit 695e7a4a51
parent d77e73f737
5 changed files with 86 additions and 53 deletions
--- 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,
--- 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
--- 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

--- 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;
--- 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)));
    
  }