Move what was Data.Name into Analysis.Name.

semantic-analysis/semantic-analysis.cabal

@@ -57,13 +57,15 @@ library
     Analysis.Typecheck
     Control.Carrier.Fail.WithLoc
   build-depends:
-      algebraic-graphs            ^>= 0.3
+     aeson
+   , algebraic-graphs            ^>= 0.3
    , base                         >= 4.13 && < 5
    , containers                  ^>= 0.6
    , fused-effects               ^>= 1.0
    , fused-effects-readline
    , fused-syntax
    , haskeline                   ^>= 0.7.5
+   , hashable
    , pathtype                    ^>= 0.8.1
    , prettyprinter                >= 1.2 && < 2
    , prettyprinter-ansi-terminal ^>= 1.1.1

semantic-analysis/src/Analysis/Concrete.hs

@@ -178,7 +178,7 @@ heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,)
 addressStyle :: Heap (Concrete term) -> G.Style (EdgeType (Concrete term), Addr) 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.:= unName name]
+        edgeAttributes _ (Slot name,    _) = ["label" G.:= formatName name]
         edgeAttributes _ (Edge Import,  _) = ["color" G.:= "blue"]
         edgeAttributes _ (Edge Lexical, _) = ["color" G.:= "green"]
         edgeAttributes _ _                 = []
@@ -186,7 +186,7 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
           Unit ->  "()"
           Bool b -> pack $ show b
           String s -> pack $ show s
-          Closure p (Span s e) (Named n _) -> "\\\\ " <> unName n <> " [" <> pack (Path.toString p) <> ":" <> showPos s <> "-" <> showPos e <> "]"
+          Closure p (Span s e) (Named n _) -> "\\\\ " <> formatName n <> " [" <> pack (Path.toString p) <> ":" <> showPos s <> "-" <> showPos e <> "]"
           Record _ -> "{}"
         showPos (Pos l c) = pack (show l) <> ":" <> pack (show c)
 

semantic-analysis/src/Analysis/Name.hs

