.gitignore

@@ -6,4 +6,5 @@
 CHANGELOG.md
 test.json
 server.py
-/workflows
+/workflows
+/spaß

app/Export.hs

@@ -10,9 +10,14 @@ module Export where
 
   import Data.Aeson
   import Data.Map hiding (fromList)
-  import Data.Vector hiding ((!))
-  import Workflow (NodeData(..), EdgeData(..), GraphData(..), Entry(..))
-  import Data.Text (pack)
+  import Data.Vector hiding ((!), (++))
+  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)
+  import Data.Maybe (fromMaybe)
+  import YamlParser (YAMLNode (..), AnchorData (..), MergeData (..))
+  import Data.Aeson.Types (toJSONKeyText)
   
   ---------------------------------------
 
@@ -21,18 +26,89 @@ module Export where
 
   instance ToJSON Entry 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 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]
+    toJSON (AnchorAlias a) = object ["type" .= String "alias", "name" .= a]
+    toJSON NoAnchor = Null
+
+  instance ToJSON MergeData where
+    toJSON (MergeData keys anchor) = object ["keys" .= keys, "anchor" .= anchor]
+
+  instance ToJSON Pos
+
+  instance ToJSON Message where
+    toJSON (Message content status viewers comment anchor merge) = object [
+                                              "content" .= content,
+                                              "status" .= status,
+                                              "viewers" .= viewers,
+                                              "comment" .= comment,
+                                              "anchor" .= anchor,
+                                              "merge" .= merge]
+
+  instance ToJSON Viewers where
+    toJSON (Viewers mappings comment anchor) = object [
+                                  "viewers" .= mappings,
+                                  "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,
+                                              "fallback-lang" .= fallbackLang,
+                                              "translations" .= translations,
+                                              "comment" .= comment,
+                                              "anchor" .= anchor,
+                                              "merge" .= merge]
+
   instance ToJSON NodeData where
     toJSON (NData d) = Array (fromList $ foldrWithKey newObject [] d) where
