WIP: converting literals to store text internally

src/Control/Abstract/Primitive.hs

@@ -12,7 +12,6 @@ import Data.Abstract.Environment
 import Data.Abstract.Name
 import Data.Semigroup.Reducer hiding (unit)
 import Data.Semilattice.Lower
-import qualified Data.ByteString.Char8 as B
 import qualified Data.Text as T
 
 builtin :: ( HasCallStack
@@ -60,4 +59,4 @@ defineBuiltins :: ( AbstractValue location value effects
                   )
                => Evaluator location value effects ()
 defineBuiltins =
-  builtin "print" (lambda lowerBound (\ v -> variable v >>= asString >>= trace . B.unpack >> unit))
+  builtin "print" (lambda lowerBound (\ v -> variable v >>= asString >>= trace . T.unpack >> unit))

src/Control/Abstract/Value.hs

@@ -94,11 +94,11 @@ class AbstractFunction location value effects => AbstractValue location value ef
   boolean :: Bool -> Evaluator location value effects value
 
   -- | Construct an abstract string value.
-  string :: ByteString -> Evaluator location value effects value
+  string :: Text -> Evaluator location value effects value
 
   -- | Construct a self-evaluating symbol value.
   --   TODO: Should these be interned in some table to provide stronger uniqueness guarantees?
-  symbol :: ByteString -> Evaluator location value effects value
+  symbol :: Text -> Evaluator location value effects value
 
   -- | Construct a floating-point value.
   float :: Scientific -> Evaluator location value effects value
@@ -122,7 +122,7 @@ class AbstractFunction location value effects => AbstractValue location value ef
   hash :: [(value, value)] -> Evaluator location value effects value
 
   -- | Extract a 'Text' from a given value.
-  asString :: value -> Evaluator location value effects ByteString
+  asString :: value -> Evaluator location value effects Text
 
   -- | Eliminate boolean values. TODO: s/boolean/truthy
   ifthenelse :: value -> Evaluator location value effects a -> Evaluator location value effects a -> Evaluator location value effects a

src/Data/Abstract/Evaluatable.hs

@@ -167,8 +167,8 @@ data EvalError return where
   FreeVariablesError :: [Name] -> EvalError Name
   -- Indicates that our evaluator wasn't able to make sense of these literals.
   IntegerFormatError  :: Text -> EvalError Integer
-  FloatFormatError    :: ByteString -> EvalError Scientific
-  RationalFormatError :: ByteString -> EvalError Rational
+  FloatFormatError    :: Text -> EvalError Scientific
+  RationalFormatError :: Text -> EvalError Rational
   DefaultExportError  :: EvalError ()
   ExportError         :: ModulePath -> Name -> EvalError ()
 

src/Data/Abstract/Value.hs

@@ -104,7 +104,7 @@ instance Ord1 Rational where liftCompare = genericLiftCompare
 instance Show1 Rational where liftShowsPrec = genericLiftShowsPrec
 
 -- | String values.
-newtype String value = String ByteString
+newtype String value = String Text
   deriving (Eq, Generic1, Ord, Show)
 
 instance Eq1 String where liftEq = genericLiftEq
@@ -112,8 +112,7 @@ instance Ord1 String where liftCompare = genericLiftCompare
 instance Show1 String where liftShowsPrec = genericLiftShowsPrec
 
 -- | Possibly-interned Symbol values.
---   TODO: Should this store a 'Text'?
-newtype Symbol value = Symbol ByteString
+newtype Symbol value = Symbol Text
   deriving (Eq, Generic1, Ord, Show)
 
 instance Eq1 Symbol where liftEq = genericLiftEq
@@ -381,7 +380,7 @@ instance ( Members '[ Allocator location (Value location)
 
 -- | The type of exceptions that can be thrown when constructing values in 'Value'’s 'MonadValue' instance.
 data ValueError location resume where
-  StringError            :: Value location                   -> ValueError location ByteString
+  StringError            :: Value location                   -> ValueError location Text
   BoolError              :: Value location                   -> ValueError location Bool
   IndexError             :: Value location -> Value location -> ValueError location (Value location)
   NamespaceError         :: Prelude.String                   -> ValueError location (Environment location)

src/Data/Scientific/Exts.hs

@@ -7,9 +7,9 @@ module Data.Scientific.Exts
 import Control.Applicative
 import Control.Exception as Exc (evaluate, try)
 import Control.Monad hiding (fail)
-import Data.Attoparsec.ByteString.Char8
-import Data.ByteString.Char8 hiding (readInt, takeWhile)
-import Data.Char (isOctDigit)
+import Data.Attoparsec.Text
+import Data.Text hiding (takeWhile)
+import Data.Char (isDigit, isOctDigit)
 import Data.Scientific
 import Numeric
 import Prelude hiding (fail, filter, null, takeWhile)
@@ -17,7 +17,7 @@ import Prologue hiding (null)
 import Text.Read (readMaybe)
 import System.IO.Unsafe
 
-parseScientific :: ByteString -> Either String Scientific
+parseScientific :: Text -> Either String Scientific
 parseScientific = parseOnly parser
 
 -- | This is a very flexible and forgiving parser for Scientific values.

src/Data/Syntax/Directive.hs

@@ -3,7 +3,7 @@ module Data.Syntax.Directive where
 
 import           Data.Abstract.Evaluatable
 import           Data.Abstract.Module (ModuleInfo(..))
-import qualified Data.ByteString.Char8 as BC
+import qualified Data.Text as T
 import           Data.JSON.Fields
 import           Data.Span
 import           Diffing.Algorithm
@@ -20,7 +20,7 @@ instance Show1 File where liftShowsPrec = genericLiftShowsPrec
 instance ToJSONFields1 File
 
 instance Evaluatable File where
-  eval File = Rval <$> (currentModule >>= string . BC.pack . modulePath)
+  eval File = Rval <$> (currentModule >>= string . T.pack . modulePath)
 
 
 -- A line directive like the Ruby constant `__LINE__`.

src/Data/Syntax/Literal.hs

@@ -2,10 +2,9 @@
 module Data.Syntax.Literal where
 
 import           Data.Abstract.Evaluatable
-import           Data.ByteString.Char8 (unpack)
-import qualified Data.ByteString.Char8 as B
 import           Data.JSON.Fields
 import           Data.Scientific.Exts
+import           Data.Text (unpack)
 import qualified Data.Text as T
 import           Diffing.Algorithm
 import           Prelude hiding (Float, null)
@@ -57,7 +56,7 @@ instance ToJSONFields1 Data.Syntax.Literal.Integer where
 -- TODO: Consider a Numeric datatype with FloatingPoint/Integral/etc constructors.
 
 -- | A literal float of unspecified width.
-newtype Float a = Float { floatContent  :: ByteString }
+newtype Float a = Float { floatContent  :: Text }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Data.Syntax.Literal.Float where liftEq = genericLiftEq
@@ -69,10 +68,10 @@ instance Evaluatable Data.Syntax.Literal.Float where
     Rval <$> (float =<< either (const (throwEvalError (FloatFormatError s))) pure (parseScientific s))
 
 instance ToJSONFields1 Float where
-  toJSONFields1 (Float f) = noChildren ["asString" .= unpack f]
+  toJSONFields1 (Float f) = noChildren ["asString" .= f]
 
 -- Rational literals e.g. `2/3r`
-newtype Rational a = Rational ByteString
+newtype Rational a = Rational Text
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Data.Syntax.Literal.Rational where liftEq = genericLiftEq
@@ -82,15 +81,15 @@ instance Show1 Data.Syntax.Literal.Rational where liftShowsPrec = genericLiftSho
 instance Evaluatable Data.Syntax.Literal.Rational where
   eval (Rational r) =
     let
-      trimmed = B.takeWhile (/= 'r') r
+      trimmed = T.takeWhile (/= 'r') r
       parsed = readMaybe @Prelude.Integer (unpack trimmed)
     in Rval <$> (rational =<< maybe (throwEvalError (RationalFormatError r)) (pure . toRational) parsed)
 
 instance ToJSONFields1 Data.Syntax.Literal.Rational where
-  toJSONFields1 (Rational r) = noChildren ["asString" .= unpack r]
+  toJSONFields1 (Rational r) = noChildren ["asString" .= r]
 
 -- Complex literals e.g. `3 + 2i`
-newtype Complex a = Complex ByteString
+newtype Complex a = Complex Text
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Data.Syntax.Literal.Complex where liftEq = genericLiftEq
@@ -101,7 +100,7 @@ instance Show1 Data.Syntax.Literal.Complex where liftShowsPrec = genericLiftShow
 instance Evaluatable Complex
 
 instance ToJSONFields1 Complex where
-  toJSONFields1 (Complex c) = noChildren ["asString" .= unpack c]
+  toJSONFields1 (Complex c) = noChildren ["asString" .= c]
 
 -- Strings, symbols
 
@@ -133,7 +132,7 @@ instance Evaluatable InterpolationElement
 instance ToJSONFields1 InterpolationElement
 
 -- | A sequence of textual contents within a string literal.
-newtype TextElement a = TextElement { textElementContent :: ByteString }
+newtype TextElement a = TextElement { textElementContent :: Text }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 TextElement where liftEq = genericLiftEq
@@ -141,7 +140,7 @@ instance Ord1 TextElement where liftCompare = genericLiftCompare
 instance Show1 TextElement where liftShowsPrec = genericLiftShowsPrec
 
 instance ToJSONFields1 TextElement where
-  toJSONFields1 (TextElement c) = noChildren ["asString" .= unpack c]
+  toJSONFields1 (TextElement c) = noChildren ["asString" .= c]
 
 instance Evaluatable TextElement where
   eval (TextElement x) = Rval <$> string x
@@ -157,7 +156,7 @@ instance Evaluatable Null where eval _ = Rval <$> null
 
 instance ToJSONFields1 Null
 
-newtype Symbol a = Symbol { symbolContent :: ByteString }
+newtype Symbol a = Symbol { symbolContent :: Text }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Symbol where liftEq = genericLiftEq
@@ -169,7 +168,7 @@ instance ToJSONFields1 Symbol
 instance Evaluatable Symbol where
   eval (Symbol s) = Rval <$> symbol s
 
-newtype Regex a = Regex { regexContent :: ByteString }
+newtype Regex a = Regex { regexContent :: Text }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Regex where liftEq = genericLiftEq
@@ -180,7 +179,7 @@ instance Show1 Regex where liftShowsPrec = genericLiftShowsPrec
 -- TODO: Character literals.
 
 instance ToJSONFields1 Regex where
-  toJSONFields1 (Regex r) = noChildren ["asString" .= unpack r]
+  toJSONFields1 (Regex r) = noChildren ["asString" .= r]
 
 
 -- TODO: Implement Eval instance for Regex

src/Language/JSON/Assignment.hs

@@ -49,10 +49,10 @@ array :: Assignment
 array = makeTerm <$> symbol Array <*> children (Literal.Array <$> many jsonValue)
 
 number :: Assignment
-number = makeTerm <$> symbol Number <*> (Literal.Float <$> source)
+number = makeTerm <$> symbol Number <*> (Literal.Float <$> tsource)
 
 string :: Assignment
-string = makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
+string = makeTerm <$> symbol String <*> (Literal.TextElement <$> tsource)
 
 boolean :: Assignment
 boolean =  makeTerm <$> symbol Grammar.True  <*> (Literal.true <$ source)

src/Language/PHP/Assignment.hs

@@ -487,7 +487,7 @@ literal :: Assignment
 literal = integer <|> float <|> string
 
 float :: Assignment
-float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
+float = makeTerm <$> symbol Float <*> (Literal.Float <$> tsource)
 
 integer :: Assignment
 integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> tsource)
@@ -760,7 +760,7 @@ comment :: Assignment
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
 string :: Assignment
-string = makeTerm <$> (symbol Grammar.String <|> symbol Heredoc) <*> (Literal.TextElement <$> source)
+string = makeTerm <$> (symbol Grammar.String <|> symbol Heredoc) <*> (Literal.TextElement <$> tsource)
 
 -- | Match infix terms separated by any of a list of operators, assigning any comments following each operand.
 infixTerm :: Assignment

src/Language/Python/Assignment.hs

@@ -354,13 +354,13 @@ list' :: Assignment
 list' = makeTerm <$> symbol List <*> children (Literal.Array <$> manyTerm expression)
 
 string :: Assignment
-string = makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
+string = makeTerm <$> symbol String <*> (Literal.TextElement <$> tsource)
 
 concatenatedString :: Assignment
 concatenatedString = makeTerm <$> symbol ConcatenatedString <*> children (manyTerm string)
 
 float :: Assignment
-float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
+float = makeTerm <$> symbol Float <*> (Literal.Float <$> tsource)
 
 integer :: Assignment
 integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> tsource)

