Merge branch 'master' into charliesome/value-ref-address

semantic.cabal

@@ -36,7 +36,6 @@ library
                      -- Control structures & interfaces for abstract interpretation
                      , Control.Abstract
                      , Control.Abstract.Addressable
-                     , Control.Abstract.Configuration
                      , Control.Abstract.Context
                      , Control.Abstract.Environment
                      , Control.Abstract.Evaluator
@@ -281,6 +280,7 @@ test-suite test
                      , Diffing.Interpreter.Spec
                      , Integration.Spec
                      , Matching.Go.Spec
+                     , Proto3.Roundtrip
                      , Rendering.TOC.Spec
                      , Semantic.Spec
                      , Semantic.CLI.Spec
@@ -295,6 +295,7 @@ test-suite test
                      , bifunctors
                      , bytestring
                      , comonad
+                     , containers
                      , effects
                      , fastsum
                      , filepath
@@ -309,7 +310,8 @@ test-suite test
                      , leancheck
                      , mtl
                      , network
-                     , containers
+                     , proto3-suite
+                     , proto3-wire
                      , recursion-schemes >= 4.1
                      , semantic
                      , text >= 1.2.1.3

src/Analysis/Abstract/Evaluating.hs

@@ -5,7 +5,6 @@ module Analysis.Abstract.Evaluating
 ) where
 
 import Control.Abstract
-import Control.Monad.Effect.Fail
 import Data.Semilattice.Lower
 
 -- | An analysis evaluating @term@s to @value@s with a list of @effects@ using 'Evaluatable', and producing incremental results of type @a@.
@@ -20,15 +19,13 @@ deriving instance (Show (Cell address value), Show address, Show value) => Show
 
 
 evaluating :: Evaluator address value
-                (  Fail
-                ': Fresh
+                (  Fresh
                 ': State (Heap address (Cell address) value)
                 ': State (ModuleTable (Maybe (address, Environment address)))
                 ': effects) result
-           -> Evaluator address value effects (Either String result, EvaluatingState address value)
+           -> Evaluator address value effects (result, EvaluatingState address value)
 evaluating
   = fmap (\ ((result, heap), modules) -> (result, EvaluatingState heap modules))
   . runState lowerBound -- State (ModuleTable (Maybe (address, Environment address)))
   . runState lowerBound -- State (Heap address (Cell address) value)
   . runFresh 0
-  . runFail

src/Analysis/Abstract/Graph.hs

@@ -21,23 +21,23 @@ import           Data.Abstract.Name
 import           Data.Abstract.Package (PackageInfo(..))
 import           Data.Aeson hiding (Result)
 import           Data.ByteString.Builder
-import qualified Data.ByteString.Char8 as BC
 import           Data.Graph
 import           Data.Sum
 import qualified Data.Syntax as Syntax
 import           Data.Term
-import           Data.Text.Encoding as T
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
 import           Prologue hiding (packageName, project)
 
 -- | A vertex of some specific type.
 data Vertex
-  = Package  { vertexName :: ByteString }
-  | Module   { vertexName :: ByteString }
-  | Variable { vertexName :: ByteString }
+  = Package  { vertexName :: Text }
+  | Module   { vertexName :: Text }
+  | Variable { vertexName :: Text }
   deriving (Eq, Ord, Show)
 
 style :: Style Vertex Builder
-style = (defaultStyle (byteString . vertexName))
+style = (defaultStyle (T.encodeUtf8Builder . vertexName))
   { vertexAttributes = vertexAttributes
   , edgeAttributes   = edgeAttributes
   }
@@ -62,7 +62,7 @@ graphingTerms :: ( Element Syntax.Identifier syntax
 graphingTerms recur term@(In _ syntax) = do
   case project syntax of
     Just (Syntax.Identifier name) -> do
-      moduleInclusion (Variable (unName name))
+      moduleInclusion (Variable (formatName name))
       variableDefinition name
     _ -> pure ()
   recur term
@@ -90,10 +90,10 @@ graphingModules recur m = interpose @(Modules address value) pure (\ m yield ->
 
 
 packageVertex :: PackageInfo -> Vertex
-packageVertex = Package . unName . packageName
+packageVertex = Package . formatName . packageName
 
 moduleVertex :: ModuleInfo -> Vertex
-moduleVertex = Module . BC.pack . modulePath
+moduleVertex = Module . T.pack . modulePath
 
 -- | Add an edge from the current package to the passed vertex.
 packageInclusion :: ( Effectful m
@@ -127,7 +127,7 @@ variableDefinition :: ( Member (Env (Hole (Located address))) effects
                    -> TermEvaluator term (Hole (Located address)) value effects ()
 variableDefinition name = do
   graph <- maybe lowerBound (maybe lowerBound (vertex . moduleVertex . addressModule) . toMaybe) <$> TermEvaluator (lookupEnv name)
-  appendGraph (vertex (Variable (unName name)) `connect` graph)
+  appendGraph (vertex (Variable (formatName name)) `connect` graph)
 
 appendGraph :: (Effectful m, Member (State (Graph Vertex)) effects) => Graph Vertex -> m effects ()
 appendGraph = modify' . (<>)
@@ -137,7 +137,7 @@ instance ToJSON Vertex where
   toJSON v = object [ "name" .= vertexToText v, "type" .= vertexToType v ]
 
 vertexToText :: Vertex -> Text
-vertexToText = decodeUtf8 . vertexName
+vertexToText = vertexName
 
 vertexToType :: Vertex -> Text
 vertexToType Package{}  = "package"

src/Analysis/Declaration.hs

@@ -5,7 +5,7 @@ module Analysis.Declaration
 , declarationAlgebra
 ) where
 
-import Data.Abstract.Name (unName)
+import Data.Abstract.Name (formatName)
 import Data.Blob
 import Data.Error (Error(..), showExpectation)
 import Data.Language as Language
@@ -19,20 +19,19 @@ import qualified Data.Syntax.Declaration as Declaration
 import qualified Data.Syntax.Expression as Expression
 import Data.Term
 import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
 import qualified Language.Markdown.Syntax as Markdown
 import qualified Language.Ruby.Syntax as Ruby.Syntax
 import Prologue hiding (project)
 
 -- | A declaration’s identifier and type.
 data Declaration
-  = MethodDeclaration   { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language, declarationReceiver :: Maybe T.Text }
-  | ClassDeclaration    { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language }
-  | ImportDeclaration   { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language, declarationAlias :: T.Text, declarationSymbols :: [(T.Text, T.Text)] }
-  | FunctionDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language }
-  | HeadingDeclaration  { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language, declarationLevel :: Int }
-  | CallReference       { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language, declarationImportIdentifier :: [T.Text] }
-  | ErrorDeclaration    { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language }
+  = MethodDeclaration   { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Language, declarationReceiver :: Maybe T.Text }
+  | ClassDeclaration    { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Language }
+  | ImportDeclaration   { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Language, declarationAlias :: T.Text, declarationSymbols :: [(T.Text, T.Text)] }
+  | FunctionDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Language }
+  | HeadingDeclaration  { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Language, declarationLevel :: Int }
+  | CallReference       { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Language, declarationImportIdentifier :: [T.Text] }
+  | ErrorDeclaration    { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Language }
   deriving (Eq, Generic, Show)
 
 
@@ -109,7 +108,7 @@ instance CustomHasDeclaration whole Declaration.Method where
     -- Methods without a receiver
     | isEmpty receiverAnn = Just $ MethodDeclaration (getSource blobSource identifierAnn) (getMethodSource blob (In ann decl)) blobLanguage Nothing
     -- Methods with a receiver type and an identifier (e.g. (a *Type) in Go).
-    | blobLanguage == Just Go
+    | blobLanguage == Go
     , [ _, Term (In receiverType _) ] <- toList receiverF = Just $ MethodDeclaration (getSource blobSource identifierAnn) (getMethodSource blob (In ann decl)) blobLanguage (Just (getSource blobSource receiverType))
     -- Methods with a receiver (class methods) are formatted like `receiver.method_name`
     | otherwise           = Just $ MethodDeclaration (getSource blobSource identifierAnn) (getMethodSource blob (In ann decl)) blobLanguage (Just (getSource blobSource receiverAnn))
@@ -129,13 +128,13 @@ getSource blobSource = toText . flip Source.slice blobSource . getField
 
 instance (Syntax.Identifier :< fs, Expression.MemberAccess :< fs) => CustomHasDeclaration (Sum fs) Expression.Call where
   customToDeclaration Blob{..} _ (Expression.Call _ (Term (In fromAnn fromF), _) _ _)
-    | Just (Expression.MemberAccess (Term (In leftAnn leftF)) (Term (In idenAnn _))) <- project fromF = Just $ CallReference (getSource idenAnn) mempty blobLanguage (memberAccess leftAnn leftF)
-    | Just (Syntax.Identifier name) <- project fromF = Just $ CallReference (T.decodeUtf8 (unName name)) mempty blobLanguage []
+    | Just (Expression.MemberAccess (Term (In leftAnn leftF)) name) <- project fromF = Just $ CallReference (formatName name) mempty blobLanguage (memberAccess leftAnn leftF)
+    | Just (Syntax.Identifier name) <- project fromF = Just $ CallReference (formatName name) mempty blobLanguage []
     | otherwise = Just $ CallReference (getSource fromAnn) mempty blobLanguage []
     where
       memberAccess modAnn termFOut
-        | Just (Expression.MemberAccess (Term (In leftAnn leftF)) (Term (In rightAnn rightF))) <- project termFOut
-        = memberAccess leftAnn leftF <> memberAccess rightAnn rightF
+        | Just (Expression.MemberAccess (Term (In leftAnn leftF)) name) <- project termFOut
+        = memberAccess leftAnn leftF <> [formatName name]
         | otherwise = [getSource modAnn]
       getSource = toText . flip Source.slice blobSource . getField
 

src/Assigning/Assignment.hs

@@ -69,6 +69,7 @@ module Assigning.Assignment
 , location
 , currentNode
 , symbol
+, rawSource
 , source
 , children
 , advance
@@ -104,6 +105,8 @@ import Data.Record
 import qualified Data.Source as Source (Source, slice, sourceBytes)
 import Data.Span
 import Data.Term
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8')
 import Text.Parser.Combinators as Parsers hiding (choice)
 import TreeSitter.Language
 
@@ -123,8 +126,8 @@ data AssignmentF ast grammar a where
   Alt :: [a] -> AssignmentF ast grammar a
   Label :: Assignment ast grammar a -> String -> AssignmentF ast grammar a
   Fail :: String -> AssignmentF ast grammar a
-  GetRubyLocals :: AssignmentF ast grammar [ByteString]
-  PutRubyLocals :: [ByteString] -> AssignmentF ast grammar ()
+  GetRubyLocals :: AssignmentF ast grammar [Text]
+  PutRubyLocals :: [Text] -> AssignmentF ast grammar ()
 
 data Tracing f a where
   Tracing :: { tracingCallSite :: Maybe (String, SrcLoc), runTracing :: f a } -> Tracing f a
@@ -144,10 +147,10 @@ tracing f = case getCallStack callStack of
 location :: HasCallStack => Assignment ast grammar (Record Location)
 location = tracing Location `Then` return
 
-getRubyLocals :: HasCallStack => Assignment ast grammar [ByteString]
+getRubyLocals :: HasCallStack => Assignment ast grammar [Text]
 getRubyLocals = tracing GetRubyLocals `Then` return
 
-putRubyLocals :: (HasCallStack, Enum grammar, Eq1 ast, Ix grammar) => [ByteString] -> Assignment ast grammar ()
+putRubyLocals :: (HasCallStack, Enum grammar, Eq1 ast, Ix grammar) => [Text] -> Assignment ast grammar ()
 putRubyLocals l = (tracing (PutRubyLocals l) `Then` return)
               <|> (tracing End `Then` return)
 
@@ -160,8 +163,13 @@ symbol :: (Enum grammar, Ix grammar, HasCallStack) => grammar -> Assignment ast
 symbol s = tracing (Choose (Table.singleton s location) Nothing Nothing) `Then` return
 
 -- | A rule to produce a node’s source as a ByteString.
-source :: HasCallStack => Assignment ast grammar ByteString
-source = tracing Source `Then` return
+-- You probably want to use 'source', unless you're throwing away the result.
+rawSource :: HasCallStack => Assignment ast grammar ByteString
+rawSource = tracing Source `Then` return
+
+-- | A rule to produce a node's source as Text. Fails if the node's source can't be parsed as UTF-8.
+source :: HasCallStack => Assignment ast grammar Text
+source = fmap decodeUtf8' rawSource >>= either (\e -> fail ("UTF-8 decoding failed: " <> show e)) pure
 
 -- | Match a node by applying an assignment to its children.
 children :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar a
@@ -299,7 +307,7 @@ data State ast grammar = State
   , statePos :: {-# UNPACK #-} !Pos  -- ^ The (1-indexed) line/column position in the Source thus far reached.
   , stateCallSites :: ![(String, SrcLoc)] -- ^ The symbols & source locations of the calls thus far.
   , stateNodes :: ![AST ast grammar]      -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.”
-  , stateRubyLocals :: ![ByteString]      -- Special state necessary for the Ruby assignment. When we refactor Assignment to use effects we should pull this out into Language.Ruby.Assignment
+  , stateRubyLocals :: ![Text]      -- Special state necessary for the Ruby assignment. When we refactor Assignment to use effects we should pull this out into Language.Ruby.Assignment
   }
 
 deriving instance (Eq grammar, Eq1 ast) => Eq (State ast grammar)

src/Control/Abstract.hs

@@ -3,7 +3,6 @@ module Control.Abstract
 ) where
 
 import Control.Abstract.Addressable as X
-import Control.Abstract.Configuration as X
 import Control.Abstract.Context as X
 import Control.Abstract.Environment as X hiding (Lookup)
 import Control.Abstract.Evaluator as X

src/Control/Abstract/Configuration.hs

@@ -1,16 +0,0 @@
-module Control.Abstract.Configuration
-( Configuration(..)
-, Live
-, getConfiguration
-) where
-
-import Control.Abstract.Addressable
-import Control.Abstract.Environment
-import Control.Abstract.Heap
-import Control.Abstract.Roots
-import Control.Abstract.TermEvaluator
-import Data.Abstract.Configuration
-
--- | Get the current 'Configuration' with a passed-in term.
-getConfiguration :: (Member (Reader (Live address)) effects, Member (Env address) effects, Member (State (Heap address (Cell address) value)) effects) => term -> TermEvaluator term address value effects (Configuration term address (Cell address) value)
-getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEnv <*> TermEvaluator getHeap

src/Control/Abstract/Heap.hs

@@ -1,6 +1,9 @@
 {-# LANGUAGE GADTs, RankNTypes, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Control.Abstract.Heap
 ( Heap
+, Configuration(..)
+, Live
+, getConfiguration
 , getHeap
 , putHeap
 , box
@@ -25,12 +28,19 @@ import Control.Abstract.Addressable
 import Control.Abstract.Environment
 import Control.Abstract.Evaluator
 import Control.Abstract.Roots
+import Control.Abstract.TermEvaluator
+import Data.Abstract.Configuration
 import Data.Abstract.Heap
 import Data.Abstract.Live
 import Data.Abstract.Name
 import Data.Semigroup.Reducer
 import Prologue
 
+-- | Get the current 'Configuration' with a passed-in term.
+getConfiguration :: (Member (Reader (Live address)) effects, Member (Env address) effects, Member (State (Heap address (Cell address) value)) effects) => term -> TermEvaluator term address value effects (Configuration term address (Cell address) value)
+getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEnv <*> TermEvaluator getHeap
+
+
 -- | Retrieve the heap.
 getHeap :: Member (State (Heap address (Cell address) value)) effects => Evaluator address value effects (Heap address (Cell address) value)
 getHeap = get

src/Control/Abstract/Modules.hs

@@ -66,9 +66,9 @@ runModules :: forall term address value effects a
               )
            => (Module term -> Evaluator address value (Modules address value ': effects) (address, Environment address))
            -> Evaluator address value (Modules address value ': effects) a
-           -> Evaluator address value (Reader (ModuleTable [Module term]) ': effects) a
+           -> Evaluator address value (Reader (ModuleTable (NonEmpty (Module term))) ': effects) a
 runModules evaluateModule = go
-  where go :: forall a . Evaluator address value (Modules address value ': effects) a -> Evaluator address value (Reader (ModuleTable [Module term]) ': effects) a
+  where go :: forall a . Evaluator address value (Modules address value ': effects) a -> Evaluator address value (Reader (ModuleTable (NonEmpty (Module term))) ': effects) a
         go = reinterpret (\ m -> case m of
           Load name -> askModuleTable @term >>= maybe (moduleNotFound name) (runMerging . foldMap (Merging . evalAndCache)) . ModuleTable.lookup name
             where
@@ -95,7 +95,7 @@ getModuleTable = get
 cacheModule :: Member (State (ModuleTable (Maybe (address, Environment address)))) effects => ModulePath -> Maybe (address, Environment address) -> Evaluator address value effects (Maybe (address, Environment address))
 cacheModule path result = modify' (ModuleTable.insert path result) $> result
 
-askModuleTable :: Member (Reader (ModuleTable [Module term])) effects => Evaluator address value effects (ModuleTable [Module term])
+askModuleTable :: Member (Reader (ModuleTable (NonEmpty (Module term)))) effects => Evaluator address value effects (ModuleTable (NonEmpty (Module term)))
 askModuleTable = ask
 
 

src/Control/Abstract/Primitive.hs

@@ -6,8 +6,8 @@ import Control.Abstract.Evaluator
 import Control.Abstract.Heap
 import Control.Abstract.Value
 import Data.Abstract.Name
-import Data.ByteString.Char8 (pack, unpack)
 import Data.Semilattice.Lower
+import Data.Text (pack, unpack)
 import Prologue
 
 builtin :: ( HasCallStack
@@ -20,7 +20,7 @@ builtin :: ( HasCallStack
         -> Evaluator address value effects value
         -> Evaluator address value effects ()
 builtin s def = withCurrentCallStack callStack $ do
-  let name' = name (pack ("__semantic_" <> s))
+  let name' = name ("__semantic_" <> pack s)
   addr <- alloc name'
   bind name' addr
   def >>= assign addr

src/Control/Abstract/Value.hs

@@ -58,11 +58,11 @@ class Show value => AbstractIntro value where
   boolean :: Bool -> value
 
   -- | Construct an abstract string value.
-  string :: ByteString -> value
+  string :: Text -> value
 
   -- | Construct a self-evaluating symbol value.
   --   TODO: Should these be interned in some table to provide stronger uniqueness guarantees?
-  symbol :: ByteString -> value
+  symbol :: Text -> value
 
   -- | Construct an abstract integral value.
   integer :: Integer -> value
@@ -120,8 +120,8 @@ class (AbstractFunction address value effects, AbstractIntro value) => AbstractV
   -- | Extract the contents of a key-value pair as a tuple.
   asPair :: value -> Evaluator address value effects (value, value)
 
-  -- | Extract a 'ByteString' from a given value.
-  asString :: value -> Evaluator address value effects ByteString
+  -- | Extract a 'Text' from a given value.
+  asString :: value -> Evaluator address value effects Text
 
   -- | Eliminate boolean values. TODO: s/boolean/truthy
   ifthenelse :: value -> Evaluator address value effects a -> Evaluator address value effects a -> Evaluator address value effects a

src/Data/AST.hs

@@ -5,27 +5,26 @@ import Data.Range
 import Data.Record
 import Data.Span
 import Data.Term
-
 import Data.Aeson
-import Data.ByteString.Char8 (pack)
+import Data.Text (pack)
 import Data.JSON.Fields
-import Data.Text.Encoding (decodeUtf8)
 
 -- | An AST node labelled with symbols and source location.
 type AST syntax grammar = Term syntax (Node grammar)
 
 data Node grammar = Node
-  { nodeSymbol :: !grammar
+  { nodeSymbol    :: !grammar
   , nodeByteRange :: {-# UNPACK #-} !Range
-  , nodeSpan :: {-# UNPACK #-} !Span
+  , nodeSpan      :: {-# UNPACK #-} !Span
   }
   deriving (Eq, Show)
 
 
 instance Show grammar => ToJSONFields (Node grammar) where
   toJSONFields Node{..} =
-    [ "symbol" .= decodeUtf8 (pack (show nodeSymbol))
-    , "span" .= nodeSpan ]
+    [ "symbol" .= pack (show nodeSymbol)
+    , "span"   .= nodeSpan
+    ]
 
 -- | A location specified as possibly-empty intervals of bytes and line/column positions.
 type Location = '[Range, Span]

src/Data/Abstract/Evaluatable.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstraintKinds, DefaultSignatures, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GADTs, RankNTypes, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
 module Data.Abstract.Evaluatable
 ( module X
 , Evaluatable(..)
@@ -40,49 +40,44 @@ import Data.Term
 import Prologue
 
 -- | The 'Evaluatable' class defines the necessary interface for a term to be evaluated. While a default definition of 'eval' is given, instances with computational content must implement 'eval' to perform their small-step operational semantics.
-class Evaluatable constr where
-  eval :: ( EvaluatableConstraints term address value effects
-          , Member Fail effects
+class Show1 constr => Evaluatable constr where
+  eval :: ( AbstractValue address value effects
+          , Declarations term
+          , FreeVariables term
+          , Member (Allocator address value) effects
+          , Member (Env address) effects
+          , Member (LoopControl address value) effects
+          , Member (Modules address value) effects
+          , Member (Reader ModuleInfo) effects
+          , Member (Reader PackageInfo) effects
+          , Member (Reader Span) effects
+          , Member (Resumable (EnvironmentError address)) effects
+          , Member (Resumable EvalError) effects
+          , Member (Resumable ResolutionError) effects
+          , Member (Resumable (Unspecialized value)) effects
+          , Member (Return address value) effects
+          , Member Trace effects
           )
        => SubtermAlgebra constr term (Evaluator address value effects (ValueRef address value))
-  default eval :: ( Member (Resumable (Unspecialized value)) effects
-                  , Member (Allocator address value) effects
-                  , Show1 constr
-                  )
-               => SubtermAlgebra constr term (Evaluator address value effects (ValueRef address value))
   eval expr = rvalBox =<< throwResumable (Unspecialized ("Eval unspecialized for " ++ liftShowsPrec (const (const id)) (const id) 0 expr ""))
 
-type EvaluatableConstraints term address value effects =
-  ( AbstractValue address value effects
-  , Declarations term
-  , FreeVariables term
-  , Member (Allocator address value) effects
-  , Member (Env address) effects
-  , Member (LoopControl address value) effects
-  , Member (Modules address value) effects
-  , Member (Reader ModuleInfo) effects
-  , Member (Reader PackageInfo) effects
-  , Member (Reader Span) effects
-  , Member (Resumable (EnvironmentError address)) effects
-  , Member (Resumable EvalError) effects
-  , Member (Resumable ResolutionError) effects
-  , Member (Resumable (Unspecialized value)) effects
-  , Member (Return address value) effects
-  , Member Trace effects
-  )
-
 
 -- | Evaluate a given package.
 evaluatePackageWith :: forall address term value inner inner' inner'' outer
-                    -- FIXME: It’d be nice if we didn’t have to mention 'Addressable' here at all, but 'Located' locations require knowledge of 'currentModule' to run. Can we fix that?
-                    .  ( Addressable address inner'
+                    .  ( AbstractValue address value inner
+                       -- FIXME: It’d be nice if we didn’t have to mention 'Addressable' here at all, but 'Located' locations require knowledge of 'currentModule' to run. Can we fix that?
+                       , Addressable address inner'
+                       , Declarations term
                        , Evaluatable (Base term)
-                       , EvaluatableConstraints term address value inner
                        , Foldable (Cell address)
-                       , Member Fail outer
+                       , FreeVariables term
                        , Member Fresh outer
                        , Member (Resumable (AddressError address value)) outer
+                       , Member (Resumable (EnvironmentError address)) outer
+                       , Member (Resumable EvalError) outer
                        , Member (Resumable (LoadError address value)) outer
+                       , Member (Resumable ResolutionError) outer
+                       , Member (Resumable (Unspecialized value)) outer
                        , Member (State (Heap address (Cell address) value)) outer
                        , Member (State (ModuleTable (Maybe (address, Environment address)))) outer
                        , Member Trace outer
@@ -147,9 +142,9 @@ traceResolve name path = trace ("resolved " <> show name <> " -> " <> show path)
 data EvalError return where
   FreeVariablesError :: [Name] -> EvalError Name
   -- Indicates that our evaluator wasn't able to make sense of these literals.
-  IntegerFormatError  :: ByteString -> EvalError Integer
-  FloatFormatError    :: ByteString -> EvalError Scientific
-  RationalFormatError :: ByteString -> EvalError Rational
+  IntegerFormatError  :: Text -> EvalError Integer
+  FloatFormatError    :: Text -> EvalError Scientific
+  RationalFormatError :: Text -> EvalError Rational
   DefaultExportError  :: EvalError ()
   ExportError         :: ModulePath -> Name -> EvalError ()
 
@@ -200,18 +195,21 @@ runUnspecializedWith = runResumableWith
 -- Instances
 
 -- | If we can evaluate any syntax which can occur in a 'Sum', we can evaluate the 'Sum'.
-instance Apply Evaluatable fs => Evaluatable (Sum fs) where
+instance (Apply Evaluatable fs, Apply Show1 fs) => Evaluatable (Sum fs) where
   eval = apply @Evaluatable eval
 
 -- | Evaluating a 'TermF' ignores its annotation, evaluating the underlying syntax.
-instance Evaluatable s => Evaluatable (TermF s a) where
+instance (Evaluatable s, Show a) => Evaluatable (TermF s a) where
   eval = eval . termFOut
 
---- | '[]' is treated as an imperative sequence of statements/declarations s.t.:
----
----   1. Each statement’s effects on the store are accumulated;
----   2. Each statement can affect the environment of later statements (e.g. by 'modify'-ing the environment); and
----   3. Only the last statement’s return value is returned.
+
+-- NOTE: Use 'Data.Syntax.Statements' instead of '[]' if you need imperative eval semantics.
+--
+-- | '[]' is treated as an imperative sequence of statements/declarations s.t.:
+--
+--   1. Each statement’s effects on the store are accumulated;
+--   2. Each statement can affect the environment of later statements (e.g. by 'modify'-ing the environment); and
+--   3. Only the last statement’s return value is returned.
 instance Evaluatable [] where
   -- 'nonEmpty' and 'foldMap1' enable us to return the last statement’s result instead of 'unit' for non-empty lists.
   eval = maybe (rvalBox unit) (runApp . foldMap1 (App . subtermRef)) . nonEmpty

src/Data/Abstract/ModuleTable.hs

@@ -16,10 +16,10 @@ import Data.Abstract.Module
 import qualified Data.Map as Map
 import Data.Semigroup
 import Data.Semilattice.Lower
-import Prologue
-import System.FilePath.Posix
 import GHC.Generics (Generic1)
 import Prelude hiding (lookup)
+import Prologue
+import System.FilePath.Posix
 
 newtype ModuleTable a = ModuleTable { unModuleTable :: Map.Map ModulePath a }
   deriving (Eq, Foldable, Functor, Generic1, Lower, Monoid, Ord, Semigroup, Traversable)
@@ -42,10 +42,10 @@ insert k v = ModuleTable . Map.insert k v . unModuleTable
 keys :: ModuleTable a -> [ModulePath]
 keys = Map.keys . unModuleTable
 
--- | Construct a 'ModuleTable' from a list of 'Module's.
-fromModules :: [Module term] -> ModuleTable [Module term]
+-- | Construct a 'ModuleTable' from a non-empty list of 'Module's.
+fromModules :: [Module term] -> ModuleTable (NonEmpty (Module term))
 fromModules modules = ModuleTable (Map.fromListWith (<>) (map toEntry modules))
-  where toEntry m = (modulePath (moduleInfo m), [m])
+  where toEntry m = (modulePath (moduleInfo m), m:|[])
 
 toPairs :: ModuleTable a -> [(ModulePath, a)]
 toPairs = Map.toList . unModuleTable

src/Data/Abstract/Name.hs

@@ -3,40 +3,39 @@ module Data.Abstract.Name
 -- * Constructors
 , name
 , nameI
-, unName
+, formatName
 ) where
 
 import           Data.Aeson
-import qualified Data.ByteString.Char8 as BC
 import qualified Data.Char as Char
-import           Data.String
+import           Data.Text (Text)
 import qualified Data.Text as Text
-import qualified Data.Text.Encoding as Text
+import           Data.String
 import           Prologue
 
 -- | The type of variable names.
 data Name
-  = Name ByteString
+  = Name Text
   | I Int
   deriving (Eq, Ord)
 
--- | Construct a 'Name' from a 'ByteString'.
-name :: ByteString -> Name
+-- | 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 'ByteString' from a 'Name'.
-unName :: Name -> ByteString
-unName (Name name) = name
-unName (I i)       = Text.encodeUtf8 . Text.pack $ '_' : (alphabet !! a) : replicate n 'ʹ'
+-- | Extract a human-readable 'Text' from a 'Name'.
+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 IsString Name where
-  fromString = Name . BC.pack
+  fromString = Name . Text.pack
 
 -- $
 -- >>> I 0
@@ -44,7 +43,7 @@ instance IsString Name where
 -- >>> I 26
 -- "_aʹ"
 instance Show Name where
-  showsPrec _ = prettyShowString . Text.unpack . Text.decodeUtf8 . unName
+  showsPrec _ = prettyShowString . Text.unpack . formatName
     where prettyShowString str = showChar '"' . foldr ((.) . prettyChar) id str . showChar '"'
           prettyChar c
             | c `elem` ['\\', '\"'] = Char.showLitChar c
@@ -56,5 +55,5 @@ instance Hashable Name where
   hashWithSalt salt (I i)       = salt `hashWithSalt` (1 :: Int) `hashWithSalt` i
 
 instance ToJSON Name where
-  toJSON = toJSON . Text.decodeUtf8 . unName
-  toEncoding = toEncoding . Text.decodeUtf8 . unName
+  toJSON = toJSON . formatName
+  toEncoding = toEncoding . formatName

src/Data/Abstract/Package.hs

@@ -5,6 +5,7 @@ import Data.Abstract.Module
 import Data.Abstract.ModuleTable as ModuleTable
 import qualified Data.Map as Map
 import Data.Abstract.Name
+import Prologue
 
 type PackageName = Name
 
@@ -20,7 +21,7 @@ newtype Version = Version { versionString :: String }
   deriving (Eq, Ord, Show)
 
 data PackageBody term = PackageBody
-  { packageModules     :: ModuleTable [Module term]
+  { packageModules     :: ModuleTable (NonEmpty (Module term))
   , packagePrelude     :: Maybe (Module term)
   , packageEntryPoints :: ModuleTable (Maybe Name)
   }

src/Data/Abstract/Path.hs

@@ -1,8 +1,7 @@
 module Data.Abstract.Path where
 
 import Prologue
-import qualified Data.ByteString.Char8 as BC
-import qualified Data.ByteString as B
+import qualified Data.Text as T
 import System.FilePath.Posix
 
 -- | Join two paths a and b. Handles walking up relative directories in b. e.g.
@@ -19,8 +18,8 @@ joinPaths a b = let bs = splitPath (normalise b)
     walkup 0 str = str
     walkup n str = walkup (pred n) (takeDirectory str)
 
-stripQuotes :: ByteString -> ByteString
-stripQuotes = B.filter (`B.notElem` "\'\"")
+stripQuotes :: Text -> Text
+stripQuotes = T.dropAround (`elem` ("\'\"" :: String))
 
-dropRelativePrefix :: ByteString -> ByteString
-dropRelativePrefix = BC.dropWhile (== '/') . BC.dropWhile (== '.')
+dropRelativePrefix :: Text -> Text
+dropRelativePrefix = T.dropWhile (== '/') . T.dropWhile (== '.')

src/Data/Abstract/Value.hs

@@ -20,8 +20,8 @@ data Value address body
   | Integer  (Number.Number Integer)
   | Rational (Number.Number Rational)
   | Float    (Number.Number Scientific)
-  | String ByteString
-  | Symbol ByteString
+  | String Text
+  | Symbol Text
   | Tuple [Value address body]
   | Array [Value address body]
   | Class Name (Environment address)
@@ -223,7 +223,7 @@ instance ( Coercible body (Eff effects)
 
 -- | The type of exceptions that can be thrown when constructing values in 'Value'’s 'MonadValue' instance.
 data ValueError address body resume where
-  StringError            :: Value address body                       -> ValueError address body ByteString
+  StringError            :: Value address body                       -> ValueError address body Text
   BoolError              :: Value address body                       -> ValueError address body Bool
   IndexError             :: Value address body -> Value address body -> ValueError address body (Value address body)
   NamespaceError         :: Prelude.String                           -> ValueError address body (Environment address)

src/Data/Blob.hs

@@ -26,17 +26,16 @@ import Data.Source as Source
 data Blob = Blob
   { blobSource :: Source -- ^ The UTF-8 encoded source text of the blob.
   , blobPath :: FilePath -- ^ The file path to the blob.
-  , blobLanguage :: Maybe Language -- ^ The language of this blob. Nothing denotes a langauge we don't support yet.
+  , blobLanguage :: Language -- ^ The language of this blob.
   }
   deriving (Show, Eq, Generic, Message, Named)
 
 nullBlob :: Blob -> Bool
 nullBlob Blob{..} = nullSource blobSource
 
-sourceBlob :: FilePath -> Maybe Language -> Source -> Blob
+sourceBlob :: FilePath -> Language -> Source -> Blob
 sourceBlob filepath language source = Blob source filepath language
 
-
 -- | Represents a blobs suitable for diffing which can be either a blob to
 -- delete, a blob to insert, or a pair of blobs to diff.
 type BlobPair = Join These Blob
@@ -51,10 +50,14 @@ blobPairInserting = Join . That
 blobPairDeleting :: Blob -> BlobPair
 blobPairDeleting = Join . This
 
-languageForBlobPair :: BlobPair -> Maybe Language
+languageForBlobPair :: BlobPair -> Language
 languageForBlobPair (Join (This Blob{..})) = blobLanguage
 languageForBlobPair (Join (That Blob{..})) = blobLanguage
-languageForBlobPair (Join (These _ Blob{..})) = blobLanguage
+languageForBlobPair (Join (These a b))
+  | blobLanguage a == Unknown || blobLanguage b == Unknown
+    = Unknown
+  | otherwise
+    = blobLanguage b
 
 pathForBlobPair :: BlobPair -> FilePath
 pathForBlobPair (Join (This Blob{..})) = blobPath
@@ -62,7 +65,7 @@ pathForBlobPair (Join (That Blob{..})) = blobPath
 pathForBlobPair (Join (These _ Blob{..})) = blobPath
 
 languageTagForBlobPair :: BlobPair -> [(String, String)]
-languageTagForBlobPair pair = maybe [] showLanguage (languageForBlobPair pair)
+languageTagForBlobPair pair = showLanguage (languageForBlobPair pair)
   where showLanguage = pure . (,) "language" . show
 
 pathKeyForBlobPair :: BlobPair -> FilePath

src/Data/Error.hs

@@ -42,7 +42,7 @@ formatError includeSource colourize Blob{..} Error{..}
        . showString (replicate (succ (posColumn (spanStart errorSpan) + lineNumberDigits)) ' ') . withSGRCode colourize [SetColor Foreground Vivid Green] (showChar '^' . showChar '\n')
     else id)
   . showCallStack colourize callStack . showChar '\n'
-  where context = maybe "\n" (sourceBytes . sconcat) (nonEmpty [ fromBytes (pack (showLineNumber i)) <> fromBytes ": " <> l | (i, l) <- zip [1..] (sourceLines blobSource), inRange (posLine (spanStart errorSpan) - 2, posLine (spanStart errorSpan)) i ])
+  where context = maybe "\n" (sourceBytes . sconcat) (nonEmpty [ fromUTF8 (pack (showLineNumber i)) <> fromUTF8 ": " <> l | (i, l) <- zip [1..] (sourceLines blobSource), inRange (posLine (spanStart errorSpan) - 2, posLine (spanStart errorSpan)) i ])
         showLineNumber n = let s = show n in replicate (lineNumberDigits - length s) ' ' <> s
         lineNumberDigits = succ (floor (logBase 10 (fromIntegral (posLine (spanStart errorSpan)) :: Double)))
 

src/Data/JSON/Fields.hs

@@ -6,14 +6,12 @@ module Data.JSON.Fields
   , ToJSONFields (..)
   , ToJSONFields1 (..)
   , (.=)
-  , noChildren
-  , withChildren
   ) where
 
 import           Data.Aeson
+import qualified Data.Map as Map
 import           Data.Sum (Apply (..), Sum)
 import qualified Data.Text as Text
-import qualified Data.Text.Encoding as Text
 import           Prologue
 
 class ToJSONFields a where
@@ -23,13 +21,11 @@ class ToJSONFields1 f where
   toJSONFields1 :: (KeyValue kv, ToJSON a) => f a -> [kv]
   default toJSONFields1 :: (KeyValue kv, ToJSON a, GToJSONFields1 (Rep1 f), GConstructorName1 (Rep1 f), Generic1 f) => f a -> [kv]
   toJSONFields1 s = let r = from1 s in
-    "term" .= gconstructorName1 r : gtoJSONFields1 r
-
-withChildren :: (KeyValue kv, ToJSON a, Foldable f) => f a -> [kv] -> [kv]
-withChildren f ks = ("children" .= toList f) : ks
-
-noChildren :: KeyValue kv => [kv] -> [kv]
-noChildren ks = ("children" .= ([] :: [Int])) : ks
+    "term" .= gconstructorName1 r : Map.foldrWithKey m [] (gtoJSONFields1 r)
+    where
+      m _ []  acc = acc
+      m k [v] acc = (k .= v) : acc
+      m k vs  acc = (k .= vs) : acc
 
 instance ToJSONFields a => ToJSONFields (Join (,) a) where
   toJSONFields (Join (a, b)) = [ "before" .= object (toJSONFields a), "after" .= object (toJSONFields b) ]
@@ -93,7 +89,10 @@ instance (GConstructorName1 f, GConstructorName1 g) => GConstructorName1 (f :+:
 
 -- | A typeclass to calculate a list of 'KeyValue's describing the record selector names and associated values on a datatype.
 class GToJSONFields1 f where
-  gtoJSONFields1 :: (KeyValue kv, ToJSON a) => f a -> [kv]
+  -- FIXME: Not ideal to allocate a Map each time here, but not an obvious way
+  -- to deal with product types without record selectors that all end up as an
+  -- array under a "children" property.
+  gtoJSONFields1 :: (ToJSON a) => f a -> Map.Map Text [SomeJSON]
 
 instance GToJSONFields1 f => GToJSONFields1 (M1 D c f) where
   gtoJSONFields1 = gtoJSONFields1 . unM1
@@ -102,41 +101,35 @@ instance GToJSONFields1 f => GToJSONFields1 (M1 C c f) where
   gtoJSONFields1 = gtoJSONFields1 . unM1
 
 instance GToJSONFields1 U1 where
-  gtoJSONFields1 _ = []
+  gtoJSONFields1 _ = mempty
 
 instance (Selector c, GSelectorJSONValue1 f) => GToJSONFields1 (M1 S c f) where
-  gtoJSONFields1 m1 = case selName m1 of
-    "" -> [ "children" .= json ]
-    n ->  [ Text.pack n .= json ]
-    where json = gselectorJSONValue1 (unM1 m1)
+  gtoJSONFields1 m1 = Map.fromList [gselectorJSONValue1 keyName (unM1 m1)]
+    where keyName = case selName m1 of
+            "" -> Nothing
+            n  -> Just (Text.pack n)
 
 instance (GToJSONFields1 f, GToJSONFields1 g) => GToJSONFields1 (f :+: g) where
   gtoJSONFields1 (L1 l) = gtoJSONFields1 l
   gtoJSONFields1 (R1 r) = gtoJSONFields1 r
 
 instance (GToJSONFields1 f, GToJSONFields1 g) => GToJSONFields1 (f :*: g) where
-  gtoJSONFields1 (x :*: y) = gtoJSONFields1 x <> gtoJSONFields1 y
+  gtoJSONFields1 (x :*: y) = Map.unionWith (<>) (gtoJSONFields1 x) (gtoJSONFields1 y)
 
 -- | A typeclass to retrieve the JSON 'Value' of a record selector.
 class GSelectorJSONValue1 f where
-  gselectorJSONValue1 :: ToJSON a => f a -> SomeJSON
+  gselectorJSONValue1 :: (ToJSON a) => Maybe Text -> f a -> (Text, [SomeJSON])
 
 instance GSelectorJSONValue1 Par1 where
-  gselectorJSONValue1 = SomeJSON . unPar1
+  gselectorJSONValue1 k x = (fromMaybe "children" k, [SomeJSON (unPar1 x)])
 
 instance ToJSON1 f => GSelectorJSONValue1 (Rec1 f) where
-  gselectorJSONValue1 = SomeJSON . SomeJSON1 . unRec1
+  gselectorJSONValue1 k x = (fromMaybe "children" k, [SomeJSON (SomeJSON1 (unRec1 x))])
 
 instance ToJSON k => GSelectorJSONValue1 (K1 r k) where
-  gselectorJSONValue1 = SomeJSON . unK1
-
-
--- TODO: Fix this orphan instance.
-instance ToJSON ByteString where
-  toJSON = toJSON . Text.decodeUtf8
-  toEncoding = toEncoding . Text.decodeUtf8
-
+  gselectorJSONValue1 k x = (fromMaybe "value" k, [SomeJSON (unK1 x)])
 
+-- | An existential type wrapping an JSON-compatible data type.
 data SomeJSON where
   SomeJSON :: ToJSON a => a -> SomeJSON
 

src/Data/Language.hs

@@ -1,13 +1,16 @@
-{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase #-}
 module Data.Language where
 
-import Prologue
 import Data.Aeson
+import Prologue
 import Proto3.Suite
 
--- | A programming language.
+-- | The various languages we support.
+-- Please do not reorder any of the field names: the current implementation of 'Primitive'
+-- delegates to the auto-generated 'Enum' instance.
 data Language
-    = Go
+    = Unknown
+    | Go
     | Haskell
     | Java
     | JavaScript
@@ -18,33 +21,54 @@ data Language
     | Ruby
     | TypeScript
     | PHP
-    deriving (Eq, Generic, Ord, Read, Show, ToJSON, Named, Enum, Finite, Message)
+    deriving (Eq, Generic, Ord, Read, Show, Bounded, ToJSON, Named, Enum, Finite, MessageField)
+
+-- | Predicate failing on 'Unknown' and passing in all other cases.
+knownLanguage :: Language -> Bool
+knownLanguage = (/= Unknown)
+
+-- | Returns 'Nothing' when passed 'Unknown'.
+ensureLanguage :: Language -> Maybe Language
+ensureLanguage Unknown = Nothing
+ensureLanguage x       = Just x
+
+-- | Defaults to 'Unknown'.
+instance HasDefault Language where def = Unknown
+
+-- | Piggybacks on top of the 'Enumerated' instance, as the generated code would.
+-- This instance will get easier when we have DerivingVia.
+instance Primitive Language where
+  primType _ = primType (Proxy @(Enumerated Language))
+  encodePrimitive f = encodePrimitive f . Enumerated . Right
+  decodePrimitive   = decodePrimitive >>= \case
+    (Enumerated (Right r)) -> pure r
+    other                  -> Prelude.fail ("Language decodeMessageField: unexpected value" <> show other)
 
 -- | Returns a Language based on the file extension (including the ".").
-languageForType :: String -> Maybe Language
+languageForType :: String -> Language
 languageForType mediaType = case mediaType of
-    ".java" -> Just Java
-    ".json" -> Just JSON
-    ".hs" -> Just Haskell
-    ".md" -> Just Markdown
-    ".rb" -> Just Ruby
-    ".go" -> Just Go
-    ".js" -> Just JavaScript
-    ".ts" -> Just TypeScript
-    ".tsx" -> Just TypeScript
-    ".jsx" -> Just JSX
-    ".py" -> Just Python
-    ".php" -> Just PHP
-    ".phpt" -> Just PHP
-    _ -> Nothing
+    ".java" -> Java
+    ".json" -> JSON
+    ".hs"   -> Haskell
+    ".md"   -> Markdown
+    ".rb"   -> Ruby
+    ".go"   -> Go
+    ".js"   -> JavaScript
+    ".ts"   -> TypeScript
+    ".tsx"  -> TypeScript
+    ".jsx"  -> JSX
+    ".py"   -> Python
+    ".php"  -> PHP
+    ".phpt" -> PHP
+    _       -> Unknown
 
 extensionsForLanguage :: Language -> [String]
 extensionsForLanguage language = case language of
-  Go -> [".go"]
-  Haskell -> [".hs"]
+  Go         -> [".go"]
+  Haskell    -> [".hs"]
   JavaScript -> [".js"]
-  PHP -> [".php"]
-  Python -> [".py"]
-  Ruby -> [".rb"]
+  PHP        -> [".php"]
+  Python     -> [".py"]
+  Ruby       -> [".rb"]
   TypeScript -> [".ts", ".tsx", ".d.tsx"]
-  _ -> []
+  _          -> []

src/Data/Project.hs

@@ -1,31 +1,30 @@
 module Data.Project where
 
-import           Data.ByteString.Char8 as BC (pack)
-import           Data.Language
-import           Prologue
-import           System.FilePath.Posix
+import Data.Text as T (pack)
+import Data.Language
+import Prologue
+import System.FilePath.Posix
 
 data Project = Project
-  { projectRootDir :: FilePath
-  , projectFiles :: [File]
-  , projectLanguage :: Language
+  { projectRootDir     :: FilePath
+  , projectFiles       :: [File]
+  , projectLanguage    :: Language
   , projectEntryPoints :: [File]
   , projectExcludeDirs :: [FilePath]
   }
   deriving (Eq, Ord, Show)
 
-projectName :: Project -> ByteString
-projectName = BC.pack . dropExtensions . takeFileName . projectRootDir
+projectName :: Project -> Text
+projectName = T.pack . dropExtensions . takeFileName . projectRootDir
 
 projectExtensions :: Project -> [String]
 projectExtensions = extensionsForLanguage . projectLanguage
 
 
 data File = File
-  { filePath :: FilePath
-  , fileLanguage :: Maybe Language
-  }
-  deriving (Eq, Ord, Show)
+  { filePath     :: FilePath
+  , fileLanguage :: Language
+  } deriving (Eq, Ord, Show)
 
 file :: FilePath -> File
 file path = File path (languageForFilePath path)

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/Source.hs

@@ -2,7 +2,7 @@
 module Data.Source
 ( Source
 , sourceBytes
-, fromBytes
+, fromUTF8
 -- Measurement
 , sourceLength
 , nullSource
@@ -38,12 +38,14 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import Proto3.Suite
 
--- | The contents of a source file, represented as a 'ByteString'.
+-- | The contents of a source file. This is represented as a UTF-8
+-- 'ByteString' under the hood. Construct these with 'fromUTF8'; obviously,
+-- passing 'fromUTF8' non-UTF8 bytes will cause crashes.
 newtype Source = Source { sourceBytes :: B.ByteString }
   deriving (Eq, IsString, Show, Generic, MessageField)
 
-fromBytes :: B.ByteString -> Source
-fromBytes = Source
+fromUTF8 :: B.ByteString -> Source
+fromUTF8 = Source
 
 
 -- Measurement

src/Data/Syntax.hs

@@ -148,21 +148,9 @@ instance FreeVariables1 Identifier where
 instance Declarations1 Identifier where
   liftDeclaredName _ (Identifier x) = pure x
 
-
-newtype Program a = Program [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, ToJSONFields1)
-
-instance Eq1 Program where liftEq = genericLiftEq
-instance Ord1 Program where liftCompare = genericLiftCompare
-instance Show1 Program where liftShowsPrec = genericLiftShowsPrec
-
-instance Evaluatable Program where
-  eval (Program xs) = eval xs
-
-
 -- | An accessibility modifier, e.g. private, public, protected, etc.
-newtype AccessibilityModifier a = AccessibilityModifier ByteString
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, ToJSONFields1)
+newtype AccessibilityModifier a = AccessibilityModifier Text
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 AccessibilityModifier where liftEq = genericLiftEq
 instance Ord1 AccessibilityModifier where liftCompare = genericLiftCompare
@@ -175,9 +163,7 @@ instance Evaluatable AccessibilityModifier
 --
 --   This can be used to represent an implicit no-op, e.g. the alternative in an 'if' statement without an 'else'.
 data Empty a = Empty
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named1, Message1)
-
-instance ToJSONFields1 Empty
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1)
 
 instance Eq1 Empty where liftEq _ _ _ = True
 instance Ord1 Empty where liftCompare _ _ _ = EQ
@@ -188,7 +174,7 @@ instance Evaluatable Empty where
 
 -- | Syntax representing a parsing or assignment error.
 data Error a = Error { errorCallStack :: ErrorStack, errorExpected :: [String], errorActual :: Maybe String, errorChildren :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Error where liftEq = genericLiftEq
 instance Ord1 Error where liftCompare = genericLiftCompare
@@ -196,12 +182,6 @@ instance Show1 Error where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Error
 
-instance ToJSONFields1 Error where
-  toJSONFields1 f@Error{..} = withChildren f [ "stack" .= errorCallStack
-                                             , "expected" .= errorExpected
-                                             , "actual" .= errorActual
-                                             ]
-
 
 errorSyntax :: Error.Error String -> [a] -> Error a
 errorSyntax Error.Error{..} = Error (ErrorStack (getCallStack callStack)) errorExpected errorActual
@@ -210,7 +190,11 @@ unError :: Span -> Error a -> Error.Error String
 unError span Error{..} = Error.withCallStack (freezeCallStack (fromCallSiteList (unErrorStack errorCallStack))) (Error.Error span errorExpected errorActual)
 
 newtype ErrorStack = ErrorStack { unErrorStack :: [(String, SrcLoc)] }
-  deriving (Eq, Show)
+  deriving (Eq)
+
+instance Show ErrorStack where
+  showsPrec _ = shows . map showPair . unErrorStack
+    where showPair (sym, loc) = sym <> " " <> srcLocFile loc <> ":" <> show (srcLocStartLine loc) <> ":" <> show (srcLocStartCol loc)
 
 instance ToJSON ErrorStack where
   toJSON (ErrorStack es) = toJSON (jSite <$> es) where
@@ -241,9 +225,7 @@ instance Ord ErrorStack where
 
 
 data Context a = Context { contextTerms :: NonEmpty a, contextSubject :: a }
-  deriving (Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 Context
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
 
 instance Diffable Context where
   subalgorithmFor blur focus (Context n s) = Context <$> traverse blur n <*> focus s

src/Data/Syntax/Comment.hs

@@ -3,21 +3,17 @@ module Data.Syntax.Comment where
 
 import Prologue
 import Data.Abstract.Evaluatable
-import Data.ByteString (unpack)
 import Data.JSON.Fields
 import Diffing.Algorithm
 
 -- | An unnested comment (line or block).
-newtype Comment a = Comment { commentContent :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+newtype Comment a = Comment { commentContent :: Text }
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, ToJSONFields1)
 
 instance Eq1 Comment where liftEq = genericLiftEq
 instance Ord1 Comment where liftCompare = genericLiftCompare
 instance Show1 Comment where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Comment where
-  toJSONFields1 f@Comment{..} = withChildren f ["contents" .= unpack commentContent ]
-
 instance Evaluatable Comment where
   eval _ = rvalBox unit
 
@@ -25,3 +21,14 @@ instance Evaluatable Comment where
 -- TODO: documentation comment types
 -- TODO: literate programming comment types? alternatively, consider those as markup
 -- TODO: Differentiate between line/block comments?
+
+-- | HashBang line (e.g. `#!/usr/bin/env node`)
+newtype HashBang a = HashBang Text
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, ToJSONFields1)
+
+instance Eq1 HashBang where liftEq = genericLiftEq
+instance Ord1 HashBang where liftCompare = genericLiftCompare
+instance Show1 HashBang where liftShowsPrec = genericLiftShowsPrec
+
+-- TODO: Implement Eval instance for HashBang
+instance Evaluatable HashBang

src/Data/Syntax/Declaration.hs

@@ -9,7 +9,7 @@ import Diffing.Algorithm
 import Prologue
 
 data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a }
-  deriving (Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
 
 instance Diffable Function where
   equivalentBySubterm = Just . functionName
@@ -18,8 +18,6 @@ instance Eq1 Function where liftEq = genericLiftEq
 instance Ord1 Function where liftCompare = genericLiftCompare
 instance Show1 Function where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Function
-
 -- TODO: Filter the closed-over environment by the free variables in the term.
 -- TODO: How should we represent function types, where applicable?
 
@@ -35,7 +33,7 @@ instance Declarations a => Declarations (Function a) where
 
 
 data Method a = Method { methodContext :: ![a], methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a }
-  deriving (Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
 
 instance Eq1 Method where liftEq = genericLiftEq
 instance Ord1 Method where liftCompare = genericLiftCompare
@@ -44,8 +42,6 @@ instance Show1 Method where liftShowsPrec = genericLiftShowsPrec
 instance Diffable Method where
   equivalentBySubterm = Just . methodName
 
-instance ToJSONFields1 Method
-
 -- Evaluating a Method creates a closure and makes that value available in the
 -- local environment.
 instance Evaluatable Method where
@@ -58,40 +54,34 @@ instance Evaluatable Method where
 
 -- | A method signature in TypeScript or a method spec in Go.
 data MethodSignature a = MethodSignature { _methodSignatureContext :: ![a], _methodSignatureName :: !a, _methodSignatureParameters :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 MethodSignature where liftEq = genericLiftEq
 instance Ord1 MethodSignature where liftCompare = genericLiftCompare
 instance Show1 MethodSignature where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 MethodSignature
-
 -- TODO: Implement Eval instance for MethodSignature
 instance Evaluatable MethodSignature
 
 
 newtype RequiredParameter a = RequiredParameter { requiredParameter :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 RequiredParameter where liftEq = genericLiftEq
 instance Ord1 RequiredParameter where liftCompare = genericLiftCompare
 instance Show1 RequiredParameter where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 RequiredParameter
-
 -- TODO: Implement Eval instance for RequiredParameter
 instance Evaluatable RequiredParameter
 
 
 newtype OptionalParameter a = OptionalParameter { optionalParameter :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 OptionalParameter where liftEq = genericLiftEq
 instance Ord1 OptionalParameter where liftCompare = genericLiftCompare
 instance Show1 OptionalParameter where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 OptionalParameter
-
 -- TODO: Implement Eval instance for OptionalParameter
 instance Evaluatable OptionalParameter
 
@@ -101,14 +91,12 @@ instance Evaluatable OptionalParameter
 -- TODO: It would be really nice to have a more meaningful type contained in here than [a]
 -- | A declaration of possibly many variables such as var foo = 5, bar = 6 in JavaScript.
 newtype VariableDeclaration a = VariableDeclaration { variableDeclarations :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 VariableDeclaration where liftEq = genericLiftEq
 instance Ord1 VariableDeclaration where liftCompare = genericLiftCompare
 instance Show1 VariableDeclaration where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 VariableDeclaration
-
 instance Evaluatable VariableDeclaration where
   eval (VariableDeclaration [])   = rvalBox unit
   eval (VariableDeclaration decs) = rvalBox =<< (multiple <$> traverse subtermValue decs)
@@ -121,14 +109,12 @@ instance Declarations a => Declarations (VariableDeclaration a) where
 
 -- | A TypeScript/Java style interface declaration to implement.
 data InterfaceDeclaration a = InterfaceDeclaration { interfaceDeclarationContext :: ![a], interfaceDeclarationIdentifier :: !a, interfaceDeclarationBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 InterfaceDeclaration where liftEq = genericLiftEq
 instance Ord1 InterfaceDeclaration where liftCompare = genericLiftCompare
 instance Show1 InterfaceDeclaration where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 InterfaceDeclaration
-
 -- TODO: Implement Eval instance for InterfaceDeclaration
 instance Evaluatable InterfaceDeclaration
 
@@ -138,38 +124,32 @@ instance Declarations a => Declarations (InterfaceDeclaration a) where
 
 -- | A public field definition such as a field definition in a JavaScript class.
 data PublicFieldDefinition a = PublicFieldDefinition { publicFieldContext :: ![a], publicFieldPropertyName :: !a, publicFieldValue :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 PublicFieldDefinition where liftEq = genericLiftEq
 instance Ord1 PublicFieldDefinition where liftCompare = genericLiftCompare
 instance Show1 PublicFieldDefinition where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 PublicFieldDefinition
-
 -- TODO: Implement Eval instance for PublicFieldDefinition
 instance Evaluatable PublicFieldDefinition
 
 
 data Variable a = Variable { variableName :: !a, variableType :: !a, variableValue :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Variable where liftEq = genericLiftEq
 instance Ord1 Variable where liftCompare = genericLiftCompare
 instance Show1 Variable where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Variable
-
 -- TODO: Implement Eval instance for Variable
 instance Evaluatable Variable
 
 data Class a = Class { classContext :: ![a], classIdentifier :: !a, classSuperclasses :: ![a], classBody :: !a }
-  deriving (Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
 
 instance Declarations a => Declarations (Class a) where
   declaredName (Class _ name _ _) = declaredName name
 
-instance ToJSONFields1 Class
-
 instance Diffable Class where
   equivalentBySubterm = Just . classIdentifier
 
@@ -189,14 +169,12 @@ instance Evaluatable Class where
 
 -- | A decorator in Python
 data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Decorator where liftEq = genericLiftEq
 instance Ord1 Decorator where liftCompare = genericLiftCompare
 instance Show1 Decorator where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Decorator
-
 -- TODO: Implement Eval instance for Decorator
 instance Evaluatable Decorator
 
@@ -204,71 +182,61 @@ instance Evaluatable Decorator
 
 
 -- | An ADT, i.e. a disjoint sum of products, like 'data' in Haskell, or 'enum' in Rust or Swift.
-data Datatype a = Datatype { datatypeName :: !a, datatypeConstructors :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+data Datatype a = Datatype { datatypeContext :: a, datatypeName :: a, datatypeConstructors :: [a], datatypeDeriving :: a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Data.Syntax.Declaration.Datatype where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Declaration.Datatype where liftCompare = genericLiftCompare
 instance Show1 Data.Syntax.Declaration.Datatype where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Data.Syntax.Declaration.Datatype
-
 -- TODO: Implement Eval instance for Datatype
 instance Evaluatable Data.Syntax.Declaration.Datatype
 
 
 -- | A single constructor in a datatype, or equally a 'struct' in C, Rust, or Swift.
-data Constructor a = Constructor { constructorName :: !a, constructorFields :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+data Constructor a = Constructor { constructorContext :: a, constructorName :: a, constructorFields :: a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Data.Syntax.Declaration.Constructor where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Declaration.Constructor where liftCompare = genericLiftCompare
 instance Show1 Data.Syntax.Declaration.Constructor where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Data.Syntax.Declaration.Constructor
-
 -- TODO: Implement Eval instance for Constructor
 instance Evaluatable Data.Syntax.Declaration.Constructor
 
 
 -- | Comprehension (e.g. ((a for b in c if a()) in Python)
 data Comprehension a = Comprehension { comprehensionValue :: !a, comprehensionBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Comprehension where liftEq = genericLiftEq
 instance Ord1 Comprehension where liftCompare = genericLiftCompare
 instance Show1 Comprehension where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Comprehension
-
 -- TODO: Implement Eval instance for Comprehension
 instance Evaluatable Comprehension
 
 
 -- | A declared type (e.g. `a []int` in Go).
 data Type a = Type { typeName :: !a, typeKind :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Type where liftEq = genericLiftEq
 instance Ord1 Type where liftCompare = genericLiftCompare
 instance Show1 Type where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Type
-
 -- TODO: Implement Eval instance for Type
 instance Evaluatable Type
 
 
 -- | Type alias declarations in Javascript/Haskell, etc.
 data TypeAlias a = TypeAlias { typeAliasContext :: ![a], typeAliasIdentifier :: !a, typeAliasKind :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypeAlias where liftEq = genericLiftEq
 instance Ord1 TypeAlias where liftCompare = genericLiftCompare
 instance Show1 TypeAlias where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 TypeAlias
-
 -- TODO: Implement Eval instance for TypeAlias
 instance Evaluatable TypeAlias where
   eval TypeAlias{..} = do

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
@@ -11,27 +11,23 @@ import           Prologue
 
 -- A file directive like the Ruby constant `__FILE__`.
 data File a = File
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 File where liftEq = genericLiftEq
 instance Ord1 File where liftCompare = genericLiftCompare
 instance Show1 File where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 File
-
 instance Evaluatable File where
-  eval File = rvalBox =<< (string . BC.pack . modulePath <$> currentModule)
+  eval File = rvalBox =<< (string . T.pack . modulePath <$> currentModule)
 
 
 -- A line directive like the Ruby constant `__LINE__`.
 data Line a = Line
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Line where liftEq = genericLiftEq
 instance Ord1 Line where liftCompare = genericLiftCompare
 instance Show1 Line where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Line
-
 instance Evaluatable Line where
   eval Line = rvalBox =<< (integer . fromIntegral . posLine . spanStart <$> currentSpan)

src/Data/Syntax/Expression.hs

@@ -10,14 +10,12 @@ import Prologue hiding (index)
 
 -- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell.
 data Call a = Call { callContext :: ![a], callFunction :: !a, callParams :: ![a], callBlock :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Call where liftEq = genericLiftEq
 instance Ord1 Call where liftCompare = genericLiftCompare
 instance Show1 Call where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Call
-
 instance Evaluatable Call where
   eval Call{..} = do
     op <- subtermValue callFunction
@@ -31,14 +29,12 @@ data Comparison a
   | Equal !a !a
   | StrictEqual !a !a
   | Comparison !a !a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Comparison where liftEq = genericLiftEq
 instance Ord1 Comparison where liftCompare = genericLiftCompare
 instance Show1 Comparison where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Comparison
-
 instance Evaluatable Comparison where
   eval t = rvalBox =<< (traverse subtermValue t >>= go) where
     go x = case x of
@@ -62,14 +58,12 @@ data Arithmetic a
   | Modulo !a !a
   | Power !a !a
   | Negate !a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Arithmetic where liftEq = genericLiftEq
 instance Ord1 Arithmetic where liftCompare = genericLiftCompare
 instance Show1 Arithmetic where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Arithmetic
-
 instance Evaluatable Arithmetic where
   eval t = rvalBox =<< (traverse subtermValue t >>= go) where
     go (Plus a b)          = liftNumeric2 add a b  where add    = liftReal (+)
@@ -85,14 +79,12 @@ instance Evaluatable Arithmetic where
 data Match a
   = Matches !a !a
   | NotMatches !a !a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Match where liftEq = genericLiftEq
 instance Ord1 Match where liftCompare = genericLiftCompare
 instance Show1 Match where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Match
-
 -- TODO: Implement Eval instance for Match
 instance Evaluatable Match
 
@@ -102,14 +94,12 @@ data Boolean a
   | And !a !a
   | Not !a
   | XOr !a !a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Boolean where liftEq = genericLiftEq
 instance Ord1 Boolean where liftCompare = genericLiftCompare
 instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Boolean
-
 instance Evaluatable Boolean where
   -- N.B. we have to use Monad rather than Applicative/Traversable on 'And' and 'Or' so that we don't evaluate both operands
   eval t = rvalBox =<< go (fmap subtermValue t) where
@@ -124,56 +114,48 @@ instance Evaluatable Boolean where
 
 -- | Javascript delete operator
 newtype Delete a = Delete a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Delete where liftEq = genericLiftEq
 instance Ord1 Delete where liftCompare = genericLiftCompare
 instance Show1 Delete where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Delete
-
 -- TODO: Implement Eval instance for Delete
 instance Evaluatable Delete
 
 
 -- | A sequence expression such as Javascript or C's comma operator.
 data SequenceExpression a = SequenceExpression { _firstExpression :: !a, _secondExpression :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 SequenceExpression where liftEq = genericLiftEq
 instance Ord1 SequenceExpression where liftCompare = genericLiftCompare
 instance Show1 SequenceExpression where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 SequenceExpression
-
 -- TODO: Implement Eval instance for SequenceExpression
 instance Evaluatable SequenceExpression
 
 
 -- | Javascript void operator
 newtype Void a = Void a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Void where liftEq = genericLiftEq
 instance Ord1 Void where liftCompare = genericLiftCompare
 instance Show1 Void where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Void
-
 -- TODO: Implement Eval instance for Void
 instance Evaluatable Void
 
 
 -- | Javascript typeof operator
 newtype Typeof a = Typeof a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Typeof where liftEq = genericLiftEq
 instance Ord1 Typeof where liftCompare = genericLiftCompare
 instance Show1 Typeof where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Typeof
-
 -- TODO: Implement Eval instance for Typeof
 instance Evaluatable Typeof
 
@@ -187,14 +169,12 @@ data Bitwise a
   | RShift !a !a
   | UnsignedRShift !a !a
   | Complement a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Bitwise where liftEq = genericLiftEq
 instance Ord1 Bitwise where liftCompare = genericLiftCompare
 instance Show1 Bitwise where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Bitwise
-
 instance Evaluatable Bitwise where
   eval t = rvalBox =<< (traverse subtermValue t >>= go) where
     genLShift x y = shiftL x (fromIntegral y)
@@ -210,35 +190,28 @@ instance Evaluatable Bitwise where
 
 -- | Member Access (e.g. a.b)
 data MemberAccess a
-  = MemberAccess !a !a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  = MemberAccess !a !Name
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 MemberAccess where liftEq = genericLiftEq
 instance Ord1 MemberAccess where liftCompare = genericLiftCompare
 instance Show1 MemberAccess where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 MemberAccess
-
 instance Evaluatable MemberAccess where
-  eval (MemberAccess obj prop) = do
-    obj <- subtermAddress obj
-    prop <- subtermRef prop
-    case prop of
-      LvalLocal propName -> pure (LvalMember obj propName)
-      _ -> raiseEff (Prologue.fail "Non-Identifier as right hand side of MemberAccess!")
+  eval (MemberAccess obj propName) = do
+    ptr <- subtermAddress obj
+    pure $! LvalMember ptr propName
 
 -- | Subscript (e.g a[1])
 data Subscript a
   = Subscript !a ![a]
   | Member !a !a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Subscript where liftEq = genericLiftEq
 instance Ord1 Subscript where liftCompare = genericLiftCompare
 instance Show1 Subscript where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Subscript
-
 -- TODO: Finish Eval instance for Subscript
 -- TODO return a special LvalSubscript instance here
 instance Evaluatable Subscript where
@@ -249,97 +222,83 @@ instance Evaluatable Subscript where
 
 -- | Enumeration (e.g. a[1:10:1] in Python (start at index 1, stop at index 10, step 1 element from start to stop))
 data Enumeration a = Enumeration { enumerationStart :: !a, enumerationEnd :: !a, enumerationStep :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Enumeration where liftEq = genericLiftEq
 instance Ord1 Enumeration where liftCompare = genericLiftCompare
 instance Show1 Enumeration where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Enumeration
-
 -- TODO: Implement Eval instance for Enumeration
 instance Evaluatable Enumeration
 
 
 -- | InstanceOf (e.g. a instanceof b in JavaScript
 data InstanceOf a = InstanceOf { instanceOfSubject :: !a, instanceOfObject :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 InstanceOf where liftEq = genericLiftEq
 instance Ord1 InstanceOf where liftCompare = genericLiftCompare
 instance Show1 InstanceOf where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 InstanceOf
-
 -- TODO: Implement Eval instance for InstanceOf
 instance Evaluatable InstanceOf
 
 
 -- | ScopeResolution (e.g. import a.b in Python or a::b in C++)
 newtype ScopeResolution a = ScopeResolution [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ScopeResolution where liftEq = genericLiftEq
 instance Ord1 ScopeResolution where liftCompare = genericLiftCompare
 instance Show1 ScopeResolution where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 ScopeResolution
-
 -- TODO: Implement Eval instance for ScopeResolution
 instance Evaluatable ScopeResolution
 
 
 -- | A non-null expression such as Typescript or Swift's ! expression.
 newtype NonNullExpression a = NonNullExpression { nonNullExpression :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 NonNullExpression where liftEq = genericLiftEq
 instance Ord1 NonNullExpression where liftCompare = genericLiftCompare
 instance Show1 NonNullExpression where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 NonNullExpression
-
 -- TODO: Implement Eval instance for NonNullExpression
 instance Evaluatable NonNullExpression
 
 
 -- | An await expression in Javascript or C#.
 newtype Await a = Await { awaitSubject :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Await where liftEq = genericLiftEq
 instance Ord1 Await where liftCompare = genericLiftCompare
 instance Show1 Await where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Await
-
 -- TODO: Implement Eval instance for Await
 instance Evaluatable Await
 
 
 -- | An object constructor call in Javascript, Java, etc.
 newtype New a = New { newSubject :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 New where liftEq = genericLiftEq
 instance Ord1 New where liftCompare = genericLiftCompare
 instance Show1 New where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 New
-
 -- TODO: Implement Eval instance for New
 instance Evaluatable New
 
 -- | A cast expression to a specified type.
 data Cast a =  Cast { castSubject :: !a, castType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Cast where liftEq = genericLiftEq
 instance Ord1 Cast where liftCompare = genericLiftCompare
 instance Show1 Cast where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Cast
-
 -- TODO: Implement Eval instance for Cast
 instance Evaluatable Cast
 

src/Data/Syntax/Literal.hs

@@ -2,10 +2,9 @@
 module Data.Syntax.Literal where
 
 import           Data.Abstract.Evaluatable
-import           Data.ByteString.Char8 (readInteger, unpack)
-import qualified Data.ByteString.Char8 as B
 import           Data.JSON.Fields
 import           Data.Scientific.Exts
+import qualified Data.Text as T
 import           Diffing.Algorithm
 import           Prelude hiding (Float, null)
 import           Prologue hiding (Set, hash, null)
@@ -15,7 +14,7 @@ import           Text.Read (readMaybe)
 -- Boolean
 
 newtype Boolean a = Boolean { booleanContent :: Bool }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named1, Message1)
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1)
 
 true :: Boolean a
 true = Boolean True
@@ -30,33 +29,25 @@ instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Boolean where
   eval (Boolean x) = rvalBox (boolean x)
 
-instance ToJSONFields1 Boolean where
-  toJSONFields1 (Boolean b) = noChildren [ "value" .= b ]
-
 -- Numeric
 
 -- | A literal integer of unspecified width. No particular base is implied.
-newtype Integer a = Integer { integerContent :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+newtype Integer a = Integer { integerContent :: Text }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Data.Syntax.Literal.Integer where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Literal.Integer where liftCompare = genericLiftCompare
 instance Show1 Data.Syntax.Literal.Integer where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Data.Syntax.Literal.Integer where
-  -- TODO: This instance probably shouldn't have readInteger?
+  -- TODO: We should use something more robust than shelling out to readMaybe.
   eval (Data.Syntax.Literal.Integer x) =
-    rvalBox =<< (integer <$> maybeM (throwEvalError (IntegerFormatError x)) (fst <$> readInteger x))
-
-instance ToJSONFields1 Data.Syntax.Literal.Integer where
-  toJSONFields1 (Integer i) = noChildren ["asString" .= unpack i]
-
--- TODO: Should IntegerLiteral hold an Integer instead of a ByteString?
--- TODO: Consider a Numeric datatype with FloatingPoint/Integral/etc constructors.
+    rvalBox =<< integer <$> maybeM (throwEvalError (IntegerFormatError x)) (readMaybe (T.unpack x))
 
 -- | A literal float of unspecified width.
-newtype Float a = Float { floatContent  :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named1, Message1)
+
+newtype Float a = Float { floatContent :: Text }
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1)
 
 instance Eq1 Data.Syntax.Literal.Float where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Literal.Float where liftCompare = genericLiftCompare
@@ -66,12 +57,9 @@ instance Evaluatable Data.Syntax.Literal.Float where
   eval (Float s) =
     rvalBox =<< (float <$> either (const (throwEvalError (FloatFormatError s))) pure (parseScientific s))
 
-instance ToJSONFields1 Float where
-  toJSONFields1 (Float f) = noChildren ["asString" .= unpack f]
-
 -- Rational literals e.g. `2/3r`
-newtype Rational a = Rational ByteString
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+newtype Rational a = Rational Text
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Data.Syntax.Literal.Rational where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Literal.Rational where liftCompare = genericLiftCompare
@@ -80,16 +68,13 @@ 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
-      parsed = readMaybe @Prelude.Integer (unpack trimmed)
+      trimmed = T.takeWhile (/= 'r') r
+      parsed = readMaybe @Prelude.Integer (T.unpack trimmed)
     in rvalBox =<< (rational <$> maybe (throwEvalError (RationalFormatError r)) (pure . toRational) parsed)
 
-instance ToJSONFields1 Data.Syntax.Literal.Rational where
-  toJSONFields1 (Rational r) = noChildren ["asString" .= unpack r]
-
 -- Complex literals e.g. `3 + 2i`
-newtype Complex a = Complex ByteString
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+newtype Complex a = Complex Text
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, ToJSONFields1)
 
 instance Eq1 Data.Syntax.Literal.Complex where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Literal.Complex where liftCompare = genericLiftCompare
@@ -98,13 +83,10 @@ instance Show1 Data.Syntax.Literal.Complex where liftShowsPrec = genericLiftShow
 -- TODO: Implement Eval instance for Complex
 instance Evaluatable Complex
 
-instance ToJSONFields1 Complex where
-  toJSONFields1 (Complex c) = noChildren ["asString" .= unpack c]
-
 -- Strings, symbols
 
 newtype String a = String { stringElements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Data.Syntax.Literal.String where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Literal.String where liftCompare = genericLiftCompare
@@ -115,10 +97,8 @@ instance Show1 Data.Syntax.Literal.String where liftShowsPrec = genericLiftShows
 -- TODO: Implement Eval instance for String
 instance Evaluatable Data.Syntax.Literal.String
 
-instance ToJSONFields1 Data.Syntax.Literal.String
-
-newtype Character a = Character { characterContent :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+newtype Character a = Character { characterContent :: Text }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Data.Syntax.Literal.Character where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Literal.Character where liftCompare = genericLiftCompare
@@ -126,11 +106,9 @@ instance Show1 Data.Syntax.Literal.Character where liftShowsPrec = genericLiftSh
 
 instance Evaluatable Data.Syntax.Literal.Character
 
-instance ToJSONFields1 Data.Syntax.Literal.Character
-
 -- | An interpolation element within a string literal.
 newtype InterpolationElement a = InterpolationElement { interpolationBody :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 InterpolationElement where liftEq = genericLiftEq
 instance Ord1 InterpolationElement where liftCompare = genericLiftCompare
@@ -139,24 +117,19 @@ instance Show1 InterpolationElement where liftShowsPrec = genericLiftShowsPrec
 -- TODO: Implement Eval instance for InterpolationElement
 instance Evaluatable InterpolationElement
 
-instance ToJSONFields1 InterpolationElement
-
 -- | A sequence of textual contents within a string literal.
-newtype TextElement a = TextElement { textElementContent :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named1, Message1)
+newtype TextElement a = TextElement { textElementContent :: Text }
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1)
 
 instance Eq1 TextElement where liftEq = genericLiftEq
 instance Ord1 TextElement where liftCompare = genericLiftCompare
 instance Show1 TextElement where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 TextElement where
-  toJSONFields1 (TextElement c) = noChildren ["asString" .= unpack c]
-
 instance Evaluatable TextElement where
   eval (TextElement x) = rvalBox (string x)
 
 data Null a = Null
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named1, Message1)
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1)
 
 instance Eq1 Null where liftEq = genericLiftEq
 instance Ord1 Null where liftCompare = genericLiftCompare
@@ -164,22 +137,18 @@ instance Show1 Null where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Null where eval _ = rvalBox null
 
-instance ToJSONFields1 Null
-
-newtype Symbol a = Symbol { symbolContent :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+newtype Symbol a = Symbol { symbolContent :: Text }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Symbol where liftEq = genericLiftEq
 instance Ord1 Symbol where liftCompare = genericLiftCompare
 instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Symbol
-
 instance Evaluatable Symbol where
   eval (Symbol s) = rvalBox (symbol s)
 
-newtype Regex a = Regex { regexContent :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+newtype Regex a = Regex { regexContent :: Text }
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, ToJSONFields1)
 
 instance Eq1 Regex where liftEq = genericLiftEq
 instance Ord1 Regex where liftCompare = genericLiftCompare
@@ -187,57 +156,44 @@ instance Show1 Regex where liftShowsPrec = genericLiftShowsPrec
 
 -- TODO: Heredoc-style string literals?
 
-instance ToJSONFields1 Regex where
-  toJSONFields1 (Regex r) = noChildren ["asString" .= unpack r]
-
-
 -- TODO: Implement Eval instance for Regex
 instance Evaluatable Regex
 
-
 -- Collections
 
 newtype Array a = Array { arrayElements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named1, Message1)
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1)
 
 instance Eq1 Array where liftEq = genericLiftEq
 instance Ord1 Array where liftCompare = genericLiftCompare
 instance Show1 Array where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Array
-
 instance Evaluatable Array where
   eval (Array a) = rvalBox =<< (array =<< traverse subtermValue a)
 
 newtype Hash a = Hash { hashElements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named1, Message1)
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1)
 
 instance Eq1 Hash where liftEq = genericLiftEq
 instance Ord1 Hash where liftCompare = genericLiftCompare
 instance Show1 Hash where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Hash
-
 instance Evaluatable Hash where
   eval t = rvalBox =<< (hash <$> traverse (subtermValue >=> asPair) (hashElements t))
 
 data KeyValue a = KeyValue { key :: !a, value :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named1, Message1)
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1)
 
 instance Eq1 KeyValue where liftEq = genericLiftEq
 instance Ord1 KeyValue where liftCompare = genericLiftCompare
 instance Show1 KeyValue where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 KeyValue
-
 instance Evaluatable KeyValue where
   eval (fmap subtermValue -> KeyValue{..}) =
     rvalBox =<< (kvPair <$> key <*> value)
 
-instance ToJSONFields1 Tuple
-
 newtype Tuple a = Tuple { tupleContents :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Tuple where liftEq = genericLiftEq
 instance Ord1 Tuple where liftCompare = genericLiftCompare
@@ -247,14 +203,12 @@ instance Evaluatable Tuple where
   eval (Tuple cs) = rvalBox =<< (multiple <$> traverse subtermValue cs)
 
 newtype Set a = Set { setElements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Set where liftEq = genericLiftEq
 instance Ord1 Set where liftCompare = genericLiftCompare
 instance Show1 Set where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Set
-
 -- TODO: Implement Eval instance for Set
 instance Evaluatable Set
 
@@ -263,28 +217,24 @@ instance Evaluatable Set
 
 -- | A declared pointer (e.g. var pointer *int in Go)
 newtype Pointer a = Pointer a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Pointer where liftEq = genericLiftEq
 instance Ord1 Pointer where liftCompare = genericLiftCompare
 instance Show1 Pointer where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Pointer
-
 -- TODO: Implement Eval instance for Pointer
 instance Evaluatable Pointer
 
 
 -- | A reference to a pointer's address (e.g. &pointer in Go)
 newtype Reference a = Reference a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Reference where liftEq = genericLiftEq
 instance Ord1 Reference where liftCompare = genericLiftCompare
 instance Show1 Reference where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Reference
-
 -- TODO: Implement Eval instance for Reference
 instance Evaluatable Reference
 

src/Data/Syntax/Statement.hs

@@ -2,22 +2,38 @@
 module Data.Syntax.Statement where
 
 import Data.Abstract.Evaluatable
-import Data.ByteString.Char8 (unpack)
+import Data.Aeson (ToJSON1 (..))
 import Data.JSON.Fields
+import Data.Semigroup.App
+import Data.Semigroup.Foldable
 import Diffing.Algorithm
 import Prelude
 import Prologue
 
+-- | Imperative sequence of statements/declarations s.t.:
+--
+--   1. Each statement’s effects on the store are accumulated;
+--   2. Each statement can affect the environment of later statements (e.g. by 'modify'-ing the environment); and
+--   3. Only the last statement’s return value is returned.
+newtype Statements a = Statements [a]
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, ToJSONFields1)
+
+instance Eq1 Statements where liftEq = genericLiftEq
+instance Ord1 Statements where liftCompare = genericLiftCompare
+instance Show1 Statements where liftShowsPrec = genericLiftShowsPrec
+instance ToJSON1 Statements
+
+instance Evaluatable Statements where
+  eval (Statements xs) = maybe (pure (Rval unit)) (runApp . foldMap1 (App . subtermRef)) (nonEmpty xs)
+
 -- | Conditional. This must have an else block, which can be filled with some default value when omitted in the source, e.g. 'pure ()' for C-style if-without-else or 'pure Nothing' for Ruby-style, in both cases assuming some appropriate Applicative context into which the If will be lifted.
 data If a = If { ifCondition :: !a, ifThenBody :: !a, ifElseBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 If where liftEq = genericLiftEq
 instance Ord1 If where liftCompare = genericLiftCompare
 instance Show1 If where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 If
-
 instance Evaluatable If where
   eval (If cond if' else') = do
     bool <- subtermValue cond
@@ -25,14 +41,12 @@ instance Evaluatable If where
 
 -- | Else statement. The else condition is any term, that upon successful completion, continues evaluation to the elseBody, e.g. `for ... else` in Python.
 data Else a = Else { elseCondition :: !a, elseBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Else where liftEq = genericLiftEq
 instance Ord1 Else where liftCompare = genericLiftCompare
 instance Show1 Else where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Else
-
 -- TODO: Implement Eval instance for Else
 instance Evaluatable Else
 
@@ -40,56 +54,48 @@ instance Evaluatable Else
 
 -- | Goto statement (e.g. `goto a` in Go).
 newtype Goto a = Goto { gotoLocation :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Goto where liftEq = genericLiftEq
 instance Ord1 Goto where liftCompare = genericLiftCompare
 instance Show1 Goto where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Goto
-
 -- TODO: Implement Eval instance for Goto
 instance Evaluatable Goto
 
 
 -- | A pattern-matching or computed jump control-flow statement, like 'switch' in C or JavaScript, or 'case' in Ruby or Haskell.
 data Match a = Match { matchSubject :: !a, matchPatterns :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Match where liftEq = genericLiftEq
 instance Ord1 Match where liftCompare = genericLiftCompare
 instance Show1 Match where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Match
-
 -- TODO: Implement Eval instance for Match
 instance Evaluatable Match
 
 
 -- | A pattern in a pattern-matching or computed jump control-flow statement, like 'case' in C or JavaScript, 'when' in Ruby, or the left-hand side of '->' in the body of Haskell 'case' expressions.
 data Pattern a = Pattern { _pattern :: !a, patternBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Pattern where liftEq = genericLiftEq
 instance Ord1 Pattern where liftCompare = genericLiftCompare
 instance Show1 Pattern where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Pattern
-
 -- TODO: Implement Eval instance for Pattern
 instance Evaluatable Pattern
 
 
 -- | A let statement or local binding, like 'a as b' or 'let a = b'.
 data Let a  = Let { letVariable :: !a, letValue :: !a, letBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Let where liftEq = genericLiftEq
 instance Ord1 Let where liftCompare = genericLiftCompare
 instance Show1 Let where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Let
-
 instance Evaluatable Let where
   eval Let{..} = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm letVariable)
@@ -101,14 +107,12 @@ instance Evaluatable Let where
 
 -- | Assignment to a variable or other lvalue.
 data Assignment a = Assignment { assignmentContext :: ![a], assignmentTarget :: !a, assignmentValue :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Assignment where liftEq = genericLiftEq
 instance Ord1 Assignment where liftCompare = genericLiftCompare
 instance Show1 Assignment where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Assignment
-
 instance Evaluatable Assignment where
   eval Assignment{..} = do
     lhs <- subtermRef assignmentTarget
@@ -130,28 +134,24 @@ instance Evaluatable Assignment where
 
 -- | Post increment operator (e.g. 1++ in Go, or i++ in C).
 newtype PostIncrement a = PostIncrement a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 PostIncrement where liftEq = genericLiftEq
 instance Ord1 PostIncrement where liftCompare = genericLiftCompare
 instance Show1 PostIncrement where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 PostIncrement
-
 -- TODO: Implement Eval instance for PostIncrement
 instance Evaluatable PostIncrement
 
 
 -- | Post decrement operator (e.g. 1-- in Go, or i-- in C).
 newtype PostDecrement a = PostDecrement a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 PostDecrement where liftEq = genericLiftEq
 instance Ord1 PostDecrement where liftCompare = genericLiftCompare
 instance Show1 PostDecrement where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 PostDecrement
-
 -- TODO: Implement Eval instance for PostDecrement
 instance Evaluatable PostDecrement
 
@@ -182,181 +182,153 @@ instance Evaluatable PreDecrement
 -- Returns
 
 newtype Return a = Return a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Return where liftEq = genericLiftEq
 instance Ord1 Return where liftCompare = genericLiftCompare
 instance Show1 Return where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Return
-
 instance Evaluatable Return where
   eval (Return x) = Rval <$> (subtermAddress x >>= earlyReturn)
 
 newtype Yield a = Yield a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Yield where liftEq = genericLiftEq
 instance Ord1 Yield where liftCompare = genericLiftCompare
 instance Show1 Yield where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Yield
-
 -- TODO: Implement Eval instance for Yield
 instance Evaluatable Yield
 
 
 newtype Break a = Break a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Break where liftEq = genericLiftEq
 instance Ord1 Break where liftCompare = genericLiftCompare
 instance Show1 Break where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Break
-
 instance Evaluatable Break where
   eval (Break x) = Rval <$> (subtermAddress x >>= throwBreak)
 
 newtype Continue a = Continue a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Continue where liftEq = genericLiftEq
 instance Ord1 Continue where liftCompare = genericLiftCompare
 instance Show1 Continue where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Continue
-
 instance Evaluatable Continue where
   eval (Continue x) = Rval <$> (subtermAddress x >>= throwContinue)
 
 newtype Retry a = Retry a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Retry where liftEq = genericLiftEq
 instance Ord1 Retry where liftCompare = genericLiftCompare
 instance Show1 Retry where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Retry
-
 -- TODO: Implement Eval instance for Retry
 instance Evaluatable Retry
 
 
 newtype NoOp a = NoOp a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 NoOp where liftEq = genericLiftEq
 instance Ord1 NoOp where liftCompare = genericLiftCompare
 instance Show1 NoOp where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 NoOp
-
 instance Evaluatable NoOp where
   eval _ = rvalBox unit
 
 -- Loops
 
 data For a = For { forBefore :: !a, forCondition :: !a, forStep :: !a, forBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 For where liftEq = genericLiftEq
 instance Ord1 For where liftCompare = genericLiftCompare
 instance Show1 For where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 For
-
 instance Evaluatable For where
   eval (fmap subtermValue -> For before cond step body) = rvalBox =<< forLoop before cond step body
 
 
 data ForEach a = ForEach { forEachBinding :: !a, forEachSubject :: !a, forEachBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ForEach where liftEq = genericLiftEq
 instance Ord1 ForEach where liftCompare = genericLiftCompare
 instance Show1 ForEach where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 ForEach
-
 -- TODO: Implement Eval instance for ForEach
 instance Evaluatable ForEach
 
 
 data While a = While { whileCondition :: !a, whileBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 While where liftEq = genericLiftEq
 instance Ord1 While where liftCompare = genericLiftCompare
 instance Show1 While where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 While
-
 instance Evaluatable While where
   eval While{..} = rvalBox =<< while (subtermValue whileCondition) (subtermValue whileBody)
 
 data DoWhile a = DoWhile { doWhileCondition :: !a, doWhileBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 DoWhile where liftEq = genericLiftEq
 instance Ord1 DoWhile where liftCompare = genericLiftCompare
 instance Show1 DoWhile where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 DoWhile
-
 instance Evaluatable DoWhile where
   eval DoWhile{..} = rvalBox =<< doWhile (subtermValue doWhileBody) (subtermValue doWhileCondition)
 
 -- Exception handling
 
 newtype Throw a = Throw a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Throw where liftEq = genericLiftEq
 instance Ord1 Throw where liftCompare = genericLiftCompare
 instance Show1 Throw where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Throw
-
 -- TODO: Implement Eval instance for Throw
 instance Evaluatable Throw
 
 
 data Try a = Try { tryBody :: !a, tryCatch :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Try where liftEq = genericLiftEq
 instance Ord1 Try where liftCompare = genericLiftCompare
 instance Show1 Try where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Try
-
 -- TODO: Implement Eval instance for Try
 instance Evaluatable Try
 
 
 data Catch a = Catch { catchException :: !a, catchBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Catch where liftEq = genericLiftEq
 instance Ord1 Catch where liftCompare = genericLiftCompare
 instance Show1 Catch where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Catch
-
 -- TODO: Implement Eval instance for Catch
 instance Evaluatable Catch
 
 
 newtype Finally a = Finally a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Finally where liftEq = genericLiftEq
 instance Ord1 Finally where liftCompare = genericLiftCompare
 instance Show1 Finally where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Finally
-
 -- TODO: Implement Eval instance for Finally
 instance Evaluatable Finally
 
@@ -365,41 +337,23 @@ instance Evaluatable Finally
 
 -- | ScopeEntry (e.g. `BEGIN {}` block in Ruby or Perl).
 newtype ScopeEntry a = ScopeEntry [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ScopeEntry where liftEq = genericLiftEq
 instance Ord1 ScopeEntry where liftCompare = genericLiftCompare
 instance Show1 ScopeEntry where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 ScopeEntry
-
 -- TODO: Implement Eval instance for ScopeEntry
 instance Evaluatable ScopeEntry
 
 
 -- | ScopeExit (e.g. `END {}` block in Ruby or Perl).
 newtype ScopeExit a = ScopeExit [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ScopeExit where liftEq = genericLiftEq
 instance Ord1 ScopeExit where liftCompare = genericLiftCompare
 instance Show1 ScopeExit where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 ScopeExit
-
 -- TODO: Implement Eval instance for ScopeExit
 instance Evaluatable ScopeExit
-
--- | HashBang line (e.g. `#!/usr/bin/env node`)
-newtype HashBang a = HashBang ByteString
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance Eq1 HashBang where liftEq = genericLiftEq
-instance Ord1 HashBang where liftCompare = genericLiftCompare
-instance Show1 HashBang where liftShowsPrec = genericLiftShowsPrec
-
-instance ToJSONFields1 HashBang where
-  toJSONFields1 (HashBang f) = noChildren [ "contents" .= unpack f ]
-
--- TODO: Implement Eval instance for HashBang
-instance Evaluatable HashBang

src/Data/Syntax/Type.hs

@@ -8,146 +8,124 @@ import Prelude hiding (Int, Float, Bool)
 import Prologue hiding (Map)
 
 data Array a = Array { arraySize :: !(Maybe a), arrayElementType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Array where liftEq = genericLiftEq
 instance Ord1 Array where liftCompare = genericLiftCompare
 instance Show1 Array where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Array
-
 -- TODO: Implement Eval instance for Array
 instance Evaluatable Array
 
 
 -- TODO: What about type variables? re: FreeVariables1
 data Annotation a = Annotation { annotationSubject :: !a, annotationType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Annotation where liftEq = genericLiftEq
 instance Ord1 Annotation where liftCompare = genericLiftCompare
 instance Show1 Annotation where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Annotation where
-
 -- TODO: Specialize Evaluatable for Type to unify the inferred type of the subject with the specified type
 instance Evaluatable Annotation where
   eval Annotation{annotationSubject = Subterm _ action} = action
 
 
 data Function a = Function { functionParameters :: ![a], functionReturn :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Function where liftEq = genericLiftEq
 instance Ord1 Function where liftCompare = genericLiftCompare
 instance Show1 Function where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Function
-
 -- TODO: Implement Eval instance for Function
 instance Evaluatable Function
 
 
 newtype Interface a = Interface [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Interface where liftEq = genericLiftEq
 instance Ord1 Interface where liftCompare = genericLiftCompare
 instance Show1 Interface where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Interface
-
 -- TODO: Implement Eval instance for Interface
 instance Evaluatable Interface
 
 
 data Map a = Map { mapKeyType :: !a, mapElementType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Map where liftEq = genericLiftEq
 instance Ord1 Map where liftCompare = genericLiftCompare
 instance Show1 Map where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Map
-
 -- TODO: Implement Eval instance for Map
 instance Evaluatable Map
 
 
 newtype Parenthesized a = Parenthesized a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Parenthesized where liftEq = genericLiftEq
 instance Ord1 Parenthesized where liftCompare = genericLiftCompare
 instance Show1 Parenthesized where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Parenthesized
-
 -- TODO: Implement Eval instance for Parenthesized
 instance Evaluatable Parenthesized
 
 
 newtype Pointer a = Pointer a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Pointer where liftEq = genericLiftEq
 instance Ord1 Pointer where liftCompare = genericLiftCompare
 instance Show1 Pointer where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Pointer
-
 -- TODO: Implement Eval instance for Pointer
 instance Evaluatable Pointer
 
 
 newtype Product a = Product [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Product where liftEq = genericLiftEq
 instance Ord1 Product where liftCompare = genericLiftCompare
 instance Show1 Product where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Product
-
 -- TODO: Implement Eval instance for Product
 instance Evaluatable Product
 
 
 data Readonly a = Readonly
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Readonly where liftEq = genericLiftEq
 instance Ord1 Readonly where liftCompare = genericLiftCompare
 instance Show1 Readonly where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Readonly
-
 -- TODO: Implement Eval instance for Readonly
 instance Evaluatable Readonly
 
 
 newtype Slice a = Slice a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Slice where liftEq = genericLiftEq
 instance Ord1 Slice where liftCompare = genericLiftCompare
 instance Show1 Slice where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Slice
-
 -- TODO: Implement Eval instance for Slice
 instance Evaluatable Slice
 
 
 newtype TypeParameters a = TypeParameters [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypeParameters where liftEq = genericLiftEq
 instance Ord1 TypeParameters where liftCompare = genericLiftCompare
 instance Show1 TypeParameters where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 TypeParameters
-
 -- TODO: Implement Eval instance for TypeParameters
 instance Evaluatable TypeParameters
 

src/Language/Go/Assignment.hs

@@ -7,7 +7,7 @@ module Language.Go.Assignment
 ) where
 
 import Assigning.Assignment hiding (Assignment, Error)
-import Data.Abstract.Name (name)
+import Data.Abstract.Name (Name, name)
 import Data.Record
 import Data.Syntax (contextualize, emptyTerm, parseError, handleError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1)
 import Language.Go.Grammar as Grammar
@@ -86,11 +86,11 @@ type Syntax =
    , Statement.NoOp
    , Statement.Pattern
    , Statement.Return
+   , Statement.Statements
    , Syntax.Context
    , Syntax.Error
    , Syntax.Empty
    , Syntax.Identifier
-   , Syntax.Program
    , Type.Annotation
    , Type.Array
    , Type.Function
@@ -111,7 +111,7 @@ assignment :: Assignment
 assignment = handleError program <|> parseError
 
 program :: Assignment
-program = makeTerm <$> symbol SourceFile <*> children (Syntax.Program <$> manyTerm expression)
+program = makeTerm <$> symbol SourceFile <*> children (Statement.Statements <$> manyTerm expression)
 
 expression :: Assignment
 expression = term (handleError (choice expressionChoices))
@@ -227,12 +227,18 @@ element = symbol Element *> children expression
 fieldIdentifier :: Assignment
 fieldIdentifier = makeTerm <$> symbol FieldIdentifier <*> (Syntax.Identifier . name <$> source)
 
+fieldIdentifier' :: Assignment.Assignment [] Grammar Name
+fieldIdentifier' = symbol FieldIdentifier *> (name <$> source)
+
 floatLiteral :: Assignment
 floatLiteral = makeTerm <$> symbol FloatLiteral <*> (Literal.Float <$> source)
 
 identifier :: Assignment
 identifier =  makeTerm <$> (symbol Identifier <|> symbol Identifier') <*> (Syntax.Identifier . name <$> source)
 
+identifier' :: Assignment.Assignment [] Grammar Name
+identifier' =  (symbol Identifier <|> symbol Identifier') *> (name <$> source)
+
 imaginaryLiteral :: Assignment
 imaginaryLiteral = makeTerm <$> symbol ImaginaryLiteral <*> (Literal.Complex <$> source)
 
@@ -260,6 +266,9 @@ runeLiteral = makeTerm <$> symbol Grammar.RuneLiteral <*> (Go.Syntax.Rune <$> so
 typeIdentifier :: Assignment
 typeIdentifier = makeTerm <$> symbol TypeIdentifier <*> (Syntax.Identifier . name <$> source)
 
+typeIdentifier' :: Assignment.Assignment [] Grammar Name
+typeIdentifier' = symbol TypeIdentifier *> (name <$> source)
+
 
 -- Primitive Types
 
@@ -301,13 +310,13 @@ pointerType :: Assignment
 pointerType = makeTerm <$> symbol PointerType <*> children (Type.Pointer <$> expression)
 
 qualifiedType :: Assignment
-qualifiedType = makeTerm <$> symbol QualifiedType <*> children (Expression.MemberAccess <$> expression <*> expression)
+qualifiedType = makeTerm <$> symbol QualifiedType <*> children (Expression.MemberAccess <$> expression <*> (identifier' <|> typeIdentifier'))
 
 sliceType :: Assignment
 sliceType = makeTerm <$> symbol SliceType <*> children (Type.Slice <$> expression)
 
 structType :: Assignment
-structType = makeTerm <$> symbol StructType <*> children (Declaration.Constructor <$> emptyTerm <*> expressions)
+structType = makeTerm <$> symbol StructType <*> children (Declaration.Constructor <$> emptyTerm <*> emptyTerm <*> expressions)
 
 typeAlias :: Assignment
 typeAlias = makeTerm <$> symbol TypeAlias <*> children (Declaration.TypeAlias [] <$> expression <*> expression)
@@ -355,7 +364,7 @@ defaultCase :: Assignment
 defaultCase = makeTerm <$> symbol DefaultCase <*> children (Go.Syntax.DefaultPattern <$> (expressions <|> emptyTerm))
 
 defaultExpressionCase :: Assignment
-defaultExpressionCase = makeTerm <$> symbol DefaultCase <*> (Go.Syntax.DefaultPattern <$ source <*> (expressions <|> emptyTerm))
+defaultExpressionCase = makeTerm <$> symbol DefaultCase <*> (Go.Syntax.DefaultPattern <$ rawSource <*> (expressions <|> emptyTerm))
 
 callExpression :: Assignment
 callExpression = makeTerm <$> symbol CallExpression <*> children (Expression.Call <$> pure [] <*> expression <*> manyTerm expression <*> emptyTerm)
@@ -432,7 +441,7 @@ parenthesizedExpression :: Assignment
 parenthesizedExpression = symbol ParenthesizedExpression *> children expressions
 
 selectorExpression :: Assignment
-selectorExpression = makeTerm <$> symbol SelectorExpression <*> children (Expression.MemberAccess <$> expression <*> expression)
+selectorExpression = makeTerm <$> symbol SelectorExpression <*> children (Expression.MemberAccess <$> expression <*> (identifier' <|> fieldIdentifier'))
 
 sliceExpression :: Assignment
 sliceExpression = makeTerm <$> symbol SliceExpression <*> children (Go.Syntax.Slice <$> expression <* token AnonLBracket <*> (emptyTerm <|> expression) <* token AnonColon <*> (expression <|> emptyTerm) <* optional (token AnonColon) <*> (expression <|> emptyTerm))

src/Language/Go/Syntax.hs

@@ -6,9 +6,8 @@ import           Data.Abstract.Module
 import qualified Data.Abstract.Package as Package
 import           Data.Abstract.Path
 import           Data.Aeson
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Char8 as BC
 import           Data.JSON.Fields
+import qualified Data.Text as T
 import           Diffing.Algorithm
 import           Prologue
 import           System.FilePath.Posix
@@ -19,15 +18,14 @@ data Relative = Relative | NonRelative
 data ImportPath = ImportPath { unPath :: FilePath, pathIsRelative :: Relative }
   deriving (Eq, Generic, Hashable, Ord, Show, ToJSON)
 
-importPath :: ByteString -> ImportPath
-importPath str = let path = stripQuotes str in ImportPath (BC.unpack path) (pathType path)
+importPath :: Text -> ImportPath
+importPath str = let path = stripQuotes str in ImportPath (T.unpack path) (pathType path)
   where
-    stripQuotes = B.filter (`B.notElem` "\'\"")
-    pathType xs | not (B.null xs), BC.head xs == '.' = Relative
+    pathType xs | not (T.null xs), T.head xs == '.' = Relative -- head call here is safe
                 | otherwise = NonRelative
 
 defaultAlias :: ImportPath -> Name
-defaultAlias = name . BC.pack . takeFileName . unPath
+defaultAlias = name . T.pack . takeFileName . unPath
 
 resolveGoImport :: ( Member (Modules address value) effects
                    , Member (Reader ModuleInfo) effects
@@ -44,27 +42,25 @@ resolveGoImport (ImportPath path Relative) = do
     [] -> throwResumable $ GoImportError path
     _ -> pure paths
 resolveGoImport (ImportPath path NonRelative) = do
-  package <- BC.unpack . unName . Package.packageName <$> currentPackage
+  package <- T.unpack . formatName . Package.packageName <$> currentPackage
   trace ("attempting to resolve " <> show path <> " for package " <> package)
   case splitDirectories path of
     -- Import an absolute path that's defined in this package being analyzed.
     -- First two are source, next is package name, remaining are path to package
     -- (e.g. github.com/golang/<package>/path...).
     (_ : _ : p : xs) | p == package -> listModulesInDir (joinPath xs)
-    _ -> throwResumable $ GoImportError path
+    _  -> throwResumable $ GoImportError path
 
 -- | Import declarations (symbols are added directly to the calling environment).
 --
 -- If the list of symbols is empty copy everything to the calling environment.
 data Import a = Import { importFrom :: ImportPath, importWildcardToken :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Import where liftEq = genericLiftEq
 instance Ord1 Import where liftCompare = genericLiftCompare
 instance Show1 Import where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Import
-
 instance Evaluatable Import where
   eval (Import importPath _) = do
     paths <- resolveGoImport importPath
@@ -79,14 +75,12 @@ instance Evaluatable Import where
 --
 -- If the list of symbols is empty copy and qualify everything to the calling environment.
 data QualifiedImport a = QualifiedImport { qualifiedImportFrom :: !ImportPath, qualifiedImportAlias :: !a}
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 QualifiedImport where liftEq = genericLiftEq
 instance Ord1 QualifiedImport where liftCompare = genericLiftCompare
 instance Show1 QualifiedImport where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 QualifiedImport
-
 instance Evaluatable QualifiedImport where
   eval (QualifiedImport importPath aliasTerm) = do
     paths <- resolveGoImport importPath
@@ -101,14 +95,12 @@ instance Evaluatable QualifiedImport where
 
 -- | Side effect only imports (no symbols made available to the calling environment).
 data SideEffectImport a = SideEffectImport { sideEffectImportFrom :: !ImportPath, sideEffectImportToken :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 SideEffectImport where liftEq = genericLiftEq
 instance Ord1 SideEffectImport where liftCompare = genericLiftCompare
 instance Show1 SideEffectImport where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 SideEffectImport
-
 instance Evaluatable SideEffectImport where
   eval (SideEffectImport importPath _) = do
     paths <- resolveGoImport importPath
@@ -118,74 +110,62 @@ instance Evaluatable SideEffectImport where
 
 -- A composite literal in Go
 data Composite a = Composite { compositeType :: !a, compositeElement :: !a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Composite where liftEq = genericLiftEq
 instance Ord1 Composite where liftCompare = genericLiftCompare
 instance Show1 Composite where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Composite
-
 -- TODO: Implement Eval instance for Composite
 instance Evaluatable Composite
 
 -- | A default pattern in a Go select or switch statement (e.g. `switch { default: s() }`).
 newtype DefaultPattern a = DefaultPattern { defaultPatternBody :: a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 DefaultPattern where liftEq = genericLiftEq
 instance Ord1 DefaultPattern where liftCompare = genericLiftCompare
 instance Show1 DefaultPattern where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 DefaultPattern
-
 -- TODO: Implement Eval instance for DefaultPattern
 instance Evaluatable DefaultPattern
 
 -- | A defer statement in Go (e.g. `defer x()`).
 newtype Defer a = Defer { deferBody :: a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Defer where liftEq = genericLiftEq
 instance Ord1 Defer where liftCompare = genericLiftCompare
 instance Show1 Defer where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Defer
-
 -- TODO: Implement Eval instance for Defer
 instance Evaluatable Defer
 
 -- | A go statement (i.e. go routine) in Go (e.g. `go x()`).
 newtype Go a = Go { goBody :: a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Go where liftEq = genericLiftEq
 instance Ord1 Go where liftCompare = genericLiftCompare
 instance Show1 Go where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Go
-
 -- TODO: Implement Eval instance for Go
 instance Evaluatable Go
 
 -- | A label statement in Go (e.g. `label:continue`).
 data Label a = Label { _labelName :: !a, labelStatement :: !a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Label where liftEq = genericLiftEq
 instance Ord1 Label where liftCompare = genericLiftCompare
 instance Show1 Label where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Label
-
 -- TODO: Implement Eval instance for Label
 instance Evaluatable Label
 
 -- | A rune literal in Go (e.g. `'⌘'`).
-newtype Rune a = Rune { _runeLiteral :: ByteString }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Rune
+newtype Rune a = Rune { _runeLiteral :: Text }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 -- TODO: Implement Eval instance for Rune
 instance Evaluatable Rune
@@ -196,9 +176,7 @@ instance Show1 Rune where liftShowsPrec = genericLiftShowsPrec
 
 -- | A select statement in Go (e.g. `select { case x := <-c: x() }` where each case is a send or receive operation on channels).
 newtype Select a = Select { selectCases :: a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Select
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 -- TODO: Implement Eval instance for Select
 instance Evaluatable Select
@@ -209,144 +187,122 @@ instance Show1 Select where liftShowsPrec = genericLiftShowsPrec
 
 -- | A send statement in Go (e.g. `channel <- value`).
 data Send a = Send { sendReceiver :: !a, sendValue :: !a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Send where liftEq = genericLiftEq
 instance Ord1 Send where liftCompare = genericLiftCompare
 instance Show1 Send where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Send
-
 -- TODO: Implement Eval instance for Send
 instance Evaluatable Send
 
 -- | A slice expression in Go (e.g. `a[1:4:3]` where a is a list, 1 is the low bound, 4 is the high bound, and 3 is the max capacity).
 data Slice a = Slice { sliceName :: !a, sliceLow :: !a, sliceHigh :: !a, sliceCapacity :: !a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Slice where liftEq = genericLiftEq
 instance Ord1 Slice where liftCompare = genericLiftCompare
 instance Show1 Slice where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Slice
-
 -- TODO: Implement Eval instance for Slice
 instance Evaluatable Slice
 
 -- | A type switch statement in Go (e.g. `switch x.(type) { // cases }`).
 data TypeSwitch a = TypeSwitch { typeSwitchSubject :: !a, typeSwitchCases :: !a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypeSwitch where liftEq = genericLiftEq
 instance Ord1 TypeSwitch where liftCompare = genericLiftCompare
 instance Show1 TypeSwitch where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 TypeSwitch
-
 -- TODO: Implement Eval instance for TypeSwitch
 instance Evaluatable TypeSwitch
 
 -- | A type switch guard statement in a Go type switch statement (e.g. `switch i := x.(type) { // cases}`).
 newtype TypeSwitchGuard a = TypeSwitchGuard { typeSwitchGuardSubject :: a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypeSwitchGuard where liftEq = genericLiftEq
 instance Ord1 TypeSwitchGuard where liftCompare = genericLiftCompare
 instance Show1 TypeSwitchGuard where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 TypeSwitchGuard
-
 -- TODO: Implement Eval instance for TypeSwitchGuard
 instance Evaluatable TypeSwitchGuard
 
 -- | A receive statement in a Go select statement (e.g. `case value := <-channel` )
 data Receive a = Receive { receiveSubject :: !a, receiveExpression :: !a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Receive where liftEq = genericLiftEq
 instance Ord1 Receive where liftCompare = genericLiftCompare
 instance Show1 Receive where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Receive
-
 -- TODO: Implement Eval instance for Receive
 instance Evaluatable Receive
 
 -- | A receive operator unary expression in Go (e.g. `<-channel` )
 newtype ReceiveOperator a = ReceiveOperator a
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ReceiveOperator where liftEq = genericLiftEq
 instance Ord1 ReceiveOperator where liftCompare = genericLiftCompare
 instance Show1 ReceiveOperator where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 ReceiveOperator
-
 -- TODO: Implement Eval instance for ReceiveOperator
 instance Evaluatable ReceiveOperator
 
 -- | A field declaration in a Go struct type declaration.
 data Field a = Field { fieldContext :: ![a], fieldName :: !a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Field where liftEq = genericLiftEq
 instance Ord1 Field where liftCompare = genericLiftCompare
 instance Show1 Field where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Field
-
 -- TODO: Implement Eval instance for Field
 instance Evaluatable Field
 
 
 data Package a = Package { packageName :: !a, packageContents :: ![a] }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Package where liftEq = genericLiftEq
 instance Ord1 Package where liftCompare = genericLiftCompare
 instance Show1 Package where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Package
-
 instance Evaluatable Package where
   eval (Package _ xs) = eval xs
 
 
 -- | A type assertion in Go (e.g. `x.(T)` where the value of `x` is not nil and is of type `T`).
 data TypeAssertion a = TypeAssertion { typeAssertionSubject :: !a, typeAssertionType :: !a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypeAssertion where liftEq = genericLiftEq
 instance Ord1 TypeAssertion where liftCompare = genericLiftCompare
 instance Show1 TypeAssertion where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 TypeAssertion
-
 -- TODO: Implement Eval instance for TypeAssertion
 instance Evaluatable TypeAssertion
 
 -- | A type conversion expression in Go (e.g. `T(x)` where `T` is a type and `x` is an expression that can be converted to type `T`).
 data TypeConversion a = TypeConversion { typeConversionType :: !a, typeConversionSubject :: !a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypeConversion where liftEq = genericLiftEq
 instance Ord1 TypeConversion where liftCompare = genericLiftCompare
 instance Show1 TypeConversion where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 TypeConversion
-
 -- TODO: Implement Eval instance for TypeConversion
 instance Evaluatable TypeConversion
 
 -- | Variadic arguments and parameters in Go (e.g. parameter: `param ...Type`, argument: `Type...`).
 data Variadic a = Variadic { variadicContext :: [a], variadicIdentifier :: a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Variadic where liftEq = genericLiftEq
 instance Ord1 Variadic where liftCompare = genericLiftCompare
 instance Show1 Variadic where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Variadic
-
 -- TODO: Implement Eval instance for Variadic
 instance Evaluatable Variadic

src/Language/Go/Type.hs

@@ -8,39 +8,33 @@ import Diffing.Algorithm
 
 -- | A Bidirectional channel in Go (e.g. `chan`).
 newtype BidirectionalChannel a = BidirectionalChannel a
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 BidirectionalChannel where liftEq = genericLiftEq
 instance Ord1 BidirectionalChannel where liftCompare = genericLiftCompare
 instance Show1 BidirectionalChannel where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 BidirectionalChannel
-
 -- TODO: Implement Eval instance for BidirectionalChannel
 instance Evaluatable BidirectionalChannel
 
 -- | A Receive channel in Go (e.g. `<-chan`).
 newtype ReceiveChannel a = ReceiveChannel a
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ReceiveChannel where liftEq = genericLiftEq
 instance Ord1 ReceiveChannel where liftCompare = genericLiftCompare
 instance Show1 ReceiveChannel where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 ReceiveChannel
-
 -- TODO: Implement Eval instance for ReceiveChannel
 instance Evaluatable ReceiveChannel
 
 -- | A Send channel in Go (e.g. `chan<-`).
 newtype SendChannel a = SendChannel a
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 SendChannel where liftEq = genericLiftEq
 instance Ord1 SendChannel where liftCompare = genericLiftCompare
 instance Show1 SendChannel where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 SendChannel
-
 -- TODO: Implement Eval instance for SendChannel
 instance Evaluatable SendChannel

src/Language/Haskell/Assignment.hs

@@ -33,20 +33,34 @@ type Syntax = '[
   , Literal.Float
   , Literal.Integer
   , Literal.TextElement
+  , Syntax.AnnotatedTypeVariable
+  , Syntax.Class
   , Syntax.Context
+  , Syntax.Context'
+  , Syntax.Deriving
   , Syntax.Empty
   , Syntax.Error
   , Syntax.Field
   , Syntax.FunctionConstructor
+  , Syntax.FunctionType
+  , Syntax.GADT
+  , Syntax.GADTConstructor
   , Syntax.Identifier
+  , Syntax.Kind
+  , Syntax.KindFunctionType
+  , Syntax.KindListType
+  , Syntax.KindSignature
   , Syntax.ListConstructor
   , Syntax.Module
   , Syntax.Pragma
+  , Syntax.QualifiedTypeConstructorIdentifier
   , Syntax.RecordDataConstructor
+  , Syntax.Star
   , Syntax.StrictType
   , Syntax.StrictTypeVariable
   , Syntax.TupleConstructor
   , Syntax.Type
+  , Syntax.TypeSignature
   , Syntax.TypeSynonym
   , Syntax.UnitConstructor
   , Type.TypeParameters
@@ -60,11 +74,43 @@ type Assignment' a = HasCallStack => Assignment.Assignment [] Grammar a
 assignment :: Assignment
 assignment = handleError $ module' <|> parseError
 
-module' :: Assignment
-module' = makeTerm
-       <$> symbol Module
-       <*> children (Syntax.Module <$> (moduleIdentifier <|> emptyTerm) <*> pure [] <*> (where' <|> expressions <|> emptyTerm))
+algebraicDatatypeDeclaration :: Assignment
+algebraicDatatypeDeclaration = makeTerm
+                            <$> symbol AlgebraicDatatypeDeclaration
+                            <*> children (Declaration.Datatype
+                                        <$> (context' <|> emptyTerm)
+                                        <*> (makeTerm <$> location <*> (Syntax.Type <$> typeConstructor <*> typeParameters <*> (kindSignature <|> emptyTerm)))
+                                        <*> ((symbol Constructors *> children (many constructor))
+                                            <|> pure [])
+                                        <*> (derivingClause <|> emptyTerm))
 
+annotatedTypeVariable :: Assignment
+annotatedTypeVariable = makeTerm <$> symbol AnnotatedTypeVariable <*> children (Syntax.AnnotatedTypeVariable <$> typeVariableIdentifier <* token Annotation <*> (kind <|> type'))
+
+character :: Assignment
+character = makeTerm <$> symbol Char <*> (Literal.Character <$> source)
+
+class' :: Assignment
+class' = makeTerm <$> symbol Class <*> children (Syntax.Class <$> typeConstructor <*> typeParameters)
+
+comment :: Assignment
+comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
+
+constructor :: Assignment
+constructor =  (makeTerm <$> symbol DataConstructor <*> children (Declaration.Constructor <$> (context' <|> emptyTerm) <*> typeConstructor <*> typeParameters))
+           <|> (makeTerm <$> symbol RecordDataConstructor <*> children (Syntax.RecordDataConstructor <$> constructorIdentifier <*> fields))
+
+constructorIdentifier :: Assignment
+constructorIdentifier = makeTerm <$> symbol ConstructorIdentifier <*> (Syntax.Identifier . Name.name <$> source)
+
+context' :: Assignment
+context' = makeTerm <$> symbol Context <*> children (Syntax.Context' <$> many (type' <|> contextPattern))
+
+contextPattern :: Assignment
+contextPattern = symbol ContextPattern *> children type'
+
+derivingClause :: Assignment
+derivingClause = makeTerm <$> symbol Deriving <*> children (Syntax.Deriving <$> many typeConstructor)
 
 expressions :: Assignment
 expressions = makeTerm'' <$> location <*> many expression
@@ -75,21 +121,32 @@ expression = term (handleError (choice expressionChoices))
 expressionChoices :: [Assignment.Assignment [] Grammar Term]
 expressionChoices = [
                       algebraicDatatypeDeclaration
+                    , annotatedTypeVariable
                     , character
                     , comment
+                    , context'
                     , constructorIdentifier
+                    , derivingClause
                     , float
                     , functionConstructor
                     , functionDeclaration
+                    , functionType
+                    , gadtConstructor
+                    , gadtDeclaration
                     , integer
+                    , kind
+                    , kindSignature
                     , listConstructor
                     , listExpression
                     , listType
                     , moduleIdentifier
+                    , qualifiedTypeConstructorIdentifier
+                    , star
                     , strictType
                     , string
                     , type'
                     , typeConstructorIdentifier
+                    , typeSignature
                     , typeSynonymDeclaration
                     , typeVariableIdentifier
                     , tuplingConstructor
@@ -98,50 +155,21 @@ expressionChoices = [
                     , where'
                     ]
 
-term :: Assignment -> Assignment
-term term = contextualize (comment <|> pragma) (postContextualize (comment <|> pragma) term)
-
-algebraicDatatypeDeclaration :: Assignment
-algebraicDatatypeDeclaration = makeTerm
-                            <$> symbol AlgebraicDatatypeDeclaration
-                            <*> children (Declaration.Datatype
-                                        <$> (makeTerm <$> location <*> (Syntax.Type <$> typeConstructor <*> typeParameters))
-                                        <*> ((symbol Constructors *> children (many constructor))
-                                            <|> pure []))
-
-comment :: Assignment
-comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
-
-constructor :: Assignment
-constructor =  (makeTerm <$> symbol DataConstructor <*> children (Declaration.Constructor <$> typeConstructor <*> typeParameters))
-           <|> (makeTerm <$> symbol RecordDataConstructor <*> children (Syntax.RecordDataConstructor <$> constructorIdentifier <*> fields))
-
 fields :: Assignment
 fields = makeTerm <$> symbol Fields <*> children (many field)
 
 field :: Assignment
-field = makeTerm <$> symbol Field <*> children (Syntax.Field <$> variableIdentifiers <* token Annotation <*> term type')
+field = makeTerm
+     <$> symbol Field
+     <*> children (Syntax.Field
+                 <$> variableIdentifiers
+                 <* token Annotation
+                 <*> fieldType)
+  where
+    fieldType = makeTerm <$> location <*> (Syntax.Type <$> term (type' <|> typeVariableIdentifier) <*> typeParameters <*> (kindSignature <|> emptyTerm))
 
-variableIdentifier :: Assignment
-variableIdentifier = makeTerm <$> symbol VariableIdentifier <*> (Syntax.Identifier . Name.name <$> source)
-
-variableIdentifiers :: Assignment
-variableIdentifiers = makeTerm <$> location <*> many variableIdentifier
-
-constructorIdentifier :: Assignment
-constructorIdentifier = makeTerm <$> symbol ConstructorIdentifier <*> (Syntax.Identifier . Name.name <$> source)
-
-moduleIdentifier :: Assignment
-moduleIdentifier = makeTerm <$> symbol ModuleIdentifier <*> (Syntax.Identifier . Name.name <$> source)
-
-typeConstructorIdentifier :: Assignment
-typeConstructorIdentifier = makeTerm <$> symbol TypeConstructorIdentifier <*> (Syntax.Identifier . Name.name <$> source)
-
-typeVariableIdentifier :: Assignment
-typeVariableIdentifier = makeTerm <$> symbol TypeVariableIdentifier <*> (Syntax.Identifier . Name.name <$> source)
-
-where' :: Assignment
-where' = makeTerm <$> (symbol Where <|> symbol Where') <*> children (many expression)
+float :: Assignment
+float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
 
 functionBody :: Assignment
 functionBody = makeTerm <$> symbol FunctionBody <*> children (many expression)
@@ -158,18 +186,52 @@ functionDeclaration = makeTerm
                                <*> (manyTermsTill expression (symbol FunctionBody) <|> pure [])
                                <*> functionBody)
 
+functionType :: Assignment
+functionType = makeTerm <$> symbol FunctionType <*> children (Syntax.FunctionType <$> type' <*> type')
+
+gadtConstructor :: Assignment
+gadtConstructor = makeTerm
+               <$> symbol GadtConstructor
+               <*> children (Syntax.GADTConstructor
+                           <$> (context' <|> emptyTerm)
+                           <*> typeConstructor
+                           <* token Annotation
+                           <*> term type')
+
+gadtDeclaration :: Assignment
+gadtDeclaration = makeTerm
+               <$> symbol GadtDeclaration
+               <*> children (Syntax.GADT
+                           <$> (context' <|> emptyTerm)
+                           <*> (makeTerm <$> location <*> (Syntax.Type <$> typeConstructor <*> typeParameters' <*> (kindSignature <|> emptyTerm)))
+                           <*> where')
+  where
+    typeParameters' = makeTerm <$> location <*> manyTermsTill expression (symbol KindSignature <|> symbol Where')
+
 integer :: Assignment
 integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> source)
 
+kind :: Assignment
+kind = kind'
+    <|> kindFunctionType
+    <|> kindListType
+    <|> star
+
+kind' :: Assignment
+kind' = makeTerm <$> symbol Kind <*> children (Syntax.Kind <$> kind)
+
+kindFunctionType :: Assignment
+kindFunctionType = makeTerm <$> symbol KindFunctionType <*> children (Syntax.KindFunctionType <$> kind <*> kind)
+
+kindListType :: Assignment
+kindListType = makeTerm <$> symbol KindListType <*> children (Syntax.KindListType <$> kind)
+
+kindSignature :: Assignment
+kindSignature = makeTerm <$> symbol KindSignature <*> children (Syntax.KindSignature <$ token Annotation <*> kind)
+
 listConstructor :: Assignment
 listConstructor = makeTerm <$> token ListConstructor <*> pure Syntax.ListConstructor
 
-pragma :: Assignment
-pragma = makeTerm <$> symbol Pragma <*> (Syntax.Pragma <$> source)
-
-unitConstructor :: Assignment
-unitConstructor = makeTerm <$> token UnitConstructor <*> pure Syntax.UnitConstructor
-
 listExpression :: Assignment
 listExpression = makeTerm <$> symbol ListExpression <*> children (Literal.Array <$> many listElement)
   where listElement = symbol Expression *> children expression
@@ -177,51 +239,110 @@ listExpression = makeTerm <$> symbol ListExpression <*> children (Literal.Array
 listType :: Assignment
 listType = makeTerm <$> symbol ListType <*> children (Literal.Array <$> many type')
 
+module' :: Assignment
+module' = makeTerm
+       <$> symbol Module
+       <*> children (Syntax.Module <$> (moduleIdentifier <|> emptyTerm) <*> pure [] <*> (where' <|> expressions <|> emptyTerm))
+
+moduleIdentifier :: Assignment
+moduleIdentifier = makeTerm <$> symbol ModuleIdentifier <*> (Syntax.Identifier . Name.name <$> source)
+
+parenthesizedTypePattern :: Assignment
+parenthesizedTypePattern = symbol ParenthesizedTypePattern *> children typeParameters
+
+pragma :: Assignment
+pragma = makeTerm <$> symbol Pragma <*> (Syntax.Pragma <$> source)
+
+qualifiedTypeConstructorIdentifier :: Assignment
+qualifiedTypeConstructorIdentifier = makeTerm <$> symbol QualifiedTypeConstructorIdentifier <*> children (Syntax.QualifiedTypeConstructorIdentifier <$> many expression)
+
+star :: Assignment
+star = makeTerm <$> token Star <*> pure Syntax.Star
+
 strictType :: Assignment
-strictType = makeTerm' <$> symbol StrictType <*> children ((inject <$> (Syntax.StrictType <$> typeConstructor <*> typeParameters))
-                                                        <|> (inject <$> (Syntax.StrictTypeVariable <$> typeVariableIdentifier)))
-
-tuplingConstructor :: Assignment
-tuplingConstructor = makeTerm <$> symbol TuplingConstructor <*> (tupleWithArity <$> source)
-        -- a tuple (,) has arity two, but only one comma, so apply the successor to the count of commas for the correct arity.
-  where tupleWithArity = Syntax.TupleConstructor . succ . count ','
-
-type' :: Assignment
-type' = (makeTerm <$> symbol Type <*> children (Syntax.Type <$> typeConstructor <*> typeParameters))
-     <|> (makeTerm <$> symbol TypePattern <*> children (Syntax.Type <$> typeConstructor <*> typeParameters))
-     <|> strictType
-     <|> typeConstructor
-
-typeParameters :: Assignment
-typeParameters = makeTerm <$> location <*> (Type.TypeParameters <$> many expression)
-
-float :: Assignment
-float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
-
-character :: Assignment
-character = makeTerm <$> symbol Char <*> (Literal.Character <$> source)
+strictType = makeTerm'
+          <$> symbol StrictType
+          <*> children (  (inject <$> (Syntax.StrictType <$> typeConstructor <*> typeParameters))
+                      <|> (inject <$> (Syntax.StrictTypeVariable <$> typeVariableIdentifier)))
 
 string :: Assignment
 string = makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
 
+typeClassIdentifier :: Assignment
+typeClassIdentifier = makeTerm <$> symbol TypeClassIdentifier <*> (Syntax.Identifier . Name.name <$> source)
+
+typeConstructorIdentifier :: Assignment
+typeConstructorIdentifier = makeTerm <$> symbol TypeConstructorIdentifier <*> (Syntax.Identifier . Name.name <$> source)
+
+typeSignature :: Assignment
+typeSignature = makeTerm <$> symbol TypeSignature <*> children (Syntax.TypeSignature <$> variableIdentifier <* token Annotation <*> type')
+
+typeVariableIdentifier :: Assignment
+typeVariableIdentifier = makeTerm <$> symbol TypeVariableIdentifier <*> (Syntax.Identifier . Name.name <$> source)
+
+tuplingConstructor :: Assignment
+tuplingConstructor = makeTerm <$> symbol TuplingConstructor <*> (tupleWithArity <$> rawSource)
+        -- a tuple (,) has arity two, but only one comma, so apply the successor to the count of commas for the correct arity.
+  where tupleWithArity = Syntax.TupleConstructor . succ . count ','
+
+type' :: Assignment
+type' =  class'
+     <|> fields
+     <|> functionType
+     <|> parenthesizedTypePattern
+     <|> strictType
+     <|> type''
+     <|> typeConstructor
+     <|> typePattern
+
+type'' :: Assignment
+type'' = makeTerm
+      <$> symbol Type
+      <*> children (Syntax.Type <$> (typeConstructor <|> typeVariableIdentifier <|> type') <*> typeParameters <*> (kindSignature <|> emptyTerm))
+
+typeParameters :: Assignment
+typeParameters = makeTerm <$> location <*> (Type.TypeParameters <$> (manyTermsTill expression (symbol Annotation) <|> many expression))
+
+typePattern :: Assignment
+typePattern = makeTerm <$> symbol TypePattern <*> children (Syntax.Type <$> typeConstructor <*> typeParameters <*> (kindSignature <|> emptyTerm))
+
 typeConstructor :: Assignment
-typeConstructor = typeConstructorIdentifier
+typeConstructor =  constructorIdentifier
                <|> functionConstructor
                <|> listConstructor
                <|> listType
+               <|> qualifiedTypeConstructorIdentifier
+               <|> typeClassIdentifier
+               <|> typeConstructorIdentifier
                <|> tuplingConstructor
                <|> unitConstructor
-               <|> constructorIdentifier
 
 typeSynonymDeclaration :: Assignment
 typeSynonymDeclaration = makeTerm
                       <$> symbol TypeSynonymDeclaration
                       <*> children (Syntax.TypeSynonym <$> typeLeft <*> typeRight)
   where
-    typeLeft = makeTerm <$> location <*> (Syntax.Type <$> typeConstructor <*> typeParametersLeft)
+    typeLeft = makeTerm <$> location <*> (Syntax.Type <$> typeConstructor <*> typeParametersLeft <*> (kindSignature <|> emptyTerm))
     typeParametersLeft = makeTerm <$> location <*> (Type.TypeParameters <$> manyTill expression (symbol TypeSynonymBody))
     typeRight = symbol TypeSynonymBody *> children type'
 
+unitConstructor :: Assignment
+unitConstructor = makeTerm <$> token UnitConstructor <*> pure Syntax.UnitConstructor
+
+variableIdentifier :: Assignment
+variableIdentifier = makeTerm <$> symbol VariableIdentifier <*> (Syntax.Identifier . Name.name <$> source)
+
+variableIdentifiers :: Assignment
+variableIdentifiers = makeTerm <$> location <*> many variableIdentifier
+
+where' :: Assignment
+where' = makeTerm <$> (symbol Where <|> symbol Where') <*> children (many expression)
+
+-- | Helpers
+
 -- | Match a series of terms or comments until a delimiter is matched.
 manyTermsTill :: Assignment.Assignment [] Grammar Term -> Assignment.Assignment [] Grammar b -> Assignment.Assignment [] Grammar [Term]
 manyTermsTill step = manyTill (step <|> comment)
+
+term :: Assignment -> Assignment
+term term = contextualize (comment <|> pragma) (postContextualize (comment <|> pragma) term)

src/Language/Haskell/Syntax.hs

@@ -11,126 +11,235 @@ data Module a = Module { moduleIdentifier :: !a
                        , moduleExports    :: ![a]
                        , moduleStatements :: !a
                        }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Module where liftEq = genericLiftEq
 instance Ord1 Module where liftCompare = genericLiftCompare
 instance Show1 Module where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Module
-
 instance Evaluatable Module
 
 data StrictType a = StrictType { strictTypeIdentifier :: !a, strictTypeParameters :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 StrictType where liftEq = genericLiftEq
 instance Ord1 StrictType where liftCompare = genericLiftCompare
 instance Show1 StrictType where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 StrictType
-
 instance Evaluatable StrictType
 
 newtype StrictTypeVariable a = StrictTypeVariable { strictTypeVariableIdentifier :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 StrictTypeVariable where liftEq = genericLiftEq
 instance Ord1 StrictTypeVariable where liftCompare = genericLiftCompare
 instance Show1 StrictTypeVariable where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 StrictTypeVariable
-
 instance Evaluatable StrictTypeVariable
 
-data Type a = Type { typeIdentifier :: !a, typeParameters :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+data Type a = Type { typeIdentifier :: a, typeParameters :: a, typeKindSignature :: a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Type where liftEq = genericLiftEq
 instance Ord1 Type where liftCompare = genericLiftCompare
 instance Show1 Type where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Type
-
 instance Evaluatable Type
 
 data TypeSynonym a = TypeSynonym { typeSynonymLeft :: !a, typeSynonymRight :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypeSynonym where liftEq = genericLiftEq
 instance Ord1 TypeSynonym where liftCompare = genericLiftCompare
 instance Show1 TypeSynonym where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 TypeSynonym
-
 instance Evaluatable TypeSynonym
 
-data UnitConstructor a = UnitConstructor deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+data UnitConstructor a = UnitConstructor
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 UnitConstructor where liftEq = genericLiftEq
 instance Ord1 UnitConstructor where liftCompare = genericLiftCompare
 instance Show1 UnitConstructor where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 UnitConstructor
-
 instance Evaluatable UnitConstructor
 
-newtype TupleConstructor a = TupleConstructor { tupleConstructorArity :: Int } deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+newtype TupleConstructor a = TupleConstructor { tupleConstructorArity :: Int }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TupleConstructor where liftEq = genericLiftEq
 instance Ord1 TupleConstructor where liftCompare = genericLiftCompare
 instance Show1 TupleConstructor where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 TupleConstructor
-
 instance Evaluatable TupleConstructor
 
-data ListConstructor a = ListConstructor deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+data ListConstructor a = ListConstructor
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ListConstructor where liftEq = genericLiftEq
 instance Ord1 ListConstructor where liftCompare = genericLiftCompare
 instance Show1 ListConstructor where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 ListConstructor
-
 instance Evaluatable ListConstructor
 
-data FunctionConstructor a = FunctionConstructor deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+data FunctionConstructor a = FunctionConstructor
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 FunctionConstructor where liftEq = genericLiftEq
 instance Ord1 FunctionConstructor where liftCompare = genericLiftCompare
 instance Show1 FunctionConstructor where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 FunctionConstructor
-
 instance Evaluatable FunctionConstructor
 
-data RecordDataConstructor a = RecordDataConstructor { recordDataConstructorName :: !a, recordDataConstructorFields :: !a } deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+data RecordDataConstructor a = RecordDataConstructor { recordDataConstructorName :: !a, recordDataConstructorFields :: !a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 RecordDataConstructor where liftEq = genericLiftEq
 instance Ord1 RecordDataConstructor where liftCompare = genericLiftCompare
 instance Show1 RecordDataConstructor where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 RecordDataConstructor
-
 instance Evaluatable RecordDataConstructor
 
-data Field a = Field { fieldName :: !a, fieldBody :: !a } deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+data Field a = Field { fieldName :: !a, fieldBody :: !a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Field where liftEq = genericLiftEq
 instance Ord1 Field where liftCompare = genericLiftCompare
 instance Show1 Field where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Field
-
 instance Evaluatable Field
 
-newtype Pragma a = Pragma ByteString deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+newtype Pragma a = Pragma Text
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Pragma where liftEq = genericLiftEq
 instance Ord1 Pragma where liftCompare = genericLiftCompare
 instance Show1 Pragma where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Pragma
-
 instance Evaluatable Pragma
+
+newtype Deriving a = Deriving [a]
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 Deriving where liftEq = genericLiftEq
+instance Ord1 Deriving where liftCompare = genericLiftCompare
+instance Show1 Deriving where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable Deriving
+
+newtype Context' a = Context' [a]
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 Context' where liftEq = genericLiftEq
+instance Ord1 Context' where liftCompare = genericLiftCompare
+instance Show1 Context' where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable Context'
+
+data Class a = Class { classType :: a, classTypeParameters :: a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 Class where liftEq = genericLiftEq
+instance Ord1 Class where liftCompare = genericLiftCompare
+instance Show1 Class where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable Class
+
+data GADT a = GADT { gadtContext :: a, gadtName :: a, gadtConstructors :: a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 GADT where liftEq = genericLiftEq
+instance Ord1 GADT where liftCompare = genericLiftCompare
+instance Show1 GADT where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable GADT
+
+data GADTConstructor a = GADTConstructor { gadtConstructorContext :: a, gadtConstructorName :: a, gadtConstructorTypeSignature :: a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 GADTConstructor where liftEq = genericLiftEq
+instance Ord1 GADTConstructor where liftCompare = genericLiftCompare
+instance Show1 GADTConstructor where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable GADTConstructor
+
+data FunctionType a = FunctionType { functionTypeLeft :: a, functionTypeRight :: a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 FunctionType where liftEq = genericLiftEq
+instance Ord1 FunctionType where liftCompare = genericLiftCompare
+instance Show1 FunctionType where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable FunctionType
+
+data TypeSignature a = TypeSignature { typeSignatureName :: a, typeSignatureContent :: a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 TypeSignature where liftEq = genericLiftEq
+instance Ord1 TypeSignature where liftCompare = genericLiftCompare
+instance Show1 TypeSignature where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable TypeSignature
+
+newtype KindSignature a = KindSignature { kindSignatureContent :: a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 KindSignature where liftEq = genericLiftEq
+instance Ord1 KindSignature where liftCompare = genericLiftCompare
+instance Show1 KindSignature where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable KindSignature
+
+data KindFunctionType a = KindFunctionType { kindFunctionTypeLeft :: a, kindFunctionTypeRight :: a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 KindFunctionType where liftEq = genericLiftEq
+instance Ord1 KindFunctionType where liftCompare = genericLiftCompare
+instance Show1 KindFunctionType where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable KindFunctionType
+
+newtype Kind a = Kind { kindKind :: a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 Kind where liftEq = genericLiftEq
+instance Ord1 Kind where liftCompare = genericLiftCompare
+instance Show1 Kind where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable Kind
+
+newtype KindListType a = KindListType { kindListTypeKind :: a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 KindListType where liftEq = genericLiftEq
+instance Ord1 KindListType where liftCompare = genericLiftCompare
+instance Show1 KindListType where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable KindListType
+
+data Star a = Star
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 Star where liftEq = genericLiftEq
+instance Ord1 Star where liftCompare = genericLiftCompare
+instance Show1 Star where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable Star
+
+newtype QualifiedTypeConstructorIdentifier a = QualifiedTypeConstructorIdentifier { qualifiedTypeConstructorIdentifierName :: [a] }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 QualifiedTypeConstructorIdentifier where liftEq = genericLiftEq
+instance Ord1 QualifiedTypeConstructorIdentifier where liftCompare = genericLiftCompare
+instance Show1 QualifiedTypeConstructorIdentifier where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable QualifiedTypeConstructorIdentifier
+
+data AnnotatedTypeVariable a = AnnotatedTypeVariable { annotatedTypeVariableIdentifier :: a, annotatedTypeVariableannotation :: a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 AnnotatedTypeVariable where liftEq = genericLiftEq
+instance Ord1 AnnotatedTypeVariable where liftCompare = genericLiftCompare
+instance Show1 AnnotatedTypeVariable where liftShowsPrec = genericLiftShowsPrec
+
+instance Evaluatable AnnotatedTypeVariable

src/Language/JSON/Assignment.hs

@@ -55,8 +55,8 @@ string :: Assignment
 string = makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
 
 boolean :: Assignment
-boolean =  makeTerm <$> symbol Grammar.True  <*> (Literal.true <$ source)
-       <|> makeTerm <$> symbol Grammar.False <*> (Literal.false <$ source)
+boolean =  makeTerm <$> symbol Grammar.True  <*> (Literal.true <$ rawSource)
+       <|> makeTerm <$> symbol Grammar.False <*> (Literal.false <$ rawSource)
 
 none :: Assignment
-none = makeTerm <$> symbol Null <*> (Literal.Null <$ source)
+none = makeTerm <$> symbol Null <*> (Literal.Null <$ rawSource)

src/Language/Java/Assignment.hs

@@ -41,6 +41,7 @@ type Syntax =
    , Expression.Boolean
    , Expression.InstanceOf
    , Expression.MemberAccess
+   , Expression.Subscript
    , Expression.Super
    , Expression.This
    , Java.Syntax.Annotation
@@ -53,10 +54,13 @@ type Syntax =
    , Java.Syntax.Module
    , Java.Syntax.New
    , Java.Syntax.Package
+   , Java.Syntax.SpreadParameter
    , Java.Syntax.Synchronized
    , Java.Syntax.TypeParameter
    , Java.Syntax.TypeWithModifiers
    , Java.Syntax.Variable
+   , Java.Syntax.Wildcard
+   , Java.Syntax.WildcardBounds
    , Literal.Array
    , Literal.Boolean
    , Literal.Integer
@@ -80,6 +84,7 @@ type Syntax =
    , Statement.PreIncrement
    , Statement.PreDecrement
    , Statement.While
+   , Statement.Statements
    , Statement.Throw
    , Statement.Try
    , Syntax.Context
@@ -87,7 +92,6 @@ type Syntax =
    , Syntax.Error
    , Syntax.Identifier
    , Syntax.AccessibilityModifier
-   , Syntax.Program
    , Type.Array
    , Type.Bool
    , Type.Int
@@ -103,7 +107,7 @@ type Assignment = HasCallStack => Assignment.Assignment [] Grammar Term
 
 -- | Assignment from AST in Java's grammar onto a program in Java's syntax.
 assignment :: Assignment
-assignment = handleError $ makeTerm <$> symbol Grammar.Program <*> children (Syntax.Program <$> manyTerm expression) <|> parseError
+assignment = handleError $ makeTerm <$> symbol Grammar.Program <*> children (Statement.Statements <$> manyTerm expression) <|> parseError
 
 -- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
 manyTerm :: Assignment -> Assignment.Assignment [] Grammar [Term]
@@ -133,6 +137,7 @@ expressionChoices :: [Assignment.Assignment [] Grammar Term]
 expressionChoices =
   [
     arrayInitializer
+  , arrayAccess
   , assignment'
   , block
   , binary
@@ -145,13 +150,13 @@ expressionChoices =
   , continue
   , constructorDeclaration
   , explicitConstructorInvocation
-  -- , constantDeclaration
+  -- , TODO: constantDeclaration
   , doWhile
+  , fieldAccess
   , fieldDeclaration
   , float
   , for
   , enum
-  -- , hexadecimal
   , if'
   , interface
   , identifier
@@ -234,21 +239,14 @@ char = makeTerm <$> symbol CharacterLiteral <*> (Literal.TextElement <$> source)
 identifier :: Assignment
 identifier = makeTerm <$> (symbol Identifier <|> symbol TypeIdentifier) <*> (Syntax.Identifier . name <$> source)
 
+identifier' :: Assignment.Assignment [] Grammar Name
+identifier' = (symbol Identifier <|> symbol TypeIdentifier) *> (name <$> source)
+
 scopedIdentifier :: Assignment
-scopedIdentifier = makeTerm <$> symbol ScopedIdentifier <*> children (Expression.MemberAccess <$> term expression <*> term expression)
+scopedIdentifier = makeTerm <$> symbol ScopedIdentifier <*> children (Expression.MemberAccess <$> term expression <*> identifier')
 
 superInterfaces :: Assignment.Assignment [] Grammar [Term]
 superInterfaces = symbol SuperInterfaces *> children (symbol InterfaceTypeList *> children(manyTerm type'))
--- a *> b
--- both of these are impure
--- getLine *> getLine
--- in half apply, they're both monadic impure actions
--- :t (<$)
--- :t (*>)
-
--- what does it mean to say monadic action? more precise term: sequence-able
--- a sequence of applicative actions can be executed left to right
--- applicative computations can't do branch and control flow; applicative computations can only compute in a direct line, monadic can compute arbitrary branches
 
 -- Declarations
 class' :: Assignment
@@ -257,19 +255,11 @@ class' = makeTerm <$> symbol ClassDeclaration <*> children (makeClass <$> many m
     makeClass modifiers identifier typeParams superClass superInterfaces = Declaration.Class (modifiers ++ typeParams) identifier (maybeToList superClass ++ superInterfaces) -- not doing an assignment, just straight up function
     classBody = makeTerm <$> symbol ClassBody <*> children (manyTerm expression)
     superClass = symbol Superclass *> children type'
-    -- matching term expression won't work since there is no node for that; it's AnonExtends
-    -- superClass = makeTerm <$> symbol SuperClass <*> children (Java.Syntax.SuperClass <$> term expression <*> type')
-    -- We'd still like to match the SuperClass node, but we don't need to create a syntax to make a term
-    -- Do you lose info by omitting the superclass term? No...
-    -- Don't need to make a term since we're not using syntax
-    -- what's the difference between using tokens: AnonExtends GenericType?
-    -- optional: when something can or can't exist and you want to produce a Maybe
--- TODO: superclass -- need to match the superclass node when it exists (which will be a rule, similar to how the type params rule matches the typeparams node when it exists)
--- optional, when we have a single term
--- superInterfaces is also optional but since it produces a list, lists already have an empty value so we don't need to wrap it up in a maybe to get an empty value
+-- TODO: superclass
+--       need to match the superclass node when it exists (which will be a rule, similar to how the type params rule matches the typeparams node when it exists)
+--       optional, when we have a single term
+--       superInterfaces is also optional but since it produces a list, lists already have an empty value so we don't need to wrap it up in a maybe to get an empty value
 
--- define this at the top level, we may change TS grammar so that if someone wants to write a Java snippet we could assign
--- it correctly; fieldDeclaration is standalone (compared to a type, which doesn't say anything by itself)
 fieldDeclaration :: Assignment
 fieldDeclaration = makeTerm <$> symbol FieldDeclaration <*> children ((,) <$> manyTerm modifier <*> type' <**> variableDeclaratorList)
 
@@ -281,26 +271,20 @@ method = makeTerm <$> symbol MethodDeclaration <*> children (makeMethod <$> many
     methodHeader = symbol MethodHeader *> children ((,,,,) <$> (typeParameters <|> pure []) <*> manyTerm annotation <*> type' <*> methodDeclarator <*> (throws <|> pure []))
     makeMethod modifiers receiver (typeParams, annotations, returnType, (name, params), throws) = Declaration.Method (returnType : modifiers ++ typeParams ++ annotations ++ throws) receiver name params
 
--- TODO: add genericType
--- Question: should this genericType be part of type or not? Its own type because it's different structurally
-
 generic :: Assignment
 generic = makeTerm <$> symbol Grammar.GenericType <*> children(Java.Syntax.GenericType <$> term type' <*> manyTerm type')
--- when do we make a term again? - if we want to wrap something in a syntax constructor, because each piece of syntax
--- will be populated by further terms inside it. in this case, we wrap two terms in a piece of syntax.
--- Q to help decide: do we lose anything by omitting the term?
 
 methodInvocation :: Assignment
-methodInvocation = makeTerm <$> symbol MethodInvocation <*> children (Expression.Call [] <$> (callFunction <$> expression <*> optional (token AnonDot *> expression)) <*> (argumentList <|> pure []) <*> emptyTerm)
+methodInvocation = makeTerm <$> symbol MethodInvocation <*> children (uncurry Expression.Call <$> (callFunction <$> expression <*> optional ((,) <$ token AnonDot <*> manyTerm typeArgument <*> identifier')) <*> (argumentList <|> pure []) <*> emptyTerm)
   where
-    callFunction a (Just b) = makeTerm1 (Expression.MemberAccess a b)
-    callFunction a Nothing = a
+    callFunction a (Just (typeArguments, b)) = (typeArguments, makeTerm1 (Expression.MemberAccess a b))
+    callFunction a Nothing = ([], a)
 
 explicitConstructorInvocation :: Assignment
-explicitConstructorInvocation = makeTerm <$> symbol ExplicitConstructorInvocation <*> children (Expression.Call [] <$> (callFunction <$> term expression <*> optional (token AnonDot *> term expression)) <*> argumentList <*> emptyTerm)
+explicitConstructorInvocation = makeTerm <$> symbol ExplicitConstructorInvocation <*> children (uncurry Expression.Call <$> (callFunction <$> term expression <*> optional ((,) <$ token AnonDot <*> manyTerm type' <*> identifier')) <*> argumentList <*> emptyTerm)
   where
-    callFunction a (Just b) = makeTerm1 (Expression.MemberAccess a b)
-    callFunction a Nothing = a
+    callFunction a (Just (typeArguments, b)) = (typeArguments, makeTerm1 (Expression.MemberAccess a b))
+    callFunction a Nothing = ([], a)
 
 module' :: Assignment
 module' = makeTerm <$> symbol ModuleDeclaration <*> children (Java.Syntax.Module <$> expression <*> many expression)
@@ -318,21 +302,18 @@ interface = makeTerm <$> symbol InterfaceDeclaration <*> children (normal <|> an
     annotationType = symbol AnnotationTypeDeclaration *> children (Declaration.InterfaceDeclaration [] <$> identifier <*> annotationTypeBody)
     annotationTypeBody = makeTerm <$> symbol AnnotationTypeBody <*> children (many expression)
     interfaceMemberDeclaration = symbol InterfaceMemberDeclaration *> children (term expression)
-    -- we won't make a term because we have a choice of a bunch of things
 
 package :: Assignment
--- package = makeTerm <$> symbol PackageDeclaration <*> children (Java.Syntax.Package <$> someTerm expression)
-package = do
-  loc <- symbol PackageDeclaration -- location which is calling the symbol API
-  c <- children $ do Java.Syntax.Package <$> someTerm expression
-  pure (makeTerm loc c) -- pure is re-wrapping it back into the outer context, which in this case is Assignment (ie., the return type of the function)
+package = makeTerm <$> symbol PackageDeclaration <*> children (Java.Syntax.Package <$> someTerm expression)
 
 enum :: Assignment
-enum = makeTerm <$> symbol Grammar.EnumDeclaration <*> children (Java.Syntax.EnumDeclaration <$> term identifier <*> manyTerm enumConstant)
-    where enumConstant = symbol EnumConstant *> children (term identifier)
+enum = makeTerm <$> symbol Grammar.EnumDeclaration <*> children (Java.Syntax.EnumDeclaration <$> manyTerm modifier <*> term identifier <*> (superInterfaces <|> pure []) <*> manyTerm enumConstant <*> (enumBodyDeclarations <|> pure []))
+    where
+      enumConstant = symbol EnumConstant *> children (term identifier)
+      enumBodyDeclarations = symbol EnumBodyDeclarations *> children (manyTerm expression)
 
 return' :: Assignment
-return' = makeTerm <$> symbol ReturnStatement <*> (Statement.Return <$> children expression)
+return' = makeTerm <$> symbol ReturnStatement <*> (Statement.Return <$> children (expression <|> emptyTerm))
 
 -- method expressions
 dims :: Assignment.Assignment [] Grammar [Term]
@@ -347,13 +328,21 @@ type' =  choice [
      , symbol ArrayType *> children (array <$> type' <*> dims) -- type rule recurs into itself
      , symbol CatchType *> children (term type')
      , symbol ExceptionType *> children (term type')
-     , symbol TypeArgument *> children (term type')
-     -- , symbol WildCard *> children (term type')
+     , wildcard
      , identifier
      , generic
     ]
     where array = foldl (\into each -> makeTerm1 (Type.Array (Just each) into))
 
+typeArgument :: Assignment
+typeArgument = symbol TypeArgument *> children (term type')
+
+wildcard :: Assignment
+wildcard = makeTerm <$> symbol Grammar.Wildcard <*> children (Java.Syntax.Wildcard <$> manyTerm annotation <*> optional (super <|> extends))
+  where
+    super = makeTerm <$> token Super <*> (Java.Syntax.WildcardBoundSuper <$> type')
+    extends = makeTerm1 <$> (Java.Syntax.WildcardBoundExtends <$> type')
+
 if' :: Assignment
 if' = makeTerm <$> symbol IfThenElseStatement <*> children (Statement.If <$> term expression <*> term expression <*> (term expression <|> emptyTerm))
 
@@ -502,6 +491,8 @@ argumentList = symbol ArgumentList *> children (manyTerm expression)
 
 super :: Assignment
 super = makeTerm <$> token Super <*> pure Expression.Super
+-- INCORRECT: super = makeTerm <$> token Super $> Expression.Super
+-- Take partially applied function and replace it instead of applying
 
 this :: Assignment
 this = makeTerm <$> token This <*> pure Expression.This
@@ -515,12 +506,10 @@ constructorDeclaration = makeTerm <$> symbol ConstructorDeclaration <*> children
       constructor modifiers (typeParameters, identifier, formalParameters) = Java.Syntax.Constructor modifiers typeParameters identifier formalParameters -- let partial application do its thing
 
 typeParameters :: Assignment.Assignment [] Grammar [Term]
-typeParameters = symbol TypeParameters *> children (manyTerm typeParam) -- this produces a list, which is what we need to return given by the type definition
+typeParameters = symbol TypeParameters *> children (manyTerm typeParam)
   where
-    typeParam = makeTerm <$> symbol Grammar.TypeParameter <*> children (Java.Syntax.TypeParameter <$> manyTerm annotation <*> term identifier <*> (typeBound <|> pure [])) -- wrapping up all three of those fields so we need to makeTerm (producing a term here)
+    typeParam = makeTerm <$> symbol Grammar.TypeParameter <*> children (Java.Syntax.TypeParameter <$> manyTerm annotation <*> term identifier <*> (typeBound <|> pure []))
     typeBound = symbol TypeBound *> children (manyTerm type')
-    -- manyTerm typeParam made sense because each type Parameter was wrapped up into a Grammar.TypeParameter node, dissimilar
-    -- to superInterfaces
 
 annotation :: Assignment
 annotation = makeTerm <$> symbol NormalAnnotation <*> children (Java.Syntax.Annotation <$> term expression <*> (elementValuePairList <|> pure []))
@@ -535,19 +524,24 @@ throws :: Assignment.Assignment [] Grammar [Term]
 throws = symbol Throws *> children (symbol ExceptionTypeList *> children(manyTerm type'))
 
 formalParameters :: Assignment.Assignment [] Grammar [Term]
-formalParameters = manyTerm parameter
+formalParameters = manyTerm (parameter <|> spreadParameter)
   where
     parameter = makeTerm <$> symbol FormalParameter <*> children (makeAnnotation <$> manyTerm modifier <*> type' <* symbol VariableDeclaratorId <*> children identifier)
     makeAnnotation [] type' variableName = Type.Annotation variableName type'
     makeAnnotation modifiers type' variableName = Type.Annotation variableName (makeTerm1 (Java.Syntax.TypeWithModifiers modifiers type'))
--- know when we are in a functor context and fmap is all gravy
--- we're just wrapping stuff up in data, we aren't building a pattern (assignment) so we aren't in an applicative context
--- when in an applicative context, we're also in a functor context (ie., defining how fmap will work over it)
--- sometimes it is nice to be able to say you're in an applicative context without refering to any particular applicative instance
-
--- constantDeclaration :: Assignment
--- constantDeclaration = makeTerm <$> symbol ConstantDeclaration <*>
 
 castExpression :: Assignment
 castExpression = makeTerm <$> symbol CastExpression <*> children (flip Type.Annotation <$> type' <*> term expression)
--- term expression, because we can deal with comments
+
+fieldAccess :: Assignment
+fieldAccess = makeTerm <$> symbol FieldAccess <*> children (Expression.MemberAccess <$> term expression <*> identifier')
+
+spreadParameter :: Assignment
+spreadParameter = makeTerm <$> symbol Grammar.SpreadParameter <*> children (Java.Syntax.SpreadParameter <$> (makeSingleDecl <$> manyTerm modifier <*> type' <*> variableDeclarator))
+  where
+    variableDeclarator = symbol VariableDeclarator *> children ((,) <$> variableDeclaratorId <*> optional expression)
+    makeSingleDecl modifiers type' (target, Nothing) = makeTerm1 (Java.Syntax.Variable modifiers type' target)
+    makeSingleDecl modifiers type' (target, Just value) = makeTerm1 (Statement.Assignment [] (makeTerm1 (Java.Syntax.Variable modifiers type' target)) value)
+
+arrayAccess :: Assignment
+arrayAccess = makeTerm <$> symbol ArrayAccess <*> children (Expression.Subscript <$> term expression <*> manyTerm expression)

src/Language/Java/Syntax.hs

@@ -7,7 +7,8 @@ import Prologue hiding (Constructor)
 import Data.JSON.Fields
 
 newtype Import a = Import [a]
-  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor,  Generic1, Mergeable, Ord, Show, Traversable, Declarations1, ToJSONFields1, Hashable1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
 
 instance Eq1 Import where liftEq = genericLiftEq
 instance Ord1 Import where liftCompare = genericLiftCompare
@@ -17,7 +18,8 @@ instance Show1 Import where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Import
 
 data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] }
-  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor,  Generic1, Mergeable, Ord, Show, Traversable, Declarations1, ToJSONFields1, Hashable1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
 
 instance Eq1 Module where liftEq = genericLiftEq
 instance Ord1 Module where liftCompare = genericLiftCompare
@@ -26,7 +28,8 @@ instance Show1 Module where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Module
 
 newtype Package a = Package [a]
-  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor,  Generic1, Mergeable, Ord, Show, Traversable, Declarations1, ToJSONFields1, Hashable1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
 
 instance Eq1 Package where liftEq = genericLiftEq
 instance Ord1 Package where liftCompare = genericLiftCompare
@@ -35,8 +38,8 @@ instance Show1 Package where liftShowsPrec = genericLiftShowsPrec
 -- TODO: Implement Eval instance for ArrayType
 instance Evaluatable Package
 
-data EnumDeclaration a = EnumDeclaration { _enumDeclarationIdentifier :: !a, _enumDeclarationBody :: ![a] }
-  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor,  Generic1, Mergeable, Ord, Show, Traversable, Declarations1, ToJSONFields1, Hashable1)
+data EnumDeclaration a = EnumDeclaration { enumDeclarationModifier :: ![a], enumDeclarationIdentifier :: !a, enumDeclarationSuperInterfaces :: ![a], enumDeclarationConstant :: ![a], enumDeclarationBody :: ![a] }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 EnumDeclaration where liftEq = genericLiftEq
 instance Ord1 EnumDeclaration where liftCompare = genericLiftCompare
@@ -45,7 +48,7 @@ instance Evaluatable EnumDeclaration
 
 
 data Variable a = Variable { variableModifiers :: ![a], variableType :: !a, variableName :: !a}
-  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor,  Generic1, Mergeable, Ord, Show, Traversable, Declarations1, ToJSONFields1, Hashable1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Variable where liftEq = genericLiftEq
 instance Ord1 Variable where liftCompare = genericLiftCompare
@@ -55,7 +58,7 @@ instance Show1 Variable where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Variable
 
 data Synchronized a = Synchronized { synchronizedSubject :: !a, synchronizedBody :: !a}
-  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor,  Generic1, Mergeable, Ord, Show, Traversable, Declarations1, ToJSONFields1, Hashable1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Synchronized where liftEq = genericLiftEq
 instance Ord1 Synchronized where liftCompare = genericLiftCompare
@@ -65,7 +68,7 @@ instance Show1 Synchronized where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Synchronized
 
 data New a = New { newType :: !a, newArgs :: ![a] }
-  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor,  Generic1, Mergeable, Ord, Show, Traversable, Declarations1, ToJSONFields1, Hashable1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 New where liftEq = genericLiftEq
 instance Ord1 New where liftCompare = genericLiftCompare
@@ -75,7 +78,7 @@ instance Show1 New where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable New
 
 data Asterisk a = Asterisk
-  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor,  Generic1, Mergeable, Ord, Show, Traversable, Declarations1, ToJSONFields1, Hashable1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Asterisk where liftEq = genericLiftEq
 instance Ord1 Asterisk where liftCompare = genericLiftCompare
@@ -86,7 +89,7 @@ instance Evaluatable Asterisk
 
 
 data Constructor a = Constructor { constructorModifiers :: ![a], constructorTypeParams :: ![a], constructorIdentifier :: !a, constructorParams :: ![a], constructorThrows :: ![a], constructorBody :: a}
-  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor,  Generic1, Mergeable, Ord, Show, Traversable, Declarations1, ToJSONFields1, Hashable1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Constructor where liftEq = genericLiftEq
 instance Ord1 Constructor where liftCompare = genericLiftCompare
@@ -96,7 +99,7 @@ instance Show1 Constructor where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Constructor
 
 data TypeParameter a = TypeParameter { typeParamAnnotation :: ![a], typeParamIdentifier :: !a, typeParamTypeBound :: ![a]}
-  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor,  Generic1, Mergeable, Ord, Show, Traversable, Declarations1, ToJSONFields1, Hashable1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypeParameter where liftEq = genericLiftEq
 instance Ord1 TypeParameter where liftCompare = genericLiftCompare
@@ -106,7 +109,7 @@ instance Show1 TypeParameter where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TypeParameter
 
 data Annotation a = Annotation { annotationName :: !a, annotationField :: [a]}
-  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor,  Generic1, Mergeable, Ord, Show, Traversable, Declarations1, ToJSONFields1, Hashable1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Annotation where liftEq = genericLiftEq
 instance Ord1 Annotation where liftCompare = genericLiftCompare
@@ -116,7 +119,7 @@ instance Show1 Annotation where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Annotation
 
 data AnnotationField a = AnnotationField { annotationFieldName :: a, annotationFieldValue :: a }
-  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor,  Generic1, Mergeable, Ord, Show, Traversable, Declarations1, ToJSONFields1, Hashable1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 AnnotationField where liftEq = genericLiftEq
 instance Ord1 AnnotationField where liftCompare = genericLiftCompare
@@ -126,7 +129,7 @@ instance Show1 AnnotationField where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable AnnotationField
 
 data GenericType a = GenericType { genericTypeIdentifier :: a, genericTypeArguments :: [a] }
-  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor,  Generic1, Mergeable, Ord, Show, Traversable, Declarations1, ToJSONFields1, Hashable1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 GenericType where liftEq = genericLiftEq
 instance Ord1 GenericType where liftCompare = genericLiftCompare
@@ -136,7 +139,7 @@ instance Show1 GenericType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable GenericType
 
 data TypeWithModifiers a = TypeWithModifiers [a] a
-  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor,  Generic1, Mergeable, Ord, Show, Traversable, Declarations1, ToJSONFields1, Hashable1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypeWithModifiers where liftEq = genericLiftEq
 instance Ord1 TypeWithModifiers where liftCompare = genericLiftCompare
@@ -144,3 +147,33 @@ instance Show1 TypeWithModifiers where liftShowsPrec = genericLiftShowsPrec
 
 -- TODO: Implement Eval instance for TypeWithModifiers
 instance Evaluatable TypeWithModifiers
+
+data Wildcard a = Wildcard { wildcardAnnotation :: [a], wildcardBounds :: Maybe a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 Wildcard where liftEq = genericLiftEq
+instance Ord1 Wildcard where liftCompare = genericLiftCompare
+instance Show1 Wildcard where liftShowsPrec = genericLiftShowsPrec
+
+-- TODO: Implement Eval instance for TypeWithModifiers
+instance Evaluatable Wildcard
+
+data WildcardBounds a = WildcardBoundExtends { wildcardBoundType :: a} | WildcardBoundSuper { wildcardBoundType :: a}
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 WildcardBounds where liftEq = genericLiftEq
+instance Ord1 WildcardBounds where liftCompare = genericLiftCompare
+instance Show1 WildcardBounds where liftShowsPrec = genericLiftShowsPrec
+
+-- TODO: Implement Eval instance for TypeWithModifiers
+instance Evaluatable WildcardBounds
+
+newtype SpreadParameter a = SpreadParameter { spreadParameterVariableDeclarator :: a}
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
+
+instance Eq1 SpreadParameter where liftEq = genericLiftEq
+instance Ord1 SpreadParameter where liftCompare = genericLiftCompare
+instance Show1 SpreadParameter where liftShowsPrec = genericLiftShowsPrec
+
+-- TODO: Implement Eval instance for SpreadParameter
+instance Evaluatable SpreadParameter

src/Language/Markdown/Assignment.hs

@@ -10,11 +10,9 @@ import Assigning.Assignment hiding (Assignment, Error)
 import Data.Record
 import Data.Syntax (makeTerm)
 import Data.Term as Term (Term(..), TermF(..), termFAnnotation, termFOut, termIn)
-import Data.Text.Encoding (encodeUtf8)
 import Parsing.CMark as Grammar (Grammar(..))
 import qualified Assigning.Assignment as Assignment
 import qualified CMarkGFM
-import qualified Data.ByteString as B
 import Data.Sum
 import qualified Data.Syntax as Syntax
 import qualified Data.Text as Text
@@ -148,14 +146,14 @@ htmlInline = makeTerm <$> symbol HTMLInline <*> (Markup.HTMLBlock <$> source)
 link :: Assignment
 link = makeTerm <$> symbol Link <*> (makeLink . termFAnnotation . termFOut <$> currentNode) <* advance
   where
-    makeLink (CMarkGFM.LINK url title) = Markup.Link (encodeUtf8 url) (nullText title)
-    makeLink _ = Markup.Link B.empty Nothing
+    makeLink (CMarkGFM.LINK url title) = Markup.Link url (nullText title)
+    makeLink _ = Markup.Link mempty Nothing
 
 image :: Assignment
 image = makeTerm <$> symbol Image <*> (makeImage . termFAnnotation . termFOut <$> currentNode) <* advance
   where
-    makeImage (CMarkGFM.IMAGE url title) = Markup.Image (encodeUtf8 url) (nullText title)
-    makeImage _ = Markup.Image B.empty Nothing
+    makeImage (CMarkGFM.IMAGE url title) = Markup.Image url (nullText title)
+    makeImage _ = Markup.Image mempty Nothing
 
 code :: Assignment
 code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source)
@@ -169,5 +167,5 @@ softBreak = makeTerm <$> token SoftBreak <*> pure Markup.LineBreak
 
 -- Implementation details
 
-nullText :: Text.Text -> Maybe ByteString
-nullText text = if Text.null text then Nothing else Just (encodeUtf8 text)
+nullText :: Text.Text -> Maybe Text.Text
+nullText text = if Text.null text then Nothing else Just text

src/Language/Markdown/Syntax.hs

@@ -2,14 +2,12 @@
 module Language.Markdown.Syntax where
 
 import Prologue hiding (Text)
-import Data.ByteString.Char8 (unpack)
 import Data.JSON.Fields
+import qualified Data.Text as T
 import Diffing.Algorithm
 
 newtype Document a = Document [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Document
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 Document where liftEq = genericLiftEq
 instance Ord1 Document where liftCompare = genericLiftCompare
@@ -19,91 +17,70 @@ instance Show1 Document where liftShowsPrec = genericLiftShowsPrec
 -- Block elements
 
 newtype Paragraph a = Paragraph [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Paragraph
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 Paragraph where liftEq = genericLiftEq
 instance Ord1 Paragraph where liftCompare = genericLiftCompare
 instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
 
 data Heading a = Heading { headingLevel :: Int, headingContent :: [a], sectionContent :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Heading
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 Heading where liftEq = genericLiftEq
 instance Ord1 Heading where liftCompare = genericLiftCompare
 instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec
 
 newtype UnorderedList a = UnorderedList [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 UnorderedList
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 UnorderedList where liftEq = genericLiftEq
 instance Ord1 UnorderedList where liftCompare = genericLiftCompare
 instance Show1 UnorderedList where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 OrderedList
-
 newtype OrderedList a = OrderedList [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 OrderedList where liftEq = genericLiftEq
 instance Ord1 OrderedList where liftCompare = genericLiftCompare
 instance Show1 OrderedList where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 BlockQuote
-
 newtype BlockQuote a = BlockQuote [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 BlockQuote where liftEq = genericLiftEq
 instance Ord1 BlockQuote where liftCompare = genericLiftCompare
 instance Show1 BlockQuote where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 ThematicBreak
-
 data ThematicBreak a = ThematicBreak
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 ThematicBreak where liftEq = genericLiftEq
 instance Ord1 ThematicBreak where liftCompare = genericLiftCompare
 instance Show1 ThematicBreak where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 HTMLBlock where
-  toJSONFields1 (HTMLBlock b) = noChildren [ "asString" .= unpack b ]
-
-newtype HTMLBlock a = HTMLBlock ByteString
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+newtype HTMLBlock a = HTMLBlock T.Text
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 HTMLBlock where liftEq = genericLiftEq
 instance Ord1 HTMLBlock where liftCompare = genericLiftCompare
 instance Show1 HTMLBlock where liftShowsPrec = genericLiftShowsPrec
 
 newtype Table a = Table [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Table
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 Table where liftEq = genericLiftEq
 instance Ord1 Table where liftCompare = genericLiftCompare
 instance Show1 Table where liftShowsPrec = genericLiftShowsPrec
 
 newtype TableRow a = TableRow [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 TableRow
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 TableRow where liftEq = genericLiftEq
 instance Ord1 TableRow where liftCompare = genericLiftCompare
 instance Show1 TableRow where liftShowsPrec = genericLiftShowsPrec
 
 newtype TableCell a = TableCell [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 TableCell
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 TableCell where liftEq = genericLiftEq
 instance Ord1 TableCell where liftCompare = genericLiftCompare
@@ -113,76 +90,56 @@ instance Show1 TableCell where liftShowsPrec = genericLiftShowsPrec
 -- Inline elements
 
 newtype Strong a = Strong [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Strong
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 Strong where liftEq = genericLiftEq
 instance Ord1 Strong where liftCompare = genericLiftCompare
 instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec
 
 newtype Emphasis a = Emphasis [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Emphasis
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 Emphasis where liftEq = genericLiftEq
 instance Ord1 Emphasis where liftCompare = genericLiftCompare
 instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec
 
-newtype Text a = Text ByteString
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Text where
-  toJSONFields1 (Text s) = noChildren ["asString" .= unpack s ]
+newtype Text a = Text T.Text
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 Text where liftEq = genericLiftEq
 instance Ord1 Text where liftCompare = genericLiftCompare
 instance Show1 Text where liftShowsPrec = genericLiftShowsPrec
 
-data Link a = Link { linkURL :: ByteString, linkTitle :: Maybe ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
--- TODO: Better ToJSONFields1 instance
-instance ToJSONFields1 Link
+data Link a = Link { linkURL :: T.Text, linkTitle :: Maybe T.Text }
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 Link where liftEq = genericLiftEq
 instance Ord1 Link where liftCompare = genericLiftCompare
 instance Show1 Link where liftShowsPrec = genericLiftShowsPrec
 
-data Image a = Image { imageURL :: ByteString, imageTitle :: Maybe ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
--- TODO: Better ToJSONFields1 instance
-instance ToJSONFields1 Image
+data Image a = Image { imageURL :: T.Text, imageTitle :: Maybe T.Text }
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 Image where liftEq = genericLiftEq
 instance Ord1 Image where liftCompare = genericLiftCompare
 instance Show1 Image where liftShowsPrec = genericLiftShowsPrec
 
-data Code a = Code { codeLanguage :: Maybe ByteString, codeContent :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
--- TODO: Better ToJSONFields1 instance
-instance ToJSONFields1 Code
+data Code a = Code { codeLanguage :: Maybe T.Text, codeContent :: T.Text }
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 Code where liftEq = genericLiftEq
 instance Ord1 Code where liftCompare = genericLiftCompare
 instance Show1 Code where liftShowsPrec = genericLiftShowsPrec
 
 data LineBreak a = LineBreak
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 LineBreak
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 LineBreak where liftEq = genericLiftEq
 instance Ord1 LineBreak where liftCompare = genericLiftCompare
 instance Show1 LineBreak where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Strikethrough
-
 newtype Strikethrough a = Strikethrough [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, ToJSONFields1)
 
 instance Eq1 Strikethrough where liftEq = genericLiftEq
 instance Ord1 Strikethrough where liftCompare = genericLiftCompare

src/Language/PHP/Assignment.hs

@@ -9,7 +9,17 @@ module Language.PHP.Assignment
 import Assigning.Assignment hiding (Assignment, Error)
 import Data.Record
 import Data.Sum
-import Data.Syntax (emptyTerm, handleError, parseError, infixContext, makeTerm, makeTerm', makeTerm1, contextualize, postContextualize)
+import Data.Syntax
+    ( contextualize
+    , emptyTerm
+    , handleError
+    , infixContext
+    , makeTerm
+    , makeTerm'
+    , makeTerm1
+    , parseError
+    , postContextualize
+    )
 import Language.PHP.Grammar as Grammar
 import qualified Assigning.Assignment as Assignment
 import qualified Data.Abstract.Name as Name
@@ -62,6 +72,7 @@ type Syntax = '[
   , Statement.Match
   , Statement.Pattern
   , Statement.Return
+  , Statement.Statements
   , Statement.Throw
   , Statement.Try
   , Statement.While
@@ -105,7 +116,6 @@ type Syntax = '[
   , Syntax.NamespaceUseGroupClause
   , Syntax.NewVariable
   , Syntax.PrintIntrinsic
-  , Syntax.Program
   , Syntax.PropertyDeclaration
   , Syntax.PropertyModifier
   , Syntax.QualifiedName
@@ -132,31 +142,9 @@ type Syntax = '[
 type Term = Term.Term (Sum Syntax) (Record Location)
 type Assignment = Assignment.Assignment [] Grammar Term
 
-append :: a -> [a] -> [a]
-append x xs = xs ++ [x]
-
-bookend :: a -> [a] -> a -> [a]
-bookend head list last = head : append last list
-
 -- | Assignment from AST in PHP's grammar onto a program in PHP's syntax.
 assignment :: Assignment
-assignment = handleError $ makeTerm <$> symbol Program <*> children (Syntax.Program <$> (bookend <$> (text <|> emptyTerm) <*> manyTerm statement <*> (text <|> emptyTerm))) <|> parseError
-
-term :: Assignment -> Assignment
-term term = contextualize (comment <|> textInterpolation) (postContextualize (comment <|> textInterpolation) term)
-
-commentedTerm :: Assignment -> Assignment
-commentedTerm term = contextualize (comment <|> textInterpolation) term <|> makeTerm1 <$> (Syntax.Context <$> some1 (comment <|> textInterpolation) <*> emptyTerm)
-
--- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
-manyTerm :: Assignment -> Assignment.Assignment [] Grammar [Term]
-manyTerm = many . commentedTerm
-
-someTerm :: Assignment -> Assignment.Assignment [] Grammar [Term]
-someTerm = fmap NonEmpty.toList . someTerm'
-
-someTerm' :: Assignment -> Assignment.Assignment [] Grammar (NonEmpty Term)
-someTerm' = NonEmpty.some1 . commentedTerm
+assignment = handleError $ makeTerm <$> symbol Program <*> children (Statement.Statements <$> (bookend <$> (text <|> emptyTerm) <*> manyTerm statement <*> (text <|> emptyTerm))) <|> parseError
 
 text :: Assignment
 text = makeTerm <$> symbol Text <*> (Syntax.Text <$> source)
@@ -293,7 +281,7 @@ parenthesizedExpression :: Assignment
 parenthesizedExpression = symbol ParenthesizedExpression *> children (term expression)
 
 classConstantAccessExpression :: Assignment
-classConstantAccessExpression = makeTerm <$> symbol ClassConstantAccessExpression <*> children (Expression.MemberAccess <$> term scopeResolutionQualifier <*> term name)
+classConstantAccessExpression = makeTerm <$> symbol ClassConstantAccessExpression <*> children (Expression.MemberAccess <$> term scopeResolutionQualifier <*> name')
 
 variable :: Assignment
 variable = callableVariable <|> scopedPropertyAccessExpression <|> memberAccessExpression <|> castExpression
@@ -308,11 +296,11 @@ callableVariable = choice [
   ]
 
 memberCallExpression :: Assignment
-memberCallExpression = makeTerm <$> symbol MemberCallExpression <*> children (Expression.Call [] <$> (makeMemberAccess <$> location <*> term dereferencableExpression <*> term memberName) <*> arguments <*> emptyTerm)
+memberCallExpression = makeTerm <$> symbol MemberCallExpression <*> children (Expression.Call [] <$> (makeMemberAccess <$> location <*> term dereferencableExpression <*> memberName') <*> arguments <*> emptyTerm)
   where makeMemberAccess loc expr memberName = makeTerm loc (Expression.MemberAccess expr memberName)
 
 scopedCallExpression :: Assignment
-scopedCallExpression = makeTerm <$> symbol ScopedCallExpression <*> children (Expression.Call [] <$> (makeMemberAccess <$> location <*> term scopeResolutionQualifier <*> term memberName) <*> arguments <*> emptyTerm)
+scopedCallExpression = makeTerm <$> symbol ScopedCallExpression <*> children (Expression.Call [] <$> (makeMemberAccess <$> location <*> term scopeResolutionQualifier <*> memberName') <*> arguments <*> emptyTerm)
   where makeMemberAccess loc expr memberName = makeTerm loc (Expression.MemberAccess expr memberName)
 
 functionCallExpression :: Assignment
@@ -330,13 +318,13 @@ subscriptExpression :: Assignment
 subscriptExpression = makeTerm <$> symbol SubscriptExpression <*> children (Expression.Subscript <$> term dereferencableExpression <*> (pure <$> (term expression <|> emptyTerm)))
 
 memberAccessExpression :: Assignment
-memberAccessExpression = makeTerm <$> symbol MemberAccessExpression <*> children (Expression.MemberAccess <$> term dereferencableExpression <*> term memberName)
+memberAccessExpression = makeTerm <$> symbol MemberAccessExpression <*> children (Expression.MemberAccess <$> term dereferencableExpression <*> memberName')
 
 dereferencableExpression :: Assignment
 dereferencableExpression = symbol DereferencableExpression *> children (term (variable <|> expression <|> arrayCreationExpression <|> string))
 
 scopedPropertyAccessExpression :: Assignment
-scopedPropertyAccessExpression = makeTerm <$> symbol ScopedPropertyAccessExpression <*> children (Expression.MemberAccess <$> term scopeResolutionQualifier <*> term simpleVariable')
+scopedPropertyAccessExpression = makeTerm <$> symbol ScopedPropertyAccessExpression <*> children (Expression.MemberAccess <$> term scopeResolutionQualifier <*> simpleVariable'')
 
 scopeResolutionQualifier :: Assignment
 scopeResolutionQualifier = choice [
@@ -465,6 +453,9 @@ newVariable = makeTerm <$> symbol NewVariable <*> children (Syntax.NewVariable <
 memberName :: Assignment
 memberName = name <|> simpleVariable' <|> expression
 
+memberName' :: Assignment.Assignment [] Grammar Name.Name
+memberName' = name' <|> simpleVariable''
+
 relativeScope :: Assignment
 relativeScope = makeTerm <$> symbol RelativeScope <*> (Syntax.RelativeScope <$> source)
 
@@ -723,6 +714,9 @@ simpleVariable = makeTerm <$> symbol SimpleVariable <*> children (Syntax.SimpleV
 simpleVariable' :: Assignment
 simpleVariable' = choice [simpleVariable, variableName]
 
+simpleVariable'' :: Assignment.Assignment [] Grammar Name.Name
+simpleVariable'' = variableName'
+
 
 yieldExpression :: Assignment
 yieldExpression = makeTerm <$> symbol YieldExpression <*> children (Statement.Yield <$> term (arrayElementInitializer <|> expression))
@@ -747,14 +741,20 @@ requireOnceExpression = makeTerm <$> symbol RequireOnceExpression <*> children (
 variableName :: Assignment
 variableName = makeTerm <$> symbol VariableName <*> children (Syntax.VariableName <$> term name)
 
+variableName' :: Assignment.Assignment [] Grammar Name.Name
+variableName' = symbol VariableName *> children name'
+
 name :: Assignment
 name = makeTerm <$> (symbol Name <|> symbol Name') <*> (Syntax.Identifier . Name.name <$> source)
 
+name' :: Assignment.Assignment [] Grammar Name.Name
+name' = (symbol Name <|> symbol Name') *> (Name.name <$> source)
+
 functionStaticDeclaration :: Assignment
 functionStaticDeclaration = makeTerm <$> symbol FunctionStaticDeclaration <*> children (Declaration.VariableDeclaration <$> manyTerm staticVariableDeclaration)
 
 staticVariableDeclaration :: Assignment
-staticVariableDeclaration = makeTerm <$> symbol StaticVariableDeclaration <*> children (Statement.Assignment <$> pure [] <*> term variableName <*> (term expression <|> emptyTerm))
+staticVariableDeclaration = makeTerm <$> symbol StaticVariableDeclaration <*> children (Statement.Assignment [] <$> term variableName <*> (term expression <|> emptyTerm))
 
 comment :: Assignment
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
@@ -762,6 +762,31 @@ comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 string :: Assignment
 string = makeTerm <$> (symbol Grammar.String <|> symbol Heredoc) <*> (Literal.TextElement <$> source)
 
+
+-- Helpers
+
+append :: a -> [a] -> [a]
+append x xs = xs ++ [x]
+
+bookend :: a -> [a] -> a -> [a]
+bookend head list last = head : append last list
+
+term :: Assignment -> Assignment
+term term = contextualize (comment <|> textInterpolation) (postContextualize (comment <|> textInterpolation) term)
+
+commentedTerm :: Assignment -> Assignment
+commentedTerm term = contextualize (comment <|> textInterpolation) term <|> makeTerm1 <$> (Syntax.Context <$> some1 (comment <|> textInterpolation) <*> emptyTerm)
+
+-- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
+manyTerm :: Assignment -> Assignment.Assignment [] Grammar [Term]
+manyTerm = many . commentedTerm
+
+someTerm :: Assignment -> Assignment.Assignment [] Grammar [Term]
+someTerm = fmap NonEmpty.toList . someTerm'
+
+someTerm' :: Assignment -> Assignment.Assignment [] Grammar (NonEmpty Term)
+someTerm' = NonEmpty.some1 . commentedTerm
+
 -- | Match infix terms separated by any of a list of operators, assigning any comments following each operand.
 infixTerm :: Assignment
           -> Assignment

src/Language/PHP/Syntax.hs

@@ -4,18 +4,14 @@ module Language.PHP.Syntax where
 import           Data.Abstract.Evaluatable
 import           Data.Abstract.Module
 import           Data.Abstract.Path
-import qualified Data.ByteString.Char8 as BC
+import qualified Data.Text as T
 import           Data.JSON.Fields
 import qualified Data.Language as Language
 import           Diffing.Algorithm
-import           Prelude hiding (fail)
 import           Prologue hiding (Text)
 
-newtype Text a = Text ByteString
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Text where
-  toJSONFields1 (Text t) = noChildren ["asString" .= BC.unpack t]
+newtype Text a = Text T.Text
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Text where liftEq = genericLiftEq
 instance Ord1 Text where liftCompare = genericLiftCompare
@@ -24,9 +20,7 @@ instance Evaluatable Text
 
 
 newtype VariableName a = VariableName a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 VariableName
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 VariableName where liftEq = genericLiftEq
 instance Ord1 VariableName where liftCompare = genericLiftCompare
@@ -44,13 +38,13 @@ instance Evaluatable VariableName
 resolvePHPName :: ( Member (Modules address value) effects
                   , Member (Resumable ResolutionError) effects
                   )
-               => ByteString
+               => T.Text
                -> Evaluator address value effects ModulePath
 resolvePHPName n = do
   modulePath <- resolve [name]
   maybeM (throwResumable $ NotFoundError name [name] Language.PHP) modulePath
   where name = toName n
-        toName = BC.unpack . dropRelativePrefix . stripQuotes
+        toName = T.unpack . dropRelativePrefix . stripQuotes
 
 include :: ( AbstractValue address value effects
            , Member (Allocator address value) effects
@@ -73,61 +67,51 @@ include pathTerm f = do
   pure (Rval v)
 
 newtype Require a = Require a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Require where liftEq          = genericLiftEq
 instance Ord1 Require where liftCompare    = genericLiftCompare
 instance Show1 Require where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Require
-
 instance Evaluatable Require where
   eval (Require path) = include path load
 
 
 newtype RequireOnce a = RequireOnce a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 RequireOnce where liftEq = genericLiftEq
 instance Ord1 RequireOnce where liftCompare = genericLiftCompare
 instance Show1 RequireOnce where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 RequireOnce
-
 instance Evaluatable RequireOnce where
   eval (RequireOnce path) = include path require
 
 
 newtype Include a = Include a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Include where liftEq          = genericLiftEq
 instance Ord1 Include where liftCompare    = genericLiftCompare
 instance Show1 Include where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Include
-
 instance Evaluatable Include where
   eval (Include path) = include path load
 
 
 newtype IncludeOnce a = IncludeOnce a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 IncludeOnce where liftEq          = genericLiftEq
 instance Ord1 IncludeOnce where liftCompare    = genericLiftCompare
 instance Show1 IncludeOnce where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 IncludeOnce
-
 instance Evaluatable IncludeOnce where
   eval (IncludeOnce path) = include path require
 
 
 newtype ArrayElement a = ArrayElement a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 ArrayElement
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ArrayElement where liftEq          = genericLiftEq
 instance Ord1 ArrayElement where liftCompare    = genericLiftCompare
@@ -135,9 +119,7 @@ instance Show1 ArrayElement where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ArrayElement
 
 newtype GlobalDeclaration a = GlobalDeclaration [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 GlobalDeclaration
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 GlobalDeclaration where liftEq          = genericLiftEq
 instance Ord1 GlobalDeclaration where liftCompare    = genericLiftCompare
@@ -145,9 +127,7 @@ instance Show1 GlobalDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable GlobalDeclaration
 
 newtype SimpleVariable a = SimpleVariable a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 SimpleVariable
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 SimpleVariable where liftEq          = genericLiftEq
 instance Ord1 SimpleVariable where liftCompare    = genericLiftCompare
@@ -156,10 +136,8 @@ instance Evaluatable SimpleVariable
 
 
 -- | TODO: Unify with TypeScript's PredefinedType
-newtype CastType a = CastType { _castType :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 CastType
+newtype CastType a = CastType { _castType :: T.Text }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 CastType where liftEq = genericLiftEq
 instance Ord1 CastType where liftCompare = genericLiftCompare
@@ -167,9 +145,7 @@ instance Show1 CastType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable CastType
 
 newtype ErrorControl a = ErrorControl a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 ErrorControl
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ErrorControl where liftEq = genericLiftEq
 instance Ord1 ErrorControl where liftCompare = genericLiftCompare
@@ -177,19 +153,15 @@ instance Show1 ErrorControl where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ErrorControl
 
 newtype Clone a = Clone a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Clone
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Clone where liftEq = genericLiftEq
 instance Ord1 Clone where liftCompare = genericLiftCompare
 instance Show1 Clone where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Clone
 
-newtype ShellCommand a = ShellCommand ByteString
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 ShellCommand
+newtype ShellCommand a = ShellCommand T.Text
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ShellCommand where liftEq = genericLiftEq
 instance Ord1 ShellCommand where liftCompare = genericLiftCompare
@@ -198,9 +170,7 @@ instance Evaluatable ShellCommand
 
 -- | TODO: Combine with TypeScript update expression.
 newtype Update a = Update { _updateSubject :: a }
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Update
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Update where liftEq = genericLiftEq
 instance Ord1 Update where liftCompare = genericLiftCompare
@@ -208,19 +178,15 @@ instance Show1 Update where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Update
 
 newtype NewVariable a = NewVariable [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 NewVariable
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 NewVariable where liftEq = genericLiftEq
 instance Ord1 NewVariable where liftCompare = genericLiftCompare
 instance Show1 NewVariable where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable NewVariable
 
-newtype RelativeScope a = RelativeScope ByteString
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 RelativeScope
+newtype RelativeScope a = RelativeScope T.Text
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 RelativeScope where liftEq = genericLiftEq
 instance Ord1 RelativeScope where liftCompare = genericLiftCompare
@@ -228,9 +194,7 @@ instance Show1 RelativeScope where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable RelativeScope
 
 data QualifiedName a = QualifiedName !a !a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 QualifiedName
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 QualifiedName where liftEq = genericLiftEq
 instance Ord1 QualifiedName where liftCompare = genericLiftCompare
@@ -240,9 +204,7 @@ instance Evaluatable QualifiedName where
   eval (fmap subtermValue -> QualifiedName name iden) = Rval <$> evaluateInScopedEnv name (box =<< iden)
 
 newtype NamespaceName a = NamespaceName (NonEmpty a)
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 NamespaceName
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
 
 instance Hashable1 NamespaceName where liftHashWithSalt = foldl
 instance Eq1 NamespaceName where liftEq = genericLiftEq
@@ -253,9 +215,7 @@ instance Evaluatable NamespaceName where
   eval (NamespaceName xs) = rvalBox =<< foldl1 (\ l r -> r >>= (evaluateInScopedEnv l . box) >>= deref) (fmap subtermValue xs)
 
 newtype ConstDeclaration a = ConstDeclaration [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 ConstDeclaration
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ConstDeclaration where liftEq = genericLiftEq
 instance Ord1 ConstDeclaration where liftCompare = genericLiftCompare
@@ -263,9 +223,7 @@ instance Show1 ConstDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ConstDeclaration
 
 data ClassConstDeclaration a = ClassConstDeclaration a [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 ClassConstDeclaration
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ClassConstDeclaration where liftEq = genericLiftEq
 instance Ord1 ClassConstDeclaration where liftCompare = genericLiftCompare
@@ -273,9 +231,7 @@ instance Show1 ClassConstDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ClassConstDeclaration
 
 newtype ClassInterfaceClause a = ClassInterfaceClause [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 ClassInterfaceClause
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ClassInterfaceClause where liftEq = genericLiftEq
 instance Ord1 ClassInterfaceClause where liftCompare = genericLiftCompare
@@ -283,9 +239,7 @@ instance Show1 ClassInterfaceClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ClassInterfaceClause
 
 newtype ClassBaseClause a = ClassBaseClause a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 ClassBaseClause
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ClassBaseClause where liftEq = genericLiftEq
 instance Ord1 ClassBaseClause where liftCompare = genericLiftCompare
@@ -294,9 +248,7 @@ instance Evaluatable ClassBaseClause
 
 
 newtype UseClause a = UseClause [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 UseClause
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 UseClause where liftEq = genericLiftEq
 instance Ord1 UseClause where liftCompare = genericLiftCompare
@@ -304,9 +256,7 @@ instance Show1 UseClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable UseClause
 
 newtype ReturnType a = ReturnType a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 ReturnType
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ReturnType where liftEq = genericLiftEq
 instance Ord1 ReturnType where liftCompare = genericLiftCompare
@@ -314,9 +264,7 @@ instance Show1 ReturnType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ReturnType
 
 newtype TypeDeclaration a = TypeDeclaration a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 TypeDeclaration
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypeDeclaration where liftEq = genericLiftEq
 instance Ord1 TypeDeclaration where liftCompare = genericLiftCompare
@@ -324,19 +272,15 @@ instance Show1 TypeDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TypeDeclaration
 
 newtype BaseTypeDeclaration a = BaseTypeDeclaration a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 BaseTypeDeclaration
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 BaseTypeDeclaration where liftEq = genericLiftEq
 instance Ord1 BaseTypeDeclaration where liftCompare = genericLiftCompare
 instance Show1 BaseTypeDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable BaseTypeDeclaration
 
-newtype ScalarType a = ScalarType ByteString
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 ScalarType
+newtype ScalarType a = ScalarType T.Text
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ScalarType where liftEq = genericLiftEq
 instance Ord1 ScalarType where liftCompare = genericLiftCompare
@@ -344,9 +288,7 @@ instance Show1 ScalarType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ScalarType
 
 newtype EmptyIntrinsic a = EmptyIntrinsic a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 EmptyIntrinsic
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 EmptyIntrinsic where liftEq = genericLiftEq
 instance Ord1 EmptyIntrinsic where liftCompare = genericLiftCompare
@@ -354,9 +296,7 @@ instance Show1 EmptyIntrinsic where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable EmptyIntrinsic
 
 newtype ExitIntrinsic a = ExitIntrinsic a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 ExitIntrinsic
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ExitIntrinsic where liftEq = genericLiftEq
 instance Ord1 ExitIntrinsic where liftCompare = genericLiftCompare
@@ -364,9 +304,7 @@ instance Show1 ExitIntrinsic where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ExitIntrinsic
 
 newtype IssetIntrinsic a = IssetIntrinsic a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 IssetIntrinsic
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 IssetIntrinsic where liftEq = genericLiftEq
 instance Ord1 IssetIntrinsic where liftCompare = genericLiftCompare
@@ -374,9 +312,7 @@ instance Show1 IssetIntrinsic where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable IssetIntrinsic
 
 newtype EvalIntrinsic a = EvalIntrinsic a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 EvalIntrinsic
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 EvalIntrinsic where liftEq = genericLiftEq
 instance Ord1 EvalIntrinsic where liftCompare = genericLiftCompare
@@ -384,9 +320,7 @@ instance Show1 EvalIntrinsic where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable EvalIntrinsic
 
 newtype PrintIntrinsic a = PrintIntrinsic a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 PrintIntrinsic
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 PrintIntrinsic where liftEq = genericLiftEq
 instance Ord1 PrintIntrinsic where liftCompare = genericLiftCompare
@@ -394,9 +328,7 @@ instance Show1 PrintIntrinsic where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable PrintIntrinsic
 
 newtype NamespaceAliasingClause a = NamespaceAliasingClause a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 NamespaceAliasingClause
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 NamespaceAliasingClause where liftEq = genericLiftEq
 instance Ord1 NamespaceAliasingClause where liftCompare = genericLiftCompare
@@ -404,9 +336,7 @@ instance Show1 NamespaceAliasingClause where liftShowsPrec = genericLiftShowsPre
 instance Evaluatable NamespaceAliasingClause
 
 newtype NamespaceUseDeclaration a = NamespaceUseDeclaration [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 NamespaceUseDeclaration
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 NamespaceUseDeclaration where liftEq = genericLiftEq
 instance Ord1 NamespaceUseDeclaration where liftCompare = genericLiftCompare
@@ -414,9 +344,7 @@ instance Show1 NamespaceUseDeclaration where liftShowsPrec = genericLiftShowsPre
 instance Evaluatable NamespaceUseDeclaration
 
 newtype NamespaceUseClause a = NamespaceUseClause [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 NamespaceUseClause
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 NamespaceUseClause where liftEq = genericLiftEq
 instance Ord1 NamespaceUseClause where liftCompare = genericLiftCompare
@@ -424,9 +352,7 @@ instance Show1 NamespaceUseClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable NamespaceUseClause
 
 newtype NamespaceUseGroupClause a = NamespaceUseGroupClause [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 NamespaceUseGroupClause
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 NamespaceUseGroupClause where liftEq = genericLiftEq
 instance Ord1 NamespaceUseGroupClause where liftCompare = genericLiftCompare
@@ -434,30 +360,26 @@ instance Show1 NamespaceUseGroupClause where liftShowsPrec = genericLiftShowsPre
 instance Evaluatable NamespaceUseGroupClause
 
 data Namespace a = Namespace { namespaceName :: a, namespaceBody :: a }
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Namespace where liftEq = genericLiftEq
 instance Ord1 Namespace where liftCompare = genericLiftCompare
 instance Show1 Namespace where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Namespace
-
 instance Evaluatable Namespace where
-  eval Namespace{..} = rvalBox =<< go names
+  eval Namespace{..} = rvalBox =<< go (freeVariables (subterm namespaceName))
     where
-      names = freeVariables (subterm namespaceName)
-      go [] = raiseEff (fail "expected at least one free variable in namespaceName, found none")
-      -- The last name creates a closure over the namespace body.
-      go [name] = letrec' name $ \addr ->
-        subtermValue namespaceBody *> makeNamespace name addr Nothing
       -- Each namespace name creates a closure over the subsequent namespace closures
-      go (name:xs) = letrec' name $ \addr ->
-        go xs <* makeNamespace name addr Nothing
+      go (name:x:xs) = letrec' name $ \addr ->
+        go (x:xs) <* makeNamespace name addr Nothing
+      -- The last name creates a closure over the namespace body.
+      go names = do
+        name <- maybeM (throwEvalError (FreeVariablesError [])) (listToMaybe names)
+        letrec' name $ \addr ->
+          subtermValue namespaceBody *> makeNamespace name addr Nothing
 
 data TraitDeclaration a = TraitDeclaration { traitName :: a, traitStatements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 TraitDeclaration
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TraitDeclaration where liftEq = genericLiftEq
 instance Ord1 TraitDeclaration where liftCompare = genericLiftCompare
@@ -465,9 +387,7 @@ instance Show1 TraitDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TraitDeclaration
 
 data AliasAs a = AliasAs { aliasAsName  :: a, aliasAsModifier :: a, aliasAsClause :: a }
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 AliasAs
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 AliasAs where liftEq = genericLiftEq
 instance Ord1 AliasAs where liftCompare = genericLiftCompare
@@ -475,9 +395,7 @@ instance Show1 AliasAs where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable AliasAs
 
 data InsteadOf a = InsteadOf a a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 InsteadOf
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 InsteadOf where liftEq = genericLiftEq
 instance Ord1 InsteadOf where liftCompare = genericLiftCompare
@@ -485,9 +403,7 @@ instance Show1 InsteadOf where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable InsteadOf
 
 newtype TraitUseSpecification a = TraitUseSpecification [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 TraitUseSpecification
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TraitUseSpecification where liftEq = genericLiftEq
 instance Ord1 TraitUseSpecification where liftCompare = genericLiftCompare
@@ -495,9 +411,7 @@ instance Show1 TraitUseSpecification where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TraitUseSpecification
 
 data TraitUseClause a = TraitUseClause [a] a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 TraitUseClause
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TraitUseClause where liftEq = genericLiftEq
 instance Ord1 TraitUseClause where liftCompare = genericLiftCompare
@@ -505,29 +419,23 @@ instance Show1 TraitUseClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TraitUseClause
 
 data DestructorDeclaration a = DestructorDeclaration [a] a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 DestructorDeclaration
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 DestructorDeclaration where liftEq = genericLiftEq
 instance Ord1 DestructorDeclaration where liftCompare = genericLiftCompare
 instance Show1 DestructorDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable DestructorDeclaration
 
-newtype Static a = Static ByteString
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Static
+newtype Static a = Static T.Text
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Static where liftEq = genericLiftEq
 instance Ord1 Static where liftCompare = genericLiftCompare
 instance Show1 Static where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Static
 
-newtype ClassModifier a = ClassModifier ByteString
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 ClassModifier
+newtype ClassModifier a = ClassModifier T.Text
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ClassModifier where liftEq = genericLiftEq
 instance Ord1 ClassModifier where liftCompare = genericLiftCompare
@@ -535,9 +443,7 @@ instance Show1 ClassModifier where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ClassModifier
 
 data ConstructorDeclaration a = ConstructorDeclaration [a] [a] a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 ConstructorDeclaration
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ConstructorDeclaration where liftEq = genericLiftEq
 instance Ord1 ConstructorDeclaration where liftCompare = genericLiftCompare
@@ -545,9 +451,7 @@ instance Show1 ConstructorDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ConstructorDeclaration
 
 data PropertyDeclaration a = PropertyDeclaration a [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 PropertyDeclaration
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 PropertyDeclaration where liftEq = genericLiftEq
 instance Ord1 PropertyDeclaration where liftCompare = genericLiftCompare
@@ -555,9 +459,7 @@ instance Show1 PropertyDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable PropertyDeclaration
 
 data PropertyModifier a = PropertyModifier a a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 PropertyModifier
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 PropertyModifier where liftEq = genericLiftEq
 instance Ord1 PropertyModifier where liftCompare = genericLiftCompare
@@ -565,9 +467,7 @@ instance Show1 PropertyModifier where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable PropertyModifier
 
 data InterfaceDeclaration a = InterfaceDeclaration a a [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 InterfaceDeclaration
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 InterfaceDeclaration where liftEq = genericLiftEq
 instance Ord1 InterfaceDeclaration where liftCompare = genericLiftCompare
@@ -575,9 +475,7 @@ instance Show1 InterfaceDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable InterfaceDeclaration
 
 newtype InterfaceBaseClause a = InterfaceBaseClause [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 InterfaceBaseClause
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 InterfaceBaseClause where liftEq = genericLiftEq
 instance Ord1 InterfaceBaseClause where liftCompare = genericLiftCompare
@@ -585,9 +483,7 @@ instance Show1 InterfaceBaseClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable InterfaceBaseClause
 
 newtype Echo a = Echo a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Echo
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Echo where liftEq = genericLiftEq
 instance Ord1 Echo where liftCompare = genericLiftCompare
@@ -595,9 +491,7 @@ instance Show1 Echo where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Echo
 
 newtype Unset a = Unset a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Unset
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Unset where liftEq = genericLiftEq
 instance Ord1 Unset where liftCompare = genericLiftCompare
@@ -605,9 +499,7 @@ instance Show1 Unset where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Unset
 
 data Declare a = Declare a a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 Declare
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Declare where liftEq = genericLiftEq
 instance Ord1 Declare where liftCompare = genericLiftCompare
@@ -615,9 +507,7 @@ instance Show1 Declare where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Declare
 
 newtype DeclareDirective a = DeclareDirective a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 DeclareDirective
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 DeclareDirective where liftEq = genericLiftEq
 instance Ord1 DeclareDirective where liftCompare = genericLiftCompare
@@ -625,9 +515,7 @@ instance Show1 DeclareDirective where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable DeclareDirective
 
 newtype LabeledStatement a = LabeledStatement { _labeledStatementIdentifier :: a }
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
-
-instance ToJSONFields1 LabeledStatement
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 LabeledStatement where liftEq = genericLiftEq
 instance Ord1 LabeledStatement where liftCompare = genericLiftCompare

src/Language/Python/Assignment.hs

@@ -8,13 +8,25 @@ module Language.Python.Assignment
 ) where
 
 import Assigning.Assignment hiding (Assignment, Error)
-import Data.Abstract.Name (name)
+import Data.Abstract.Name (Name, name)
 import Data.Record
-import Data.Syntax (contextualize, emptyTerm, handleError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1, parseError, postContextualize)
+import Data.Syntax
+    ( contextualize
+    , emptyTerm
+    , handleError
+    , infixContext
+    , makeTerm
+    , makeTerm'
+    , makeTerm''
+    , makeTerm1
+    , parseError
+    , postContextualize
+    )
 import GHC.Stack
 import Language.Python.Grammar as Grammar
 import Language.Python.Syntax as Python.Syntax
 import qualified Assigning.Assignment as Assignment
+import qualified Data.List.NonEmpty as NonEmpty
 import Data.Sum
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Comment as Comment
@@ -24,7 +36,7 @@ import qualified Data.Syntax.Literal as Literal
 import qualified Data.Syntax.Statement as Statement
 import qualified Data.Syntax.Type as Type
 import qualified Data.Term as Term
-import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Text as T
 import Prologue
 
 
@@ -68,6 +80,7 @@ type Syntax =
    , Statement.Let
    , Statement.NoOp
    , Statement.Return
+   , Statement.Statements
    , Statement.Throw
    , Statement.Try
    , Statement.While
@@ -80,7 +93,6 @@ type Syntax =
    , Syntax.Empty
    , Syntax.Error
    , Syntax.Identifier
-   , Syntax.Program
    , Type.Annotation
    , []
    ]
@@ -90,17 +102,7 @@ type Assignment = HasCallStack => Assignment.Assignment [] Grammar Term
 
 -- | Assignment from AST in Python's grammar onto a program in Python's syntax.
 assignment :: Assignment
-assignment = handleError $ makeTerm <$> symbol Module <*> children (Syntax.Program <$> manyTerm expression) <|> parseError
-
--- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
-manyTerm :: Assignment -> Assignment.Assignment [] Grammar [Term]
-manyTerm term = many (contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm))
-
-someTerm :: Assignment -> Assignment.Assignment [] Grammar [Term]
-someTerm term = some (contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm))
-
-term :: Assignment -> Assignment
-term term = contextualize comment (postContextualize comment term)
+assignment = handleError $ makeTerm <$> symbol Module <*> children (Statement.Statements <$> manyTerm expression) <|> parseError
 
 expression :: Assignment
 expression = handleError (choice expressionChoices)
@@ -341,6 +343,9 @@ yield = makeTerm <$> symbol Yield <*> (Statement.Yield <$> children (term ( expr
 identifier :: Assignment
 identifier = makeTerm <$> (symbol Identifier <|> symbol Identifier' <|> symbol DottedName) <*> (Syntax.Identifier . name <$> source)
 
+identifier' :: Assignment.Assignment [] Grammar Name
+identifier' = (symbol Identifier <|> symbol Identifier' <|> symbol DottedName) *> (name <$> source)
+
 set :: Assignment
 set = makeTerm <$> symbol Set <*> children (Literal.Set <$> manyTerm expression)
 
@@ -375,7 +380,7 @@ import' =   makeTerm'' <$> symbol ImportStatement <*> children (manyTerm (aliase
     -- `import a as b`
     aliasedImport = makeTerm <$> symbol AliasedImport <*> children (Python.Syntax.QualifiedAliasedImport  <$> importPath <*> expression)
     -- `import a`
-    plainImport = makeTerm <$> location <*> (Python.Syntax.QualifiedImport <$> importPath)
+    plainImport = makeTerm <$> symbol DottedName <*> children (Python.Syntax.QualifiedImport . NonEmpty.map T.unpack <$> NonEmpty.some1 identifierSource)
     -- `from a import foo `
     importSymbol = makeNameAliasPair <$> aliasIdentifier <*> pure Nothing
     -- `from a import foo as bar`
@@ -394,7 +399,7 @@ import' =   makeTerm'' <$> symbol ImportStatement <*> children (manyTerm (aliase
     makeNameAliasPair from Nothing = (from, from)
 
 assertStatement :: Assignment
-assertStatement = makeTerm <$> symbol AssertStatement <*> children (Expression.Call <$> pure [] <*> (makeTerm <$> symbol AnonAssert <*> (Syntax.Identifier . name <$> source)) <*> manyTerm expression <*> emptyTerm)
+assertStatement = makeTerm <$> symbol AssertStatement <*> children (Expression.Call [] <$> (makeTerm <$> symbol AnonAssert <*> (Syntax.Identifier . name <$> source)) <*> manyTerm expression <*> emptyTerm)
 
 printStatement :: Assignment
 printStatement = do
@@ -408,19 +413,19 @@ printStatement = do
     printCallTerm location identifier = makeTerm location <$> (Expression.Call [] identifier <$> manyTerm expression <*> emptyTerm)
 
 nonlocalStatement :: Assignment
-nonlocalStatement = makeTerm <$> symbol NonlocalStatement <*> children (Expression.Call <$> pure [] <*> term (makeTerm <$> symbol AnonNonlocal <*> (Syntax.Identifier . name <$> source)) <*> manyTerm expression <*> emptyTerm)
+nonlocalStatement = makeTerm <$> symbol NonlocalStatement <*> children (Expression.Call [] <$> term (makeTerm <$> symbol AnonNonlocal <*> (Syntax.Identifier . name <$> source)) <*> manyTerm expression <*> emptyTerm)
 
 globalStatement :: Assignment
-globalStatement = makeTerm <$> symbol GlobalStatement <*> children (Expression.Call <$> pure [] <*> term (makeTerm <$> symbol AnonGlobal <*> (Syntax.Identifier . name <$> source)) <*> manyTerm expression <*> emptyTerm)
+globalStatement = makeTerm <$> symbol GlobalStatement <*> children (Expression.Call [] <$> term (makeTerm <$> symbol AnonGlobal <*> (Syntax.Identifier . name <$> source)) <*> manyTerm expression <*> emptyTerm)
 
 await :: Assignment
-await = makeTerm <$> symbol Await <*> children (Expression.Call <$> pure [] <*> term (makeTerm <$> symbol AnonAwait <*> (Syntax.Identifier . name <$> source)) <*> manyTerm expression <*> emptyTerm)
+await = makeTerm <$> symbol Await <*> children (Expression.Call [] <$> term (makeTerm <$> symbol AnonAwait <*> (Syntax.Identifier . name <$> source)) <*> manyTerm expression <*> emptyTerm)
 
 returnStatement :: Assignment
 returnStatement = makeTerm <$> symbol ReturnStatement <*> children (Statement.Return <$> term (expressionList <|> emptyTerm))
 
 deleteStatement :: Assignment
-deleteStatement = makeTerm <$> symbol DeleteStatement <*> children (Expression.Call <$> pure [] <*> term deleteIdentifier <* symbol ExpressionList <*> children (manyTerm expression) <*> emptyTerm)
+deleteStatement = makeTerm <$> symbol DeleteStatement <*> children (Expression.Call [] <$> term deleteIdentifier <* symbol ExpressionList <*> children (manyTerm expression) <*> emptyTerm)
   where deleteIdentifier = makeTerm <$> symbol AnonDel <*> (Syntax.Identifier . name <$> source)
 
 raiseStatement :: Assignment
@@ -432,7 +437,7 @@ ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> ter
         makeElif (loc, makeIf) rest = makeTerm loc (makeIf rest)
 
 execStatement :: Assignment
-execStatement = makeTerm <$> symbol ExecStatement <*> children (Expression.Call <$> pure [] <*> term (makeTerm <$> location <*> (Syntax.Identifier . name <$> source)) <*> manyTerm (string <|> expression) <*> emptyTerm)
+execStatement = makeTerm <$> symbol ExecStatement <*> children (Expression.Call [] <$> term (makeTerm <$> location <*> (Syntax.Identifier . name <$> source)) <*> manyTerm (string <|> expression) <*> emptyTerm)
 
 passStatement :: Assignment
 passStatement = makeTerm <$> symbol PassStatement <*> (Statement.NoOp <$> emptyTerm <* advance)
@@ -444,7 +449,7 @@ continueStatement :: Assignment
 continueStatement = makeTerm <$> symbol ContinueStatement <*> (Statement.Continue <$> emptyTerm <* advance)
 
 memberAccess :: Assignment
-memberAccess = makeTerm <$> symbol Attribute <*> children (Expression.MemberAccess <$> expression <*> identifier)
+memberAccess = makeTerm <$> symbol Attribute <*> children (Expression.MemberAccess <$> expression <*> identifier')
 
 subscript :: Assignment
 subscript = makeTerm <$> symbol Subscript <*> children (Expression.Subscript <$> term expression <*> manyTerm expression)
@@ -456,14 +461,14 @@ slice = makeTerm <$> symbol Slice <*> children
                           <*> (term expression <|> emptyTerm))
 
 call :: Assignment
-call = makeTerm <$> symbol Call <*> children (Expression.Call <$> pure [] <*> term (identifier <|> expression) <*> (symbol ArgumentList *> children (manyTerm expression) <|> someTerm comprehension) <*> emptyTerm)
+call = makeTerm <$> symbol Call <*> children (Expression.Call [] <$> term (identifier <|> expression) <*> (symbol ArgumentList *> children (manyTerm expression) <|> someTerm comprehension) <*> emptyTerm)
 
 boolean :: Assignment
 boolean =  makeTerm <$> token Grammar.True <*> pure Literal.true
        <|> makeTerm <$> token Grammar.False <*> pure Literal.false
 
 none :: Assignment
-none = makeTerm <$> symbol None <*> (Literal.Null <$ source)
+none = makeTerm <$> symbol None <*> (Literal.Null <$ rawSource)
 
 comprehension :: Assignment
 comprehension =  makeTerm <$> symbol ListComprehension       <*> children (Declaration.Comprehension <$> term expression <*> expressions)
@@ -483,6 +488,19 @@ ifClause = symbol IfClause *> children expressions
 conditionalExpression :: Assignment
 conditionalExpression = makeTerm <$> symbol ConditionalExpression <*> children (flip Statement.If <$> term expression <*> term expression <*> expressions)
 
+
+-- Helpers
+
+-- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
+manyTerm :: Assignment -> Assignment.Assignment [] Grammar [Term]
+manyTerm term = many (contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm))
+
+someTerm :: Assignment -> Assignment.Assignment [] Grammar [Term]
+someTerm term = some (contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm))
+
+term :: Assignment -> Assignment
+term term = contextualize comment (postContextualize comment term)
+
 -- | Match a left-associated infix chain of terms, optionally followed by comments. Like 'chainl1' but assigning comment nodes automatically.
 chainl1Term :: Assignment -> Assignment.Assignment [] Grammar (Term -> Term -> Term) -> Assignment
 chainl1Term expr op = postContextualize (comment <|> symbol AnonLambda *> empty) expr `chainl1` op

src/Language/Python/Syntax.hs

@@ -7,27 +7,26 @@ import           Data.Abstract.Module
 import           Data.Aeson
 import           Data.Functor.Classes.Generic
 import           Data.JSON.Fields
-import           Data.Mergeable
-import           Diffing.Algorithm
-import           GHC.Generics
-import           Prelude hiding (fail)
-import           Prologue
-import           System.FilePath.Posix
-import qualified Data.ByteString.Char8 as BC
 import qualified Data.Language as Language
 import qualified Data.List.NonEmpty as NonEmpty
+import           Data.Mergeable
+import qualified Data.Text as T
+import           Diffing.Algorithm
+import           GHC.Generics
+import           Prologue
+import           System.FilePath.Posix
 
 data QualifiedName
   = QualifiedName (NonEmpty FilePath)
   | RelativeQualifiedName FilePath (Maybe QualifiedName)
   deriving (Eq, Generic, Hashable, Ord, Show, ToJSON)
 
-qualifiedName :: NonEmpty ByteString -> QualifiedName
-qualifiedName xs = QualifiedName (BC.unpack <$> xs)
+qualifiedName :: NonEmpty Text -> QualifiedName
+qualifiedName xs = QualifiedName (T.unpack <$> xs)
 
-relativeQualifiedName :: ByteString -> [ByteString] -> QualifiedName
-relativeQualifiedName prefix []    = RelativeQualifiedName (BC.unpack prefix) Nothing
-relativeQualifiedName prefix paths = RelativeQualifiedName (BC.unpack prefix) (Just (qualifiedName (NonEmpty.fromList paths)))
+relativeQualifiedName :: Text -> [Text] -> QualifiedName
+relativeQualifiedName prefix []    = RelativeQualifiedName (T.unpack prefix) Nothing
+relativeQualifiedName prefix paths = RelativeQualifiedName (T.unpack prefix) (Just (qualifiedName (NonEmpty.fromList paths)))
 
 -- Python module resolution.
 -- https://docs.python.org/3/reference/import.html#importsystem
@@ -88,9 +87,7 @@ resolvePythonModules q = do
 --
 -- If the list of symbols is empty copy everything to the calling environment.
 data Import a = Import { importFrom :: QualifiedName, importSymbols :: ![(Name, Name)] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 Import
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Import where liftEq = genericLiftEq
 instance Ord1 Import where liftCompare = genericLiftCompare
@@ -101,7 +98,7 @@ instance Evaluatable Import where
   -- from . import moduleY
   -- This is a bit of a special case in the syntax as this actually behaves like a qualified relative import.
   eval (Import (RelativeQualifiedName n Nothing) [(name, _)]) = do
-    path <- NonEmpty.last <$> resolvePythonModules (RelativeQualifiedName n (Just (qualifiedName (unName name :| []))))
+    path <- NonEmpty.last <$> resolvePythonModules (RelativeQualifiedName n (Just (qualifiedName (formatName name :| []))))
     rvalBox =<< evalQualifiedImport name path
 
   -- from a import b
@@ -137,10 +134,8 @@ evalQualifiedImport name path = letrec' name $ \addr -> do
   bindAll importedEnv
   unit <$ makeNamespace name addr Nothing
 
-newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: QualifiedName }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 QualifiedImport
+newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: NonEmpty FilePath }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 QualifiedImport where liftEq = genericLiftEq
 instance Ord1 QualifiedImport where liftCompare = genericLiftCompare
@@ -148,10 +143,9 @@ instance Show1 QualifiedImport where liftShowsPrec = genericLiftShowsPrec
 
 -- import a.b.c
 instance Evaluatable QualifiedImport where
-  eval (QualifiedImport (RelativeQualifiedName _ _))        = raiseEff (fail "technically this is not allowed in python")
-  eval (QualifiedImport qname@(QualifiedName qualifiedName)) = do
-    modulePaths <- resolvePythonModules qname
-    rvalBox =<< go (NonEmpty.zip (name . BC.pack <$> qualifiedName) modulePaths)
+  eval (QualifiedImport qualifiedName) = do
+    modulePaths <- resolvePythonModules (QualifiedName qualifiedName)
+    rvalBox =<< go (NonEmpty.zip (name . T.pack <$> qualifiedName) modulePaths)
     where
       -- Evaluate and import the last module, updating the environment
       go ((name, path) :| []) = evalQualifiedImport name path
@@ -162,9 +156,7 @@ instance Evaluatable QualifiedImport where
         makeNamespace name addr Nothing
 
 data QualifiedAliasedImport a = QualifiedAliasedImport { qualifiedAliasedImportFrom :: QualifiedName, qualifiedAliasedImportAlias :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 QualifiedAliasedImport
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 QualifiedAliasedImport where liftEq = genericLiftEq
 instance Ord1 QualifiedAliasedImport where liftCompare = genericLiftCompare
@@ -188,26 +180,22 @@ instance Evaluatable QualifiedAliasedImport where
 
 -- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell)
 data Ellipsis a = Ellipsis
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Ellipsis where liftEq = genericLiftEq
 instance Ord1 Ellipsis where liftCompare = genericLiftCompare
 instance Show1 Ellipsis where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Ellipsis
-
 -- TODO: Implement Eval instance for Ellipsis
 instance Evaluatable Ellipsis
 
 
 data Redirect a = Redirect !a !a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Redirect where liftEq = genericLiftEq
 instance Ord1 Redirect where liftCompare = genericLiftCompare
 instance Show1 Redirect where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Redirect
-
 -- TODO: Implement Eval instance for Redirect
 instance Evaluatable Redirect

src/Language/Ruby/Assignment.hs

@@ -10,7 +10,18 @@ import Assigning.Assignment hiding (Assignment, Error)
 import Data.Abstract.Name (name)
 import Data.List (elem)
 import Data.Record
-import Data.Syntax (contextualize, postContextualize, emptyTerm, parseError, handleError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1)
+import Data.Syntax
+    ( contextualize
+    , emptyTerm
+    , handleError
+    , infixContext
+    , makeTerm
+    , makeTerm'
+    , makeTerm''
+    , makeTerm1
+    , parseError
+    , postContextualize
+    )
 import Language.Ruby.Grammar as Grammar
 import qualified Assigning.Assignment as Assignment
 import Data.Sum
@@ -69,6 +80,7 @@ type Syntax = '[
   , Statement.Return
   , Statement.ScopeEntry
   , Statement.ScopeExit
+  , Statement.Statements
   , Statement.Try
   , Statement.While
   , Statement.Yield
@@ -76,7 +88,6 @@ type Syntax = '[
   , Syntax.Empty
   , Syntax.Error
   , Syntax.Identifier
-  , Syntax.Program
   , Ruby.Syntax.Class
   , Ruby.Syntax.Load
   , Ruby.Syntax.LowPrecedenceBoolean
@@ -92,7 +103,7 @@ type Assignment = Assignment' Term
 
 -- | Assignment from AST in Ruby’s grammar onto a program in Ruby’s syntax.
 assignment :: Assignment
-assignment = handleError $ makeTerm <$> symbol Program <*> children (Syntax.Program <$> many expression) <|> parseError
+assignment = handleError $ makeTerm <$> symbol Program <*> children (Statement.Statements <$> many expression) <|> parseError
 
 expression :: Assignment
 expression = term (handleError (choice expressionChoices))
@@ -350,14 +361,13 @@ methodCall = makeTerm' <$> symbol MethodCall <*> children (require <|> load <|>
 
     selector = Just <$> term methodSelector
     require = inject <$> (symbol Identifier *> do
-      s <- source
+      s <- rawSource
       guard (s `elem` ["require", "require_relative"])
       Ruby.Syntax.Require (s == "require_relative") <$> nameExpression)
-    load = inject <$> (symbol Identifier *> do
-      s <- source
+    load = inject <$ symbol Identifier <*> do
+      s <- rawSource
       guard (s == "load")
-      Ruby.Syntax.Load <$> loadArgs)
-    loadArgs = (symbol ArgumentList <|> symbol ArgumentListWithParens)  *> children (some expression)
+      (symbol ArgumentList <|> symbol ArgumentListWithParens) *> children (Ruby.Syntax.Load <$> expression <*> optional expression)
     nameExpression = (symbol ArgumentList <|> symbol ArgumentListWithParens) *> children expression
 
 methodSelector :: Assignment
@@ -416,7 +426,7 @@ assignment' = makeTerm  <$> symbol Assignment         <*> children (Statement.As
        <|> lhsIdent
        <|> expression
 
-identWithLocals :: Assignment' (Record Location, ByteString, [ByteString])
+identWithLocals :: Assignment' (Record Location, Text, [Text])
 identWithLocals = do
   loc <- symbol Identifier
   -- source advances, so it's important we call getRubyLocals first
@@ -477,10 +487,10 @@ conditional :: Assignment
 conditional = makeTerm <$> symbol Conditional <*> children (Statement.If <$> expression <*> expression <*> expression)
 
 emptyStatement :: Assignment
-emptyStatement = makeTerm <$> symbol EmptyStatement <*> (Syntax.Empty <$ source <|> pure Syntax.Empty)
+emptyStatement = makeTerm <$> symbol EmptyStatement <*> (Syntax.Empty <$ rawSource <|> pure Syntax.Empty)
 
 
--- Helper functions
+-- Helpers
 
 invert :: Assignment -> Assignment
 invert term = makeTerm <$> location <*> fmap Expression.Not term

src/Language/Ruby/Syntax.hs

@@ -5,11 +5,10 @@ import           Control.Monad (unless)
 import           Data.Abstract.Evaluatable
 import qualified Data.Abstract.Module as M
 import           Data.Abstract.Path
-import qualified Data.ByteString.Char8 as BC
+import qualified Data.Text as T
 import           Data.JSON.Fields
 import qualified Data.Language as Language
 import           Diffing.Algorithm
-import           Prelude hiding (fail)
 import           Prologue
 import           System.FilePath.Posix
 
@@ -20,7 +19,7 @@ import           System.FilePath.Posix
 resolveRubyName :: ( Member (Modules address value) effects
                    , Member (Resumable ResolutionError) effects
                    )
-                => ByteString
+                => Text
                 -> Evaluator address value effects M.ModulePath
 resolveRubyName name = do
   let name' = cleanNameOrPath name
@@ -32,25 +31,23 @@ resolveRubyName name = do
 resolveRubyPath :: ( Member (Modules address value) effects
                    , Member (Resumable ResolutionError) effects
                    )
-                => ByteString
+                => Text
                 -> Evaluator address value effects M.ModulePath
 resolveRubyPath path = do
   let name' = cleanNameOrPath path
   modulePath <- resolve [name']
   maybeM (throwResumable $ NotFoundError name' [name'] Language.Ruby) modulePath
 
-cleanNameOrPath :: ByteString -> String
-cleanNameOrPath = BC.unpack . dropRelativePrefix . stripQuotes
+cleanNameOrPath :: Text -> String
+cleanNameOrPath = T.unpack . dropRelativePrefix . stripQuotes
 
 data Send a = Send { sendReceiver :: Maybe a, sendSelector :: Maybe a, sendArgs :: [a], sendBlock :: Maybe a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Send where liftEq = genericLiftEq
 instance Ord1 Send where liftCompare = genericLiftCompare
 instance Show1 Send where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Send
-
 instance Evaluatable Send where
   eval Send{..} = do
     let sel = case sendSelector of
@@ -60,14 +57,12 @@ instance Evaluatable Send where
     Rval <$> call func (map subtermAddress sendArgs) -- TODO pass through sendBlock
 
 data Require a = Require { requireRelative :: Bool, requirePath :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Require where liftEq = genericLiftEq
 instance Ord1 Require where liftCompare = genericLiftCompare
 instance Show1 Require where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Require
-
 instance Evaluatable Require where
   eval (Require _ x) = do
     name <- subtermValue x >>= asString
@@ -89,24 +84,21 @@ doRequire path = do
     Just (_, env) -> pure (boolean False, env)
 
 
-newtype Load a = Load { loadArgs :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+data Load a = Load { loadPath :: a, loadWrap :: Maybe a }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Load where liftEq = genericLiftEq
 instance Ord1 Load where liftCompare = genericLiftCompare
 instance Show1 Load where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Load
-
 instance Evaluatable Load where
-  eval (Load [x]) = do
+  eval (Load x Nothing) = do
     path <- subtermValue x >>= asString
     rvalBox =<< doLoad path False
-  eval (Load [x, wrap]) = do
+  eval (Load x (Just wrap)) = do
     path <- subtermValue x >>= asString
     shouldWrap <- subtermValue wrap >>= asBool
     rvalBox =<< doLoad path shouldWrap
-  eval (Load _) = raiseEff (fail "invalid argument supplied to load, path is required")
 
 doLoad :: ( AbstractValue address value effects
           , Member (Env address) effects
@@ -114,7 +106,7 @@ doLoad :: ( AbstractValue address value effects
           , Member (Resumable ResolutionError) effects
           , Member Trace effects
           )
-       => ByteString
+       => Text
        -> Bool
        -> Evaluator address value effects value
 doLoad path shouldWrap = do
@@ -127,9 +119,7 @@ doLoad path shouldWrap = do
 -- TODO: autoload
 
 data Class a = Class { classIdentifier :: !a, classSuperClass :: !(Maybe a), classBody :: !a }
-  deriving (Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 Class
+  deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
 
 instance Diffable Class where
   equivalentBySubterm = Just . classIdentifier
@@ -146,14 +136,12 @@ instance Evaluatable Class where
       subtermValue classBody <* makeNamespace name addr super)
 
 data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Module where liftEq = genericLiftEq
 instance Ord1 Module where liftCompare = genericLiftCompare
 instance Show1 Module where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Module
-
 instance Evaluatable Module where
   eval (Module iden xs) = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm iden)
@@ -163,9 +151,7 @@ instance Evaluatable Module where
 data LowPrecedenceBoolean a
   = LowAnd !a !a
   | LowOr !a !a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 LowPrecedenceBoolean
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Evaluatable LowPrecedenceBoolean where
   -- N.B. we have to use Monad rather than Applicative/Traversable on 'And' and 'Or' so that we don't evaluate both operands

src/Language/TypeScript/Assignment.hs

@@ -7,11 +7,22 @@ module Language.TypeScript.Assignment
 ) where
 
 import Assigning.Assignment hiding (Assignment, Error)
-import Data.Abstract.Name (name)
+import Data.Abstract.Name (Name, name)
 import qualified Assigning.Assignment as Assignment
 import Data.Record
 import Data.Sum
-import Data.Syntax (emptyTerm, handleError, parseError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1, contextualize, postContextualize)
+import Data.Syntax
+    ( contextualize
+    , emptyTerm
+    , handleError
+    , infixContext
+    , makeTerm
+    , makeTerm'
+    , makeTerm''
+    , makeTerm1
+    , parseError
+    , postContextualize
+    )
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Comment as Comment
 import qualified Data.Syntax.Declaration as Declaration
@@ -27,6 +38,7 @@ import Prologue
 -- | The type of TypeScript syntax.
 type Syntax = '[
     Comment.Comment
+  , Comment.HashBang
   , Declaration.Class
   , Declaration.Function
   , Declaration.Method
@@ -72,7 +84,6 @@ type Syntax = '[
   , Statement.Finally
   , Statement.For
   , Statement.ForEach
-  , Statement.HashBang
   , Statement.If
   , Statement.Match
   , Statement.Pattern
@@ -80,6 +91,7 @@ type Syntax = '[
   , Statement.Return
   , Statement.ScopeEntry
   , Statement.ScopeExit
+  , Statement.Statements
   , Statement.Throw
   , Statement.Try
   , Statement.While
@@ -88,7 +100,6 @@ type Syntax = '[
   , Syntax.Empty
   , Syntax.Error
   , Syntax.Identifier
-  , Syntax.Program
   , Syntax.Context
   , Type.Readonly
   , Type.TypeParameters
@@ -175,14 +186,7 @@ type Assignment = Assignment.Assignment [] Grammar Term
 
 -- | Assignment from AST in TypeScript’s grammar onto a program in TypeScript’s syntax.
 assignment :: Assignment
-assignment = handleError $ makeTerm <$> symbol Program <*> children (Syntax.Program <$> manyTerm statement) <|> parseError
-
--- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
-manyTerm :: Assignment -> Assignment.Assignment [] Grammar [Term]
-manyTerm term = many (contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm))
-
-term :: Assignment -> Assignment
-term term = contextualize comment (postContextualize comment term)
+assignment = handleError $ makeTerm <$> symbol Program <*> children (Statement.Statements <$> manyTerm statement) <|> parseError
 
 expression :: Assignment
 expression = handleError everything
@@ -228,7 +232,7 @@ expression = handleError everything
       ]
 
 undefined' :: Assignment
-undefined' = makeTerm <$> symbol Grammar.Undefined <*> (TypeScript.Syntax.Undefined <$ source)
+undefined' = makeTerm <$> symbol Grammar.Undefined <*> (TypeScript.Syntax.Undefined <$ rawSource)
 
 assignmentExpression :: Assignment
 assignmentExpression = makeTerm <$> symbol AssignmentExpression <*> children (Statement.Assignment [] <$> term (memberExpression <|> subscriptExpression <|> identifier <|> destructuringPattern) <*> expression)
@@ -266,7 +270,7 @@ ternaryExpression :: Assignment
 ternaryExpression = makeTerm <$> symbol Grammar.TernaryExpression <*> children (Statement.If <$> term expression <*> term expression <*> term expression)
 
 memberExpression :: Assignment
-memberExpression = makeTerm <$> (symbol Grammar.MemberExpression <|> symbol Grammar.MemberExpression') <*> children (Expression.MemberAccess <$> term expression <*> term propertyIdentifier)
+memberExpression = makeTerm <$> (symbol Grammar.MemberExpression <|> symbol Grammar.MemberExpression') <*> children (Expression.MemberAccess <$> term expression <*> propertyIdentifier')
 
 newExpression :: Assignment
 newExpression = makeTerm <$> symbol Grammar.NewExpression <*> children (Expression.New . pure <$> term expression)
@@ -278,13 +282,13 @@ yieldExpression :: Assignment
 yieldExpression = makeTerm <$> symbol Grammar.YieldExpression <*> children (Statement.Yield <$> term (expression <|> emptyTerm))
 
 this :: Assignment
-this = makeTerm <$> symbol Grammar.This <*> (TypeScript.Syntax.This <$ source)
+this = makeTerm <$> symbol Grammar.This <*> (TypeScript.Syntax.This <$ rawSource)
 
 regex :: Assignment
 regex = makeTerm <$> symbol Grammar.Regex <*> (Literal.Regex <$> source)
 
 null' :: Assignment
-null' = makeTerm <$> symbol Null <*> (Literal.Null <$ source)
+null' = makeTerm <$> symbol Null <*> (Literal.Null <$ rawSource)
 
 anonymousClass :: Assignment
 anonymousClass = makeTerm <$> symbol Grammar.AnonymousClass <*> children (Declaration.Class <$> pure [] <*> emptyTerm <*> (classHeritage' <|> pure []) <*> classBodyStatements)
@@ -309,7 +313,7 @@ implementsClause' :: Assignment
 implementsClause' = makeTerm <$> symbol Grammar.ImplementsClause <*> children (TypeScript.Syntax.ImplementsClause <$> manyTerm ty)
 
 super :: Assignment
-super = makeTerm <$> symbol Grammar.Super <*> (TypeScript.Syntax.Super <$ source)
+super = makeTerm <$> symbol Grammar.Super <*> (TypeScript.Syntax.Super <$ rawSource)
 
 typeAssertion :: Assignment
 typeAssertion = makeTerm <$> symbol Grammar.TypeAssertion <*> children (TypeScript.Syntax.TypeAssertion <$> term typeArguments' <*> term expression)
@@ -336,10 +340,10 @@ string :: Assignment
 string = makeTerm <$> symbol Grammar.String <*> (Literal.TextElement <$> source)
 
 true :: Assignment
-true = makeTerm <$> symbol Grammar.True <*> (Literal.true <$ source)
+true = makeTerm <$> symbol Grammar.True <*> (Literal.true <$ rawSource)
 
 false :: Assignment
-false = makeTerm <$> symbol Grammar.False <*> (Literal.false <$ source)
+false = makeTerm <$> symbol Grammar.False <*> (Literal.false <$ rawSource)
 
 identifier :: Assignment
 identifier = makeTerm <$> (symbol Identifier <|> symbol Identifier') <*> (Syntax.Identifier . name <$> source)
@@ -397,6 +401,9 @@ jsxAttribute = makeTerm <$> symbol Grammar.JsxAttribute <*> children (TypeScript
 propertyIdentifier :: Assignment
 propertyIdentifier = makeTerm <$> symbol PropertyIdentifier <*> (Syntax.Identifier . name <$> source)
 
+propertyIdentifier' :: Assignment.Assignment [] Grammar Name
+propertyIdentifier' = symbol PropertyIdentifier *> (name <$> source)
+
 sequenceExpression :: Assignment
 sequenceExpression = makeTerm <$> symbol Grammar.SequenceExpression <*> children (Expression.SequenceExpression <$> term expression <*> term expressions)
 
@@ -419,7 +426,7 @@ spreadElement :: Assignment
 spreadElement = symbol SpreadElement *> children (term expression)
 
 readonly' :: Assignment
-readonly' = makeTerm <$> symbol Readonly <*> (Type.Readonly <$ source)
+readonly' = makeTerm <$> symbol Readonly <*> (Type.Readonly <$ rawSource)
 
 methodDefinition :: Assignment
 methodDefinition = makeMethod <$>
@@ -632,7 +639,7 @@ throwStatement :: Assignment
 throwStatement = makeTerm <$> symbol Grammar.ThrowStatement <*> children (Statement.Throw <$> term expressions)
 
 hashBang :: Assignment
-hashBang = makeTerm <$> symbol HashBangLine <*> (Statement.HashBang <$> source)
+hashBang = makeTerm <$> symbol HashBangLine <*> (Comment.HashBang <$> source)
 
 labeledStatement :: Assignment
 labeledStatement = makeTerm <$> symbol Grammar.LabeledStatement <*> children (TypeScript.Syntax.LabeledStatement <$> statementIdentifier <*> term statement)
@@ -676,7 +683,7 @@ importStatement =   makeImportTerm <$> symbol Grammar.ImportStatement <*> childr
     fromClause = symbol Grammar.String *> (TypeScript.Syntax.importPath <$> source)
 
 debuggerStatement :: Assignment
-debuggerStatement = makeTerm <$> symbol Grammar.DebuggerStatement <*> (TypeScript.Syntax.Debugger <$ source)
+debuggerStatement = makeTerm <$> symbol Grammar.DebuggerStatement <*> (TypeScript.Syntax.Debugger <$ rawSource)
 
 expressionStatement' :: Assignment
 expressionStatement' = symbol ExpressionStatement *> children (term expressions)
@@ -858,8 +865,18 @@ binaryExpression = makeTerm' <$> symbol BinaryExpression <*> children (infixTerm
   ])
   where invert cons a b = Expression.Not (makeTerm1 (cons a b))
 
+
+-- Helpers
+
+-- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
+manyTerm :: Assignment -> Assignment.Assignment [] Grammar [Term]
+manyTerm term = many (contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm))
+
+term :: Assignment -> Assignment
+term term = contextualize comment (postContextualize comment term)
+
 emptyStatement :: Assignment
-emptyStatement = makeTerm <$> symbol EmptyStatement <*> (Syntax.Empty <$ source <|> pure Syntax.Empty)
+emptyStatement = makeTerm <$> symbol EmptyStatement <*> (Syntax.Empty <$ rawSource <|> pure Syntax.Empty)
 
 -- | Match infix terms separated by any of a list of operators, assigning any comments following each operand.
 infixTerm :: Assignment

src/Language/TypeScript/Syntax.hs

@@ -7,13 +7,11 @@ import qualified Data.Abstract.Module as M
 import           Data.Abstract.Package
 import           Data.Abstract.Path
 import           Data.Aeson
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Char8 as BC
 import           Data.JSON.Fields
 import qualified Data.Language as Language
 import qualified Data.Map as Map
+import qualified Data.Text as T
 import           Diffing.Algorithm
-import           Prelude
 import           Prologue
 import           System.FilePath.Posix
 
@@ -23,15 +21,15 @@ data Relative = Relative | NonRelative
 data ImportPath = ImportPath { unPath :: FilePath, pathIsRelative :: Relative }
   deriving (Eq, Generic, Hashable, Ord, Show, ToJSON)
 
-importPath :: ByteString -> ImportPath
-importPath str = let path = stripQuotes str in ImportPath (BC.unpack path) (pathType path)
+-- TODO: fix the duplication present in this and Python
+importPath :: Text -> ImportPath
+importPath str = let path = stripQuotes str in ImportPath (T.unpack path) (pathType path)
   where
-    stripQuotes = B.filter (`B.notElem` "\'\"")
-    pathType xs | not (B.null xs), BC.head xs == '.' = Relative
+    pathType xs | not (T.null xs), T.head xs == '.' = Relative -- TODO: fix partiality
                 | otherwise = NonRelative
 
 toName :: ImportPath -> Name
-toName = name . BC.pack . unPath
+toName = name . T.pack . unPath
 
 -- Node.js resolution algorithm: https://nodejs.org/api/modules.html#modules_all_together
 --
@@ -146,9 +144,7 @@ evalRequire modulePath alias = letrec' alias $ \addr -> do
   unit <$ makeNamespace alias addr Nothing
 
 data Import a = Import { importSymbols :: ![(Name, Name)], importFrom :: ImportPath }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 Import
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Import where liftEq = genericLiftEq
 instance Ord1 Import where liftCompare = genericLiftCompare
@@ -167,14 +163,12 @@ instance Evaluatable Import where
         | otherwise = Env.overwrite symbols importedEnv
 
 data JavaScriptRequire a = JavaScriptRequire { javascriptRequireIden :: !a, javascriptRequireFrom :: ImportPath }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 JavaScriptRequire where liftEq = genericLiftEq
 instance Ord1 JavaScriptRequire where liftCompare = genericLiftCompare
 instance Show1 JavaScriptRequire where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 JavaScriptRequire
-
 instance Evaluatable JavaScriptRequire where
   eval (JavaScriptRequire aliasTerm importPath) = do
     modulePath <- resolveWithNodejsStrategy importPath javascriptExtensions
@@ -183,14 +177,12 @@ instance Evaluatable JavaScriptRequire where
 
 
 data QualifiedAliasedImport a = QualifiedAliasedImport { qualifiedAliasedImportAlias :: !a, qualifiedAliasedImportFrom :: ImportPath }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 QualifiedAliasedImport where liftEq = genericLiftEq
 instance Ord1 QualifiedAliasedImport where liftCompare = genericLiftCompare
 instance Show1 QualifiedAliasedImport where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 QualifiedAliasedImport
-
 instance Evaluatable QualifiedAliasedImport where
   eval (QualifiedAliasedImport aliasTerm importPath) = do
     modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
@@ -198,14 +190,12 @@ instance Evaluatable QualifiedAliasedImport where
     rvalBox =<< evalRequire modulePath alias
 
 newtype SideEffectImport a = SideEffectImport { sideEffectImportFrom :: ImportPath }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 SideEffectImport where liftEq = genericLiftEq
 instance Ord1 SideEffectImport where liftCompare = genericLiftCompare
 instance Show1 SideEffectImport where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 SideEffectImport
-
 instance Evaluatable SideEffectImport where
   eval (SideEffectImport importPath) = do
     modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
@@ -215,14 +205,12 @@ instance Evaluatable SideEffectImport where
 
 -- | Qualified Export declarations
 newtype QualifiedExport a = QualifiedExport { qualifiedExportSymbols :: [(Name, Name)] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 QualifiedExport where liftEq = genericLiftEq
 instance Ord1 QualifiedExport where liftCompare = genericLiftCompare
 instance Show1 QualifiedExport where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 QualifiedExport
-
 instance Evaluatable QualifiedExport where
   eval (QualifiedExport exportSymbols) = do
     -- Insert the aliases with no addresses.
@@ -233,14 +221,12 @@ instance Evaluatable QualifiedExport where
 
 -- | Qualified Export declarations that export from another module.
 data QualifiedExportFrom a = QualifiedExportFrom { qualifiedExportFrom :: ImportPath, qualifiedExportFromSymbols :: ![(Name, Name)]}
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 QualifiedExportFrom where liftEq = genericLiftEq
 instance Ord1 QualifiedExportFrom where liftCompare = genericLiftCompare
 instance Show1 QualifiedExportFrom where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 QualifiedExportFrom
-
 instance Evaluatable QualifiedExportFrom where
   eval (QualifiedExportFrom importPath exportSymbols) = do
     modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
@@ -252,9 +238,7 @@ instance Evaluatable QualifiedExportFrom where
     rvalBox unit
 
 newtype DefaultExport a = DefaultExport { defaultExport :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 DefaultExport
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 DefaultExport where liftEq = genericLiftEq
 instance Ord1 DefaultExport where liftCompare = genericLiftCompare
@@ -275,9 +259,7 @@ instance Evaluatable DefaultExport where
 
 -- | Lookup type for a type-level key in a typescript map.
 data LookupType a = LookupType { lookupTypeIdentifier :: a, lookupTypeKey :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 LookupType
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 LookupType where liftEq = genericLiftEq
 instance Ord1 LookupType where liftCompare = genericLiftCompare
@@ -285,10 +267,8 @@ instance Show1 LookupType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable LookupType
 
 -- | ShorthandPropertyIdentifier used in object patterns such as var baz = { foo } to mean var baz = { foo: foo }
-newtype ShorthandPropertyIdentifier a = ShorthandPropertyIdentifier ByteString
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 ShorthandPropertyIdentifier
+newtype ShorthandPropertyIdentifier a = ShorthandPropertyIdentifier T.Text
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ShorthandPropertyIdentifier where liftEq = genericLiftEq
 instance Ord1 ShorthandPropertyIdentifier where liftCompare = genericLiftCompare
@@ -296,9 +276,7 @@ instance Show1 ShorthandPropertyIdentifier where liftShowsPrec = genericLiftShow
 instance Evaluatable ShorthandPropertyIdentifier
 
 data Union a = Union { _unionLeft :: !a, _unionRight :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 Language.TypeScript.Syntax.Union
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Language.TypeScript.Syntax.Union where liftEq = genericLiftEq
 instance Ord1 Language.TypeScript.Syntax.Union where liftCompare = genericLiftCompare
@@ -306,9 +284,7 @@ instance Show1 Language.TypeScript.Syntax.Union where liftShowsPrec = genericLif
 instance Evaluatable Language.TypeScript.Syntax.Union
 
 data Intersection a = Intersection { _intersectionLeft :: !a, _intersectionRight :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 Intersection
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Intersection where liftEq = genericLiftEq
 instance Ord1 Intersection where liftCompare = genericLiftCompare
@@ -316,9 +292,7 @@ instance Show1 Intersection where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Intersection
 
 data FunctionType a = FunctionType { _functionTypeParameters :: !a, _functionFormalParameters :: ![a], _functionType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 FunctionType
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 FunctionType where liftEq = genericLiftEq
 instance Ord1 FunctionType where liftCompare = genericLiftCompare
@@ -326,9 +300,7 @@ instance Show1 FunctionType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable FunctionType
 
 data AmbientFunction a = AmbientFunction { _ambientFunctionContext :: ![a], _ambientFunctionIdentifier :: !a, _ambientFunctionParameters :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 AmbientFunction
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 AmbientFunction where liftEq = genericLiftEq
 instance Ord1 AmbientFunction where liftCompare = genericLiftCompare
@@ -336,9 +308,7 @@ instance Show1 AmbientFunction where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable AmbientFunction
 
 data ImportRequireClause a = ImportRequireClause { _importRequireIdentifier :: !a, _importRequireSubject :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 ImportRequireClause
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ImportRequireClause where liftEq = genericLiftEq
 instance Ord1 ImportRequireClause where liftCompare = genericLiftCompare
@@ -346,9 +316,7 @@ instance Show1 ImportRequireClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ImportRequireClause
 
 newtype ImportClause a = ImportClause { _importClauseElements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 ImportClause
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ImportClause where liftEq = genericLiftEq
 instance Ord1 ImportClause where liftCompare = genericLiftCompare
@@ -356,9 +324,7 @@ instance Show1 ImportClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ImportClause
 
 newtype Tuple a = Tuple { _tupleElements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 Tuple
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Tuple where liftEq = genericLiftEq
 instance Ord1 Tuple where liftCompare = genericLiftCompare
@@ -368,9 +334,7 @@ instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Tuple
 
 data Constructor a = Constructor { _constructorTypeParameters :: !a, _constructorFormalParameters :: ![a], _constructorType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 Language.TypeScript.Syntax.Constructor
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Language.TypeScript.Syntax.Constructor where liftEq = genericLiftEq
 instance Ord1 Language.TypeScript.Syntax.Constructor where liftCompare = genericLiftCompare
@@ -378,9 +342,7 @@ instance Show1 Language.TypeScript.Syntax.Constructor where liftShowsPrec = gene
 instance Evaluatable Language.TypeScript.Syntax.Constructor
 
 data TypeParameter a = TypeParameter { _typeParameter :: !a, _typeParameterConstraint :: !a, _typeParameterDefaultType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 TypeParameter
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypeParameter where liftEq = genericLiftEq
 instance Ord1 TypeParameter where liftCompare = genericLiftCompare
@@ -388,9 +350,7 @@ instance Show1 TypeParameter where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TypeParameter
 
 data TypeAssertion a = TypeAssertion { _typeAssertionParameters :: !a, _typeAssertionExpression :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 TypeAssertion
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypeAssertion where liftEq = genericLiftEq
 instance Ord1 TypeAssertion where liftCompare = genericLiftCompare
@@ -398,9 +358,7 @@ instance Show1 TypeAssertion where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TypeAssertion
 
 newtype Annotation a = Annotation { _annotationType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 Annotation
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Annotation where liftEq = genericLiftEq
 instance Ord1 Annotation where liftCompare = genericLiftCompare
@@ -408,9 +366,7 @@ instance Show1 Annotation where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Annotation
 
 newtype Decorator a = Decorator { _decoratorTerm :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 Decorator
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Decorator where liftEq = genericLiftEq
 instance Ord1 Decorator where liftCompare = genericLiftCompare
@@ -418,9 +374,7 @@ instance Show1 Decorator where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Decorator
 
 newtype ComputedPropertyName a = ComputedPropertyName a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 ComputedPropertyName
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ComputedPropertyName where liftEq = genericLiftEq
 instance Ord1 ComputedPropertyName where liftCompare = genericLiftCompare
@@ -428,9 +382,7 @@ instance Show1 ComputedPropertyName where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ComputedPropertyName
 
 newtype Constraint a = Constraint { _constraintType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 Constraint
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Constraint where liftEq = genericLiftEq
 instance Ord1 Constraint where liftCompare = genericLiftCompare
@@ -438,9 +390,7 @@ instance Show1 Constraint where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Constraint
 
 newtype DefaultType a = DefaultType { _defaultType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 DefaultType
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 DefaultType where liftEq = genericLiftEq
 instance Ord1 DefaultType where liftCompare = genericLiftCompare
@@ -448,29 +398,23 @@ instance Show1 DefaultType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable DefaultType
 
 newtype ParenthesizedType a = ParenthesizedType { _parenthesizedType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 ParenthesizedType
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ParenthesizedType where liftEq = genericLiftEq
 instance Ord1 ParenthesizedType where liftCompare = genericLiftCompare
 instance Show1 ParenthesizedType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ParenthesizedType
 
-newtype PredefinedType a = PredefinedType { _predefinedType :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 PredefinedType
+newtype PredefinedType a = PredefinedType { _predefinedType :: T.Text }
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 PredefinedType where liftEq = genericLiftEq
 instance Ord1 PredefinedType where liftCompare = genericLiftCompare
 instance Show1 PredefinedType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable PredefinedType
 
-newtype TypeIdentifier a = TypeIdentifier ByteString
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 TypeIdentifier
+newtype TypeIdentifier a = TypeIdentifier T.Text
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypeIdentifier where liftEq = genericLiftEq
 instance Ord1 TypeIdentifier where liftCompare = genericLiftCompare
@@ -478,9 +422,7 @@ instance Show1 TypeIdentifier where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TypeIdentifier
 
 data NestedIdentifier a = NestedIdentifier !a !a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 NestedIdentifier
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 NestedIdentifier where liftEq = genericLiftEq
 instance Ord1 NestedIdentifier where liftCompare = genericLiftCompare
@@ -488,9 +430,7 @@ instance Show1 NestedIdentifier where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable NestedIdentifier
 
 data NestedTypeIdentifier a = NestedTypeIdentifier !a !a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 NestedTypeIdentifier
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 NestedTypeIdentifier where liftEq = genericLiftEq
 instance Ord1 NestedTypeIdentifier where liftCompare = genericLiftCompare
@@ -498,9 +438,7 @@ instance Show1 NestedTypeIdentifier where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable NestedTypeIdentifier
 
 data GenericType a = GenericType { _genericTypeIdentifier :: !a, _genericTypeArguments :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 GenericType
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 GenericType where liftEq = genericLiftEq
 instance Ord1 GenericType where liftCompare = genericLiftCompare
@@ -508,9 +446,7 @@ instance Show1 GenericType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable GenericType
 
 data TypePredicate a = TypePredicate { _typePredicateIdentifier :: !a, _typePredicateType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 TypePredicate
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypePredicate where liftEq = genericLiftEq
 instance Ord1 TypePredicate where liftCompare = genericLiftCompare
@@ -518,9 +454,7 @@ instance Show1 TypePredicate where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TypePredicate
 
 newtype ObjectType a = ObjectType { _objectTypeElements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 ObjectType
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ObjectType where liftEq = genericLiftEq
 instance Ord1 ObjectType where liftCompare = genericLiftCompare
@@ -528,9 +462,7 @@ instance Show1 ObjectType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ObjectType
 
 data With a = With { _withExpression :: !a, _withBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 With
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 With where liftEq = genericLiftEq
 instance Ord1 With where liftCompare = genericLiftCompare
@@ -538,9 +470,7 @@ instance Show1 With where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable With
 
 newtype AmbientDeclaration a = AmbientDeclaration { _ambientDeclarationBody :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 AmbientDeclaration
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 AmbientDeclaration where liftEq = genericLiftEq
 instance Ord1 AmbientDeclaration where liftCompare = genericLiftCompare
@@ -550,9 +480,7 @@ instance Evaluatable AmbientDeclaration where
   eval (AmbientDeclaration body) = subtermRef body
 
 data EnumDeclaration a = EnumDeclaration { enumDeclarationIdentifier :: !a, _enumDeclarationBody :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 EnumDeclaration
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 EnumDeclaration where liftEq = genericLiftEq
 instance Ord1 EnumDeclaration where liftCompare = genericLiftCompare
@@ -563,9 +491,7 @@ instance Declarations a => Declarations (EnumDeclaration a) where
   declaredName EnumDeclaration{..} = declaredName enumDeclarationIdentifier
 
 newtype ExtendsClause a = ExtendsClause { _extendsClauses :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 ExtendsClause
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ExtendsClause where liftEq = genericLiftEq
 instance Ord1 ExtendsClause where liftCompare = genericLiftCompare
@@ -573,9 +499,7 @@ instance Show1 ExtendsClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ExtendsClause
 
 newtype ArrayType a = ArrayType { _arrayType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 ArrayType
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ArrayType where liftEq = genericLiftEq
 instance Ord1 ArrayType where liftCompare = genericLiftCompare
@@ -583,9 +507,7 @@ instance Show1 ArrayType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ArrayType
 
 newtype FlowMaybeType a = FlowMaybeType { _flowMaybeType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 FlowMaybeType
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 FlowMaybeType where liftEq = genericLiftEq
 instance Ord1 FlowMaybeType where liftCompare = genericLiftCompare
@@ -593,9 +515,7 @@ instance Show1 FlowMaybeType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable FlowMaybeType
 
 newtype TypeQuery a = TypeQuery { _typeQuerySubject :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 TypeQuery
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypeQuery where liftEq = genericLiftEq
 instance Ord1 TypeQuery where liftCompare = genericLiftCompare
@@ -603,9 +523,7 @@ instance Show1 TypeQuery where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TypeQuery
 
 newtype IndexTypeQuery a = IndexTypeQuery { _indexTypeQuerySubject :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 IndexTypeQuery
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 IndexTypeQuery where liftEq = genericLiftEq
 instance Ord1 IndexTypeQuery where liftCompare = genericLiftCompare
@@ -613,29 +531,23 @@ instance Show1 IndexTypeQuery where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable IndexTypeQuery
 
 newtype TypeArguments a = TypeArguments { _typeArguments :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 TypeArguments
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 TypeArguments where liftEq = genericLiftEq
 instance Ord1 TypeArguments where liftCompare = genericLiftCompare
 instance Show1 TypeArguments where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TypeArguments
 
-newtype ThisType a = ThisType ByteString
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 ThisType
+newtype ThisType a = ThisType T.Text
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ThisType where liftEq = genericLiftEq
 instance Ord1 ThisType where liftCompare = genericLiftCompare
 instance Show1 ThisType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ThisType
 
-newtype ExistentialType a = ExistentialType ByteString
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 ExistentialType
+newtype ExistentialType a = ExistentialType T.Text
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ExistentialType where liftEq = genericLiftEq
 instance Ord1 ExistentialType where liftCompare = genericLiftCompare
@@ -643,9 +555,7 @@ instance Show1 ExistentialType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ExistentialType
 
 newtype LiteralType a = LiteralType { _literalTypeSubject :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 LiteralType
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 LiteralType where liftEq = genericLiftEq
 instance Ord1 LiteralType where liftCompare = genericLiftCompare
@@ -653,9 +563,7 @@ instance Show1 LiteralType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable LiteralType
 
 data PropertySignature a = PropertySignature { _modifiers :: ![a], _propertySignaturePropertyName :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 PropertySignature
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 PropertySignature where liftEq = genericLiftEq
 instance Ord1 PropertySignature where liftCompare = genericLiftCompare
@@ -663,9 +571,7 @@ instance Show1 PropertySignature where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable PropertySignature
 
 data CallSignature a = CallSignature { _callSignatureTypeParameters :: !a, _callSignatureParameters :: ![a], _callSignatureType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 CallSignature
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 CallSignature where liftEq = genericLiftEq
 instance Ord1 CallSignature where liftCompare = genericLiftCompare
@@ -674,9 +580,7 @@ instance Evaluatable CallSignature
 
 -- | Todo: Move type params and type to context
 data ConstructSignature a = ConstructSignature { _constructSignatureTypeParameters :: !a, _constructSignatureParameters :: ![a], _constructSignatureType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 ConstructSignature
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ConstructSignature where liftEq = genericLiftEq
 instance Ord1 ConstructSignature where liftCompare = genericLiftCompare
@@ -684,9 +588,7 @@ instance Show1 ConstructSignature where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ConstructSignature
 
 data IndexSignature a = IndexSignature { _indexSignatureSubject :: a, _indexSignatureType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 IndexSignature
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 IndexSignature where liftEq = genericLiftEq
 instance Ord1 IndexSignature where liftCompare = genericLiftCompare
@@ -694,9 +596,7 @@ instance Show1 IndexSignature where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable IndexSignature
 
 data AbstractMethodSignature a = AbstractMethodSignature { _abstractMethodSignatureContext :: ![a], _abstractMethodSignatureName :: !a, _abstractMethodSignatureParameters :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 AbstractMethodSignature
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 AbstractMethodSignature where liftEq = genericLiftEq
 instance Ord1 AbstractMethodSignature where liftCompare = genericLiftCompare
@@ -704,9 +604,7 @@ instance Show1 AbstractMethodSignature where liftShowsPrec = genericLiftShowsPre
 instance Evaluatable AbstractMethodSignature
 
 data Debugger a = Debugger
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 Debugger
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Debugger where liftEq = genericLiftEq
 instance Ord1 Debugger where liftCompare = genericLiftCompare
@@ -714,9 +612,7 @@ instance Show1 Debugger where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Debugger
 
 data ForOf a = ForOf { _forOfBinding :: !a, _forOfSubject :: !a, _forOfBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 ForOf
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ForOf where liftEq = genericLiftEq
 instance Ord1 ForOf where liftCompare = genericLiftCompare
@@ -724,9 +620,7 @@ instance Show1 ForOf where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ForOf
 
 data This a = This
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 This
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 This where liftEq = genericLiftEq
 instance Ord1 This where liftCompare = genericLiftCompare
@@ -734,9 +628,7 @@ instance Show1 This where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable This
 
 data LabeledStatement a = LabeledStatement { _labeledStatementIdentifier :: !a, _labeledStatementSubject :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 LabeledStatement
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 LabeledStatement where liftEq = genericLiftEq
 instance Ord1 LabeledStatement where liftCompare = genericLiftCompare
@@ -744,9 +636,7 @@ instance Show1 LabeledStatement where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable LabeledStatement
 
 newtype Update a = Update { _updateSubject :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 Update
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Update where liftEq = genericLiftEq
 instance Ord1 Update where liftCompare = genericLiftCompare
@@ -754,14 +644,12 @@ instance Show1 Update where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Update
 
 data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Module where liftEq = genericLiftEq
 instance Ord1 Module where liftCompare = genericLiftCompare
 instance Show1 Module where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 Module
-
 instance Evaluatable Module where
   eval (Module iden xs) = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm iden)
@@ -771,14 +659,12 @@ instance Evaluatable Module where
 
 
 data InternalModule a = InternalModule { internalModuleIdentifier :: !a, internalModuleStatements :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 InternalModule where liftEq = genericLiftEq
 instance Ord1 InternalModule where liftCompare = genericLiftCompare
 instance Show1 InternalModule where liftShowsPrec = genericLiftShowsPrec
 
-instance ToJSONFields1 InternalModule
-
 instance Evaluatable InternalModule where
   eval (InternalModule iden xs) = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm iden)
@@ -790,9 +676,7 @@ instance Declarations a => Declarations (InternalModule a) where
 
 
 data ImportAlias a = ImportAlias { _importAliasSubject :: !a, _importAlias :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 ImportAlias
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ImportAlias where liftEq = genericLiftEq
 instance Ord1 ImportAlias where liftCompare = genericLiftCompare
@@ -800,9 +684,7 @@ instance Show1 ImportAlias where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ImportAlias
 
 data Super a = Super
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 Super
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Super where liftEq = genericLiftEq
 instance Ord1 Super where liftCompare = genericLiftCompare
@@ -810,9 +692,7 @@ instance Show1 Super where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Super
 
 data Undefined a = Undefined
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 Undefined
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 Undefined where liftEq = genericLiftEq
 instance Ord1 Undefined where liftCompare = genericLiftCompare
@@ -820,9 +700,7 @@ instance Show1 Undefined where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Undefined
 
 data ClassHeritage a = ClassHeritage { _classHeritageExtendsClause :: !a, _implementsClause :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 ClassHeritage
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ClassHeritage where liftEq = genericLiftEq
 instance Ord1 ClassHeritage where liftCompare = genericLiftCompare
@@ -830,7 +708,7 @@ instance Show1 ClassHeritage where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ClassHeritage
 
 data AbstractClass a = AbstractClass { abstractClassIdentifier :: !a,  _abstractClassTypeParameters :: !a, classHeritage :: ![a], classBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 AbstractClass where liftEq = genericLiftEq
 instance Ord1 AbstractClass where liftCompare = genericLiftCompare
@@ -838,8 +716,6 @@ instance Show1 AbstractClass where liftShowsPrec = genericLiftShowsPrec
 instance Declarations a => Declarations (AbstractClass a) where
   declaredName AbstractClass{..} = declaredName abstractClassIdentifier
 
-instance ToJSONFields1 AbstractClass
-
 instance Evaluatable AbstractClass where
   eval AbstractClass{..} = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm abstractClassIdentifier)
@@ -852,19 +728,15 @@ instance Evaluatable AbstractClass where
 
 
 data JsxElement a = JsxElement { _jsxOpeningElement :: !a,  _jsxElements :: ![a], _jsxClosingElement :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 JsxElement
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 JsxElement where liftEq = genericLiftEq
 instance Ord1 JsxElement where liftCompare = genericLiftCompare
 instance Show1 JsxElement where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxElement
 
-newtype JsxText a = JsxText ByteString
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 JsxText
+newtype JsxText a = JsxText T.Text
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 JsxText where liftEq = genericLiftEq
 instance Ord1 JsxText where liftCompare = genericLiftCompare
@@ -872,9 +744,7 @@ instance Show1 JsxText where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxText
 
 newtype JsxExpression a = JsxExpression { _jsxExpression :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 JsxExpression
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 JsxExpression where liftEq = genericLiftEq
 instance Ord1 JsxExpression where liftCompare = genericLiftCompare
@@ -882,9 +752,7 @@ instance Show1 JsxExpression where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxExpression
 
 data JsxOpeningElement a = JsxOpeningElement { _jsxOpeningElementIdentifier :: !a,  _jsxAttributes :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 JsxOpeningElement
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 JsxOpeningElement where liftEq = genericLiftEq
 instance Ord1 JsxOpeningElement where liftCompare = genericLiftCompare
@@ -892,9 +760,7 @@ instance Show1 JsxOpeningElement where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxOpeningElement
 
 newtype JsxClosingElement a = JsxClosingElement { _jsxClosingElementIdentifier :: a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 JsxClosingElement
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 JsxClosingElement where liftEq = genericLiftEq
 instance Ord1 JsxClosingElement where liftCompare = genericLiftCompare
@@ -902,9 +768,7 @@ instance Show1 JsxClosingElement where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxClosingElement
 
 data JsxSelfClosingElement a = JsxSelfClosingElement { _jsxSelfClosingElementIdentifier :: !a, _jsxSelfClosingElementAttributes :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 JsxSelfClosingElement
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 JsxSelfClosingElement where liftEq = genericLiftEq
 instance Ord1 JsxSelfClosingElement where liftCompare = genericLiftCompare
@@ -912,9 +776,7 @@ instance Show1 JsxSelfClosingElement where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxSelfClosingElement
 
 data JsxAttribute a = JsxAttribute { _jsxAttributeTarget :: !a, _jsxAttributeValue :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 JsxAttribute
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 JsxAttribute where liftEq = genericLiftEq
 instance Ord1 JsxAttribute where liftCompare = genericLiftCompare
@@ -922,9 +784,7 @@ instance Show1 JsxAttribute where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxAttribute
 
 newtype ImplementsClause a = ImplementsClause { _implementsClauseTypes :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 ImplementsClause
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 ImplementsClause where liftEq = genericLiftEq
 instance Ord1 ImplementsClause where liftCompare = genericLiftCompare
@@ -932,9 +792,7 @@ instance Show1 ImplementsClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ImplementsClause
 
 data OptionalParameter a = OptionalParameter { _optionalParameterContext :: ![a], _optionalParameterSubject :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 OptionalParameter
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 OptionalParameter where liftEq = genericLiftEq
 instance Ord1 OptionalParameter where liftCompare = genericLiftCompare
@@ -942,9 +800,7 @@ instance Show1 OptionalParameter where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable OptionalParameter
 
 data RequiredParameter a = RequiredParameter { _requiredParameterContext :: ![a], _requiredParameterSubject :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 RequiredParameter
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 RequiredParameter where liftEq = genericLiftEq
 instance Ord1 RequiredParameter where liftCompare = genericLiftCompare
@@ -952,9 +808,7 @@ instance Show1 RequiredParameter where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable RequiredParameter
 
 data RestParameter a = RestParameter { _restParameterContext :: ![a], _restParameterSubject :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 RestParameter
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 RestParameter where liftEq = genericLiftEq
 instance Ord1 RestParameter where liftCompare = genericLiftCompare
@@ -962,9 +816,7 @@ instance Show1 RestParameter where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable RestParameter
 
 newtype JsxFragment a = JsxFragment [a]
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 JsxFragment
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 JsxFragment where liftEq = genericLiftEq
 instance Ord1 JsxFragment where liftCompare = genericLiftCompare
@@ -972,9 +824,7 @@ instance Show1 JsxFragment where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxFragment
 
 data JsxNamespaceName a = JsxNamespaceName a a
-  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
-
-instance ToJSONFields1 JsxNamespaceName
+  deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
 
 instance Eq1 JsxNamespaceName where liftEq = genericLiftEq
 instance Ord1 JsxNamespaceName where liftCompare = genericLiftCompare

src/Parsing/Parser.hs

@@ -13,6 +13,7 @@ module Parsing.Parser
 -- À la carte parsers
 , goParser
 , javaParser
+, javaASTParser
 , jsonParser
 , markdownParser
 , pythonParser
@@ -82,11 +83,11 @@ someAnalysisParser :: ( ApplyAll' typeclasses Go.Syntax
                    -> SomeAnalysisParser typeclasses (Record Location) -- ^ A 'SomeAnalysisParser abstracting the syntax type to be produced.
 someAnalysisParser _ Go         = SomeAnalysisParser goParser Nothing
 someAnalysisParser _ Java       = SomeAnalysisParser javaParser Nothing
-someAnalysisParser _ JavaScript = SomeAnalysisParser typescriptParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) (Just JavaScript))
+someAnalysisParser _ JavaScript = SomeAnalysisParser typescriptParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) JavaScript)
 someAnalysisParser _ Haskell    = SomeAnalysisParser haskellParser Nothing
 someAnalysisParser _ PHP        = SomeAnalysisParser phpParser Nothing
-someAnalysisParser _ Python     = SomeAnalysisParser pythonParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) (Just Python))
-someAnalysisParser _ Ruby       = SomeAnalysisParser rubyParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) (Just Ruby))
+someAnalysisParser _ Python     = SomeAnalysisParser pythonParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) Python)
+someAnalysisParser _ Ruby       = SomeAnalysisParser rubyParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) Ruby)
 someAnalysisParser _ TypeScript = SomeAnalysisParser typescriptParser Nothing
 someAnalysisParser _ l          = error $ "Analysis not supported for: " <> show l
 
@@ -126,18 +127,19 @@ someParser :: ( ApplyAll typeclasses (Sum Go.Syntax)
               , ApplyAll typeclasses (Sum PHP.Syntax)
               )
            => Language                                        -- ^ The 'Language' to select.
-           -> Parser (SomeTerm typeclasses (Record Location)) -- ^ A 'SomeParser' abstracting the syntax type to be produced.
-someParser Go         = SomeParser goParser
-someParser Java       = SomeParser javaParser
-someParser JavaScript = SomeParser typescriptParser
-someParser JSON       = SomeParser jsonParser
-someParser Haskell    = SomeParser haskellParser
-someParser JSX        = SomeParser typescriptParser
-someParser Markdown   = SomeParser markdownParser
-someParser Python     = SomeParser pythonParser
-someParser Ruby       = SomeParser rubyParser
-someParser TypeScript = SomeParser typescriptParser
-someParser PHP        = SomeParser phpParser
+           -> Maybe (Parser (SomeTerm typeclasses (Record Location))) -- ^ A 'SomeParser' abstracting the syntax type to be produced.
+someParser Go         = Just (SomeParser goParser)
+someParser Java       = Just (SomeParser javaParser)
+someParser JavaScript = Just (SomeParser typescriptParser)
+someParser JSON       = Just (SomeParser jsonParser)
+someParser Haskell    = Just (SomeParser haskellParser)
+someParser JSX        = Just (SomeParser typescriptParser)
+someParser Markdown   = Just (SomeParser markdownParser)
+someParser Python     = Just (SomeParser pythonParser)
+someParser Ruby       = Just (SomeParser rubyParser)
+someParser TypeScript = Just (SomeParser typescriptParser)
+someParser PHP        = Just (SomeParser phpParser)
+someParser Unknown    = Nothing
 
 
 goParser :: Parser Go.Term
@@ -153,7 +155,10 @@ pythonParser :: Parser Python.Term
 pythonParser = AssignmentParser (ASTParser tree_sitter_python) Python.assignment
 
 javaParser :: Parser Java.Term
-javaParser = AssignmentParser (ASTParser tree_sitter_java) Java.assignment
+javaParser = AssignmentParser javaASTParser Java.assignment
+
+javaASTParser :: Parser (AST [] Java.Grammar)
+javaASTParser = ASTParser tree_sitter_java
 
 jsonParser :: Parser JSON.Term
 jsonParser = AssignmentParser (ASTParser tree_sitter_json) JSON.assignment
@@ -181,14 +186,16 @@ data SomeASTParser where
                 => Parser (AST [] grammar)
                 -> SomeASTParser
 
-someASTParser :: Language -> SomeASTParser
-someASTParser Go         = SomeASTParser (ASTParser tree_sitter_go :: Parser (AST [] Go.Grammar))
-someASTParser Haskell    = SomeASTParser (ASTParser tree_sitter_haskell :: Parser (AST [] Haskell.Grammar))
-someASTParser JavaScript = SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar))
-someASTParser JSON       = SomeASTParser (ASTParser tree_sitter_json :: Parser (AST [] JSON.Grammar))
-someASTParser JSX        = SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar))
-someASTParser Python     = SomeASTParser (ASTParser tree_sitter_python :: Parser (AST [] Python.Grammar))
-someASTParser Ruby       = SomeASTParser (ASTParser tree_sitter_ruby :: Parser (AST [] Ruby.Grammar))
-someASTParser TypeScript = SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar))
-someASTParser PHP        = SomeASTParser (ASTParser tree_sitter_php :: Parser (AST [] PHP.Grammar))
-someASTParser l          = error $ "Tree-Sitter AST parsing not supported for: " <> show l
+someASTParser :: Language -> Maybe SomeASTParser
+someASTParser Go         = Just (SomeASTParser (ASTParser tree_sitter_go :: Parser (AST [] Go.Grammar)))
+someASTParser Haskell    = Just (SomeASTParser (ASTParser tree_sitter_haskell :: Parser (AST [] Haskell.Grammar)))
+someASTParser Java       = Just (SomeASTParser (ASTParser tree_sitter_java :: Parser (AST [] Java.Grammar)))
+someASTParser JavaScript = Just (SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar)))
+someASTParser JSON       = Just (SomeASTParser (ASTParser tree_sitter_json :: Parser (AST [] JSON.Grammar)))
+someASTParser JSX        = Just (SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar)))
+someASTParser Python     = Just (SomeASTParser (ASTParser tree_sitter_python :: Parser (AST [] Python.Grammar)))
+someASTParser Ruby       = Just (SomeASTParser (ASTParser tree_sitter_ruby :: Parser (AST [] Ruby.Grammar)))
+someASTParser TypeScript = Just (SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar)))
+someASTParser PHP        = Just (SomeASTParser (ASTParser tree_sitter_php :: Parser (AST [] PHP.Grammar)))
+someASTParser Markdown   = Nothing
+someASTParser Unknown    = Nothing

src/Rendering/Imports.hs

@@ -9,6 +9,7 @@ import Analysis.Declaration
 import Analysis.PackageDef
 import Data.Aeson
 import Data.Blob
+import Data.Language (ensureLanguage)
 import Data.Record
 import Data.Span
 import Data.Term
@@ -44,7 +45,7 @@ renderToImports blob term = ImportSummary $ toMap (termToModule blob term)
           _ -> defaultModuleName
 
 makeModule :: (HasField fields Span, HasField fields (Maybe Declaration)) => T.Text -> Blob -> [Record fields] -> Module
-makeModule name Blob{..} ds = Module name [T.pack blobPath] (T.pack . show <$> blobLanguage) (mapMaybe importSummary ds) (mapMaybe (declarationSummary name) ds) (mapMaybe referenceSummary ds)
+makeModule name Blob{..} ds = Module name [T.pack blobPath] (T.pack . show <$> ensureLanguage blobLanguage) (mapMaybe importSummary ds) (mapMaybe (declarationSummary name) ds) (mapMaybe referenceSummary ds)
 
 
 getPackageDef :: HasField fields (Maybe PackageDef) => Record fields -> Maybe PackageDef

src/Rendering/Symbol.hs

@@ -10,6 +10,7 @@ import Prologue
 import Analysis.Declaration
 import Data.Aeson
 import Data.Blob
+import Data.Language (ensureLanguage)
 import Data.Record
 import Data.Span
 import Data.Term
@@ -34,7 +35,7 @@ renderToSymbols :: (HasField fields (Maybe Declaration), HasField fields Span, F
 renderToSymbols fields Blob{..} term = [toJSON (termToC fields blobPath term)]
   where
     termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => SymbolFields -> FilePath -> Term f (Record fields) -> File
-    termToC fields path = File (T.pack path) (T.pack . show <$> blobLanguage) . mapMaybe (symbolSummary fields path "unchanged") . termTableOfContentsBy declaration
+    termToC fields path = File (T.pack path) (T.pack (show blobLanguage)) . mapMaybe (symbolSummary fields path "unchanged") . termTableOfContentsBy declaration
 
 -- | Construct a 'Symbol' from a node annotation and a change type label.
 symbolSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => SymbolFields -> FilePath -> T.Text -> Record fields -> Maybe Symbol
@@ -43,7 +44,7 @@ symbolSummary SymbolFields{..} path _ record = case getDeclaration record of
   Just declaration -> Just Symbol
     { symbolName = when symbolFieldsName (declarationIdentifier declaration)
     , symbolPath = when symbolFieldsPath (T.pack path)
-    , symbolLang = join (when symbolFieldsLang (T.pack . show <$> declarationLanguage declaration))
+    , symbolLang = join (when symbolFieldsLang (T.pack . show <$> ensureLanguage (declarationLanguage declaration)))
     , symbolKind = when symbolFieldsKind (toCategoryName declaration)
     , symbolLine = when symbolFieldsLine (declarationText declaration)
     , symbolSpan = when symbolFieldsSpan (getField record)
@@ -52,7 +53,7 @@ symbolSummary SymbolFields{..} path _ record = case getDeclaration record of
 
 data File = File
   { filePath :: T.Text
-  , fileLanguage :: Maybe T.Text
+  , fileLanguage :: T.Text
   , fileSymbols :: [Symbol]
   } deriving (Generic, Eq, Show)
 

src/Rendering/TOC.hs

@@ -54,7 +54,7 @@ data TOCSummary
     , summarySpan :: Span
     , summaryChangeType :: T.Text
     }
-  | ErrorSummary { errorText :: T.Text, errorSpan :: Span, errorLanguage :: Maybe Language }
+  | ErrorSummary { errorText :: T.Text, errorSpan :: Span, errorLanguage :: Language }
   deriving (Generic, Eq, Show)
 
 instance ToJSON TOCSummary where
@@ -146,7 +146,7 @@ recordSummary changeText record = case getDeclaration record of
   Just declaration -> Just $ TOCSummary (toCategoryName declaration) (formatIdentifier declaration) (getField record) changeText
   Nothing -> Nothing
   where
-    formatIdentifier (MethodDeclaration identifier _ (Just Language.Go) (Just receiver)) = "(" <> receiver <> ") " <> identifier
+    formatIdentifier (MethodDeclaration identifier _ Language.Go        (Just receiver)) = "(" <> receiver <> ") " <> identifier
     formatIdentifier (MethodDeclaration identifier _ _                  (Just receiver)) = receiver <> "." <> identifier
     formatIdentifier declaration = declarationIdentifier declaration
 

src/Semantic/AST.hs

@@ -18,8 +18,7 @@ withSomeAST f (SomeAST ast) = f ast
 
 astParseBlob :: (Member (Exc SomeException) effs, Member Task effs) => Blob -> Eff effs SomeAST
 astParseBlob blob@Blob{..}
-  | Just (SomeASTParser parser) <- someASTParser <$> blobLanguage
-  = SomeAST <$> parse parser blob
+  | Just (SomeASTParser parser) <- someASTParser blobLanguage = SomeAST <$> parse parser blob
   | otherwise = noLanguageForBlob blobPath
 
 

src/Semantic/CLI.hs

@@ -8,6 +8,7 @@ module Semantic.CLI
 ) where
 
 import           Data.Project
+import           Data.Language (ensureLanguage)
 import           Data.List (intercalate)
 import           Data.List.Split (splitWhen)
 import           Data.Version (showVersion)
@@ -98,15 +99,15 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar
       rootDir <- rootDirectoryOption
       excludeDirs <- excludeDirsOption
       File{..} <- argument filePathReader (metavar "DIR:LANGUAGE | FILE")
-      pure $ Task.readProject rootDir filePath (fromJust fileLanguage) excludeDirs >>= Graph.runGraph graphType includePackages >>= serializer
+      pure $ Task.readProject rootDir filePath fileLanguage excludeDirs >>= Graph.runGraph graphType includePackages >>= serializer
 
     rootDirectoryOption = optional (strOption (long "root" <> help "Root directory of project. Optional, defaults to entry file/directory." <> metavar "DIR"))
     excludeDirsOption = many (strOption (long "exclude-dir" <> help "Exclude a directory (e.g. vendor)" <> metavar "DIR"))
     filePathReader = eitherReader parseFilePath
     parseFilePath arg = case splitWhen (== ':') arg of
-        [a, b] | lang <- readMaybe b -> Right (File a lang)
-               | lang <- readMaybe a -> Right (File b lang)
-        [path] -> maybe (Left $ "Cannot identify language for path: " <> path) (Right . File path . Just) (languageForFilePath path)
+        [a, b] | (Just lang) <- readMaybe b >>= ensureLanguage -> Right (File a lang)
+               | (Just lang) <- readMaybe a >>= ensureLanguage -> Right (File b lang)
+        [path] -> maybe (Left $ "Cannot identify language for path: " <> path) (Right . File path) (ensureLanguage (languageForFilePath path))
         args -> Left ("cannot parse `" <> join args <> "`\nexpecting FILE:LANGUAGE or just FILE")
 
     optionsReader options = eitherReader $ \ str -> maybe (Left ("expected one of: " <> intercalate ", " (fmap fst options))) (Right . snd) (find ((== str) . fst) options)

src/Semantic/Diff.hs

@@ -54,6 +54,6 @@ withParsedBlobPair :: (Member (Distribute WrappedTask) effs, Member (Exc SomeExc
                    -> BlobPair
                    -> Eff effs (SomeTermPair '[ConstructorName, Diffable, Eq1, HasDeclaration, Hashable1, Show1, ToJSONFields1, Traversable] (Record fields))
 withParsedBlobPair decorate blobs
-  | Just (SomeParser parser) <- someParser @'[ConstructorName, Diffable, Eq1, HasDeclaration, Hashable1, Show1, ToJSONFields1, Traversable] <$> languageForBlobPair blobs
-  = SomeTermPair <$> distributeFor blobs (\ blob -> WrapTask (parse parser blob >>= decorate blob))
+  | Just (SomeParser parser) <- someParser @'[ConstructorName, Diffable, Eq1, HasDeclaration, Hashable1, Show1, ToJSONFields1, Traversable] (languageForBlobPair blobs)
+    = SomeTermPair <$> distributeFor blobs (\ blob -> WrapTask (parse parser blob >>= decorate blob))
   | otherwise = noLanguageForBlob (pathForBlobPair blobs)

src/Semantic/Graph.hs

@@ -18,20 +18,18 @@ module Semantic.Graph
 
 import           Analysis.Abstract.Evaluating
 import           Analysis.Abstract.Graph
-import           Control.Monad.Effect.Trace
 import           Control.Abstract
-import qualified Control.Exception as Exc
 import           Control.Monad.Effect (reinterpret)
 import           Data.Abstract.Address
 import           Data.Abstract.Evaluatable
 import           Data.Abstract.Module
 import           Data.Abstract.Package as Package
-import           Data.Abstract.Value (Value, ValueError(..), runValueErrorWith)
-import           Data.ByteString.Char8 (pack)
+import           Data.Abstract.Value (Value, ValueError (..), runValueErrorWith)
 import           Data.Graph
 import           Data.Project
 import           Data.Record
 import           Data.Term
+import           Data.Text (pack)
 import           Parsing.Parser
 import           Prologue hiding (MonadError (..))
 import           Semantic.IO (Files)
@@ -39,7 +37,7 @@ import           Semantic.Task as Task
 
 data GraphType = ImportGraph | CallGraph
 
-runGraph :: ( Member (Distribute WrappedTask) effs, Member (Exc SomeException) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
+runGraph :: ( Member (Distribute WrappedTask) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
          => GraphType
          -> Bool
          -> Project
@@ -54,8 +52,7 @@ runGraph graphType includePackages project
         analyzeModule = (if includePackages then graphingPackages else id) . graphingModules
     analyze runGraphAnalysis (evaluatePackageWith analyzeModule analyzeTerm package) >>= extractGraph
     where extractGraph result = case result of
-            (Right ((_, graph), _), _) -> pure (simplify graph)
-            _ -> Task.throwError (toException (Exc.ErrorCall ("graphImports: import graph rendering failed " <> show result)))
+            (((_, graph), _), _) -> pure (simplify graph)
           runGraphAnalysis
             = run
             . evaluating

src/Semantic/IO.hs

@@ -44,7 +44,7 @@ import qualified Data.ByteString as B
 import qualified Data.ByteString.Builder as B
 import qualified Data.ByteString.Lazy as BL
 import           Data.Language
-import           Data.Source (fromBytes, fromText)
+import           Data.Source (fromUTF8, fromText)
 import           Prelude hiding (readFile)
 import           Prologue hiding (MonadError (..), fail)
 import           System.Directory (doesDirectoryExist)
@@ -61,7 +61,7 @@ readFile :: forall m. MonadIO m => File -> m (Maybe Blob.Blob)
 readFile (File "/dev/null" _) = pure Nothing
 readFile (File path language) = do
   raw <- liftIO (Just <$> B.readFile path)
-  pure $ Blob.sourceBlob path language . fromBytes <$> raw
+  pure $ Blob.sourceBlob path language . fromUTF8 <$> raw
 
 readFilePair :: forall m. MonadIO m => File -> File -> m Blob.BlobPair
 readFilePair a b = Join <$> join (maybeThese <$> readFile a <*> readFile b)
@@ -77,7 +77,7 @@ isDirectory :: MonadIO m => FilePath -> m Bool
 isDirectory path = liftIO (doesDirectoryExist path)
 
 -- | Return a language based on a FilePath's extension, or Nothing if extension is not found or not supported.
-languageForFilePath :: FilePath -> Maybe Language
+languageForFilePath :: FilePath -> Language
 languageForFilePath = languageForType . takeExtension
 
 -- | Read JSON encoded blob pairs from a handle.
@@ -108,7 +108,7 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do
   paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs
   pure $ Project rootDir (toFile <$> paths) lang entryPoints excludeDirs
   where
-    toFile path = File path (Just lang)
+    toFile path = File path lang
     exts = extensionsForLanguage lang
 
 -- Recursively find files in a directory.
@@ -138,7 +138,7 @@ findFilesInDir path exts excludeDirs = do
 readBlobsFromDir :: MonadIO m => FilePath -> m [Blob.Blob]
 readBlobsFromDir path = do
   paths <- liftIO (globDir1 (compile "[^vendor]**/*[.rb|.js|.tsx|.go|.py]") path)
-  let paths' = catMaybes $ fmap (\p -> File p . Just <$> languageForFilePath p) paths
+  let paths' = fmap (\p -> File p (languageForFilePath p)) paths
   blobs <- traverse readFile paths'
   pure (catMaybes blobs)
 
@@ -153,7 +153,7 @@ toBlob :: Blob -> Blob.Blob
 toBlob Blob{..} = Blob.sourceBlob path language' (fromText content)
   where language' = case language of
           "" -> languageForFilePath path
-          _  -> readMaybe language
+          _  -> fromMaybe Unknown (readMaybe language)
 
 
 newtype BlobDiff = BlobDiff { blobs :: [BlobPair] }

src/Semantic/Parse.hs

@@ -30,4 +30,4 @@ withParsedBlobs :: (Member (Distribute WrappedTask) effs, Monoid output) => (for
 withParsedBlobs render = distributeFoldMap (\ blob -> WrapTask (parseSomeBlob blob >>= withSomeTerm (render blob)))
 
 parseSomeBlob :: (Member (Exc SomeException) effs, Member Task effs) => Blob -> Eff effs (SomeTerm '[ConstructorName, Foldable, Functor, HasDeclaration, HasPackageDef, Show1, ToJSONFields1] (Record Location))
-parseSomeBlob blob@Blob{..} = maybe (noLanguageForBlob blobPath) (flip parse blob . someParser) blobLanguage
+parseSomeBlob blob@Blob{..} = maybe (noLanguageForBlob blobPath) (`parse` blob) (someParser blobLanguage)

src/Semantic/Task.hs

@@ -227,7 +227,7 @@ runParser blob@Blob{..} parser = case parser of
       in length term `seq` pure term
   SomeParser parser -> SomeTerm <$> runParser blob parser
   where blobFields = ("path", blobPath) : languageTag
-        languageTag = maybe [] (pure . (,) ("language" :: String) . show) blobLanguage
+        languageTag = pure . (,) ("language" :: String) . show $ blobLanguage
         errors :: (Syntax.Error :< fs, Apply Foldable fs, Apply Functor fs) => Term (Sum fs) (Record Assignment.Location) -> [Error.Error String]
         errors = cata $ \ (In a syntax) -> case syntax of
           _ | Just err@Syntax.Error{} <- project syntax -> [Syntax.unError (getField a) err]

src/Semantic/Util.hs

@@ -35,9 +35,9 @@ import qualified Language.TypeScript.Assignment as TypeScript
 
 justEvaluating
   = runM
-  . fmap (first reassociate)
   . evaluating
   . runPrintingTrace
+  . fmap reassociate
   . runLoadError
   . runUnspecialized
   . runResolutionError
@@ -54,6 +54,7 @@ checking
   . runTermEvaluator @_ @Monovariant @Type
   . caching @[]
   . providingLiveSet
+  . fmap reassociate
   . runLoadError
   . runUnspecialized
   . runResolutionError
@@ -71,9 +72,9 @@ evalTypeScriptProject path = justEvaluating =<< evaluateProject typescriptParser
 
 typecheckGoFile path = checking =<< evaluateProjectWithCaching goParser Language.Go Nothing path
 
-rubyPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) (Just Language.Ruby)
-pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) (Just Language.Python)
-javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) (Just Language.JavaScript)
+rubyPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) Language.Ruby
+pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) Language.Python
+javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) Language.JavaScript
 
 -- Evaluate a project, starting at a single entrypoint.
 evaluateProject parser lang prelude path = do
@@ -90,14 +91,11 @@ blob :: FilePath -> IO Blob
 blob = runTask . readBlob . file
 
 
-injectConst :: a -> SomeExc (Sum '[Const a])
-injectConst = SomeExc . inject . Const
-
 mergeExcs :: Either (SomeExc (Sum excs)) (Either (SomeExc exc) result) -> Either (SomeExc (Sum (exc ': excs))) result
 mergeExcs = either (\ (SomeExc sum) -> Left (SomeExc (weaken sum))) (either (\ (SomeExc exc) -> Left (SomeExc (inject exc))) Right)
 
-reassociate = mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . first injectConst
-reassociateTypes = mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . first injectConst
+reassociate :: Either (SomeExc exc1) (Either (SomeExc exc2) (Either (SomeExc exc3) (Either (SomeExc exc4) (Either (SomeExc exc5) (Either (SomeExc exc6) (Either (SomeExc exc7) result)))))) -> Either (SomeExc (Sum '[exc7, exc6, exc5, exc4, exc3, exc2, exc1])) result
+reassociate = mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . Right
 
 
 newtype Quieterm syntax ann = Quieterm { unQuieterm :: TermF syntax ann (Quieterm syntax ann) }

test/Assigning/Assignment/Spec.hs

@@ -4,17 +4,18 @@ module Assigning.Assignment.Spec (spec) where
 import Assigning.Assignment
 import Data.AST
 import Data.Bifunctor (first)
-import Data.ByteString.Char8 as B (ByteString, length, words)
 import Data.Ix
 import Data.Range
 import Data.Semigroup ((<>))
 import Data.Source
 import Data.Span
 import Data.Term
+import Data.Text as T (Text, length, words)
+import Data.Text.Encoding (encodeUtf8)
 import GHC.Stack (getCallStack)
 import Prelude hiding (words)
 import Test.Hspec
-import TreeSitter.Language (Symbol(..), SymbolType(..))
+import TreeSitter.Language (Symbol (..), SymbolType (..))
 
 spec :: Spec
 spec = do
@@ -33,8 +34,8 @@ spec = do
     it "matches repetitions" $
       let s = "colourless green ideas sleep furiously"
           w = words s
-          (_, nodes) = foldl (\ (i, prev) word -> (i + B.length word + 1, prev <> [node Red i (i + B.length word) []])) (0, []) w in
-      fst <$> runAssignment (fromBytes s) (many red) (makeState nodes)
+          (_, nodes) = foldl (\ (i, prev) word -> (i + T.length word + 1, prev <> [node Red i (i + T.length word) []])) (0, []) w in
+      fst <$> runAssignment (fromUTF8 (encodeUtf8 s)) (many red) (makeState nodes)
       `shouldBe`
         Right (Out <$> w)
 
@@ -259,9 +260,9 @@ data Grammar = Palette | Red | Green | Blue | Magenta
 
 instance Symbol Grammar where
   symbolType Magenta = Anonymous
-  symbolType _ = Regular
+  symbolType _       = Regular
 
-data Out = Out B.ByteString | OutError B.ByteString
+data Out = Out T.Text | OutError T.Text
   deriving (Eq, Show)
 
 red :: HasCallStack => Assignment [] Grammar Out

test/Control/Abstract/Evaluator/Spec.hs

@@ -30,10 +30,10 @@ spec = parallel $ do
 
 evaluate
   = runM
-  . fmap (first reassociate)
   . evaluating @Precise @(Value Precise (Eff _))
   . runReader (PackageInfo (name "test") Nothing mempty)
   . runReader (ModuleInfo "test/Control/Abstract/Evaluator/Spec.hs")
+  . fmap reassociate
   . runValueError
   . runEnvironmentError
   . runAddressError
@@ -43,6 +43,5 @@ evaluate
   . runReturn
   . runLoopControl
 
-reassociate :: Either Prelude.String (Either (SomeExc exc1) (Either (SomeExc exc2) (Either (SomeExc exc3) result))) -> Either (SomeExc (Sum '[Const Prelude.String, exc1, exc2, exc3])) result
-reassociate (Left s) = Left (SomeExc (inject (Const s)))
-reassociate (Right (Right (Right (Right a)))) = Right a
+reassociate :: Either (SomeExc exc1) (Either (SomeExc exc2) (Either (SomeExc exc3) result)) -> Either (SomeExc (Sum '[exc3, exc2, exc1])) result
+reassociate = mergeExcs . mergeExcs . mergeExcs . Right

test/Data/Functor/Listable.hs

@@ -274,7 +274,7 @@ instance Listable Declaration where
   tiers
     =  cons4 MethodDeclaration
     \/ cons3 FunctionDeclaration
-    \/ cons2 (\ a b -> ErrorDeclaration a b Nothing)
+    \/ cons2 (\ a b -> ErrorDeclaration a b Language.Unknown)
 
 instance Listable CyclomaticComplexity where
   tiers = cons1 CyclomaticComplexity
@@ -299,7 +299,7 @@ instance Listable Span where
 
 
 instance Listable Source where
-  tiers = fromBytes `mapT` tiers
+  tiers = fromUTF8 `mapT` tiers
 
 instance Listable ByteString where
   tiers = (T.encodeUtf8 . T.pack) `mapT` strings

test/Data/Source/Spec.hs

@@ -22,7 +22,7 @@ spec = parallel $ do
 
   describe "spanToRange" $ do
     prop "computes single-line ranges" $
-      \ s -> let source = fromBytes s
+      \ s -> let source = fromUTF8 s
                  spans = zipWith (\ i Range {..} -> Span (Pos i 1) (Pos i (succ (end - start)))) [1..] ranges
                  ranges = sourceLineRanges source in
         spanToRange source <$> spans `shouldBe` ranges

test/Diffing/Interpreter/Spec.hs

@@ -3,6 +3,7 @@ module Diffing.Interpreter.Spec where
 
 import Data.Diff
 import Data.Functor.Listable
+import Data.Maybe
 import Data.Record
 import Data.Sum
 import Data.Term
@@ -12,6 +13,7 @@ import qualified Data.Syntax as Syntax
 import Test.Hspec (Spec, describe, it, parallel)
 import Test.Hspec.Expectations.Pretty
 import Test.Hspec.LeanCheck
+import Test.LeanCheck.Core
 
 spec :: Spec
 spec = parallel $ do
@@ -34,8 +36,11 @@ spec = parallel $ do
           wrap = termIn Nil . inject in
       diffTerms (wrap [ term "b" ]) (wrap [ term "a", term "b" ]) `shouldBe` merge (Nil, Nil) (inject [ inserting (term "a"), merging (term "b") ])
 
-    prop "compares nodes against context" $
-      \ a b -> diffTerms a (termIn Nil (inject (Syntax.Context (pure b) a))) `shouldBe` insertF (In Nil (inject (Syntax.Context (pure (inserting b)) (merging (a :: Term ListableSyntax (Record '[]))))))
+    let noContext :: Term ListableSyntax a -> Bool
+        noContext = isNothing . project @Syntax.Context . termOut
+
+    prop "compares nodes against context" . forAll (filterT (noContext . fst) tiers) $
+      \ (a, b) -> diffTerms a (termIn Nil (inject (Syntax.Context (pure b) a))) `shouldBe` insertF (In Nil (inject (Syntax.Context (pure (inserting b)) (merging (a :: Term ListableSyntax (Record '[]))))))
 
     prop "diffs forward permutations as changes" $
       \ a -> let wrap = termIn Nil . inject

test/Matching/Go/Spec.hs

@@ -9,10 +9,11 @@ import           Data.Sum
 import qualified Data.Syntax.Declaration as Decl
 import qualified Data.Syntax.Literal as Lit
 import qualified Data.Syntax.Statement as Stmt
+import           Data.Text (Text)
 import           SpecHelpers
 
--- This gets the ByteString contents of all integers
-integerMatcher :: (Lit.Integer :< fs) => Matcher (Term (Sum fs) ann) ByteString
+-- This gets the Text contents of all integers
+integerMatcher :: (Lit.Integer :< fs) => Matcher (Term (Sum fs) ann) Text
 integerMatcher = match Lit.integerContent target
 
 -- This matches all for-loops with its index variable new variable bound to 0,

test/Proto3/Roundtrip.hs

@@ -0,0 +1,38 @@
+{-# LANGUAGE TypeApplications #-}
+
+module Proto3.Roundtrip (spec) where
+
+import SpecHelpers
+
+import Data.Span
+import qualified Data.ByteString.Lazy as L
+import Data.Source
+import Proto3.Suite
+import qualified Proto3.Wire.Encode as E
+
+shouldRoundtrip :: (Eq a, Show a, Message a) => a -> Expectation
+shouldRoundtrip a = go a `shouldBe` Right a
+  where go = fromByteString . L.toStrict . toLazyByteString
+
+spec :: Spec
+spec = parallel $ do
+  describe "spans" $
+    prop "roundtrips" $
+      \sp -> shouldRoundtrip @Span sp
+
+  describe "blobs" $ do
+    it "should roundtrip given a Message instance" $ do
+      let bl = Blob (fromUTF8 "puts 'hi'") "example.rb" Ruby
+      shouldRoundtrip bl
+
+  describe "languages" $ do
+    -- If this test broke, it means you've probably added another 'Language'.
+    -- Add it to the list of languages below and everything should be good,
+    -- as long as you added it in a way that doesn't break prior Enum encodings.
+    it "should match up with Enum declarations" $ do
+      let go :: (Primitive f, MessageField f) => [f] -> [L.ByteString]
+          go x = E.toLazyByteString . encodePrimitive (fieldNumber 0) <$> x
+      let ints = [0..fromEnum (maxBound @Language)]
+      let langs = [Unknown, Go, Haskell, Java, JavaScript, JSON,
+                   JSX, Markdown, Python, Ruby, TypeScript, PHP]
+      go ints `shouldBe` go langs

test/Rendering/TOC/Spec.hs

@@ -174,14 +174,14 @@ numTocSummaries diff = length $ filter isValidSummary (diffTOC diff)
 programWithChange :: Term' -> Diff'
 programWithChange body = merge (programInfo, programInfo) (inject [ function' ])
   where
-    function' = merge (Just (FunctionDeclaration "foo" mempty Nothing) :. emptyInfo, Just (FunctionDeclaration "foo" mempty Nothing) :. emptyInfo) (inject (Declaration.Function [] name' [] (merge (Nothing :. emptyInfo, Nothing :. emptyInfo) (inject [ inserting body ]))))
+    function' = merge (Just (FunctionDeclaration "foo" mempty Ruby) :. emptyInfo, Just (FunctionDeclaration "foo" mempty Ruby) :. emptyInfo) (inject (Declaration.Function [] name' [] (merge (Nothing :. emptyInfo, Nothing :. emptyInfo) (inject [ inserting body ]))))
     name' = let info = Nothing :. emptyInfo in merge (info, info) (inject (Syntax.Identifier (name "foo")))
 
 -- Return a diff where term is inserted in the program, below a function found on both sides of the diff.
 programWithChangeOutsideFunction :: Term' -> Diff'
 programWithChangeOutsideFunction term = merge (programInfo, programInfo) (inject [ function', term' ])
   where
-    function' = merge (Just (FunctionDeclaration "foo" mempty Nothing) :. emptyInfo, Just (FunctionDeclaration "foo" mempty Nothing) :. emptyInfo) (inject (Declaration.Function [] name' [] (merge (Nothing :. emptyInfo, Nothing :. emptyInfo) (inject []))))
+    function' = merge (Just (FunctionDeclaration "foo" mempty Unknown) :. emptyInfo, Just (FunctionDeclaration "foo" mempty Unknown) :. emptyInfo) (inject (Declaration.Function [] name' [] (merge (Nothing :. emptyInfo, Nothing :. emptyInfo) (inject []))))
     name' = let info = Nothing :. emptyInfo in  merge (info, info) (inject (Syntax.Identifier (name "foo")))
     term' = inserting term
 
@@ -198,9 +198,9 @@ programOf :: Diff' -> Diff'
 programOf diff = merge (programInfo, programInfo) (inject [ diff ])
 
 functionOf :: Text -> Term' -> Term'
-functionOf n body = termIn (Just (FunctionDeclaration n mempty Nothing) :. emptyInfo) (inject (Declaration.Function [] name' [] (termIn (Nothing :. emptyInfo) (inject [body]))))
+functionOf n body = termIn (Just (FunctionDeclaration n mempty Unknown) :. emptyInfo) (inject (Declaration.Function [] name' [] (termIn (Nothing :. emptyInfo) (inject [body]))))
   where
-    name' = termIn (Nothing :. emptyInfo) (inject (Syntax.Identifier (name (encodeUtf8 n))))
+    name' = termIn (Nothing :. emptyInfo) (inject (Syntax.Identifier (name n)))
 
 programInfo :: Record '[Maybe Declaration, Range, Span]
 programInfo = Nothing :. emptyInfo

test/Semantic/CLI/Spec.hs

@@ -1,11 +1,12 @@
 module Semantic.CLI.Spec (spec) where
 
-import Control.Monad (when)
-import Data.ByteString.Builder
-import Data.Foldable (for_)
-import Semantic.CLI
-import Semantic.IO
-import Semantic.Task
+import           Control.Monad (when)
+import qualified Data.ByteString as B
+import           Data.ByteString.Builder
+import           Data.Foldable (for_)
+import           Semantic.CLI
+import           Semantic.IO
+import           Semantic.Task
 
 import SpecHelpers
 
@@ -24,38 +25,30 @@ spec = parallel $ do
         output <- runTask $ readBlobs (Right files) >>= runParse
         runBuilder output `shouldBe'` expected
   where
-    shouldBe' actual expected = do
-      when (actual /= expected) $ print actual
+    shouldBe' actual' expectedFile = do
+      let actual = verbatim actual'
+      expected <- verbatim <$> B.readFile expectedFile
       actual `shouldBe` expected
 
-parseFixtures :: [(String, [Blob] -> TaskEff Builder, [File], ByteString)]
+parseFixtures :: [(String, [Blob] -> TaskEff Builder, [File], FilePath)]
 parseFixtures =
-  [ (show SExpressionTermRenderer, runParse SExpressionTermRenderer, pathMode, sExpressionParseTreeOutput)
-  , (show JSONTermRenderer, runParse JSONTermRenderer, pathMode, jsonParseTreeOutput)
-  , (show JSONTermRenderer, runParse JSONTermRenderer, pathMode', jsonParseTreeOutput')
-  , (show JSONTermRenderer, runParse JSONTermRenderer, [], emptyJsonParseTreeOutput)
-  , (show (SymbolsTermRenderer defaultSymbolFields), runParse (SymbolsTermRenderer defaultSymbolFields), [File "test/fixtures/ruby/corpus/method-declaration.A.rb" (Just Ruby)], symbolsOutput)
-  , (show TagsTermRenderer, runParse TagsTermRenderer, [File "test/fixtures/ruby/corpus/method-declaration.A.rb" (Just Ruby)], tagsOutput)
+  [ (show SExpressionTermRenderer, runParse SExpressionTermRenderer, path, "test/fixtures/ruby/corpus/and-or.parseA.txt")
+  , (show JSONTermRenderer, runParse JSONTermRenderer, path, prefix </> "parse-tree.json")
+  , (show JSONTermRenderer, runParse JSONTermRenderer, path', prefix </> "parse-trees.json")
+  , (show JSONTermRenderer, runParse JSONTermRenderer, [], prefix </> "parse-tree-empty.json")
+  , (show (SymbolsTermRenderer defaultSymbolFields), runParse (SymbolsTermRenderer defaultSymbolFields), path'', prefix </> "parse-tree.symbols.json")
+  , (show TagsTermRenderer, runParse TagsTermRenderer, path'', prefix </> "parse-tree.tags.json")
   ]
-  where pathMode = [File "test/fixtures/ruby/corpus/and-or.A.rb" (Just Ruby)]
-        pathMode' = [File "test/fixtures/ruby/corpus/and-or.A.rb" (Just Ruby), File "test/fixtures/ruby/corpus/and-or.B.rb" (Just Ruby)]
+  where path = [File "test/fixtures/ruby/corpus/and-or.A.rb" Ruby]
+        path' = [File "test/fixtures/ruby/corpus/and-or.A.rb" Ruby, File "test/fixtures/ruby/corpus/and-or.B.rb" Ruby]
+        path'' = [File "test/fixtures/ruby/corpus/method-declaration.A.rb" Ruby]
+        prefix = "test/fixtures/cli"
 
-        sExpressionParseTreeOutput = "(Program\n  (LowAnd\n    (Send\n      (Identifier))\n    (Send\n      (Identifier))))\n"
-        jsonParseTreeOutput = "{\"trees\":[{\"tree\":{\"term\":\"Program\",\"children\":[{\"term\":\"LowAnd\",\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"foo\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"bar\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}},\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"path\":\"test/fixtures/ruby/corpus/and-or.A.rb\",\"language\":\"Ruby\"}]}\n"
-        jsonParseTreeOutput' = "{\"trees\":[{\"tree\":{\"term\":\"Program\",\"children\":[{\"term\":\"LowAnd\",\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"foo\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"bar\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}},\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"path\":\"test/fixtures/ruby/corpus/and-or.A.rb\",\"language\":\"Ruby\"},{\"tree\":{\"term\":\"Program\",\"children\":[{\"term\":\"LowOr\",\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"foo\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"bar\",\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}},\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]}},{\"term\":\"LowAnd\",\"children\":{\"term\":\"LowOr\",\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"a\",\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"b\",\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}},\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]}},\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"c\",\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}},\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]}}],\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"path\":\"test/fixtures/ruby/corpus/and-or.B.rb\",\"language\":\"Ruby\"}]}\n"
-        emptyJsonParseTreeOutput = "{\"trees\":[]}\n"
-        symbolsOutput = "{\"files\":[{\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb\",\"symbols\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"kind\":\"Method\",\"symbol\":\"foo\"}],\"language\":\"Ruby\"}]}\n"
-        tagsOutput = "[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb\",\"kind\":\"Method\",\"symbol\":\"foo\",\"line\":\"def foo\",\"language\":\"Ruby\"}]\n"
-
-
-diffFixtures :: [(String, [BlobPair] -> TaskEff Builder, [Both File], ByteString)]
+diffFixtures :: [(String, [BlobPair] -> TaskEff Builder, [Both File], FilePath)]
 diffFixtures =
-  [ (show JSONDiffRenderer, runDiff JSONDiffRenderer, pathMode, jsonOutput)
-  , (show SExpressionDiffRenderer, runDiff SExpressionDiffRenderer, pathMode, sExpressionOutput)
-  , (show ToCDiffRenderer, runDiff ToCDiffRenderer, pathMode, tocOutput)
+  [ (show JSONDiffRenderer, runDiff JSONDiffRenderer, pathMode, prefix </> "diff-tree.json")
+  , (show SExpressionDiffRenderer, runDiff SExpressionDiffRenderer, pathMode, "test/fixtures/ruby/corpus/method-declaration.diffA-B.txt")
+  , (show ToCDiffRenderer, runDiff ToCDiffRenderer, pathMode, prefix </> "diff-tree.toc.json")
   ]
-  where pathMode = [both (File "test/fixtures/ruby/corpus/method-declaration.A.rb" (Just Ruby)) (File "test/fixtures/ruby/corpus/method-declaration.B.rb"  (Just Ruby))]
-
-        jsonOutput = "{\"diffs\":[{\"diff\":{\"merge\":{\"term\":\"Program\",\"children\":[{\"merge\":{\"term\":\"Method\",\"methodContext\":[],\"methodReceiver\":{\"merge\":{\"term\":\"Empty\",\"before\":{\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}},\"after\":{\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}}}},\"methodName\":{\"patch\":{\"replace\":[{\"term\":\"Identifier\",\"name\":\"foo\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"term\":\"Identifier\",\"name\":\"bar\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}]}},\"methodParameters\":[{\"patch\":{\"insert\":{\"term\":\"Identifier\",\"name\":\"a\",\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}}}],\"methodBody\":{\"merge\":{\"children\":[{\"patch\":{\"insert\":{\"term\":\"Send\",\"sourceRange\":[13,16],\"sendReceiver\":null,\"sendBlock\":null,\"sendArgs\":[],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]},\"sendSelector\":{\"patch\":{\"insert\":{\"term\":\"Identifier\",\"name\":\"baz\",\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}}}}}],\"before\":{\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,4]}},\"after\":{\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}},\"before\":{\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}},\"after\":{\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}}}}],\"before\":{\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"after\":{\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}}}},\"stat\":{\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb\",\"replace\":[{\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb\",\"language\":\"Ruby\"},{\"path\":\"test/fixtures/ruby/corpus/method-declaration.B.rb\",\"language\":\"Ruby\"}]}}]}\n"
-        sExpressionOutput = "(Program\n  (Method\n    (Empty)\n  { (Identifier)\n  ->(Identifier) }\n  {+(Identifier)+}\n    (Statements\n    {+(Send\n      {+(Identifier)+})+})))\n"
-        tocOutput = "{\"changes\":{\"test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"modified\"}]},\"errors\":{}}\n"
+  where pathMode = [both (File "test/fixtures/ruby/corpus/method-declaration.A.rb" Ruby) (File "test/fixtures/ruby/corpus/method-declaration.B.rb"  Ruby)]
+        prefix = "test/fixtures/cli"

test/Semantic/IO/Spec.hs

@@ -23,15 +23,15 @@ spec :: Spec
 spec = parallel $ do
   describe "readFile" $ do
     it "returns a blob for extant files" $ do
-      Just blob <- readFile (File "semantic.cabal" Nothing)
+      Just blob <- readFile (File "semantic.cabal" Unknown)
       blobPath blob `shouldBe` "semantic.cabal"
 
     it "throws for absent files" $ do
-      readFile (File "this file should not exist" Nothing) `shouldThrow` anyIOException
+      readFile (File "this file should not exist" Unknown) `shouldThrow` anyIOException
 
   describe "readBlobPairsFromHandle" $ do
-    let a = sourceBlob "method.rb" (Just Ruby) "def foo; end"
-    let b = sourceBlob "method.rb" (Just Ruby) "def bar(x); end"
+    let a = sourceBlob "method.rb" Ruby "def foo; end"
+    let b = sourceBlob "method.rb" Ruby "def bar(x); end"
     it "returns blobs for valid JSON encoded diff input" $ do
       blobs <- blobsFromFilePath "test/fixtures/cli/diff.json"
       blobs `shouldBe` [blobPairDiffing a b]
@@ -56,7 +56,7 @@ spec = parallel $ do
     it "returns blobs for unsupported language" $ do
       h <- openFileForReading "test/fixtures/cli/diff-unsupported-language.json"
       blobs <- readBlobPairsFromHandle h
-      let b' = sourceBlob "test.kt" Nothing "fun main(args: Array<String>) {\nprintln(\"hi\")\n}\n"
+      let b' = sourceBlob "test.kt" Unknown "fun main(args: Array<String>) {\nprintln(\"hi\")\n}\n"
       blobs `shouldBe` [blobPairInserting b']
 
     it "detects language based on filepath for empty language" $ do
@@ -83,11 +83,11 @@ spec = parallel $ do
         TS.ts_parser_loop_until_cancelled p nullPtr nullPtr 0
         pure True
 
-      res <- timeout 500 (wait churn)
+      res <- timeout 1500 (wait churn)
       res `shouldBe` Nothing
 
       TS.ts_parser_set_enabled p (CBool 0)
-      done <- timeout 500 (wait churn)
+      done <- timeout 1500 (wait churn)
 
       done `shouldBe` (Just True)
 
@@ -97,7 +97,7 @@ spec = parallel $ do
     it "returns blobs for valid JSON encoded parse input" $ do
       h <- openFileForReading "test/fixtures/cli/parse.json"
       blobs <- readBlobsFromHandle h
-      let a = sourceBlob "method.rb" (Just Ruby) "def foo; end"
+      let a = sourceBlob "method.rb" Ruby "def foo; end"
       blobs `shouldBe` [a]
 
     it "throws on blank input" $ do

test/Semantic/Spec.hs

@@ -11,13 +11,13 @@ import SpecHelpers
 spec :: Spec
 spec = parallel $ do
   describe "parseBlob" $ do
-    it "throws if not given a language" $ do
-      runTask (runParse SExpressionTermRenderer [methodsBlob { blobLanguage = Nothing }]) `shouldThrow` (\ code -> case code of
+    it "throws if given an unknown language" $ do
+      runTask (runParse SExpressionTermRenderer [methodsBlob { blobLanguage = Unknown }]) `shouldThrow` (\ code -> case code of
         ExitFailure 1 -> True
         _ -> False)
 
     it "renders with the specified renderer" $ do
       output <- fmap runBuilder . runTask $ runParse SExpressionTermRenderer [methodsBlob]
-      output `shouldBe` "(Program\n  (Method\n    (Empty)\n    (Identifier)\n    (Statements)))\n"
+      output `shouldBe` "(Statements\n  (Method\n    (Empty)\n    (Identifier)\n    (Statements)))\n"
   where
-    methodsBlob = Blob "def foo\nend\n" "methods.rb" (Just Ruby)
+    methodsBlob = Blob "def foo\nend\n" "methods.rb" Ruby

test/Spec.hs

@@ -23,6 +23,7 @@ import qualified Semantic.Spec
 import qualified Semantic.CLI.Spec
 import qualified Semantic.IO.Spec
 import qualified Semantic.Stat.Spec
+import qualified Proto3.Roundtrip
 import Test.Hspec
 
 main :: IO ()
@@ -51,3 +52,4 @@ main = hspec $ do
     describe "Semantic.CLI" Semantic.CLI.Spec.spec
     describe "Semantic.IO" Semantic.IO.Spec.spec
     describe "Integration" Integration.Spec.spec
+    describe "Protobuf roundtripping" Proto3.Roundtrip.spec

test/SpecHelpers.hs

@@ -38,6 +38,7 @@ import Data.Range as X
 import Data.Record as X
 import Data.Source as X
 import Data.Span as X
+import Data.Sum
 import Data.Term as X
 import Parsing.Parser as X
 import Rendering.Renderer as X hiding (error)
@@ -77,11 +78,39 @@ readFilePair :: Both FilePath -> IO BlobPair
 readFilePair paths = let paths' = fmap file paths in
                      runBothWith IO.readFilePair paths'
 
+testEvaluating :: TermEvaluator term Precise
+                    (Value Precise (Eff effects))
+                    '[ Resumable (ValueError Precise (Eff effects))
+                     , Resumable (AddressError Precise (Value Precise (Eff effects)))
+                     , Resumable EvalError, Resumable (EnvironmentError Precise)
+                     , Resumable ResolutionError
+                     , Resumable (Unspecialized (Value Precise (Eff effects)))
+                     , Resumable (LoadError Precise (Value Precise (Eff effects)))
+                     , Fresh
+                     , State (Heap Precise Latest (Value Precise (Eff effects)))
+                     , State (ModuleTable (Maybe (Value Precise (Eff effects), Environment Precise)))
+                     , Trace
+                     ]
+                   [(Value Precise (Eff effects), Environment Precise)]
+               -> ((Either
+                      (SomeExc
+                         (Data.Sum.Sum
+                          '[ ValueError Precise (Eff effects)
+                           , AddressError Precise (Value Precise (Eff effects))
+                           , EvalError
+                           , EnvironmentError Precise
+                           , ResolutionError
+                           , Unspecialized (Value Precise (Eff effects))
+                           , LoadError Precise (Value Precise (Eff effects))
+                           ]))
+                      [(Value Precise (Eff effects), Environment Precise)],
+                    EvaluatingState Precise (Value Precise (Eff effects))),
+                   [String])
 testEvaluating
   = run
   . runReturningTrace
-  . fmap (first reassociate)
   . evaluating
+  . fmap reassociate
   . runLoadError
   . runUnspecialized
   . runResolutionError

test/fixtures/cli/diff-tree.json

@@ -0,0 +1,198 @@
+{
+  "diffs": [
+  {
+    "diff":
+    {
+      "merge":
+      {
+        "term": "Statements",
+        "children": [
+        {
+          "merge":
+          {
+            "term": "Method",
+            "methodBody":
+            {
+              "merge":
+              {
+                "children": [
+                {
+                  "patch":
+                  {
+                    "insert":
+                    {
+                      "term": "Send",
+                      "sourceRange": [13, 16],
+                      "sendReceiver": null,
+                      "sendBlock": null,
+                      "sendArgs": [],
+                      "sourceSpan":
+                      {
+                        "start": [2, 3],
+                        "end": [2, 6]
+                      },
+                      "sendSelector":
+                      {
+                        "patch":
+                        {
+                          "insert":
+                          {
+                            "term": "Identifier",
+                            "name": "baz",
+                            "sourceRange": [13, 16],
+                            "sourceSpan":
+                            {
+                              "start": [2, 3],
+                              "end": [2, 6]
+                            }
+                          }
+                        }
+                      }
+                    }
+                  }
+                }],
+                "before":
+                {
+                  "sourceRange": [8, 11],
+                  "sourceSpan":
+                  {
+                    "start": [2, 1],
+                    "end": [2, 4]
+                  }
+                },
+                "after":
+                {
+                  "sourceRange": [13, 16],
+                  "sourceSpan":
+                  {
+                    "start": [2, 3],
+                    "end": [2, 6]
+                  }
+                }
+              }
+            },
+            "methodContext": [],
+            "methodName":
+            {
+              "patch":
+              {
+                "replace": [
+                {
+                  "term": "Identifier",
+                  "name": "foo",
+                  "sourceRange": [4, 7],
+                  "sourceSpan":
+                  {
+                    "start": [1, 5],
+                    "end": [1, 8]
+                  }
+                },
+                {
+                  "term": "Identifier",
+                  "name": "bar",
+                  "sourceRange": [4, 7],
+                  "sourceSpan":
+                  {
+                    "start": [1, 5],
+                    "end": [1, 8]
+                  }
+                }]
+              }
+            },
+            "methodParameters": [
+            {
+              "patch":
+              {
+                "insert":
+                {
+                  "term": "Identifier",
+                  "name": "a",
+                  "sourceRange": [8, 9],
+                  "sourceSpan":
+                  {
+                    "start": [1, 9],
+                    "end": [1, 10]
+                  }
+                }
+              }
+            }],
+            "methodReceiver":
+            {
+              "merge":
+              {
+                "term": "Empty",
+                "before":
+                {
+                  "sourceRange": [0, 0],
+                  "sourceSpan":
+                  {
+                    "start": [1, 1],
+                    "end": [1, 1]
+                  }
+                },
+                "after":
+                {
+                  "sourceRange": [0, 0],
+                  "sourceSpan":
+                  {
+                    "start": [1, 1],
+                    "end": [1, 1]
+                  }
+                }
+              }
+            },
+            "before":
+            {
+              "sourceRange": [0, 11],
+              "sourceSpan":
+              {
+                "start": [1, 1],
+                "end": [2, 4]
+              }
+            },
+            "after":
+            {
+              "sourceRange": [0, 20],
+              "sourceSpan":
+              {
+                "start": [1, 1],
+                "end": [3, 4]
+              }
+            }
+          }
+        }],
+        "before":
+        {
+          "sourceRange": [0, 12],
+          "sourceSpan":
+          {
+            "start": [1, 1],
+            "end": [3, 1]
+          }
+        },
+        "after":
+        {
+          "sourceRange": [0, 21],
+          "sourceSpan":
+          {
+            "start": [1, 1],
+            "end": [4, 1]
+          }
+        }
+      }
+    },
+    "stat":
+    {
+      "path": "test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb",
+      "replace": [
+      {
+        "path": "test/fixtures/ruby/corpus/method-declaration.A.rb",
+        "language": "Ruby"
+      },
+      {
+        "path": "test/fixtures/ruby/corpus/method-declaration.B.rb",
+        "language": "Ruby"
+      }]
+    }
+  }]
+}

test/fixtures/cli/diff-tree.toc.json

@@ -0,0 +1,18 @@
+{
+  "changes":
+  {
+    "test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb": [
+    {
+      "span":
+      {
+        "start": [1, 1],
+        "end": [3, 4]
+      },
+      "category": "Method",
+      "term": "bar",
+      "changeType": "modified"
+    }]
+  },
+  "errors":
+  {}
+}

test/fixtures/cli/parse-tree-empty.json

@@ -0,0 +1,3 @@
+{
+  "trees": []
+}

test/fixtures/cli/parse-tree.json

@@ -0,0 +1,74 @@
+{
+  "trees": [
+  {
+    "tree":
+    {
+      "term": "Statements",
+      "children": [
+      {
+        "term": "LowAnd",
+        "children": [
+        {
+          "term": "Send",
+          "sendArgs": [],
+          "sendBlock": null,
+          "sendReceiver": null,
+          "sendSelector":
+          {
+            "term": "Identifier",
+            "name": "foo",
+            "sourceRange": [0, 3],
+            "sourceSpan":
+            {
+              "start": [1, 1],
+              "end": [1, 4]
+            }
+          },
+          "sourceRange": [0, 3],
+          "sourceSpan":
+          {
+            "start": [1, 1],
+            "end": [1, 4]
+          }
+        },
+        {
+          "term": "Send",
+          "sendArgs": [],
+          "sendBlock": null,
+          "sendReceiver": null,
+          "sendSelector":
+          {
+            "term": "Identifier",
+            "name": "bar",
+            "sourceRange": [8, 11],
+            "sourceSpan":
+            {
+              "start": [1, 9],
+              "end": [1, 12]
+            }
+          },
+          "sourceRange": [8, 11],
+          "sourceSpan":
+          {
+            "start": [1, 9],
+            "end": [1, 12]
+          }
+        }],
+        "sourceRange": [0, 11],
+        "sourceSpan":
+        {
+          "start": [1, 1],
+          "end": [1, 12]
+        }
+      }],
+      "sourceRange": [0, 12],
+      "sourceSpan":
+      {
+        "start": [1, 1],
+        "end": [2, 1]
+      }
+    },
+    "path": "test/fixtures/ruby/corpus/and-or.A.rb",
+    "language": "Ruby"
+  }]
+}

test/fixtures/cli/parse-tree.symbols.json

@@ -0,0 +1,17 @@
+{
+  "files": [
+  {
+    "path": "test/fixtures/ruby/corpus/method-declaration.A.rb",
+    "symbols": [
+    {
+      "span":
+      {
+        "start": [1, 1],
+        "end": [2, 4]
+      },
+      "kind": "Method",
+      "symbol": "foo"
+    }],
+    "language": "Ruby"
+  }]
+}

test/fixtures/cli/parse-tree.tags.json

@@ -0,0 +1,13 @@
+[
+{
+  "span":
+  {
+    "start": [1, 1],
+    "end": [2, 4]
+  },
+  "path": "test/fixtures/ruby/corpus/method-declaration.A.rb",
+  "kind": "Method",
+  "symbol": "foo",
+  "line": "def foo",
+  "language": "Ruby"
+}]

test/fixtures/cli/parse-trees.json

@@ -0,0 +1,234 @@
+{
+  "trees": [
+  {
+    "tree":
+    {
+      "term": "Statements",
+      "children": [
+      {
+        "term": "LowAnd",
+        "children": [
+        {
+          "term": "Send",
+          "sendArgs": [],
+          "sendBlock": null,
+          "sendReceiver": null,
+          "sendSelector":
+          {
+            "term": "Identifier",
+            "name": "foo",
+            "sourceRange": [0, 3],
+            "sourceSpan":
+            {
+              "start": [1, 1],
+              "end": [1, 4]
+            }
+          },
+          "sourceRange": [0, 3],
+          "sourceSpan":
+          {
+            "start": [1, 1],
+            "end": [1, 4]
+          }
+        },
+        {
+          "term": "Send",
+          "sendArgs": [],
+          "sendBlock": null,
+          "sendReceiver": null,
+          "sendSelector":
+          {
+            "term": "Identifier",
+            "name": "bar",
+            "sourceRange": [8, 11],
+            "sourceSpan":
+            {
+              "start": [1, 9],
+              "end": [1, 12]
+            }
+          },
+          "sourceRange": [8, 11],
+          "sourceSpan":
+          {
+            "start": [1, 9],
+            "end": [1, 12]
+          }
+        }],
+        "sourceRange": [0, 11],
+        "sourceSpan":
+        {
+          "start": [1, 1],
+          "end": [1, 12]
+        }
+      }],
+      "sourceRange": [0, 12],
+      "sourceSpan":
+      {
+        "start": [1, 1],
+        "end": [2, 1]
+      }
+    },
+    "path": "test/fixtures/ruby/corpus/and-or.A.rb",
+    "language": "Ruby"
+  },
+  {
+    "tree":
+    {
+      "term": "Statements",
+      "children": [
+      {
+        "term": "LowOr",
+        "children": [
+        {
+          "term": "Send",
+          "sendArgs": [],
+          "sendBlock": null,
+          "sendReceiver": null,
+          "sendSelector":
+          {
+            "term": "Identifier",
+            "name": "foo",
+            "sourceRange": [0, 3],
+            "sourceSpan":
+            {
+              "start": [1, 1],
+              "end": [1, 4]
+            }
+          },
+          "sourceRange": [0, 3],
+          "sourceSpan":
+          {
+            "start": [1, 1],
+            "end": [1, 4]
+          }
+        },
+        {
+          "term": "Send",
+          "sendArgs": [],
+          "sendBlock": null,
+          "sendReceiver": null,
+          "sendSelector":
+          {
+            "term": "Identifier",
+            "name": "bar",
+            "sourceRange": [7, 10],
+            "sourceSpan":
+            {
+              "start": [1, 8],
+              "end": [1, 11]
+            }
+          },
+          "sourceRange": [7, 10],
+          "sourceSpan":
+          {
+            "start": [1, 8],
+            "end": [1, 11]
+          }
+        }],
+        "sourceRange": [0, 10],
+        "sourceSpan":
+        {
+          "start": [1, 1],
+          "end": [1, 11]
+        }
+      },
+      {
+        "term": "LowAnd",
+        "children": [
+        {
+          "term": "LowOr",
+          "children": [
+          {
+            "term": "Send",
+            "sendArgs": [],
+            "sendBlock": null,
+            "sendReceiver": null,
+            "sendSelector":
+            {
+              "term": "Identifier",
+              "name": "a",
+              "sourceRange": [11, 12],
+              "sourceSpan":
+              {
+                "start": [2, 1],
+                "end": [2, 2]
+              }
+            },
+            "sourceRange": [11, 12],
+            "sourceSpan":
+            {
+              "start": [2, 1],
+              "end": [2, 2]
+            }
+          },
+          {
+            "term": "Send",
+            "sendArgs": [],
+            "sendBlock": null,
+            "sendReceiver": null,
+            "sendSelector":
+            {
+              "term": "Identifier",
+              "name": "b",
+              "sourceRange": [16, 17],
+              "sourceSpan":
+              {
+                "start": [2, 6],
+                "end": [2, 7]
+              }
+            },
+            "sourceRange": [16, 17],
+            "sourceSpan":
+            {
+              "start": [2, 6],
+              "end": [2, 7]
+            }
+          }],
+          "sourceRange": [11, 17],
+          "sourceSpan":
+          {
+            "start": [2, 1],
+            "end": [2, 7]
+          }
+        },
+        {
+          "term": "Send",
+          "sendArgs": [],
+          "sendBlock": null,
+          "sendReceiver": null,
+          "sendSelector":
+          {
+            "term": "Identifier",
+            "name": "c",
+            "sourceRange": [22, 23],
+            "sourceSpan":
+            {
+              "start": [2, 12],
+              "end": [2, 13]
+            }
+          },
+          "sourceRange": [22, 23],
+          "sourceSpan":
+          {
+            "start": [2, 12],
+            "end": [2, 13]
+          }
+        }],
+        "sourceRange": [11, 23],
+        "sourceSpan":
+        {
+          "start": [2, 1],
+          "end": [2, 13]
+        }
+      }],
+      "sourceRange": [0, 24],
+      "sourceSpan":
+      {
+        "start": [1, 1],
+        "end": [3, 1]
+      }
+    },
+    "path": "test/fixtures/ruby/corpus/and-or.B.rb",
+    "language": "Ruby"
+  }]
+}

test/fixtures/go/corpus/array-types.diffA-B.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function

test/fixtures/go/corpus/array-types.diffB-A.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function

test/fixtures/go/corpus/array-types.parseA.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function

test/fixtures/go/corpus/array-types.parseB.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function

test/fixtures/go/corpus/array-with-implicit-length.diffA-B.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function
@@ -11,9 +11,9 @@
         (Array
           (Identifier))
         (Statements
-        {+(Integer)+}
-        {+(Integer)+}
         { (Integer)
         ->(Integer) }
-        {-(Integer)-}
-        {-(Integer)-})))))
+        { (Integer)
+        ->(Integer) }
+        { (Integer)
+        ->(Integer) })))))

test/fixtures/go/corpus/array-with-implicit-length.diffB-A.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function
@@ -11,9 +11,9 @@
         (Array
           (Identifier))
         (Statements
-        {+(Integer)+}
         { (Integer)
         ->(Integer) }
         { (Integer)
         ->(Integer) }
-        {-(Integer)-})))))
+        { (Integer)
+        ->(Integer) })))))

test/fixtures/go/corpus/array-with-implicit-length.parseA.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function

test/fixtures/go/corpus/array-with-implicit-length.parseB.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function

test/fixtures/go/corpus/assignment-statements.diffA-B.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function
@@ -45,11 +45,15 @@
       {+(RShift
         {+(Identifier)+}
         {+(Integer)+})+})+}
-    {+(Assignment
-      {+(Identifier)+}
-      {+(DividedBy
+      (Assignment
+      { (Identifier)
+      ->(Identifier) }
+      { (Times
+        {-(Identifier)-}
+        {-(Integer)-})
+      ->(DividedBy
         {+(Identifier)+}
-        {+(Integer)+})+})+}
+        {+(Integer)+}) })
     {+(Assignment
       {+(Identifier)+}
       {+(BXOr
@@ -78,11 +82,6 @@
               {+(KeyValue
                 {+(Identifier)+}
                 {+(Integer)+})+})+})+})+})+})+}
-    {-(Assignment
-      {-(Identifier)-}
-      {-(Times
-        {-(Identifier)-}
-        {-(Integer)-})-})-}
     {-(Assignment
       {-(Identifier)-}
       {-(Plus

test/fixtures/go/corpus/assignment-statements.diffB-A.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function
@@ -30,11 +30,15 @@
       {+(Times
         {+(Identifier)+}
         {+(Integer)+})+})+}
-    {+(Assignment
-      {+(Identifier)+}
-      {+(Plus
+      (Assignment
+      { (Identifier)
+      ->(Identifier) }
+      { (Times
+        {-(Identifier)-}
+        {-(Integer)-})
+      ->(Plus
         {+(Identifier)+}
-        {+(Integer)+})+})+}
+        {+(Integer)+}) })
     {+(Assignment
       {+(Identifier)+}
       {+(LShift
@@ -60,12 +64,16 @@
       {+(Modulo
         {+(Identifier)+}
         {+(Integer)+})+})+}
-    {+(Assignment
-      {+(Identifier)+}
-      {+(Not
+      (Assignment
+      { (Identifier)
+      ->(Identifier) }
+      { (Plus
+        {-(Identifier)-}
+        {-(Integer)-})
+      ->(Not
         {+(BAnd
           {+(Identifier)+}
-          {+(Integer)+})+})+})+}
+          {+(Integer)+})+}) })
     {+(Assignment
       {+(Identifier)+}
       {+(Statements
@@ -78,16 +86,6 @@
               {+(KeyValue
                 {+(Identifier)+}
                 {+(Integer)+})+})+})+})+})+})+}
-    {-(Assignment
-      {-(Identifier)-}
-      {-(Times
-        {-(Identifier)-}
-        {-(Integer)-})-})-}
-    {-(Assignment
-      {-(Identifier)-}
-      {-(Plus
-        {-(Identifier)-}
-        {-(Integer)-})-})-}
     {-(Assignment
       {-(Identifier)-}
       {-(LShift

test/fixtures/go/corpus/assignment-statements.parseA.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function

test/fixtures/go/corpus/assignment-statements.parseB.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function

test/fixtures/go/corpus/binary-expressions.diffA-B.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function
@@ -22,17 +22,13 @@
         ->(Identifier) }
         { (Identifier)
         ->(Identifier) }))
-      (Equal
-      { (Identifier)
-      ->(Identifier) }
-      { (Identifier)
-      ->(Identifier) })
-      (Not
-        (Equal
-        { (Identifier)
-        ->(Identifier) }
-        { (Identifier)
-        ->(Identifier) }))
+    {+(Equal
+      {+(Identifier)+}
+      {+(Identifier)+})+}
+    {+(Not
+      {+(Equal
+        {+(Identifier)+}
+        {+(Identifier)+})+})+}
     {+(LessThan
       {+(Identifier)+}
       {+(Identifier)+})+}
@@ -78,6 +74,13 @@
     {+(BAnd
       {+(Identifier)+}
       {+(Identifier)+})+}
+    {-(Equal
+      {-(Identifier)-}
+      {-(Identifier)-})-}
+    {-(Not
+      {-(Equal
+        {-(Identifier)-}
+        {-(Identifier)-})-})-}
     {-(LessThan
       {-(Identifier)-}
       {-(Identifier)-})-}

test/fixtures/go/corpus/binary-expressions.diffB-A.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function
@@ -22,17 +22,13 @@
         ->(Identifier) }
         { (Identifier)
         ->(Identifier) }))
-      (Equal
-      { (Identifier)
-      ->(Identifier) }
-      { (Identifier)
-      ->(Identifier) })
-      (Not
-        (Equal
-        { (Identifier)
-        ->(Identifier) }
-        { (Identifier)
-        ->(Identifier) }))
+    {+(Equal
+      {+(Identifier)+}
+      {+(Identifier)+})+}
+    {+(Not
+      {+(Equal
+        {+(Identifier)+}
+        {+(Identifier)+})+})+}
     {+(LessThan
       {+(Identifier)+}
       {+(Identifier)+})+}
@@ -78,6 +74,13 @@
     {+(BAnd
       {+(Identifier)+}
       {+(Identifier)+})+}
+    {-(Equal
+      {-(Identifier)-}
+      {-(Identifier)-})-}
+    {-(Not
+      {-(Equal
+        {-(Identifier)-}
+        {-(Identifier)-})-})-}
     {-(LessThan
       {-(Identifier)-}
       {-(Identifier)-})-}

test/fixtures/go/corpus/binary-expressions.parseA.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function

test/fixtures/go/corpus/binary-expressions.parseB.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function

test/fixtures/go/corpus/call-expressions.diffA-B.txt

@@ -1,4 +1,4 @@
-(Program
+(Statements
   (Package
     (Identifier))
   (Function
@@ -21,20 +21,14 @@
           (Identifier)
           (Identifier))
         (Empty))
-    {+(Call
-      {+(Identifier)+}
-      {+(Statements
-        {+(Identifier)+}
-        {+(Variadic
-          {+(Identifier)+})+})+}
-      {+(Empty)+})+}
-    {-(Call
-      {-(Identifier)-}
-      {-(Statements
-        {-(Identifier)-}
-        {-(Variadic
-          {-(Identifier)-})-})-}
-      {-(Empty)-})-}
+      (Call
+      { (Identifier)
+      ->(Identifier) }
+        (Statements
+          (Identifier)
+          (Variadic
+            (Identifier)))
+        (Empty))
     {-(Call
       {-(Identifier)-}
       {-(Statements)-}