-      newObject :: String -> Map String Entry -> [Value] -> [Value]
+      newObject :: Text -> Map Text Entry -> [Value] -> [Value]
       newObject ident values result = object [
                                         "id" .= ident,
                                         "name" .= values ! "name",
                                         "val" .= show 5, -- Todo adjust to number of edges
                                         "stateData" .= object [
+                                                          "comment" .= values ! "comment",
+                                                          "anchor" .= values ! "anchor",
                                                           "viewers" .= values ! "viewers",
                                                           "final" .= values ! "final",
                                                           "messages" .= values ! "messages",
@@ -41,13 +117,15 @@ module Export where
 
   instance ToJSON EdgeData where
     toJSON (EData d) = Array (fromList $ foldrWithKey newObject [] d) where
-      newObject :: String -> Map String Entry -> [Value] -> [Value]
+      newObject :: Text -> Map Text Entry -> [Value] -> [Value]
       newObject ident values result = object [
                                         "id" .= ident,
                                         "name" .= values ! "name",
                                         "source" .= values ! "source",
                                         "target" .= values ! "target",
                                         "actionData" .= object [
+                                                          "comment" .= values ! "comment",
+                                                          "anchor" .= values ! "anchor",
                                                           "mode" .= values ! "mode",
                                                           "actors" .= values ! "actors",
                                                           "viewers" .= values ! "viewers",

app/Index.hs

@@ -10,47 +10,48 @@
 
 module Index where
 
-  import Data.Yaml
   import Control.Applicative hiding (empty)
   import GHC.Generics (Generic)
   import Data.Map
   import Data.Maybe (fromMaybe, fromJust)
+  import Data.Text (Text)
+  import YamlParser
   
-  type Index = Map String Entry
+  type Index = Map Text Entry
 
   data Entry = Entry {
-    graphFile       :: String,
-    category        :: Maybe String,
-    defScope        :: Maybe String,
+    graphFile       :: Text,
+    category        :: Maybe Text,
+    defScope        :: Maybe Text,
     defDescription  :: Maybe Description,
     instDescription :: Maybe Description,
-    instances       :: Value
-  } deriving (Show, Generic)
+    instances       :: YAMLNode
+  } deriving Show
 
-  instance FromJSON Entry where
-    parseJSON (Object o) = Entry <$>
-                           o .:  "graph-file" <*>
-                           o .:? "category" <*>
-                           o .:? "definition-scope" <*>
-                           o .:? "definition-description" <*>
-                           o .:? "instance-description" <*>
-                           o .:  "instances"
-    parseJSON _ = error "Unexpected yaml"
+  instance FromYAML' Entry where
+    fromYAML (Mapping mapping _ _ _ _) = Entry
+                                         <$> mapping <|  "graph-file"
+                                         <*> mapping <|? "category"
+                                         <*> mapping <|? "definition-scope"
+                                         <*> mapping <|? "definition-description"
+                                         <*> mapping <|? "instance-description"
+                                         <*> mapping <|  "instances"
+    -- parseJSON _ = error "Unexpected yaml"
 
-  type Title = String
-  type Content = String
+  type Title = Text
+  type Content = Text
 
   data Description = Description {
-    fallbackLang :: Maybe String,
+    fallbackLang :: Maybe Text,
     fallback     :: (Maybe Title, Maybe Content),
-    translations :: Map String (Maybe Title, Maybe Content)
-  } deriving (Show, Generic)
+    translations :: Map Text (Maybe Title, Maybe Content)
+  } deriving Show
 
-  instance FromJSON Description where
-    parseJSON (Object o) = Description <$>
-                           o .:? "fallback-lang" <*>
-                           o .:  "fallback" <*>
-                           o .:  "translations"
+  instance FromYAML' Description where
+    fromYAML (Mapping mapping _ _ _ _) = Description
+                                         <$> mapping <|? "fallback-lang"
+                                         <*> mapping <|  "fallback"
+                                         <*> mapping <|  "translations"
 
   english = "en-eu";
 
@@ -63,8 +64,8 @@ module Index where
                                  def = description.fallback
                              in  findWithDefault def english description.translations
 
-  getEntryByFile :: String -> Index -> Entry
+  getEntryByFile :: Text -> Index -> Entry
   getEntryByFile file index = query (elems index) file where
-    query :: [Entry] -> String -> Entry
-    query [] _ = error $ "No entries left for " ++ file
+    query :: [Entry] -> Text -> Entry
+    query [] _ = error $ "No entries left for " ++ show file
     query (x:xs) file = if x.graphFile == file then x else query xs file

app/Main.hs

@@ -6,14 +6,16 @@ module Main where
 
   ----------------Imports----------------
 
+  import Prelude hiding (lookup)
   import System.Environment (getArgs)
   import System.Directory
-  import Data.Yaml (ParseException, decodeEither', Value (String, Null))
   import Data.Aeson (encode, encodeFile)
 
   import qualified Data.ByteString.Char8 as BS
+  import qualified Data.ByteString.Lazy as BS.L
   import Workflow (Workflow, buildData)
   import Export
+  import YamlParser (parse, ParseState (..), decodeWithComments1, decodeWithComments1Strict, YAMLNode)
   import Data.Maybe (fromJust, isNothing, isJust, fromMaybe)
   import Data.Either (isLeft, fromLeft, fromRight)
   import Data.List (dropWhileEnd)
@@ -21,6 +23,16 @@ module Main where
   import Text.Regex.TDFA ((=~))
   import Index (Index, Entry (Entry), getDefDescription, getInstDescription, getEntryByFile)
   import Data.Char (isSpace)
+
+  import Data.Text (pack, unpack, Text)
+  import Data.YAML (decode1Strict, Node, Pos, Parser, parseEither)
+  import Data.YAML.Event hiding (Scalar)
+  import Control.Monad (forM_)
+  import Control.Monad.State.Lazy
+  import Data.Map.Lazy (Map, insert, lookup, empty)
+  import Data.Text.Encoding (encodeUtf8, decodeUtf8)
+  import Data.Text.Lazy (toStrict)
+  import Debug.Trace (trace)
   
   ---------------------------------------
 
@@ -33,11 +45,36 @@ module Main where
   main :: IO ()
   main = getArgs >>= process >>= finish where
     process :: [String] -> IO Bool
+    process [path] = printEvents path >> runParser path >> return True
     process args@[_, _] = generateJSON args >> return False
     process args@["--all", src, to] = processDirectory src to >> return False
     process _ = print "Please provide (1) a source and (2) a target file or provide '--all' and (1) a source and (2) a target directory" >> return True
     finish :: Bool -> IO ()
     finish abort = if abort then return () else print "Done."
+
+
+  printEvents :: FilePath -> IO ()
+  printEvents path = do
+    input <- BS.L.readFile path
+    forM_ (parseEvents input) $ \ev -> case ev of
+      Left _ -> error "Failed to parse"
+      Right event -> putStrLn (show (eEvent event) ++ " @" ++ show (posLine $ ePos event))
+
+
+  runParser :: FilePath -> IO ()
+  runParser path = do
+    input <- BS.L.readFile path
+    -- let events = parseEvents input
+    -- let mainEvents = validHead events
+    -- unless (isJust mainEvents) . error $ "Missing DocumentStart event"
+    -- let initState = PState [] empty []
+    -- let (rootNode, state) = runState (parse $ fromJust mainEvents) initState
+    let decoded = decodeWithComments1 input :: Either (Pos, String) YAMLNode -- Workflow
+    print decoded
+    -- print rootNode where
+    --   validHead :: EvStream -> Maybe EvStream
+    --   validHead ((Right (EvPos StreamStart _)):(Right (EvPos (DocumentStart _) _)):es) = Just es
+    --   validHead _ = Nothing
          
 
 
@@ -47,9 +84,10 @@ module Main where
   generateJSON args = do
     -- print $ head args
     -- print $ last args
+    putStrLn $ "reading " ++ head args ++ "..."
     content <- BS.readFile (head args)
-    let decoded = decodeEither' content :: Either ParseException Workflow
-    if isLeft decoded then throw (fromLeft undefined decoded) else do
+    let decoded = decodeWithComments1Strict content :: Either (Pos, String) Workflow
+    if isLeft decoded then error (show $ fromLeft undefined decoded) else do
       let yaml = fromRight undefined decoded
       -- let GData (nodeData, edgeData) = buildData yaml
       -- putStrLn $ "\nNode Data:\n\n" ++ show nodeData
@@ -85,25 +123,25 @@ module Main where
                      in  (match, relative, absolute)
     writeIndex :: Index -> [(String, FilePath)] -> String -> IO () -- content of _index.yaml -> targets -> content for index.json
     writeIndex index [] content = print index >> writeFile (to ++ "/index.json") ('[':content)
-    writeIndex index (x:xs) content = let entry = findEntry (fst x) index
+    writeIndex index (x:xs) content = let entry = findEntry (pack $ fst x) index
                                           (name1, description1) = getDefDescription entry
                                           (name2, description2) = getInstDescription entry
                                           name = if isJust name1 then name1 else name2
                                           description = if isJust description1 then description1 else description2
                                           url = snd x
                                           format = dropWhileEnd isSpace . map (\y -> if y == '\n' then ' ' else y)
-                                          newContent = (if null xs then "" else ",\n") ++ "{\n\"name\": \"" ++ format (fromMaybe (snd x) name)
+                                          newContent = (if null xs then "" else ",\n") ++ "{\n\"name\": \"" ++ format (unpack $ fromMaybe (pack $ snd x) name)
                                                         ++ "\",\n\"description\": \""
-                                                        ++ format (fromMaybe "" description) ++ "\",\n\"url\": \"" ++ url ++ "\"}"
+                                                        ++ format (unpack $ fromMaybe (pack "") description) ++ "\",\n\"url\": \"" ++ url ++ "\"}"
                                       in  writeIndex index xs (newContent ++ content)
     decodeIndex :: FilePath -> IO Index
     decodeIndex path = do
       content <- BS.readFile path
-      let decoded = decodeEither' content :: Either ParseException Index
+      let decoded = decodeWithComments1Strict content :: Either (Pos, String) Index
       if isLeft decoded
-      then throw (fromLeft undefined decoded)
+      then error $ show (fromLeft undefined decoded)
       else return $ fromRight undefined decoded
-    findEntry :: String -> Index -> Entry
+    findEntry :: Text -> Index -> Entry
     findEntry file index = getEntryByFile file index
 
 

app/Workflow.hs

@@ -12,13 +12,20 @@ module Workflow where
 
   ----------------Imports----------------
 
-  import Data.Yaml
+  import Data.YAML hiding (Scalar, Mapping, Sequence, encode)
+  import Data.Aeson(encode, ToJSON (toJSON), ToJSONKey (toJSONKey))
   import Control.Applicative hiding (empty)
   import GHC.Generics (Generic)
   import Data.Map
   import Data.Maybe (fromMaybe, isNothing, fromJust)
-  import Data.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.Aeson.Types (toJSONKeyText)
+  
   ---------------------------------------
 
 
@@ -26,96 +33,200 @@ module Workflow where
   
   -- | Outer structure of a workflow, i.e. nodes and stages.
   data Workflow = Workflow {
-    nodes  :: Map String State,
-    stages :: Maybe Value
-  } deriving (Show, Generic)
+    nodes  :: Map Text State,
+    stages :: Maybe YAMLNode,
+    anchor :: AnchorData,
+    merge  :: [MergeData]
+  } deriving Show
 
-  instance FromJSON Workflow
+  instance FromYAML' Workflow where
+    fromYAML (Mapping mapping _ anchor merge pos) = Workflow
+                                                <$> mapping <|  "nodes"
+                                                <*> mapping <|? "stages"
+                                                <*> pure anchor
+                                                <*> pure merge
 
 
   -- | Structure of a node.
   data State = State {
     viewers  :: Maybe StateViewers,
-    payload  :: Maybe (Map String Value),
+    payload  :: Maybe (Map Text YAMLNode),
     final    :: Maybe Final,
-    edges    :: Maybe (Map String Action),
-    messages :: Maybe [Value]
-  } deriving (Show, Generic)
+    edges    :: Maybe (Map Text Action),
+    messages :: Maybe [Message],
+    comment :: [Comment],
+    anchor :: AnchorData,
+    merge  :: [MergeData]
+  } deriving Show
 
-  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"
+  instance FromYAML' State where
+    fromYAML (Mapping mapping comment anchor merge _) = State
+                                                        <$> mapping <|? "viewers"
+                                                        <*> mapping <|? "payload-view"
+                                                        <*> mapping <|? "final"
+                                                        <*> mapping <|? "edges"
+                                                        <*> mapping <|? "messages"
+                                                        <*> pure comment
+                                                        <*> pure anchor
+                                                        <*> pure merge
 
   
   -- | Wrapper for the `final` value of any node.
-  newtype Final =  Final {final :: String} deriving (Show, Generic)
+  data Final =  Final {
+    final :: Text,
+    comment :: [Comment],
+    anchor :: AnchorData
+    } deriving Show
 
-  instance FromJSON Final where
-    parseJSON v = case v of
-                    String _ -> Final <$> parseJSON v
-                    Bool x   -> Final <$> parseJSON (String . pack . show $ x)
+  instance FromYAML' Final where
+    fromYAML (Scalar bytes comment anchor _) = Final
+                                               <$> pure (decodeUtf8 bytes)
+                                               <*> pure comment
+                                               <*> pure anchor
+      
+      -- case scalar of
+      --               SStr x  -> pure . Final $ show x
+      --               SBool x -> pure . Final $ show x
 
 
   -- | Structure of the `viewers` object of any node.
   data StateViewers = StateViewers {
-    name    :: Either Label String,
-    viewers :: Maybe [Map String Value]
-  } deriving (Show, Generic)
+    name    :: Either Label Text,
+    viewers :: Maybe Viewers,
+    comment :: [Comment],
+    anchor  :: AnchorData,
+    merge  :: [MergeData]
+  } deriving Show
 
