From bb73145e55dfb74e0ba771d9dc1fda453b8b81cf Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 7 Feb 2022 10:48:15 -0500
Subject: [PATCH] The root node must be mapped from the graph as well.

---
 semantic-analysis/src/Analysis/Syntax.hs | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Syntax.hs b/semantic-analysis/src/Analysis/Syntax.hs
index 6ed68ac5d..300ce8578 100644
--- a/semantic-analysis/src/Analysis/Syntax.hs
+++ b/semantic-analysis/src/Analysis/Syntax.hs
@@ -150,13 +150,13 @@ parseGraph :: Syntax rep => A.Value -> A.Parser (IntMap.IntMap rep, Maybe rep)
 parseGraph = A.withArray "nodes" $ \ nodes -> do
   (untied, First root) <- foldMap (\ (k, v, r) -> ([(k, v)], First r)) <$> traverse (A.withObject "node" parseNode) (V.toList nodes)
   let tied = fix (\ tied -> ($ tied) <$> IntMap.fromList untied)
-  pure (tied, root)
+  pure (tied, ($ tied) <$> root)
 
-parseNode :: Syntax rep => A.Object -> A.Parser (IntMap.Key, IntMap.IntMap rep -> rep, Maybe rep)
+parseNode :: Syntax rep => A.Object -> A.Parser (IntMap.Key, IntMap.IntMap rep -> rep, Maybe (IntMap.IntMap rep -> rep))
 parseNode o = do
   edges <- o A..: pack "edges"
   index <- o A..: pack "id"
-  let parseType attrs = attrs A..: pack "type" >>= \case
+  let parseType attrs = \case
         "string" -> const . string <$> attrs A..: pack "text"
         "true"   -> pure (const (bool True))
         "false"  -> pure (const (bool False))
@@ -173,4 +173,7 @@ parseNode o = do
         f attrs
         pure (IntMap.! sink))
       findEdgeNamed name = foldMap (resolveWith (\ attrs -> attrs A..: pack "type" >>= guard . (== name))) edges
-  o A..: pack "attrs" >>= A.withObject "attrs" (fmap (index,,Nothing) . parseType)
+  o A..: pack "attrs" >>= A.withObject "attrs" (\ attrs -> do
+    ty <- attrs A..: pack "type"
+    let node = parseType attrs ty
+    (index,,Nothing) <$> node)