From 03b12f2900a5200a38daf935f2157debd762f218 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 7 Oct 2019 17:10:24 -0400
Subject: [PATCH] Define as a newtype wrapper around Text.

---
 semantic-core/src/Analysis/Concrete.hs   |  4 ++--
 semantic-core/src/Analysis/ScopeGraph.hs |  3 +--
 semantic-core/src/Data/Name.hs           | 12 ++++++++----
 3 files changed, 11 insertions(+), 8 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index b84dd1331..f21e2afb8 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -197,7 +197,7 @@ heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,)
 addressStyle :: Heap term -> G.Style (EdgeType term, Precise) Text
 addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
   where vertex (_, addr) = pack (show addr) <> " = " <> maybe "?" fromConcrete (IntMap.lookup addr heap)
-        edgeAttributes _ (Slot name,    _) = ["label" G.:= name]
+        edgeAttributes _ (Slot name,    _) = ["label" G.:= unName name]
         edgeAttributes _ (Edge Import,  _) = ["color" G.:= "blue"]
         edgeAttributes _ (Edge Lexical, _) = ["color" G.:= "green"]
         edgeAttributes _ _                 = []
@@ -205,7 +205,7 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
           Unit ->  "()"
           Bool b -> pack $ show b
           String s -> pack $ show s
-          Closure (Loc p (Span s e)) n _ _ -> "\\\\ " <> n <> " [" <> p <> ":" <> showPos s <> "-" <> showPos e <> "]"
+          Closure (Loc p (Span s e)) (Name n) _ _ -> "\\\\ " <> n <> " [" <> p <> ":" <> showPos s <> "-" <> showPos e <> "]"
           Record _ -> "{}"
         showPos (Pos l c) = pack (show l) <> ":" <> pack (show c)
 
diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 0ca3311c4..38a17f2d6 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -25,12 +25,11 @@ import qualified Data.Map as Map
 import           Data.Name
 import           Data.Proxy
 import qualified Data.Set as Set
-import           Data.Text (Text)
 import           Data.Traversable (for)
 import           Prelude hiding (fail)
 
 data Decl = Decl
-  { declSymbol :: Text
+  { declSymbol :: Name
   , declLoc    :: Loc
   }
   deriving (Eq, Ord, Show)
diff --git a/semantic-core/src/Data/Name.hs b/semantic-core/src/Data/Name.hs
index 944155f6d..c312540b6 100644
--- a/semantic-core/src/Data/Name.hs
+++ b/semantic-core/src/Data/Name.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE DeriveTraversable, LambdaCase, OverloadedLists #-}
+{-# LANGUAGE DeriveTraversable, GeneralizedNewtypeDeriving, LambdaCase, OverloadedLists #-}
 module Data.Name
-( Name
+( Name(..)
 , Named(..)
 , named
 , named'
@@ -15,10 +15,14 @@ module Data.Name
 import qualified Data.Char as Char
 import           Data.HashSet (HashSet)
 import qualified Data.HashSet as HashSet
+import           Data.String
 import           Data.Text as Text (Text, any, unpack)
+import           Data.Text.Prettyprint.Doc
 
 -- | User-specified and -relevant names.
-type Name = Text
+newtype Name = Name { unName :: Text }
+  deriving (Eq, IsString, Ord, Pretty, Show)
+
 
 -- | Annotates an @a@ with a 'Name'-provided name, which is ignored for '==' and 'compare'.
 data Named a = Named (Ignored Name) a
@@ -50,7 +54,7 @@ reservedNames = [ "#true", "#false", "if", "then", "else"
 -- | Returns true if any character would require quotation or if the
 -- name conflicts with a Core primitive.
 needsQuotation :: Name -> Bool
-needsQuotation u = HashSet.member (unpack u) reservedNames || Text.any (not . isSimpleCharacter) u
+needsQuotation (Name u) = HashSet.member (unpack u) reservedNames || Text.any (not . isSimpleCharacter) u
 
 -- | A ‘simple’ character is, loosely defined, a character that is compatible
 -- with identifiers in most ASCII-oriented programming languages. This is defined