-  instance FromJSON StateViewers where
-    parseJSON (Object o) = StateViewers <$>
-                           ((Left <$> o .:  "display-label") <|> (Right <$> o .:  "display-label")) <*>
-                           o .:? "viewers"
-    parseJSON _ = error "unexpected stateViewers data format"
+  instance FromYAML' StateViewers where
+    fromYAML (Mapping mapping comment anchor merge _) = StateViewers
+                                                        <$> ((Left <$> mapping <| "display-label") <|> (Right <$> mapping <| "display-label"))
+                                                        <*> mapping <|? "viewers"
+                                                        <*> pure comment
+                                                        <*> pure anchor
+                                                        <*> pure merge
+
+        
+  data Viewers = Viewers {
+    viewers :: [Map Text YAMLNode],
+    comment :: [Comment],
+    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)
+
+  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
 
 
   
   -- | Structure of the @display-label@ object of any node or edge.
   data Label = Label {
-    fallback :: Maybe String,
-    translations :: Maybe Value
-  } deriving (Show, Generic)
+    fallback :: Maybe Text,
+    fallbackLang :: Maybe Text,
+    translations :: Maybe YAMLNode,
+    comment :: [Comment],
+    anchor :: AnchorData,
+    merge  :: [MergeData]
+  } deriving Show
 
