From 712c7d768c11f66ac24b2ba3105368ea7210e73c Mon Sep 17 00:00:00 2001 From: David Mosbach Date: Fri, 5 May 2023 22:46:40 +0200 Subject: [PATCH] parse actor & viewer data --- app/Export.hs | 17 ++++++++++++----- app/Workflow.hs | 30 +++++++++++++++++++----------- 2 files changed, 31 insertions(+), 16 deletions(-) diff --git a/app/Export.hs b/app/Export.hs index 12779ae..20d2975 100644 --- a/app/Export.hs +++ b/app/Export.hs @@ -7,16 +7,22 @@ module Export where import Data.Aeson import Data.Map hiding (fromList) import Data.Vector hiding ((!)) - import Workflow (NodeData(..), EdgeData(..), GraphData(..)) - + import Workflow (NodeData(..), EdgeData(..), GraphData(..), Entry(..)) + import Data.Text (pack) + --------------------------------------- ---------------Instances--------------- + instance ToJSON Entry where + toJSON (Single s) = toJSON s + toJSON (Dict d) = toJSON d + toJSON (List l) = toJSON l + instance ToJSON NodeData where toJSON (NData d) = Array (fromList $ foldrWithKey newObject [] d) where - newObject :: String -> Map String String -> [Value] -> [Value] + newObject :: String -> Map String Entry -> [Value] -> [Value] newObject ident values result = object [ "id" .= ident, "name" .= values ! "name", @@ -28,14 +34,15 @@ module Export where instance ToJSON EdgeData where toJSON (EData d) = Array (fromList $ foldrWithKey newObject [] d) where - newObject :: String -> Map String String -> [Value] -> [Value] + newObject :: String -> Map String Entry -> [Value] -> [Value] newObject ident values result = object [ "id" .= ident, "name" .= values ! "name", "source" .= values ! "source", "target" .= values ! "target", "actionData" .= object [ - "mode" .= values ! "mode"]] : result + "mode" .= values ! "mode", + "actors" .= values ! "actors"]] : result instance ToJSON GraphData where toJSON (GData (nd, ed)) = object ["states" .= toJSON nd, "actions" .= toJSON ed] diff --git a/app/Workflow.hs b/app/Workflow.hs index d3465c3..268fe86 100644 --- a/app/Workflow.hs +++ b/app/Workflow.hs @@ -60,7 +60,7 @@ module Workflow where -- | Structure of the `viewers` object of any node. data StateViewers = StateViewers { name :: Either Label String, - viewers :: Maybe Value + viewers :: Maybe [Map String Value] } deriving (Show, Generic) instance FromJSON StateViewers where @@ -85,7 +85,7 @@ module Workflow where mode :: Maybe String, source :: Maybe String, name :: Maybe Label, - actors :: Maybe Value, + actors :: Maybe [Map String Value], viewActor :: Maybe Value, viewers :: Maybe Value, messages :: Maybe Value, @@ -103,12 +103,15 @@ module Workflow where o .:? "messages" <*> o .:? "form" parseJSON _ = error "unexpected action data format" + + + data Entry = Single String | Dict (Map String Value) | List [Entry] deriving(Show, Generic) -- | Data of all nodes prepared for JSON encoding. - newtype NodeData = NData (Map String (Map String String)) deriving (Show, Generic) + newtype NodeData = NData (Map String (Map String Entry)) deriving (Show, Generic) -- | Data of all edges prepared for JSON encoding. - newtype EdgeData = EData (Map String (Map String String)) deriving (Show, Generic) + newtype EdgeData = EData (Map String (Map String Entry)) deriving (Show, Generic) -- | Data of the entire workflow prepared for JSON encoding. newtype GraphData = GData (NodeData , EdgeData) deriving (Show, Generic) @@ -134,21 +137,25 @@ module Workflow where 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 + extract :: State -> Map String Entry + extract s = fromList [("name", Single name), ("viewers", List $ Prelude.map Dict viewers), ("final", Single final)] where (name, viewers) = case s.viewers of - Nothing -> ("", "") + Nothing -> ("", [empty :: Map String Value]) Just x -> case x.name of - Left y -> (fromMaybe "" y.fallback, show x.viewers) - Right y -> (y, show x.viewers) + Left y -> (fromMaybe "" y.fallback, fromMaybe [empty :: Map String Value] x.viewers) + Right y -> (y, fromMaybe [empty :: Map String Value] 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 + newData :: String -> Action -> String -> Map String Entry + newData ident a targetID = fromList [("name", Single name), + ("source", Single source), + ("target", Single targetID), + ("mode", Single mode), + ("actors", List $ Prelude.map Dict actors)] where name = if isNothing a.name then ident else case (fromJust a.name).fallback of @@ -156,5 +163,6 @@ module Workflow where Just x -> x source = fromMaybe initID a.source mode = fromMaybe "" a.mode + actors = fromMaybe [] a.actors --------------------------------------- \ No newline at end of file