@@ -1,14 +1,67 @@
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Analysis.Name
-( Name(..)
+( Name (Name)
+-- * Constructors
+, gensym
+, name
+, nameI
+, formatName
+, __self
 ) where
 
-import Data.String (IsString)
+import           Control.Effect.Fresh
+import           Data.Aeson
+import qualified Data.Char as Char
+import           Data.Hashable
+import           Data.String
 import           Data.Text (Text)
+import qualified Data.Text as Text
 
--- | User-specified and -relevant names.
-newtype Name = Name { unName :: Text }
-  deriving (Eq, IsString, Ord, Show)
+-- | The type of variable names.
+data Name
+  = Name Text
+  | I Int
+  deriving (Eq, Ord)
 
+instance IsString Name where
+  fromString = Name . fromString
 
+-- | Generate a fresh (unused) name for use in synthesized variables/closures/etc.
+gensym :: Has Fresh sig m => m Name
+gensym = I <$> fresh
+
+-- | Construct a 'Name' from a 'Text'.
+name :: Text -> Name
+name = Name
+
+-- | Construct a 'Name' from an 'Int'. This is suitable for automatic generation, e.g. using a Fresh effect, but should not be used for human-generated names.
+nameI :: Int -> Name
+nameI = I
+
+-- | Extract a human-readable 'Text' from a 'Name'.
+-- Sample outputs can be found in @Data.Abstract.Name.Spec@.
+formatName :: Name -> Text
+formatName (Name name) = name
+formatName (I i)       = Text.pack $ '_' : (alphabet !! a) : replicate n 'ʹ'
+  where alphabet = ['a'..'z']
+        (n, a) = i `divMod` length alphabet
+
+instance Show Name where
+  showsPrec _ = prettyShowString . Text.unpack . formatName
+    where prettyShowString str = showChar '"' . foldr ((.) . prettyChar) id str . showChar '"'
+          prettyChar c
+            | c `elem` ['\\', '\"'] = Char.showLitChar c
+            | Char.isPrint c        = showChar c
+            | otherwise             = Char.showLitChar c
+
+instance Hashable Name where
+  hashWithSalt salt (Name name) = hashWithSalt salt name
+  hashWithSalt salt (I i)       = salt `hashWithSalt` (1 :: Int) `hashWithSalt` i
+
+instance ToJSON Name where
+  toJSON = toJSON . formatName
+  toEncoding = toEncoding . formatName
+
+__self :: Name
+__self = name "__semantic_self"

semantic-core/src/Core/Name.hs

@@ -22,6 +22,7 @@ reservedNames = [ "#true", "#false", "if", "then", "else"
 -- name conflicts with a Core primitive.
 needsQuotation :: Name -> Bool
 needsQuotation (Name u) = HashSet.member (unpack u) reservedNames || Text.any (not . isSimpleCharacter) u
+needsQuotation _        = False
 
 -- | A ‘simple’ character is, loosely defined, a character that is compatible
 -- with identifiers in most ASCII-oriented programming languages. This is defined

semantic-core/src/Core/Parser.hs

@@ -16,7 +16,7 @@ import           Control.Applicative
 import           Control.Monad
 import           Core.Core ((:<-) (..), Core)
 import qualified Core.Core as Core
-import           Core.Name
+import           Core.Name hiding (name)
 import qualified Data.Char as Char
 import           Data.Foldable (foldl')
 import           Data.Function

semantic-core/src/Core/Pretty.hs

@@ -10,7 +10,7 @@ module Core.Pretty
 
 import           Analysis.File
 import           Core.Core
-import           Core.Name
+import           Core.Name hiding (name)
 import           Data.Foldable (toList)
 import           Data.Text.Prettyprint.Doc
 import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
@@ -43,7 +43,9 @@ primitive = keyword . mappend "#"
 data Style = Unicode | Ascii
 
 name :: Name -> AnsiDoc
-name (Name n) = if needsQuotation (Name n) then enclose (symbol "#{") (symbol "}") (pretty n) else pretty n
+name n
+  | needsQuotation n = enclose (symbol "#{") (symbol "}") (pretty (formatName n))
+  | otherwise        = pretty (formatName n)
 
 prettyCore :: Style -> Term Core Name -> AnsiDoc
 prettyCore style = unPrec . go . fmap name

semantic-python/semantic-python.cabal

@@ -24,6 +24,7 @@ common haskell
                      , fused-effects ^>= 1.0
                      , fused-syntax
                      , parsers ^>= 0.12.10
+                     , semantic-analysis ^>= 0
                      , semantic-core ^>= 0.0
                      , semantic-source ^>= 0.0
                      , semantic-tags ^>= 0.0

semantic-python/src/Language/Python/Core.hs

@@ -205,7 +205,7 @@ instance Compile Py.ClassDefinition where
               typefn = prelude ["type"]
               object = prelude ["object"]
 
-          pure (typefn $$ Core.string (coerce n) $$ object $$ contents)
+          pure (typefn $$ Core.string (formatName n) $$ object $$ contents)
 
     body <- compile pybody buildTypeCall next
     let coreName = Name.named' n

semantic-python/src/Language/Python/Patterns.hs

@@ -9,17 +9,16 @@ module Language.Python.Patterns
   ) where
 
 import           AST.Element
-import           Data.Coerce
-import           Data.Text (Text)
+import qualified Analysis.Name
 import qualified TreeSitter.Python.AST as Py
 
 -- | Useful pattern synonym for extracting a single identifier from
 -- a Python ExpressionList. Easier than pattern-matching every time.
 -- TODO: when this is finished, we won't need this pattern, as we'll
 -- handle ExpressionLists the smart way every time.
-pattern SingleIdentifier :: Coercible t Text => t -> Py.ExpressionList a
-pattern SingleIdentifier name <- Py.ExpressionList
+pattern SingleIdentifier :: Analysis.Name.Name -> Py.ExpressionList a
+pattern SingleIdentifier n <- Py.ExpressionList
   { Py.extraChildren =
-    [ Py.Expression (Prj (Py.PrimaryExpression (Prj Py.Identifier { text = coerce -> name })))
+    [ Py.Expression (Prj (Py.PrimaryExpression (Prj Py.Identifier { text = Analysis.Name.name -> n })))
     ]
   }

semantic-python/src/Language/Python/ScopeGraph.hs

@@ -87,7 +87,7 @@ scopeGraphModule = getAp . scopeGraph
 instance ToScopeGraph Py.AssertStatement where scopeGraph = onChildren
 
 instance ToScopeGraph Py.Assignment where
-  scopeGraph (Py.Assignment _ (SingleIdentifier t) _val _typ) = complete <* declare @Name t DeclProperties
+  scopeGraph (Py.Assignment _ (SingleIdentifier t) _val _typ) = complete <* declare @Name (formatName t) DeclProperties
   scopeGraph x                                                = todo x
 
 instance ToScopeGraph Py.Await where

semantic-scope-graph/semantic-scope-graph.cabal

@@ -33,12 +33,13 @@ library
     , algebraic-graphs    >= 0.3 && < 0.5
     , containers
     , fused-effects      ^>= 1.0
+    , generic-monoid
     , hashable
     , lens
-    , semilattices
-    , generic-monoid
     , pathtype
+    , semantic-analysis
     , semantic-source    ^>= 0.0
+    , semilattices
     , text               ^>= 1.2.3.1
   hs-source-dirs:      src
   default-language:    Haskell2010

semantic-scope-graph/src/Data/Name.hs

@@ -1,63 +1,5 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
 module Data.Name
-( Name
--- * Constructors
-, gensym
-, name
-, nameI
-, formatName
-, __self
+( module Analysis.Name
 ) where
 
-import           Control.Effect.Fresh
-import           Data.Aeson
-import qualified Data.Char as Char
-import           Data.Hashable
-import           Data.Text (Text)
-import qualified Data.Text as Text
-
--- | The type of variable names.
-data Name
-  = Name Text
-  | I Int
-  deriving (Eq, Ord)
-
--- | Generate a fresh (unused) name for use in synthesized variables/closures/etc.
-gensym :: Has Fresh sig m => m Name
-gensym = I <$> fresh
-
--- | Construct a 'Name' from a 'Text'.
-name :: Text -> Name
-name = Name
-
--- | Construct a 'Name' from an 'Int'. This is suitable for automatic generation, e.g. using a Fresh effect, but should not be used for human-generated names.
-nameI :: Int -> Name
-nameI = I
-
--- | Extract a human-readable 'Text' from a 'Name'.
--- Sample outputs can be found in @Data.Abstract.Name.Spec@.
-formatName :: Name -> Text
-formatName (Name name) = name
-formatName (I i)       = Text.pack $ '_' : (alphabet !! a) : replicate n 'ʹ'
-  where alphabet = ['a'..'z']
-        (n, a) = i `divMod` length alphabet
-
-instance Show Name where
-  showsPrec _ = prettyShowString . Text.unpack . formatName
-    where prettyShowString str = showChar '"' . foldr ((.) . prettyChar) id str . showChar '"'
-          prettyChar c
-            | c `elem` ['\\', '\"'] = Char.showLitChar c
-            | Char.isPrint c        = showChar c
-            | otherwise             = Char.showLitChar c
-
-instance Hashable Name where
-  hashWithSalt salt (Name name) = hashWithSalt salt name
-  hashWithSalt salt (I i)       = salt `hashWithSalt` (1 :: Int) `hashWithSalt` i
-
-instance ToJSON Name where
-  toJSON = toJSON . formatName
-  toEncoding = toEncoding . formatName
-
-__self :: Name
-__self = name "__semantic_self"
+import Analysis.Name