From 596ac8da54a0e0edf00e6381340e4d794dffca60 Mon Sep 17 00:00:00 2001
From: joshvera <josh@joshvera.com>
Date: Wed, 5 Feb 2020 20:44:04 -0500
Subject: [PATCH] Label the edge to the import instead of the last hole

---
 .../src/Control/Carrier/Sketch/ScopeGraph.hs  |  3 +-
 semantic-scope-graph/src/Data/ScopeGraph.hs   | 31 ++++++++++---------
 2 files changed, 18 insertions(+), 16 deletions(-)

diff --git a/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs b/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs
index 99b21ba14..6a2e36958 100644
--- a/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs
+++ b/semantic-scope-graph/src/Control/Carrier/Sketch/ScopeGraph.hs
@@ -35,6 +35,7 @@ import           Data.Semilattice.Lower
 import           GHC.Records
 import           Source.Span
 import qualified System.Path as Path
+import qualified Data.List.NonEmpty as NonEmpty
 
 -- | The state type used to keep track of the in-progress graph and
 -- positional/contextual information. The name "sketchbook" is meant
@@ -93,7 +94,7 @@ instance (Effect sig, Algebra sig m) => Algebra (ScopeGraphEff :+: Reader Name :
     k name
   alg (L (InsertEdge label address k)) = do
     Sketchbook old current <- SketchC get
-    let new = ScopeGraph.addImportEdge label address current old
+    let new = ScopeGraph.addImportEdge label (NonEmpty.toList address) current old
     SketchC (put (Sketchbook new current))
     k ()
 
diff --git a/semantic-scope-graph/src/Data/ScopeGraph.hs b/semantic-scope-graph/src/Data/ScopeGraph.hs
index 1c8fcc547..7bee1c259 100644
--- a/semantic-scope-graph/src/Data/ScopeGraph.hs
+++ b/semantic-scope-graph/src/Data/ScopeGraph.hs
@@ -356,24 +356,25 @@ insertEdge label target currentAddress g@(ScopeGraph graph) = fromMaybe g $ do
   let newScope = currentScope' { edges = Map.insert label (target : scopes) (edges currentScope') }
   pure (ScopeGraph (Map.insert currentAddress newScope graph))
 
-addImportEdge :: Ord scopeAddress => EdgeLabel -> NonEmpty scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
-addImportEdge edge names currentAddress g = do
-  case names of
-    (x :| []) -> addImportHole x currentAddress g
-    (x :| xs) -> do
-      case lookupScope x g of
-        Just _ -> addImportEdge edge (NonEmpty.fromList xs) x g
-        Nothing ->
-          let
-            scopeGraph' = insertEdge edge x currentAddress (newScope x mempty g)
-            in
-            addImportEdge edge (NonEmpty.fromList xs) x scopeGraph'
-
+addImportEdge :: Ord scopeAddress => EdgeLabel -> [scopeAddress] -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
+addImportEdge edge importEdge currentAddress g = do
+  case importEdge of
+    (name:[]) -> maybe
+                (insertEdge edge name currentAddress (newScope name mempty g))
+                (const (insertEdge edge name currentAddress g))
+                (lookupScope name g)
+    (name:names) -> let
+      scopeGraph' = maybe
+        (insertEdge VoidL name currentAddress (newScope name mempty g))
+        (const (insertEdge edge name currentAddress g))
+        (lookupScope name g)
+      in
+        addImportEdge edge names name scopeGraph'
 
 addImportHole :: Ord scopeAddress => scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress
 addImportHole name currentAddress g = fromMaybe g $ do
   let scope' = newScope name mempty g
-  pure (insertEdge Void name currentAddress scope')
+  pure (insertEdge VoidL name currentAddress scope')
 
 
 -- | Update the 'Scope' containing a 'Declaration' with an associated scope address.
@@ -451,5 +452,5 @@ formatDeclaration = formatName . unDeclaration
 
 -- | The type of edge from a scope to its parent scopes.
 -- Either a lexical edge or an import edge in the case of non-lexical edges.
-data EdgeLabel = Lexical | Import | Void | Export | Superclass
+data EdgeLabel = Lexical | Import | Export | Superclass | VoidL
   deriving (Bounded, Enum, Eq, Ord, Show)