-  instance FromJSON Label
+  instance FromYAML' Label where
+    fromYAML (Mapping mapping comment anchor merge _) = Label
+                                                        <$> mapping <|? "fallback"
+                                                        <*> mapping <|? "fallback-lang"
+                                                        <*> mapping <|? "translations"
+                                                        <*> pure comment
+                                                        <*> pure anchor
+                                                        <*> pure merge
+    fromYAML (Scalar bytes comment anchor _) = Label
+                                               <$> pure (Just . decodeUtf8 $ bytes)
+                                               <*> pure (Just . pack $ "de-de-formal")
+                                               <*> pure Nothing
+                                               <*> pure comment
+                                               <*> pure anchor
+                                               <*> pure []
 
 
   -- | Structure of an edge.
   data Action = Action {
-    mode      :: Maybe String,
-    source    :: Maybe String,
+    mode      :: Maybe Text,
+    source    :: Maybe Text,
     name      :: Maybe Label,
-    actors    :: Maybe [Map String Value],
-    viewActor :: Maybe [Map String Value],
-    viewers   :: Maybe [Map String Value],
-    messages  :: Maybe [Value],
-    form      :: Maybe Value
-  } deriving (Show, Generic)
+    actors    :: Maybe Actors,
+    viewActor :: Maybe Viewers,
+    viewers   :: Maybe Viewers,
+    messages  :: Maybe [Message],
+    form      :: Maybe YAMLNode,
+    comment   :: [Comment],
+    anchor    :: AnchorData,
+    merge     :: [MergeData]
+  } deriving Show
 
-  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"
+  instance FromYAML' Action where
+    fromYAML (Mapping mapping comment anchor merge _) = Action
+                                                        <$> mapping <|? "mode"
+                                                        <*> mapping <|? "source"
+                                                        <*> mapping <|? "display-label"
+                                                        <*> mapping <|? "actors"
+                                                        <*> mapping <|? "view-actor"
+                                                        <*> mapping <|? "viewers"
+                                                        <*> mapping <|? "messages"
+                                                        <*> mapping <|? "form"
+                                                        <*> pure comment
+                                                        <*> pure anchor
+                                                        <*> pure merge
+
+  data Message = Message {
+    content :: Label,
+    status  :: Maybe Text,
+    viewers :: Maybe Viewers,
+    comment :: [Comment],
+    anchor  :: AnchorData,
+    merge   :: [MergeData]
+  } deriving Show
+
+  instance FromYAML' Message where
+    fromYAML (Mapping mapping comment anchor merge _) = Message
+                                                        <$> mapping <|  "content"
+                                                        <*> mapping <|? "status"
+                                                        <*> mapping <|? "viewers"
+                                                        <*> pure comment
+                                                        <*> pure anchor
+                                                        <*> pure merge
 
 
-  data Entry = Single String | Dict (Map String Value) | List [Entry] | Val Value deriving(Show, Generic)
+  data Entry = Single Text
+             | Msg Message
+             | Vie Viewers
+             | Act Actors
+             | Dict (Map Text YAMLNode)
+             | List [Entry]
+             | Val YAMLNode deriving Show
   
   
   -- | Data of all nodes prepared for JSON encoding.
-  newtype NodeData  = NData (Map String (Map String Entry)) deriving (Show, Generic)
+  newtype NodeData  = NData (Map Text (Map Text Entry)) deriving (Show, Generic)
   -- | Data of all edges prepared for JSON encoding.
-  newtype EdgeData  = EData (Map String (Map String Entry)) deriving (Show, Generic)
+  newtype EdgeData  = EData (Map Text (Map Text Entry)) deriving (Show, Generic)
   -- | Data of the entire workflow prepared for JSON encoding.
   newtype GraphData = GData (NodeData , EdgeData) deriving (Show, Generic)
 
@@ -134,53 +245,60 @@ module Workflow where
 
   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,
