parse actor & viewer data

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]

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 :: State -> Map String Entry
-    extract s = fromList [("name", name), ("viewers", viewers), ("final", final)] where
+    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)
+                                      Left y  -> (fromMaybe "" y.fallback, fromMaybe [empty :: Map String Value] x.viewers)
-                                      Right y -> (y, show 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 :: String -> Action -> String -> Map String Entry
-    newData ident a targetID = fromList [("name", name), ("source", source), ("target", targetID), ("mode", mode)] where
+    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
 
   ---------------------------------------