diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..5e00d0d
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+/dist-newstyle
+CHANGELOG.md
+test.json
\ No newline at end of file
diff --git a/app/Export.hs b/app/Export.hs
new file mode 100644
index 0000000..12779ae
--- /dev/null
+++ b/app/Export.hs
@@ -0,0 +1,43 @@
+{-# Language OverloadedStrings #-}
+
+module Export where
+
+ ----------------Imports----------------
+
+ import Data.Aeson
+ import Data.Map hiding (fromList)
+ import Data.Vector hiding ((!))
+ import Workflow (NodeData(..), EdgeData(..), GraphData(..))
+
+ ---------------------------------------
+
+
+ ---------------Instances---------------
+
+ instance ToJSON NodeData where
+ toJSON (NData d) = Array (fromList $ foldrWithKey newObject [] d) where
+ newObject :: String -> Map String String -> [Value] -> [Value]
+ newObject ident values result = object [
+ "id" .= ident,
+ "name" .= values ! "name",
+ "val" .= show 5, -- Todo adjust to number of edges
+ "stateData" .= object [
+ "viewers" .= values ! "viewers",
+ "final" .= values ! "final"]] : result
+ -- toEncoding = genericToEncoding defaultOptions
+
+ instance ToJSON EdgeData where
+ toJSON (EData d) = Array (fromList $ foldrWithKey newObject [] d) where
+ newObject :: String -> Map String String -> [Value] -> [Value]
+ newObject ident values result = object [
+ "id" .= ident,
+ "name" .= values ! "name",
+ "source" .= values ! "source",
+ "target" .= values ! "target",
+ "actionData" .= object [
+ "mode" .= values ! "mode"]] : result
+
+ instance ToJSON GraphData where
+ toJSON (GData (nd, ed)) = object ["states" .= toJSON nd, "actions" .= toJSON ed]
+
+ ---------------------------------------
\ No newline at end of file
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
index 0000000..a58b7f9
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,52 @@
+module Main where
+
+ ----------------Imports----------------
+
+ import System.Environment (getArgs)
+ import Data.Yaml (ParseException, decodeEither')
+ import Data.Aeson (encode, encodeFile)
+
+ import qualified Data.ByteString.Char8 as BS
+ import Workflow (Workflow, buildData)
+ import Export
+ import Data.Maybe (fromJust, isNothing)
+ import Data.Either (isLeft, fromLeft, fromRight)
+ import Control.Exception (throw)
+
+ ---------------------------------------
+
+
+ ----------------Methods----------------
+
+ -- | Required command line arguments:
+ -- 1. A workflow source file (YAML)
+ -- 2. A graph data target file (JSON)
+ main :: IO ()
+ main = getArgs >>= process >>= finish where
+ process :: [String] -> IO Bool
+ process args = if length args /= 2
+ then print "Please provide (1) a source and (2) a target file" >> return True
+ else generateJSON args >> return False
+ finish :: Bool -> IO ()
+ finish abort = if abort then return () else print "Done."
+
+
+
+ -- | Imports the YAML document specified in the first command line argument and
+ -- exports the graph data to the JSON file specified in the second argument.
+ generateJSON :: [String] -> IO ()
+ generateJSON args = do
+ content <- BS.readFile (head args)
+ let decoded = decodeEither' content :: Either ParseException Workflow
+ if isLeft decoded then throw (fromLeft undefined decoded) else do
+ let yaml = fromRight undefined decoded
+ -- let GData (nodeData, edgeData) = buildData yaml
+ -- putStrLn $ "\nNode Data:\n\n" ++ show nodeData
+ -- putStrLn $ "\nEdge Data:\n\n" ++ show edgeData
+ -- encodeFile (last args) $ GData (nodeData, edgeData)
+ encodeFile (last args) $ buildData yaml
+
+ ---------------------------------------
+
+-- https://stackoverflow.com/questions/59903779/how-to-parse-json-with-field-of-optional-and-variant-type-in-haskell
+-- https://stackoverflow.com/questions/21292428/reading-yaml-lists-of-objects-in-haskell
\ No newline at end of file
diff --git a/app/Workflow.hs b/app/Workflow.hs
new file mode 100644
index 0000000..d3465c3
--- /dev/null
+++ b/app/Workflow.hs
@@ -0,0 +1,160 @@
+{-# Language DuplicateRecordFields,
+ NoFieldSelectors,
+ OverloadedRecordDot,
+ OverloadedStrings,
+ DeriveGeneric #-}
+
+module Workflow where
+
+ ----------------Imports----------------
+
+ import Data.Yaml
+ import Control.Applicative hiding (empty)
+ import GHC.Generics (Generic)
+ import Data.Map
+ import Data.Maybe (fromMaybe, isNothing, fromJust)
+ import Data.Text (pack)
+
+ ---------------------------------------
+
+
+ ---------Data Types & Instances--------
+
+ -- | Outer structure of a workflow, i.e. nodes and stages.
+ data Workflow = Workflow {
+ nodes :: Map String State,
+ stages :: Maybe Value
+ } deriving (Show, Generic)
+
+ instance FromJSON Workflow
+
+
+ -- | Structure of a node.
+ data State = State {
+ viewers :: Maybe StateViewers,
+ payload :: Maybe Value,
+ final :: Maybe Final,
+ edges :: Maybe (Map String Action),
+ messages :: Maybe Value
+ } deriving (Show, Generic)
+
+ instance FromJSON State where
+ parseJSON (Object o) = State <$>
+ o .:? "viewers" <*>
+ o .:? "payload-view" <*>
+ o .:? "final" <*>
+ o .:? "edges" <*>
+ o .:? "messages"
+ parseJSON _ = error "unexpected state data format"
+
+
+ -- | Wrapper for the `final` value of any node.
+ newtype Final = Final {final :: String} deriving (Show, Generic)
+
+ instance FromJSON Final where
+ parseJSON v = case v of
+ String _ -> Final <$> parseJSON v
+ Bool x -> Final <$> parseJSON (String . pack . show $ x)
+
+
+ -- | Structure of the `viewers` object of any node.
+ data StateViewers = StateViewers {
+ name :: Either Label String,
+ viewers :: Maybe Value
+ } deriving (Show, Generic)
+
+ instance FromJSON StateViewers where
+ parseJSON (Object o) = StateViewers <$>
+ ((Left <$> o .: "display-label") <|> (Right <$> o .: "display-label")) <*>
+ o .:? "viewers"
+ parseJSON _ = error "unexpected stateViewers data format"
+
+
+
+ -- | Structure of the @display-label@ object of any node or edge.
+ data Label = Label {
+ fallback :: Maybe String,
+ translations :: Maybe Value
+ } deriving (Show, Generic)
+
+ instance FromJSON Label
+
+
+ -- | Structure of an edge.
+ data Action = Action {
+ mode :: Maybe String,
+ source :: Maybe String,
+ name :: Maybe Label,
+ actors :: Maybe Value,
+ viewActor :: Maybe Value,
+ viewers :: Maybe Value,
+ messages :: Maybe Value,
+ form :: Maybe Value
+ } deriving (Show, Generic)
+
+ instance FromJSON Action where
+ parseJSON (Object o) = Action <$>
+ o .:? "mode" <*>
+ o .:? "source" <*>
+ o .:? "display-label" <*>
+ o .:? "actors" <*>
+ o .:? "view-actor" <*>
+ o .:? "viewers" <*>
+ o .:? "messages" <*>
+ o .:? "form"
+ parseJSON _ = error "unexpected action data format"
+
+
+ -- | Data of all nodes prepared for JSON encoding.
+ newtype NodeData = NData (Map String (Map String String)) deriving (Show, Generic)
+ -- | Data of all edges prepared for JSON encoding.
+ newtype EdgeData = EData (Map String (Map String String)) deriving (Show, Generic)
+ -- | Data of the entire workflow prepared for JSON encoding.
+ newtype GraphData = GData (NodeData , EdgeData) deriving (Show, Generic)
+
+ ---------------------------------------
+
+
+ ---------------Constants---------------
+
+ -- | Name of the source of an initial action.
+ initID = "@@INIT"
+
+ ---------------------------------------
+
+
+ ----------------Methods----------------
+
+ buildData :: Workflow -> GraphData
+ buildData wf = GData $ foldrWithKey analyse (NData empty, EData empty) nodes where
+ nodes = insert initID (State {final = Just $ Final "False",
+ viewers = Just $ StateViewers (Left (Label (Just initID) Nothing)) Nothing,
+ payload = Nothing,
+ edges = Nothing,
+ messages = Nothing}) wf.nodes
+ analyse :: String -> State -> (NodeData , EdgeData) -> (NodeData , EdgeData)
+ analyse k s (NData n, ed@(EData e)) = (NData $ insert k (extract s) n, updateEdges k s.edges ed)
+ extract :: State -> Map String String
+ extract s = fromList [("name", name), ("viewers", viewers), ("final", final)] where
+ (name, viewers) = case s.viewers of
+ Nothing -> ("", "")
+ Just x -> case x.name of
+ Left y -> (fromMaybe "" y.fallback, show x.viewers)
+ Right y -> (y, show x.viewers)
+ final = case s.final of
+ Nothing -> ""
+ Just x -> x.final
+ updateEdges :: String -> Maybe (Map String Action) -> EdgeData -> EdgeData
+ updateEdges _ Nothing e = e
+ updateEdges targetID (Just edges) (EData e) = EData $ foldrWithKey (\ k action eData -> insert (k ++ "_@_" ++ targetID) (newData k action targetID) eData) e edges
+ newData :: String -> Action -> String -> Map String String
+ newData ident a targetID = fromList [("name", name), ("source", source), ("target", targetID), ("mode", mode)] where
+ name = if isNothing a.name
+ then ident
+ else case (fromJust a.name).fallback of
+ Nothing -> show a.name
+ Just x -> x
+ source = fromMaybe initID a.source
+ mode = fromMaybe "" a.mode
+
+ ---------------------------------------
\ No newline at end of file
diff --git a/editor.css b/editor.css
new file mode 100644
index 0000000..3ab857d
--- /dev/null
+++ b/editor.css
@@ -0,0 +1,7 @@
+/* .body {
+ margin: 50px 50px 50px 50px;
+}
+
+#editor {
+ border: 10px solid red;
+} */
\ No newline at end of file
diff --git a/editor.html b/editor.html
new file mode 100644
index 0000000..23700f1
--- /dev/null
+++ b/editor.html
@@ -0,0 +1,23 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
\ No newline at end of file
diff --git a/editor.js b/editor.js
new file mode 100644
index 0000000..f122803
--- /dev/null
+++ b/editor.js
@@ -0,0 +1,257 @@
+var workflow = {}
+
+// fetch('./test.json')
+// .then((response) => response.json())
+// .then((data) => {
+// for (var key in data)
+// workflow[key] = data[key];
+// });
+
+// Counters for placeholder IDs of states/actions added via GUI
+var stateIdCounter = workflow.states ? workflow.states.length : 0;
+var actionIdCounter = workflow.states ? workflow.actions.length : 0;
+
+
+var selfLoops = {}; // All edges whose targets equal their sources.
+var overlappingEdges = {}; // All edges whose target and source are connected by further.
+const selfLoopCurvMin = 0.5; // Minimum curvature of a self loop.
+const curvatureMinMax = 0.2; // Minimum/maximum curvature (1 +/- x) of overlapping edges.
+
+var selection = null; // The currently selected node/edge.
+
+
+/**
+ * Identifies and stores self loops as well as overlapping edges (i.e. multiple edges sharing the
+ * same source and target).
+ */
+function identifyOverlappingEdges() {
+ selfLoops = {};
+ overlappingEdges = {};
+ workflow.actions.forEach(edge => {
+ var source = typeof(edge.source) === 'string' ? edge.source : edge.source.id;
+ var target = typeof(edge.target) === 'string' ? edge.target : edge.target.id;
+ var pre = source <= target ? source : target;
+ var post = source <= target ? target : source;
+ edge.nodePairId = pre + '_' + post;
+ var category = edge.source === edge.target ? selfLoops : overlappingEdges;
+ if (!category[edge.nodePairId]) category[edge.nodePairId] = [];
+ category[edge.nodePairId].push(edge);
+ });
+}
+
+
+/**
+ * Computes the curvature of the loops stored in `selfLoops` and overlapping edges
+ * stored in `overlappingEdges`.
+ */
+function computeCurvatures() {
+ // Self loops
+ Object.keys(selfLoops).forEach(id => {
+ var edges = selfLoops[id];
+ for (let i = 0; i < edges.length; i++)
+ edges[i].curvature = selfLoopCurvMin + i / 10;
+ });
+ // Overlapping edges
+ Object.keys(overlappingEdges)
+ .filter(nodePairId => overlappingEdges[nodePairId].length > 1)
+ .forEach(nodePairId => {
+ var edges = overlappingEdges[nodePairId];
+ var lastIndex = edges.length - 1;
+ var lastEdge = edges[lastIndex];
+ lastEdge.curvature = curvatureMinMax;
+ let delta = 2 * curvatureMinMax / lastIndex;
+ for (let i = 0; i < lastIndex; i++) {
+ edges[i].curvature = - curvatureMinMax + i * delta;
+ if (lastEdge.source !== edges[i].source) edges[i].curvature *= -1;
+ }
+ });
+}
+
+
+/**
+ * Marks the given item as selected.
+ * @param {*} item The node or edge to select.
+ */
+function select(item) {
+ selection = item;
+ console.log(item);
+ // TODO
+}
+
+
+/**
+ * Updates the nodes and edges of the workflow graph.
+ */
+function updateGraph() {
+ identifyOverlappingEdges()
+ computeCurvatures()
+ Graph.graphData({nodes: workflow.states, links: workflow.actions});
+}
+
+
+/**
+ * Adds a new action between two states.
+ * @param {*} source The source state.
+ * @param {*} target The target state.
+ */
+function connect(source, target) {
+ let linkId = actionIdCounter ++;
+ action = {id: linkId, source: source, target: target, name: 'action_' + linkId};
+ workflow.actions.push(action);
+ updateGraph();
+}
+
+
+/**
+ * Adds a new state to the workflow.
+ * @param {*} x The x coordinate on the canvas.
+ * @param {*} y The y coordinate on the canvas.
+ * @returns The new state.
+ */
+function addState(x, y) {
+ let nodeId = stateIdCounter ++;
+ state = {id: nodeId, x: x, y: y, name: 'state_' + nodeId, fx: x, fy: y, val: 5};
+ workflow.states.push(state);
+ updateGraph();
+ return state;
+}
+
+
+/**
+ * Removes an edge from the workflow.
+ * @param {*} action The action to remove.
+ */
+function removeAction(action) {
+ workflow.actions.splice(workflow.actions.indexOf(action), 1);
+}
+
+
+/**
+ * Removes a state from the workflow.
+ * @param {*} state The state to remove.
+ */
+function removeState(state) {
+ workflow.actions
+ .filter(edge => edge.source === state || edge.target === state)
+ .forEach(edge => removeAction(edge));
+ workflow.states.splice(workflow.states.indexOf(state), 1);
+}
+
+const Graph = ForceGraph()
+ (document.getElementById('graph'))
+ .linkDirectionalArrowLength(6)
+ .linkDirectionalArrowRelPos(1)
+ .nodeColor(node => {
+ if (node.stateData && node.stateData.final !== 'False' && node.stateData.final !== '') {
+ if (node.stateData.final === 'True' || node.stateData.final === 'ok') {
+ return selection === node ? '#a4eb34' : '#7fad36';
+ } else if (node.stateData.final === 'not-ok') {
+ return selection === node ? '#f77474' : '#f25050';
+ } else {
+ //console.log(node.stateData.final);
+ }
+ } else if (node.name === '@@INIT') {
+ return selection === node ? '#e8cd84' : '#d1ad4b';
+ } else {
+ return selection === node ? '#5fbad9' : '#4496b3';
+ }
+ })
+ .linkColor(edge => selection === edge ? 'black' : '#999999')
+ .linkCurvature('curvature')
+ .linkCanvasObjectMode(() => 'after')
+ .linkCanvasObject((edge, context) => {
+ const MAX_FONT_SIZE = 4;
+ const LABEL_NODE_MARGIN = Graph.nodeRelSize() * edge.source.val * 1.5;
+
+ const source = edge.source;
+ const target = edge.target;
+ const curvature = edge.curvature || 0;
+
+ var textPos = (source === target) ? {x: source.x, y: source.y} : Object.assign(...['x', 'y'].map(c => ({
+ [c]: source[c] + (target[c] - source[c]) / 2
+ })));
+
+ const edgeVector = {x: target.x - source.x, y: target.y - source.y};
+ if (source !== target) {
+ var evLength = Math.sqrt(Math.pow(edgeVector.x, 2) + Math.pow(edgeVector.y, 2));
+ var perpendicular = {x: edgeVector.x, y: (-Math.pow(edgeVector.x, 2) / edgeVector.y)};
+ var pLength = Math.sqrt(Math.pow(perpendicular.x, 2) + Math.pow(perpendicular.y, 2));
+ perpendicular.x = perpendicular.x / pLength;
+ perpendicular.y = perpendicular.y / pLength;
+ var fromSource = {x: source.x + perpendicular.x, y: source.y + perpendicular.y};
+ // If source would cycle around target in clockwise direction, would fromSource point into this direction?
+ // If not, the perpendicular vector must be flipped in order to ensure that the label is displayed on the
+ // intended curved edge.
+ var isClockwise = (source.x < target.x && fromSource.y > source.y) ||
+ (source.x > target.x && fromSource.y < source.y) ||
+ (source.x === target.x && ((source.y < target.y && fromSource.x < source.x) ||
+ source.y > target.y && fromSource.x > source.x));
+ var offset = 0.5 * evLength * (isClockwise ? -curvature : curvature);
+ textPos = {x: textPos.x + perpendicular.x * offset, y: textPos.y + perpendicular.y * offset};
+ } else if (edge.__controlPoints) { // Position label relative to the Bezier control points of the self loop
+ edgeVector.x = edge.__controlPoints[2] - edge.__controlPoints[0];
+ edgeVector.y = edge.__controlPoints[3] - edge.__controlPoints[1];
+ var ctrlCenter = {x: edge.__controlPoints[0] + (edge.__controlPoints[2] - edge.__controlPoints[0]) / 2,
+ y: edge.__controlPoints[1] + (edge.__controlPoints[3] - edge.__controlPoints[1]) / 2};
+ var fromSource = {x: ctrlCenter.x - source.x, y: ctrlCenter.y - source.y};
+ var fromSrcLen = Math.sqrt(Math.pow(fromSource.x, 2) + Math.pow(fromSource.y, 2));
+ fromSource.x /= fromSrcLen;
+ fromSource.y /= fromSrcLen;
+ // The distance of the control point is 70 * curvature. Slightly more than half of it is appropriate here:
+ textPos = {x: source.x + fromSource.x * 37 * curvature, y: source.y + fromSource.y * 37 * curvature};
+ }
+
+ const maxTextLength = (source !== target) ? Math.sqrt(Math.pow(edgeVector.x, 2) + Math.pow(edgeVector.y, 2)) - LABEL_NODE_MARGIN
+ : 1.5 * Math.sqrt(4 * source.val);
+
+ var textAngle = Math.atan2(edgeVector.y, edgeVector.x);
+ // maintain label vertical orientation for legibility
+ if (textAngle > Math.PI / 2) textAngle = -(Math.PI - textAngle);
+ if (textAngle < -Math.PI / 2) textAngle = -(-Math.PI - textAngle);
+
+ var label = edge.name;
+
+ // estimate fontSize to fit in link length
+ //context.font = '1px Sans-Serif';
+ const fontSize = MAX_FONT_SIZE;// Math.min(MAX_FONT_SIZE, maxTextLength / context.measureText(label).width);
+ context.font = `${fontSize}px Sans-Serif`;
+
+ var textLen = context.measureText(label).width;
+ if (textLen > maxTextLength) {
+ var allowedLen = maxTextLength * (label.length / textLen);
+ label = label.substring(0, allowedLen);
+ if (label !== edge.name) label += '...';
+ textLen = context.measureText(label).width;
+ }
+
+ const bckgDimensions = [textLen, fontSize];
+
+ // draw text label (with background rect)
+ context.save();
+ context.translate(textPos.x, textPos.y);
+ context.rotate(textAngle);
+
+ context.fillStyle = 'rgba(255, 255, 255, 0.8)';
+ context.fillRect(- bckgDimensions[0] / 2, - bckgDimensions[1] / 2, ...bckgDimensions);
+
+ context.textAlign = 'center';
+ context.textBaseline = 'middle';
+ context.fillStyle = selection === edge ? 'black' : 'darkgrey';
+ context.fillText(label, 0, 0);
+ context.restore();
+ })
+ .onNodeDragEnd(node => {
+ node.fx = node.x;
+ node.fy = node.y;
+ })
+ .onNodeClick((node, _) => select(node))
+ .onNodeRightClick((node, _) => removeState(node))
+ .onLinkClick((edge, _) => select(edge))
+ .onLinkRightClick((edge, _) => removeAction(edge))
+ .onBackgroundClick(event => {
+ var coords = Graph.screen2GraphCoords(event.layerX, event.layerY);
+ var newState = addState(coords.x, coords.y);
+ selection = newState;
+ });
+
+updateGraph();
\ No newline at end of file
diff --git a/workflow-visualiser.cabal b/workflow-visualiser.cabal
new file mode 100644
index 0000000..42615c1
--- /dev/null
+++ b/workflow-visualiser.cabal
@@ -0,0 +1,41 @@
+cabal-version: 2.4
+name: workflow-visualiser
+version: 0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- A URL where users can report bugs.
+-- bug-reports:
+
+-- The license under which the package is released.
+-- license:
+author: David Mosbach
+maintainer: david.mosbach@live.de
+
+-- A copyright notice.
+-- copyright:
+-- category:
+extra-source-files: CHANGELOG.md
+
+executable workflow-visualiser
+ main-is: Main.hs
+
+ -- Modules included in this executable, other than Main.
+ other-modules: Workflow,
+ Export
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends: base ^>=4.16.3.0,
+ yaml >= 0.11.11.0,
+ aeson >= 2.1.2.0,
+ bytestring,
+ containers,
+ text,
+ vector
+ hs-source-dirs: app
+ default-language: Haskell2010