src/Language/Ruby/Syntax.hs

@@ -20,7 +20,7 @@ import           System.FilePath.Posix
 resolveRubyName :: Members '[ Modules location value
                             , Resumable ResolutionError
                             ] effects
-                => ByteString
+                => Text
                 -> Evaluator location value effects M.ModulePath
 resolveRubyName name = do
   let name' = cleanNameOrPath name

src/Language/TypeScript/Assignment.hs

@@ -281,7 +281,7 @@ this :: Assignment
 this = makeTerm <$> symbol Grammar.This <*> (TypeScript.Syntax.This <$ source)
 
 regex :: Assignment
-regex = makeTerm <$> symbol Grammar.Regex <*> (Literal.Regex <$> source)
+regex = makeTerm <$> symbol Grammar.Regex <*> (Literal.Regex <$> tsource)
 
 null' :: Assignment
 null' = makeTerm <$> symbol Null <*> (Literal.Null <$ source)
@@ -330,10 +330,10 @@ importAlias' :: Assignment
 importAlias' = makeTerm <$> symbol Grammar.ImportAlias <*> children (TypeScript.Syntax.ImportAlias <$> term identifier <*> term (identifier <|> nestedIdentifier))
 
 number :: Assignment
-number = makeTerm <$> symbol Grammar.Number <*> (Literal.Float <$> source)
+number = makeTerm <$> symbol Grammar.Number <*> (Literal.Float <$> tsource)
 
 string :: Assignment
-string = makeTerm <$> symbol Grammar.String <*> (Literal.TextElement <$> source)
+string = makeTerm <$> symbol Grammar.String <*> (Literal.TextElement <$> tsource)
 
 true :: Assignment
 true = makeTerm <$> symbol Grammar.True <*> (Literal.true <$ source)