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

parse actor & viewer data

Browse Source
This commit is contained in:
David Mosbach 2023-05-05 22:46:40 +02:00
parent 2611130ac7
commit 712c7d768c
2 changed files with 31 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
app/Export.hs
View File

@ -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]

30
app/Workflow.hs
View File

@ -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
---------------------------------------