+    nodes = insert initID (State {final = Just $ Final "False" [] NoAnchor,
+                                  viewers = Just $ StateViewers (Left (Label (Just initID) Nothing Nothing [] NoAnchor [])) Nothing [] NoAnchor [],
                                   payload = Nothing,
                                   edges = Nothing,
-                                  messages = Nothing}) wf.nodes
-    analyse :: String -> State -> (NodeData , EdgeData) -> (NodeData , EdgeData)
+                                  messages = Nothing,
+                                  comment = [],
+                                  anchor = NoAnchor,
+                                  merge = []}) wf.nodes
+    analyse :: Text -> 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 Entry
+    extract :: State -> Map Text Entry
     extract s = fromList [("name",     Single name),
-                          ("viewers",  List $ Prelude.map Dict viewers),
+                          ("comment",  List $ Prelude.map Single s.comment),
+                          ("anchor",   Single . pack . show $ s.anchor),
+                          ("viewers",  Vie viewers),
                           ("final",    Single final),
-                          ("messages", List $ Prelude.map Val messages),
+                          ("messages", List $ Prelude.map Msg messages),
                           ("payload",  payload)] where
       (name, viewers) = case s.viewers of
-                          Nothing -> ("", [empty :: Map String Value])
+                          Nothing -> ("", Viewers [] [] NoAnchor)
                           Just x -> case x.name of
-                                      Left y  -> (fromMaybe "" y.fallback, fromMaybe [empty :: Map String Value] x.viewers)
-                                      Right y -> (y, fromMaybe [empty :: Map String Value] x.viewers)
+                                      Left y  -> (fromMaybe "" y.fallback, fromMaybe (Viewers [] [] NoAnchor) x.viewers)
+                                      Right y -> (y, fromMaybe (Viewers [] [] NoAnchor) x.viewers)
       final = case s.final of
                 Nothing -> ""
                 Just x  -> x.final
       messages = fromMaybe [] s.messages
-      payload = maybe (Val Null) Dict  s.payload
-    updateEdges :: String -> Maybe (Map String Action) -> EdgeData -> EdgeData
+      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 (k ++ "_@_" ++ targetID) (newData k action targetID) eData) e edges
-    newData :: String -> Action -> String -> Map String Entry
+    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),
+                                         ("anchor",     Single . pack . show $ a.anchor),
                                          ("source",     Single source),
                                          ("target",     Single targetID),
                                          ("mode",       Single mode),
-                                         ("actors",     List $ Prelude.map Dict actors),
-                                         ("viewers",    List $ Prelude.map Dict viewers),
-                                         ("view-actor", List $ Prelude.map Dict viewActor),
-                                         ("messages",   List $ Prelude.map Val messages),
+                                         ("actors",     Act actors),
+                                         ("viewers",    Vie viewers),
+                                         ("view-actor", Vie viewActor),
+                                         ("messages",   List $ Prelude.map Msg messages),
                                          ("form",       Val form)] where
       name = if isNothing a.name
              then ident
              else case (fromJust a.name).fallback of
-                  Nothing -> show a.name
+                  Nothing -> pack $ show a.name
                   Just x  -> x
       source = fromMaybe initID a.source
       mode = fromMaybe "" a.mode
-      actors = fromMaybe [] a.actors
-      viewers = fromMaybe [] a.viewers
-      viewActor = fromMaybe [] a.viewActor
+      actors = fromMaybe (Actors $ Viewers [] [] NoAnchor) a.actors
+      viewers = fromMaybe (Viewers [] [] NoAnchor) a.viewers
+      viewActor = fromMaybe (Viewers [] [] NoAnchor) a.viewActor
       messages = fromMaybe [] a.messages
-      form = fromMaybe Null a.form
+      form = fromMaybe (Scalar (encodeUtf8 "null") [] NoAnchor (Pos 0 0 0 0)) a.form
 
   ---------------------------------------

app/YamlParser.hs

