mirror of
https://github.com/github/semantic.git
synced 2024-11-24 08:54:07 +03:00
Define as a newtype wrapper around Text.
This commit is contained in:
parent
397dc43e84
commit
03b12f2900
@ -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)
|
||||
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user