@@ -0,0 +1,231 @@
+{-# Language DuplicateRecordFields,
+    NoFieldSelectors,
+    OverloadedRecordDot  #-}
+
+module YamlParser where
+  import Prelude hiding (lookup)
+  import qualified Prelude as P
+  import Control.Monad.State.Lazy
+  import Data.Map.Lazy (Map, insert, lookup, empty, fromList, toList, (!))
+  import Data.Text.Encoding (encodeUtf8, decodeUtf8)
+  import Data.Text.Lazy (toStrict)
+  import Debug.Trace (trace)
+  import Data.Maybe (fromJust, isNothing, isJust, fromMaybe)
+  import Data.Text (pack, unpack, Text)
+  import Data.YAML (decode1Strict, Node, Pos, Parser, parseEither)
+  import Data.YAML.Event hiding (Scalar)
+  import qualified Data.YAML.Event as Y
+  import qualified Data.ByteString.Char8 as BS
+  import qualified Data.ByteString.Lazy as BS.L
+
+  activateTrace = False
+  
+  showTrace :: EvPos -> a -> a
+  showTrace event action = if activateTrace
+                           then trace (show (eEvent event) ++ " @" ++ show (posLine $ ePos event)) action
+                           else action
+
+  data ParseState = PState {
+    rootNodes :: [YAMLNode],
+    anchors :: Map Text YAMLNode,
+    comments :: [Comment] -- YAML comment queue for the next node.
+  }
+
+  data AnchorData = NoAnchor | AnchorDef Text | AnchorAlias Text deriving (Show, Eq, Ord)
+  data MergeData = MergeData {keys :: [Text], anchor :: AnchorData} deriving (Show, Eq, Ord)
+
+
+  data YAMLNode =
+    Scalar {
+      bytes :: BS.ByteString,
+      {-tag :: Tag,-}
+      {-style :: Style,-}
+      comment :: [Comment], -- TODO every node preceded by a scalar preceded by a comment stores said comment  
+      anchorData :: AnchorData,
+      pos :: Pos
+    } | Mapping {
+      content :: [(YAMLNode, YAMLNode)],
+      comment :: [Comment],
+      anchorData :: AnchorData,
+      mergeData :: [MergeData], -- keys of the maps merged into this mapping by "<<"
+      pos :: Pos
+    } | Sequence {
+      children :: [YAMLNode],
+      comment :: [Comment],
+      anchorData :: AnchorData,
+      pos :: Pos
+    } deriving (Show, Eq)
+
+  instance Ord YAMLNode where
+    (Scalar b1 _ _ _) <= (Scalar b2 _ _ _) = b1 <= b2
+    _ <= _ = undefined
+
+
+  type Comment = Text
+
+  parse :: EvStream -> State ParseState YAMLNode
+  parse ((Right (EvPos (DocumentEnd _) pos)):_) = get >>= \pState -> return $ if  length pState.rootNodes == 1
+                                                                            then head pState.rootNodes
+                                                                            else Sequence pState.rootNodes [] NoAnchor pos
+  parse [] = get >>= \pState -> return $ if  length pState.rootNodes == 1
+                                         then head pState.rootNodes
+                                         else Sequence pState.rootNodes [] NoAnchor undefined
+  parse ((Right (EvPos StreamStart _)):es) = parseComment es >>= parse
+  parse ((Right (EvPos (DocumentStart _) _)):es) = parse es
+  parse es = do
+    (root, es') <- parseNode es
+    pState <- get
+    when (isJust root) . put $ pState {rootNodes = fromJust root : pState.rootNodes}
+    parse es'
+
+  parseComment :: EvStream -> State ParseState EvStream
+  parseComment ((Right (EvPos (Y.Comment comment) _)):es) = do
+    pState <- get
+    put $ pState {comments = comment : pState.comments}
+    parseComment es
+  parseComment es = return es
+
+
+  parseNode :: EvStream -> State ParseState (Maybe YAMLNode, EvStream)
+  parseNode [] = trace "Unexpected eof" $ return (Nothing, [])
+  parseNode ((Left (p,s)):es) = trace ("Failed to parse: " ++ show s ++ " @ line " ++ show p.posLine) $ parseNode es
+  parseNode es@((Right (EvPos event pos)):es') = do
+    pState <- get
+    showTrace (EvPos event pos) $ case event of
+      Y.Comment _ -> parseComment es >>= parseNode
+      Y.SequenceStart anchor _ _ -> parseSequence es' anchor [] >>= \(seq, es'') -> return (Just seq, es'')
+      Y.MappingStart anchor _ _ -> parseMapping es' anchor [] [] >>= \(map, es'') -> return (Just map, es'')
+      Y.Scalar anchor _ _ text -> parseScalar anchor text pos >>= \scal -> return (Just scal, es')
+      Y.Alias anchor -> parseAlias anchor >>= \a -> return (Just a, es')
+      _ -> return (Nothing, es) -- error $ "Unexpected event: " ++ show event ++ " @" ++ show (posLine pos)
+
+
+  parseSequence :: EvStream -> Maybe Anchor -> [YAMLNode] -> State ParseState (YAMLNode, EvStream)
+  parseSequence ((Right (EvPos SequenceEnd pos)):es) anchor children = showTrace (EvPos SequenceEnd pos) $ do
+    pState <- get
+    let anchorData = maybe NoAnchor AnchorDef anchor
+    let seq = Sequence (reverse children) [] anchorData pos
+    let anchors = if isNothing anchor then pState.anchors else insert (fromJust anchor) seq pState.anchors
+    put $ pState {anchors = anchors}
+    return (seq, es)
+  parseSequence es anchor children = do
+    (child, es') <- parseNode es
+    case child of
+      Nothing -> parseSequence es' anchor children
+      Just c  -> parseSequence es' anchor (c : children)
+
+
+  parseMapping :: EvStream -> Maybe Anchor -> [(YAMLNode, YAMLNode)] -> [MergeData] -> State ParseState (YAMLNode, EvStream)
+  parseMapping ((Right (EvPos MappingEnd pos)):es) anchor content mergeData = showTrace (EvPos MappingEnd pos) $ do
+    pState <- get
+    let anchorData = maybe NoAnchor AnchorDef anchor
+    let map = Mapping (reverse content) [] anchorData mergeData pos
+    let anchors = if isNothing anchor then pState.anchors else insert (fromJust anchor) map pState.anchors
+    put $ pState {anchors = anchors}
+    return (map, es)
+  parseMapping es anchor content mergeData = do
+    (maybeKey, es') <- parseNode es
+    case maybeKey of
+      Nothing -> parseMapping es' anchor content mergeData
+      Just key -> do
+        unless (isScalar key) . error $ "Key not a scalar: " ++ show key
+        (maybeVal, es'') <- parseNode es'
+        let val = fromJust maybeVal
+        if isMerge key then do
+          let (content', mergeKeys) = mergeMappings [] content val
+          let mergeData' = (MergeData mergeKeys key.anchorData) : mergeData
+          parseMapping es'' anchor content' mergeData'
+        else do
+          let content' = (key {comment = []}, val {comment = key.comment}) : content -- migrate comment to val to preserve it for the workflow data structure. alternative. don't use Data.Map for e.g. nodes and stages but a custom type and transfer it later.
+          parseMapping es'' anchor content' mergeData where
+          isScalar :: YAMLNode -> Bool
+          isScalar (Scalar {}) = True
+          isScalar _ = False
+          isMapping :: YAMLNode -> Bool
+          isMapping (Mapping {}) = True
+          isMapping _ = False
+          isSequence :: YAMLNode -> Bool
+          isSequence (Sequence {}) = True
+          isSequence _ = False
+          isMerge :: YAMLNode -> Bool
+          isMerge (Scalar b _ _ _) = unpack (decodeUtf8 b) == "<<"
+          mergeMappings :: [Text] -> [(YAMLNode, YAMLNode)] -> YAMLNode -> ([(YAMLNode, YAMLNode)], [Text])
+          mergeMappings mergeKeys content (Mapping [] _ _ _ _) = (content, mergeKeys)
+          mergeMappings mergeKeys content m@(Mapping (x@(key, _):xs) _ _ _ _)
+            | isJust $ P.lookup key content = mergeMappings mergeKeys content m {content = xs}
+            | otherwise = mergeMappings ((decodeUtf8 key.bytes) : mergeKeys) (x : content) m {content = xs}
+          mergeMappings mergeKeys content (Sequence [] _ _ _) = (content, mergeKeys)
+          mergeMappings mergeKeys content s@(Sequence (m@(Mapping {}):xs) _ _ _) = mergeMappings mergeKeys' content' s {children = xs} where
+            (content', mergeKeys') = mergeMappings mergeKeys content m
+
+
+  parseScalar :: Maybe Anchor -> Text -> Pos -> State ParseState YAMLNode
+  parseScalar anchor text pos = do
+    pState <- get
+    let comments = pState.comments
+    let anchorData = maybe NoAnchor AnchorDef anchor
+    let scal = Scalar (encodeUtf8 text) comments anchorData pos
+    let anchors = if isNothing anchor then pState.anchors else insert (fromJust anchor) scal pState.anchors
+    put $ pState {anchors = anchors, comments = []}
+    return scal
+
+  
+  parseAlias :: Anchor -> State ParseState YAMLNode
+  parseAlias anchor = do
+    pState <- get
+    case lookup anchor pState.anchors of
+      Nothing -> error $ "Anchor '" ++ show anchor ++ "' not defined"
+      Just node -> return node {anchorData = AnchorAlias anchor}
+
+
+  class FromYAML' a where
+    fromYAML :: YAMLNode -> Parser a
+
+  instance FromYAML' a => FromYAML' (Maybe a) where
+    fromYAML y@(Scalar bs _ _ _)
+      | decodeUtf8 bs == pack "null" = pure Nothing
+      | otherwise = Just <$> fromYAML y
+    fromYAML y = Just <$> fromYAML y
+
+  instance (Ord k, FromYAML' k, FromYAML' v) => FromYAML' (Map k v) where
+    fromYAML (Mapping c _ _ _ _) = fromList <$> mapM (\(a,b) -> (,) <$> fromYAML a <*> fromYAML b) c
+
+  instance FromYAML' Text where
+    fromYAML (Scalar bs _ _ _) = pure $ decodeUtf8 bs
+
+  instance FromYAML' YAMLNode where
+    fromYAML = pure
+
+  instance FromYAML' v => FromYAML' [v] where
+    fromYAML (Sequence c _ _ _) = mapM fromYAML c
+
+  instance (FromYAML' a, FromYAML' b) => FromYAML' (a,b) where
+    fromYAML (Sequence [n1, n2] _ _ _) = (,) <$> fromYAML n1
+                                           <*> fromYAML n2
+
+  decodeWithComments1 :: FromYAML' v => BS.L.ByteString -> Either (Pos, String) v
+  decodeWithComments1 input = do
+    let events = parseEvents input
+    -- let mainEvents = validHead events
+    -- unless (isJust mainEvents) . error $ "Missing DocumentStart event"
+    let initState = PState [] empty []
+    let content = evalState (parse events) initState
+    parseEither . fromYAML $ content
+    where
+      validHead :: EvStream -> Maybe EvStream
+      validHead ((Right (EvPos StreamStart _)):(Right (EvPos (DocumentStart _) _)):es) = Just es
+      validHead _ = Nothing
+
+  decodeWithComments1Strict :: FromYAML' v => BS.ByteString -> Either (Pos, String) v
+  decodeWithComments1Strict = decodeWithComments1 . BS.L.fromChunks . (:[])
+
+  
+  (<|) :: FromYAML' a => [(YAMLNode, YAMLNode)] -> Text -> Parser a
+  mapping <| key = maybe (fail $ "key " ++ show key ++ " not found") fromYAML (P.lookup key $ prep mapping) where
+    prep :: [(YAMLNode, YAMLNode)] -> [(Text, YAMLNode)]
+    prep mapping = [(decodeUtf8 scalar.bytes, val) | (scalar, val) <- mapping]
+
+  (<|?) :: FromYAML' a => [(YAMLNode, YAMLNode)] -> Text -> Parser (Maybe a)
+  mapping <|? key = maybe (pure Nothing) fromYAML (P.lookup key $ prep mapping) where
+    prep :: [(YAMLNode, YAMLNode)] -> [(Text, YAMLNode)]
+    prep mapping = [(decodeUtf8 scalar.bytes, val) | (scalar, val) <- mapping]

editor.js

@@ -567,9 +567,11 @@ function generatePanelContent(selection) {
         viewerList.appendChild(v);
       });
       children.push(viewerList);
+    } else if (content instanceof Roles) {
+      content.format().forEach(child => children.push(child));
     } else {
       var p = document.createElement('p');
-      var text = document.createTextNode(JSON.stringify(data[key]));
+      var text = document.createTextNode((key == 'comment') ? data[key].join(' ') : JSON.stringify(data[key]));
       p.appendChild(text);
       children.push(p);
     }
@@ -685,9 +687,7 @@ function prepareWorkflow() {
     var messages = [];
     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 = new Viewers(state.stateData.viewers);
     state.stateData.payload = new Payload(state.stateData.payload);
     nodeIndex.add(state.id, state.name);
   })
@@ -696,20 +696,14 @@ function prepareWorkflow() {
     var messages = [];
     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;
-    var actors = [];
-    action.actionData.actors.forEach(v => actors.push(new Role(v)));
-    action.actionData.actors = actors;
-    var viewActors = [];
-    action.actionData['actor Viewers'].forEach(v => viewActors.push(new Role(v)));
-    action.actionData['actor Viewers'] = viewActors;
+    action.actionData.viewers = new Viewers(action.actionData.viewers);
+    action.actionData.actors = new Actors(action.actionData.actors);
+    action.actionData['actor Viewers'] = new Viewers(action.actionData['actor Viewers']);
     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);
@@ -729,10 +723,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);
@@ -751,7 +745,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);
@@ -871,8 +865,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;

workflow-visualiser.cabal

@@ -27,18 +27,20 @@ executable workflow-visualiser
     -- Modules included in this executable, other than Main.
     other-modules: Workflow,
                    Export,
-                   Index
+                   Index,
+                   YamlParser
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
     build-depends:    base ^>=4.16.3.0,
-                      yaml >= 0.11.11.0,
+                      HsYAML,
                       aeson >= 2.1.2.0,
                       bytestring,
                       containers,
                       text,
                       vector,
                       directory,
-                      regex-tdfa
+                      regex-tdfa,
+                      mtl
     hs-source-dirs:   app
     default-language: Haskell2010

workflow.js

@@ -24,6 +24,66 @@ class Role {
   }
 }
 
+class Roles {
+  constructor(json, roleName) {
+    this.roleName = roleName
+    this.anchor = json.anchor && new Anchor(json.anchor)
+    this[roleName] = [];
+    for (const role of json[roleName])
+      this[roleName].push(new Role(role));
+    this.comment = json.comment;
+  }
+
+  format() {
+    var r = document.createElement('h4');
+    var roles = document.createTextNode('Roles');
+    r.appendChild(roles);
+    var rolesList = document.createElement('ul');
+    this[this.roleName].forEach(r => {
+      var role = document.createElement('li');
+      role.appendChild(document.createTextNode(r.name));
+      rolesList.appendChild(role);
+    });
+    var result = [];
+    if (this.comment.length > 0) {
+      var c = document.createElement('h4');
+      c.innerText = 'Comment';
+      var comment = document.createElement('p');
+      comment.innerText = this.comment.join(' ');
+      result.push(c, comment);
+    }
+    if (this.anchor) {
+      var a = document.createElement('h4');
+      a.appendChild(this.anchor.format());
+      result.push(a);
+    } else result.push(r)
+    result.push(rolesList);
+    return result;
+  }
+}
+
+class Viewers extends Roles {
+  constructor(json) {
+    super(json, 'viewers');
+  }
+}
+
+class Actors extends Roles {
+  constructor(json) {
+    super(json, 'actors');
+  }
+}
+class Anchor {
+  constructor(json) {
+    this.name = json.name;
+    this.type = json.type;
+  }
+
+  format() {
+    return document.createTextNode(`${this.type == 'alias' ? '*' : '&'}${this.name}`);
+  }
+}
+
 class Message {
 
   constructor(json) {
@@ -32,8 +92,7 @@ class Message {
     this.fallbackLang = content['fallback-lang'];
     this.translations = content.translations;
     this.status = json.status;
-    this.viewers = [];
-    json.viewers.forEach(v => this.viewers.push(new Role(v)));
+    this.viewers = new Viewers(json.viewers);
     
   }
 
@@ -41,19 +100,16 @@ class Message {
     var v = document.createElement('h3');
     var viewers = document.createTextNode('Viewers');
     v.appendChild(viewers);
-    var viewerList = document.createElement('ul');
-    this.viewers.forEach(v => {
-      var viewer = document.createElement('li');
-      viewer.appendChild(document.createTextNode(v.name));
-      viewerList.appendChild(viewer);
-    });
+    var viewerList = this.viewers.format();
     var h = document.createElement('h3');
     var heading = document.createTextNode('Status');
     h.appendChild(heading);
     var p = document.createElement('p');
     var text = document.createTextNode(this.status);
     p.appendChild(text);
-    var result = [v, viewerList, h, p];
+    var result = [v];
+    result = result.concat(viewerList);
+    result.push(h, p);
     h = document.createElement('h3');
     heading = document.createTextNode(this.fallbackLang);
     h.appendChild(heading);