Merge pull request #350 from github/abstract-a-la-carte-terms

Abstract à la carte terms

bench/Evaluation.hs

@@ -12,6 +12,7 @@ import           Data.Blob
 import           Data.Blob.IO (readBlobFromFile')
 import           Data.Bifunctor
 import           Data.Functor.Classes
+import           Data.Functor.Foldable (Base, Recursive)
 import           "semantic" Data.Graph (Graph (..), topologicalSort)
 import           Data.Graph.ControlFlowVertex
 import qualified Data.Language as Language
@@ -25,24 +26,27 @@ import           Semantic.Graph
 import           Semantic.Task (SomeException, TaskSession (..), runTask, withOptions)
 import           Semantic.Util hiding (evalPythonProject, evalRubyProject, evaluateProject)
 import           Source.Loc
+import           Source.Span (HasSpan)
 import qualified System.Path as Path
 import           System.Path ((</>))
 
 -- Duplicating this stuff from Util to shut off the logging
 
 callGraphProject' :: ( Language.SLanguage lang
-                     , Ord1 syntax
-                     , Declarations1 syntax
-                     , Evaluatable syntax
-                     , FreeVariables1 syntax
-                     , AccessControls1 syntax
                      , HasPrelude lang
-                     , Functor syntax
-                     , VertexDeclaration1 syntax
+                     , AccessControls (term Loc)
+                     , Declarations (term Loc)
+                     , Evaluatable (Base (term Loc))
+                     , FreeVariables (term Loc)
+                     , HasSpan (term Loc)
+                     , Ord (term Loc)
+                     , Recursive (term Loc)
+                     , Show (term Loc)
+                     , VertexDeclaration term
                      )
                   => TaskSession
                   -> Proxy lang
-                  -> Parser (Term syntax Loc)
+                  -> Parser (term Loc)
                   -> Path.RelFile
                   -> IO (Either String (Data.Graph.Graph ControlFlowVertex))
 callGraphProject' session proxy parser path = fmap (first show) . runTask session $ do

semantic.cabal

@@ -181,14 +181,18 @@ library
                      -- Language-specific grammar/syntax types, & assignments
                      , Language.Markdown.Assignment
                      , Language.Markdown.Syntax
+                     , Language.Markdown.Term
                      , Language.Go.Assignment
                      , Language.Go.Syntax
+                     , Language.Go.Term
                      , Language.Go.Type
                      , Language.Ruby.Assignment
                      , Language.Ruby.Syntax
+                     , Language.Ruby.Term
                      , Language.TSX.Assignment
                      , Language.TSX.Syntax
                      , Language.TSX.Syntax.JSX
+                     , Language.TSX.Term
                      , Language.TypeScript.Assignment
                      , Language.TypeScript.Resolution
                      , Language.TypeScript.Syntax
@@ -196,10 +200,13 @@ library
                      , Language.TypeScript.Syntax.JavaScript
                      , Language.TypeScript.Syntax.TypeScript
                      , Language.TypeScript.Syntax.Types
+                     , Language.TypeScript.Term
                      , Language.PHP.Assignment
                      , Language.PHP.Syntax
+                     , Language.PHP.Term
                      , Language.Python.Assignment
                      , Language.Python.Syntax
+                     , Language.Python.Term
                      , Numeric.Exts
                      -- Parser glue
                      , Parsing.CMark

src/Analysis/Decorator.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
 module Analysis.Decorator
 ( decoratorWithAlgebra
 ) where
@@ -7,8 +7,8 @@ import Data.Term
 import Prologue
 
 -- | Lift an algebra into a decorator for terms annotated with records.
-decoratorWithAlgebra :: Functor syntax
-                     => RAlgebra (TermF syntax a) (Term syntax a) b -- ^ An R-algebra on terms.
-                     -> Term syntax a                               -- ^ A term to decorate with values produced by the R-algebra.
-                     -> Term syntax b                               -- ^ A term decorated with values produced by the R-algebra.
+decoratorWithAlgebra :: (Functor (Syntax term), IsTerm term, Recursive (term a), Base (term a) ~ TermF (Syntax term) a)
+                     => RAlgebra (TermF (Syntax term) a) (term a) b -- ^ An R-algebra on terms.
+                     -> term a                                      -- ^ A term to decorate with values produced by the R-algebra.
+                     -> term b                                      -- ^ A term decorated with values produced by the R-algebra.
 decoratorWithAlgebra alg = para $ \ c@(In _ f) -> termIn (alg (fmap (second termAnnotation) c)) (fmap snd f)

src/Analysis/TOCSummary.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE AllowAmbiguousTypes, LambdaCase, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE AllowAmbiguousTypes, LambdaCase, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances, ViewPatterns #-}
 module Analysis.TOCSummary
 ( Declaration(..)
 , formatIdentifier
@@ -64,8 +64,8 @@ formatKind = \case
 --   If you’re getting errors about missing a @'HasDeclarationBy' ''Custom'@ instance for your syntax type, you probably forgot step 1.
 --
 --   If you’re getting 'Nothing' for your syntax node at runtime, you probably forgot step 2.
-declarationAlgebra :: (Foldable syntax, HasDeclaration syntax)
-                   => Blob -> RAlgebra (TermF syntax Loc) (Term syntax Loc) (Maybe Declaration)
+declarationAlgebra :: (Foldable (Syntax term), HasDeclaration (Syntax term), IsTerm term)
+                   => Blob -> RAlgebra (TermF (Syntax term) Loc) (term Loc) (Maybe Declaration)
 declarationAlgebra blob (In ann syntax) = toDeclaration blob ann syntax
 
 -- | Types for which we can produce a 'Declaration' in 'Maybe'. There is exactly one instance of this typeclass; adding customized 'Declaration's for a new type is done by defining an instance of @'HasDeclarationBy' ''Custom'@ instead.
@@ -73,7 +73,7 @@ declarationAlgebra blob (In ann syntax) = toDeclaration blob ann syntax
 --   This typeclass employs the Advanced Overlap techniques designed by Oleg Kiselyov & Simon Peyton Jones: https://wiki.haskell.org/GHC/AdvancedOverlap.
 class HasDeclaration syntax where
   -- | Compute a 'Declaration' for a syntax type using its @'HasDeclarationBy' ''Custom'@ instance, if any, or else falling back to the default definition (which simply returns 'Nothing').
-  toDeclaration :: Foldable whole => Blob -> Loc -> syntax (Term whole Loc, Maybe Declaration) -> Maybe Declaration
+  toDeclaration :: (Foldable (Syntax term), IsTerm term) => Blob -> Loc -> syntax (term Loc, Maybe Declaration) -> Maybe Declaration
 
 -- | Define 'toDeclaration' using the @'HasDeclarationBy' ''Custom'@ instance for a type if there is one or else use the default definition.
 --
@@ -86,7 +86,7 @@ instance (DeclarationStrategy syntax ~ strategy, HasDeclarationBy strategy synta
 
 -- | Produce a 'Declaration' for a syntax node using either the 'Default' or 'Custom' strategy.
 class HasDeclarationBy (strategy :: Strategy) syntax where
-  toDeclarationBy :: Foldable whole => Blob -> Loc -> syntax (Term whole Loc, Maybe Declaration) -> Maybe Declaration
+  toDeclarationBy :: (Foldable (Syntax term), IsTerm term) => Blob -> Loc -> syntax (term Loc, Maybe Declaration) -> Maybe Declaration
 
 -- | The 'Default' strategy produces 'Nothing'.
 instance HasDeclarationBy 'Default syntax where
@@ -98,7 +98,7 @@ instance HasDeclarationBy 'Custom Markdown.Heading where
   toDeclarationBy blob@Blob{..} ann (Markdown.Heading level terms _)
     = Just $ Declaration (Heading level) (headingText terms) (Loc.span ann) (blobLanguage blob)
     where headingText terms = getSource $ maybe (byteRange ann) sconcat (nonEmpty (headingByteRange <$> toList terms))
-          headingByteRange (Term (In ann _), _) = byteRange ann
+          headingByteRange (t, _) = byteRange (termAnnotation t)
           getSource = firstLine . toText . Source.slice blobSource
           firstLine = T.takeWhile (/= '\n')
 
@@ -110,7 +110,7 @@ instance HasDeclarationBy 'Custom Syntax.Error where
 
 -- | Produce a 'Function' for 'Declaration.Function' nodes so long as their identifier is non-empty (defined as having a non-empty 'Range').
 instance HasDeclarationBy 'Custom Declaration.Function where
-  toDeclarationBy blob@Blob{..} ann (Declaration.Function _ (Term (In identifierAnn _), _) _ _)
+  toDeclarationBy blob@Blob{..} ann (Declaration.Function _ (termAnnotation -> identifierAnn, _) _ _)
     -- Do not summarize anonymous functions
     | isEmpty identifierAnn = Nothing
     -- Named functions
@@ -119,12 +119,12 @@ instance HasDeclarationBy 'Custom Declaration.Function where
 
 -- | Produce a 'Method' for 'Declaration.Method' nodes. If the method’s receiver is non-empty (defined as having a non-empty 'Range'), the 'identifier' will be formatted as 'receiver.method_name'; otherwise it will be simply 'method_name'.
 instance HasDeclarationBy 'Custom Declaration.Method where
-  toDeclarationBy blob@Blob{..} ann (Declaration.Method _ (Term (In receiverAnn receiverF), _) (Term (In identifierAnn _), _) _ _ _)
+  toDeclarationBy blob@Blob{..} ann (Declaration.Method _ (toTermF -> In receiverAnn receiverF, _) (termAnnotation -> identifierAnn, _) _ _ _)
     -- Methods without a receiver
     | isEmpty receiverAnn = Just $ Declaration (Method Nothing) (getSource blobSource identifierAnn) (Loc.span ann) (blobLanguage blob)
     -- Methods with a receiver type and an identifier (e.g. (a *Type) in Go).
     | blobLanguage blob == Go
-    , [ _, Term (In receiverType _) ] <- toList receiverF = Just $ Declaration (Method (Just (getSource blobSource receiverType))) (getSource blobSource identifierAnn) (Loc.span ann) (blobLanguage blob)
+    , [ _, termAnnotation -> receiverType ] <- toList receiverF = Just $ Declaration (Method (Just (getSource blobSource receiverType))) (getSource blobSource identifierAnn) (Loc.span ann) (blobLanguage blob)
     -- Methods with a receiver (class methods) are formatted like `receiver.method_name`
     | otherwise           = Just $ Declaration (Method (Just (getSource blobSource receiverAnn))) (getSource blobSource identifierAnn) (Loc.span ann) (blobLanguage blob)
     where

src/Control/Carrier/Parse/Measured.hs

@@ -21,8 +21,6 @@ import           Data.Blob
 import qualified Data.Error as Error
 import qualified Data.Flag as Flag
 import qualified Data.Syntax as Syntax
-import           Data.Sum
-import           Data.Term
 import           Data.Typeable
 import           Parsing.CMark
 import           Parsing.Parser
@@ -80,14 +78,10 @@ data ParserCancelled = ParserTimedOut | AssignmentTimedOut
 
 instance Exception ParserCancelled
 
-errors :: (Syntax.Error :< fs, Apply Foldable fs, Apply Functor fs) => Term (Sum fs) Assignment.Loc -> [Error.Error String]
-errors = cata $ \ (In Assignment.Loc{..} syntax) ->
-  maybe (fold syntax) (pure . Syntax.unError span) (project syntax)
 
 runAssignment
-  :: ( Apply Foldable syntaxes
-     , Apply Functor syntaxes
-     , Element Syntax.Error syntaxes
+  :: ( Foldable term
+     , Syntax.HasErrors term
      , Member (Error SomeException) sig
      , Member (Reader TaskSession) sig
      , Member Telemetry sig
@@ -96,11 +90,11 @@ runAssignment
      , Carrier sig m
      , MonadIO m
      )
-  => (Source -> assignment (Term (Sum syntaxes) Assignment.Loc) -> ast -> Either (Error.Error String) (Term (Sum syntaxes) Assignment.Loc))
+  => (Source -> assignment (term Assignment.Loc) -> ast -> Either (Error.Error String) (term Assignment.Loc))
   -> Parser ast
   -> Blob
-  -> assignment (Term (Sum syntaxes) Assignment.Loc)
-  -> m (Term (Sum syntaxes) Assignment.Loc)
+  -> assignment (term Assignment.Loc)
+  -> m (term Assignment.Loc)
 runAssignment assign parser blob@Blob{..} assignment = do
   taskSession <- ask
   let requestID' = ("github_request_id", requestID taskSession)
@@ -124,7 +118,7 @@ runAssignment assign parser blob@Blob{..} assignment = do
         logError taskSession Error blob err (("task", "assign") : logFields)
         throwError (toException err)
       Right term -> do
-        for_ (zip (errors term) [(0::Integer)..]) $ \ (err, i) -> case Error.errorActual err of
+        for_ (zip (Syntax.getErrors term) [(0::Integer)..]) $ \ (err, i) -> case Error.errorActual err of
           Just "ParseError" -> do
             when (i == 0) $ writeStat (increment "parse.parse_errors" languageTag)
             logError taskSession Warning blob err (("task", "parse") : logFields)

src/Data/Abstract/AccessControls/Instances.hs

@@ -15,16 +15,27 @@ import qualified Data.Syntax.Literal as Literal
 import qualified Data.Syntax.Statement as Statement
 import qualified Data.Syntax.Type as Type
 import qualified Language.Go.Syntax as Go
+import qualified Language.Go.Term as Go
 import qualified Language.Go.Type as Go
-import qualified Language.Markdown.Syntax as Markdown
 import qualified Language.PHP.Syntax as PHP
+import qualified Language.PHP.Term as PHP
 import qualified Language.Python.Syntax as Python
+import qualified Language.Python.Term as Python
 import qualified Language.Ruby.Syntax as Ruby
+import qualified Language.Ruby.Term as Ruby
 import qualified Language.TSX.Syntax as TSX
+import qualified Language.TSX.Term as TSX
 import qualified Language.TypeScript.Syntax as TypeScript
+import qualified Language.TypeScript.Term as TypeScript
 import Data.Quieterm
 
 deriving instance AccessControls1 syntax => AccessControls (Term syntax ann)
+deriving instance AccessControls (Go.Term ann)
+deriving instance AccessControls (PHP.Term ann)
+deriving instance AccessControls (Python.Term ann)
+deriving instance AccessControls (Ruby.Term ann)
+deriving instance AccessControls (TSX.Term ann)
+deriving instance AccessControls (TypeScript.Term ann)
 
 instance (AccessControls recur, AccessControls1 syntax) => AccessControls (TermF syntax ann recur) where
   termToAccessControl = liftTermToAccessControl termToAccessControl . termFOut
@@ -211,26 +222,6 @@ instance AccessControls1 Go.Select
 instance AccessControls1 Go.TypeSwitchGuard
 instance AccessControls1 Go.ReceiveOperator
 
-instance AccessControls1 Markdown.Document
-instance AccessControls1 Markdown.Paragraph
-instance AccessControls1 Markdown.UnorderedList
-instance AccessControls1 Markdown.OrderedList
-instance AccessControls1 Markdown.BlockQuote
-instance AccessControls1 Markdown.HTMLBlock
-instance AccessControls1 Markdown.Table
-instance AccessControls1 Markdown.TableRow
-instance AccessControls1 Markdown.TableCell
-instance AccessControls1 Markdown.Strong
-instance AccessControls1 Markdown.Emphasis
-instance AccessControls1 Markdown.Text
-instance AccessControls1 Markdown.Strikethrough
-instance AccessControls1 Markdown.Heading
-instance AccessControls1 Markdown.ThematicBreak
-instance AccessControls1 Markdown.Link
-instance AccessControls1 Markdown.Image
-instance AccessControls1 Markdown.Code
-instance AccessControls1 Markdown.LineBreak
-
 instance AccessControls1 PHP.Text
 instance AccessControls1 PHP.VariableName
 instance AccessControls1 PHP.Require

src/Data/Syntax.hs

@@ -25,80 +25,80 @@ import qualified Data.Abstract.ScopeGraph as ScopeGraph
 -- Combinators
 
 -- | Lift syntax and an annotation into a term, injecting the syntax into a union & ensuring the annotation encompasses all children.
-makeTerm :: (HasCallStack, Element syntax syntaxes, Semigroup ann, Apply Foldable syntaxes) => ann -> syntax (Term (Sum syntaxes) ann) -> Term (Sum syntaxes) ann
+makeTerm :: (HasCallStack, Element syntax syntaxes, Sum syntaxes ~ Syntax term, Semigroup ann, Apply Foldable syntaxes, IsTerm term) => ann -> syntax (term ann) -> term ann
 makeTerm ann = makeTerm' ann . inject
 
 -- | Lift a union and an annotation into a term, ensuring the annotation encompasses all children.
-makeTerm' :: (HasCallStack, Semigroup ann, Foldable syntax) => ann -> syntax (Term syntax ann) -> Term syntax ann
+makeTerm' :: (HasCallStack, Semigroup ann, Foldable (Syntax term), IsTerm term) => ann -> Syntax term (term ann) -> term ann
 makeTerm' ann syntax = termIn (sconcat (ann :| (termAnnotation <$> toList syntax))) syntax
 
 -- | Lift syntax and an annotation into a term, injecting the syntax into a union & ensuring the annotation encompasses all children. Removes extra structure if term is a list of a single item.
-makeTerm'' :: (HasCallStack, Element syntax syntaxes, Semigroup ann, Apply Foldable syntaxes, Foldable syntax) => ann -> syntax (Term (Sum syntaxes) ann) -> Term (Sum syntaxes) ann
+makeTerm'' :: (HasCallStack, Element syntax syntaxes, Sum syntaxes ~ Syntax term, Semigroup ann, Apply Foldable syntaxes, Foldable syntax, IsTerm term) => ann -> syntax (term ann) -> term ann
 makeTerm'' ann children = case toList children of
   [x] -> x
   _ -> makeTerm' ann (inject children)
 
 -- | Lift non-empty syntax into a term, injecting the syntax into a union & appending all subterms’.annotations to make the new term’s annotation.
-makeTerm1 :: (HasCallStack, Element syntax syntaxes, Semigroup ann, Apply Foldable syntaxes) => syntax (Term (Sum syntaxes) ann) -> Term (Sum syntaxes) ann
+makeTerm1 :: (HasCallStack, Element syntax syntaxes, Sum syntaxes ~ Syntax term, Semigroup ann, Apply Foldable syntaxes, IsTerm term) => syntax (term ann) -> term ann
 makeTerm1 = makeTerm1' . inject
 
 -- | Lift a non-empty union into a term, appending all subterms’ annotations to make the new term’s annotation.
-makeTerm1' :: (HasCallStack, Semigroup ann, Foldable syntax) => syntax (Term syntax ann) -> Term syntax ann
+makeTerm1' :: (HasCallStack, Semigroup ann, Foldable (Syntax term), IsTerm term) => Syntax term (term ann) -> term ann
 makeTerm1' syntax = case toList syntax of
   a : _ -> makeTerm' (termAnnotation a) syntax
   _ -> error "makeTerm1': empty structure"
 
 -- | Construct an empty term at the current position.
-emptyTerm :: (HasCallStack, Empty :< syntaxes, Apply Foldable syntaxes) => Assignment.Assignment ast grammar (Term (Sum syntaxes) Loc)
+emptyTerm :: (HasCallStack, Empty :< syntaxes, Sum syntaxes ~ Syntax term, Apply Foldable syntaxes, IsTerm term) => Assignment.Assignment ast grammar (term Loc)
 emptyTerm = makeTerm . startLocation <$> Assignment.location <*> pure Empty
   where startLocation Loc{..} = Loc (Range.point (Range.start byteRange)) (Span.point (Span.start span))
 
 -- | Catch assignment errors into an error term.
-handleError :: (HasCallStack, Error :< syntaxes, Enum grammar, Eq1 ast, Ix grammar, Show grammar, Apply Foldable syntaxes) => Assignment.Assignment ast grammar (Term (Sum syntaxes) Loc) -> Assignment.Assignment ast grammar (Term (Sum syntaxes) Loc)
+handleError :: (HasCallStack, Error :< syntaxes, Sum syntaxes ~ Syntax term, Enum grammar, Eq1 ast, Ix grammar, Show grammar, Apply Foldable syntaxes, IsTerm term) => Assignment.Assignment ast grammar (term Loc) -> Assignment.Assignment ast grammar (term Loc)
 handleError = flip Assignment.catchError (\ err -> makeTerm <$> Assignment.location <*> pure (errorSyntax (either id show <$> err) []) <* Assignment.source)
 
 -- | Catch parse errors into an error term.
-parseError :: (HasCallStack, Error :< syntaxes, Bounded grammar, Enum grammar, Ix grammar, Apply Foldable syntaxes) => Assignment.Assignment ast grammar (Term (Sum syntaxes) Loc)
+parseError :: (HasCallStack, Error :< syntaxes, Sum syntaxes ~ Syntax term, Bounded grammar, Enum grammar, Ix grammar, Apply Foldable syntaxes, IsTerm term) => Assignment.Assignment ast grammar (term Loc)
 parseError = makeTerm <$> Assignment.token maxBound <*> pure (Error (ErrorStack $ errorSite <$> getCallStack (freezeCallStack callStack)) [] (Just "ParseError") [])
 
 -- | Match context terms before a subject term, wrapping both up in a Context term if any context terms matched, or otherwise returning the subject term.
-contextualize :: (HasCallStack, Context :< syntaxes, Alternative m, Semigroup ann, Apply Foldable syntaxes)
-              => m (Term (Sum syntaxes) ann)
-              -> m (Term (Sum syntaxes) ann)
-              -> m (Term (Sum syntaxes) ann)
+contextualize :: (HasCallStack, Context :< syntaxes, Sum syntaxes ~ Syntax term, Alternative m, Semigroup ann, Apply Foldable syntaxes, IsTerm term)
+              => m (term ann)
+              -> m (term ann)
+              -> m (term ann)
 contextualize context rule = make <$> Assignment.manyThrough context rule
   where make (cs, node) = case nonEmpty cs of
           Just cs -> makeTerm1 (Context cs node)
           _ -> node
 
 -- | Match context terms after a subject term and before a delimiter, returning the delimiter paired with a Context term if any context terms matched, or the subject term otherwise.
-postContextualizeThrough :: (HasCallStack, Context :< syntaxes, Alternative m, Semigroup ann, Apply Foldable syntaxes)
-                         => m (Term (Sum syntaxes) ann)
-                         -> m (Term (Sum syntaxes) ann)
+postContextualizeThrough :: (HasCallStack, Context :< syntaxes, Sum syntaxes ~ Syntax term, Alternative m, Semigroup ann, Apply Foldable syntaxes, IsTerm term)
+                         => m (term ann)
+                         -> m (term ann)
                          -> m delimiter
-                         -> m (Term (Sum syntaxes) ann, delimiter)
+                         -> m (term ann, delimiter)
 postContextualizeThrough context rule end = make <$> rule <*> Assignment.manyThrough context end
   where make node (cs, end) = case nonEmpty cs of
           Just cs -> (makeTerm1 (Context cs node), end)
           _ -> (node, end)
 
 -- | Match context terms after a subject term, wrapping both up in a Context term if any context terms matched, or otherwise returning the subject term.
-postContextualize :: (HasCallStack, Context :< syntaxes, Alternative m, Semigroup ann, Apply Foldable syntaxes)
-                  => m (Term (Sum syntaxes) ann)
-                  -> m (Term (Sum syntaxes) ann)
-                  -> m (Term (Sum syntaxes) ann)
+postContextualize :: (HasCallStack, Context :< syntaxes, Sum syntaxes ~ Syntax term, Alternative m, Semigroup ann, Apply Foldable syntaxes, IsTerm term)
+                  => m (term ann)
+                  -> m (term ann)
+                  -> m (term ann)
 postContextualize context rule = make <$> rule <*> many context
   where make node cs = case nonEmpty cs of
           Just cs -> makeTerm1 (Context cs node)
           _ -> node
 
 -- | Match infix terms separated by any of a list of operators, with optional context terms following each operand.
-infixContext :: (Context :< syntaxes, Assignment.Parsing m, Semigroup ann, HasCallStack, Apply Foldable syntaxes)
-             => m (Term (Sum syntaxes) ann)
-             -> m (Term (Sum syntaxes) ann)
-             -> m (Term (Sum syntaxes) ann)
-             -> [m (Term (Sum syntaxes) ann -> Term (Sum syntaxes) ann -> Sum syntaxes (Term (Sum syntaxes) ann))]
-             -> m (Sum syntaxes (Term (Sum syntaxes) ann))
+infixContext :: (Context :< syntaxes, Sum syntaxes ~ Syntax term, Assignment.Parsing m, Semigroup ann, HasCallStack, Apply Foldable syntaxes, IsTerm term)
+             => m (term ann)
+             -> m (term ann)
+             -> m (term ann)
+             -> [m (term ann -> term ann -> Sum syntaxes (term ann))]
+             -> m (Sum syntaxes (term ann))
 infixContext context left right operators = uncurry (&) <$> postContextualizeThrough context left (asum operators) <*> postContextualize context right
 
 class Generate (c :: (* -> *) -> Constraint) (all :: [* -> *]) (fs :: [* -> *]) where
@@ -213,6 +213,14 @@ instance Ord ErrorStack where
             ]
 
 
+class HasErrors term where
+  getErrors :: term Loc -> [Error.Error String]
+
+instance (Error :< fs, Apply Foldable fs, Apply Functor fs) => HasErrors (Term (Sum fs)) where
+  getErrors = cata $ \ (In Loc{..} syntax) ->
+    maybe (fold syntax) (pure . unError span) (Data.Sum.project syntax)
+
+
 data Context a = Context { contextTerms :: NonEmpty a, contextSubject :: a }
   deriving (Eq, Foldable, FreeVariables1, Functor, Generic1, Ord, Show, ToJSONFields1, Traversable, NFData1)
   deriving (Eq1, Show1, Ord1) via Generically Context

src/Data/Term.hs

@@ -1,17 +1,18 @@
 {-# LANGUAGE FunctionalDependencies, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
 module Data.Term
 ( Term(..)
-, termIn
-, termAnnotation
-, termOut
-, injectTerm
-, projectTerm
-, guardTerm
 , TermF(..)
 , termSize
 , hoistTerm
 , hoistTermF
 , Annotated (..)
+-- * Abstract term interfaces
+, IsTerm(..)
+, termAnnotation
+, termOut
+, projectTerm
+, termIn
+, injectTerm
 ) where
 
 import Prologue
@@ -26,20 +27,6 @@ import           Text.Show
 -- | A Term with an abstract syntax tree and an annotation.
 newtype Term syntax ann = Term { unTerm :: TermF syntax ann (Term syntax ann) }
 
-termAnnotation :: Term syntax ann -> ann
-termAnnotation = termFAnnotation . unTerm
-
-termOut :: Term syntax ann -> syntax (Term syntax ann)
-termOut = termFOut . unTerm
-
-projectTerm :: forall f syntax ann . (f :< syntax) => Term (Sum syntax) ann -> Maybe (f (Term (Sum syntax) ann))
-projectTerm = Sum.project . termOut
-
-guardTerm :: forall m f syntax ann . (f :< syntax, Alternative m)
-          => Term (Sum syntax) ann
-          -> m (f (Term (Sum syntax) ann))
-guardTerm = Sum.projectGuard . termOut
-
 data TermF syntax ann recur = In { termFAnnotation :: ann, termFOut :: syntax recur }
   deriving (Eq, Ord, Foldable, Functor, Show, Traversable, Generic1)
 
@@ -72,13 +59,6 @@ termSize :: (Foldable f, Functor f) => Term f annotation -> Int
 termSize = cata size where
   size (In _ syntax) = 1 + sum syntax
 
--- | Build a Term from its annotation and syntax.
-termIn :: ann -> syntax (Term syntax ann) -> Term syntax ann
-termIn = (Term .) . In
-
-injectTerm :: (f :< syntax) => ann -> f (Term (Sum syntax) ann) -> Term (Sum syntax) ann
-injectTerm a = termIn a . Sum.inject
-
 
 hoistTerm :: Functor f => (forall a. f a -> g a) -> Term f a -> Term g a
 hoistTerm f = go where go (Term r) = Term (hoistTermF f (fmap go r))
@@ -171,3 +151,35 @@ instance (ToJSON b, ToJSONFields a, ToJSONFields1 f) => ToJSONFields (TermF f a
 instance (ToJSON b, ToJSONFields a, ToJSONFields1 f) => ToJSON (TermF f a b) where
   toJSON = object . toJSONFields
   toEncoding = pairs . mconcat . toJSONFields
+
+
+class IsTerm term where
+  type Syntax term :: * -> *
+
+  toTermF :: term ann -> TermF (Syntax term) ann (term ann)
+  fromTermF :: TermF (Syntax term) ann (term ann) -> term ann
+
+
+termAnnotation :: IsTerm term => term ann -> ann
+termAnnotation = termFAnnotation . toTermF
+
+termOut :: IsTerm term => term ann -> Syntax term (term ann)
+termOut = termFOut . toTermF
+
+projectTerm :: (f :< syntax, Sum syntax ~ Syntax term, IsTerm term) => term ann -> Maybe (f (term ann))
+projectTerm = Sum.project . termOut
+
+
+-- | Build a term from its annotation and syntax.
+termIn :: IsTerm term => ann -> Syntax term (term ann) -> term ann
+termIn = fmap fromTermF . In
+
+injectTerm :: (f :< syntax, Sum syntax ~ Syntax term, IsTerm term) => ann -> f (term ann) -> term ann
+injectTerm a = termIn a . Sum.inject
+
+
+instance IsTerm (Term syntax) where
+  type Syntax (Term syntax) = syntax
+
+  toTermF = unTerm
+  fromTermF = Term

src/Diffing/Interpreter.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilyDependencies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeOperators, UndecidableInstances #-}
 module Diffing.Interpreter
 ( diffTerms
 , DiffTerms(..)
@@ -31,17 +31,11 @@ stripDiff :: Functor syntax
 stripDiff = bimap snd snd
 
 -- | The class of term types for which we can compute a diff.
-class Bifoldable (DiffFor term) => DiffTerms term where
-  -- | The type of diffs for the given term type.
-  --
-  -- Note that the dependency means that the diff type is in 1:1 correspondence with the term type. This allows subclasses of 'DiffTerms' to receive e.g. @'DiffFor' term a b@ without incurring ambiguity, since every diff type is unique to its term type.
-  type DiffFor term = (diff :: * -> * -> *) | diff -> term
-
+class IsTerm term => DiffTerms term where
   -- | Diff an 'Edit' of terms.
-  diffTermPair :: Edit (term ann1) (term ann2) -> DiffFor term ann1 ann2
+  diffTermPair :: Edit (term ann1) (term ann2) -> Diff.Diff (Syntax term) ann1 ann2
 
 instance (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => DiffTerms (Term syntax) where
-  type DiffFor (Term syntax) = Diff.Diff syntax
   diffTermPair = edit Diff.deleting Diff.inserting diffTerms
 
 

src/Language/Go/Assignment.hs

@@ -1,10 +1,9 @@
-{-# LANGUAGE DataKinds, RankNTypes, TypeOperators #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-} -- FIXME
+{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators #-}
 module Language.Go.Assignment
 ( assignment
-, Syntax
+, Go.Syntax
 , Grammar
-, Term
+, Go.Term(..)
 ) where
 
 import Prologue
@@ -24,128 +23,24 @@ import qualified Data.Syntax.Statement as Statement
 import qualified Data.Syntax.Type as Type
 import qualified Data.Term as Term
 import           Language.Go.Syntax as Go.Syntax hiding (runeLiteral, labelName)
+import           Language.Go.Term as Go
 import           Language.Go.Type as Go.Type
 import Data.ImportPath (importPath, defaultAlias)
 import           TreeSitter.Go as Grammar
 
-type Syntax =
-  '[ Comment.Comment
-   , Declaration.Constructor
-   , Declaration.Function
-   , Declaration.Method
-   , Declaration.MethodSignature
-   , Declaration.Type
-   , Declaration.TypeAlias
-   , Expression.Plus
-   , Expression.Minus
-   , Expression.Times
-   , Expression.DividedBy
-   , Expression.Modulo
-   , Expression.Power
-   , Expression.Negate
-   , Expression.FloorDivision
-   , Expression.BOr
-   , Expression.BAnd
-   , Expression.BXOr
-   , Expression.LShift
-   , Expression.RShift
-   , Expression.UnsignedRShift
-   , Expression.Complement
-   , Expression.Call
-   , Expression.LessThan
-   , Expression.LessThanEqual
-   , Expression.GreaterThan
-   , Expression.GreaterThanEqual
-   , Expression.Equal
-   , Expression.StrictEqual
-   , Expression.Comparison
-   , Expression.Subscript
-   , Expression.Member
-   , Statement.PostDecrement
-   , Statement.PostIncrement
-   , Expression.MemberAccess
-   , Expression.And
-   , Expression.Not
-   , Expression.Or
-   , Expression.XOr
-   , Go.Syntax.Composite
-   , Go.Syntax.DefaultPattern
-   , Go.Syntax.Defer
-   , Go.Syntax.Field
-   , Go.Syntax.Go
-   , Go.Syntax.Label
-   , Go.Syntax.Package
-   , Go.Syntax.Receive
-   , Go.Syntax.ReceiveOperator
-   , Go.Syntax.Rune
-   , Go.Syntax.Select
-   , Go.Syntax.Send
-   , Go.Syntax.Slice
-   , Go.Syntax.TypeAssertion
-   , Go.Syntax.TypeConversion
-   , Go.Syntax.TypeSwitch
-   , Go.Syntax.TypeSwitchGuard
-   , Go.Syntax.Variadic
-   , Go.Type.BidirectionalChannel
-   , Go.Type.ReceiveChannel
-   , Go.Type.SendChannel
-   , Go.Syntax.Import
-   , Go.Syntax.QualifiedImport
-   , Go.Syntax.SideEffectImport
-   , Literal.Array
-   , Literal.Complex
-   , Literal.Float
-   , Literal.Hash
-   , Literal.Integer
-   , Literal.KeyValue
-   , Literal.Pointer
-   , Literal.Reference
-   , Literal.TextElement
-   , Statement.Assignment
-   , Statement.Break
-   , Statement.Continue
-   , Statement.For
-   , Statement.ForEach
-   , Statement.Goto
-   , Statement.If
-   , Statement.Match
-   , Statement.NoOp
-   , Statement.Pattern
-   , Statement.Return
-   , Statement.Statements
-   , Syntax.Context
-   , Syntax.Error
-   , Syntax.Empty
-   , Syntax.Identifier
-   , Type.Annotation
-   , Type.Array
-   , Type.Function
-   , Type.Interface
-   , Type.Map
-   , Type.Parenthesized
-   , Type.Pointer
-   , Type.Slice
-   , []
-   , Literal.String
-   , Literal.EscapeSequence
-   , Literal.Null
-   , Literal.Boolean
-   ]
-
-type Term = Term.Term (Sum Syntax) Loc
 type Assignment = Assignment.Assignment [] Grammar
 
 -- | Assignment from AST in Go's grammar onto a program in Go's syntax.
-assignment :: Assignment Term
+assignment :: Assignment (Term Loc)
 assignment = handleError program <|> parseError
 
-program :: Assignment Term
+program :: Assignment (Term Loc)
 program = makeTerm <$> symbol SourceFile <*> children (Statement.Statements <$> manyTerm expression)
 
-expression :: Assignment Term
+expression :: Assignment (Term Loc)
 expression = term (handleError (choice expressionChoices))
 
-expressionChoices :: [Assignment Term]
+expressionChoices :: [Assignment (Term Loc)]
 expressionChoices =
   [ argumentList
   , assignment'
@@ -213,7 +108,7 @@ expressionChoices =
   , types
   ]
 
-types :: Assignment Term
+types :: Assignment (Term Loc)
 types =
   choice [ arrayType
          , channelType
@@ -234,86 +129,86 @@ types =
          , typeSwitchStatement
          ]
 
-identifiers :: Assignment Term
+identifiers :: Assignment (Term Loc)
 identifiers = makeTerm'' <$> location <*> manyTerm identifier
 
-expressions :: Assignment Term
+expressions :: Assignment (Term Loc)
 expressions = makeTerm'' <$> location <*> manyTerm expression
 
 
 -- Literals
 
-comment :: Assignment Term
+comment :: Assignment (Term Loc)
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
-compositeLiteral :: Assignment Term
+compositeLiteral :: Assignment (Term Loc)
 compositeLiteral = makeTerm <$> symbol CompositeLiteral <*> children (Go.Syntax.Composite <$> expression <*> expression)
 
-element :: Assignment Term
+element :: Assignment (Term Loc)
 element = symbol Element *> children expression
 
-fieldIdentifier :: Assignment Term
+fieldIdentifier :: Assignment (Term Loc)
 fieldIdentifier = makeTerm <$> symbol FieldIdentifier <*> (Syntax.Identifier . name <$> source)
 
-floatLiteral :: Assignment Term
+floatLiteral :: Assignment (Term Loc)
 floatLiteral = makeTerm <$> symbol FloatLiteral <*> (Literal.Float <$> source)
 
-identifier :: Assignment Term
+identifier :: Assignment (Term Loc)
 identifier =  makeTerm <$> (symbol Identifier <|> symbol Identifier' <|> symbol Identifier'') <*> (Syntax.Identifier . name <$> source)
 
-imaginaryLiteral :: Assignment Term
+imaginaryLiteral :: Assignment (Term Loc)
 imaginaryLiteral = makeTerm <$> symbol ImaginaryLiteral <*> (Literal.Complex <$> source)
 
-interpretedStringLiteral :: Assignment Term
+interpretedStringLiteral :: Assignment (Term Loc)
 interpretedStringLiteral = makeTerm' <$> symbol InterpretedStringLiteral <*> children (  (inject . Literal.String <$> some escapeSequence)
                                                                                      <|> (inject . Literal.TextElement <$> source))
 
-escapeSequence :: Assignment Term
+escapeSequence :: Assignment (Term Loc)
 escapeSequence = makeTerm <$> symbol EscapeSequence <*> (Literal.EscapeSequence <$> source)
 
-intLiteral :: Assignment Term
+intLiteral :: Assignment (Term Loc)
 intLiteral = makeTerm <$> symbol IntLiteral <*> (Literal.Integer <$> source)
 
-literalValue :: Assignment Term
+literalValue :: Assignment (Term Loc)
 literalValue = makeTerm <$> symbol LiteralValue <*> children (manyTerm expression)
 
-packageIdentifier :: Assignment Term
+packageIdentifier :: Assignment (Term Loc)
 packageIdentifier = makeTerm <$> symbol PackageIdentifier <*> (Syntax.Identifier . name <$> source)
 
-parenthesizedType :: Assignment Term
+parenthesizedType :: Assignment (Term Loc)
 parenthesizedType = makeTerm <$> symbol Grammar.ParenthesizedType <*> children (Type.Parenthesized <$> expression)
 
-rawStringLiteral :: Assignment Term
+rawStringLiteral :: Assignment (Term Loc)
 rawStringLiteral = makeTerm <$> symbol RawStringLiteral <*> (Literal.TextElement <$> source)
 
-runeLiteral :: Assignment Term
+runeLiteral :: Assignment (Term Loc)
 runeLiteral = makeTerm <$> symbol Grammar.RuneLiteral <*> (Go.Syntax.Rune <$> source)
 
-typeIdentifier :: Assignment Term
+typeIdentifier :: Assignment (Term Loc)
 typeIdentifier = makeTerm <$> symbol TypeIdentifier <*> (Syntax.Identifier . name <$> source)
 
-nil :: Assignment Term
+nil :: Assignment (Term Loc)
 nil = makeTerm <$> symbol Nil <*> (Literal.Null <$ source)
 
-boolean :: Assignment Term
+boolean :: Assignment (Term Loc)
 boolean =  makeTerm <$> token Grammar.True <*> pure Literal.true
        <|> makeTerm <$> token Grammar.False <*> pure Literal.false
 
 
 -- Primitive Types
 
-arrayType :: Assignment Term
+arrayType :: Assignment (Term Loc)
 arrayType = makeTerm <$> symbol ArrayType <*> children (Type.Array . Just <$> expression <*> expression)
 
-channelType :: Assignment Term
+channelType :: Assignment (Term Loc)
 channelType =  makeTerm' <$> symbol ChannelType <*> children (mkChannelType <$> optional (token AnonLAngleMinus) <* token AnonChan <*> optional (token AnonLAngleMinus) <*> expression)
   where
-    mkChannelType :: Maybe a -> Maybe a -> b -> Sum Syntax b
+    mkChannelType :: Maybe a -> Maybe a -> b -> Sum Go.Syntax b
     mkChannelType receive send | Just _ <- receive = inject . Go.Type.ReceiveChannel
                                | Just _ <- send    = inject . Go.Type.SendChannel
                                | otherwise         = inject . Go.Type.BidirectionalChannel
 
-fieldDeclaration :: Assignment Term
+fieldDeclaration :: Assignment (Term Loc)
 fieldDeclaration =  mkFieldDeclarationWithTag <$> symbol FieldDeclaration <*> children ((,,) <$> (manyTermsTill expression (void (symbol TypeIdentifier)) <|> manyTerm expression) <*> optional expression <*> optional expression)
   where
     mkFieldDeclarationWithTag loc (fields, type', tag) | Just ty <- type', Just tag' <- tag = makeTerm loc (Go.Syntax.Field [ty, tag'] (makeTerm loc fields))
@@ -321,38 +216,38 @@ fieldDeclaration =  mkFieldDeclarationWithTag <$> symbol FieldDeclaration <*> ch
                                                        | Just tag' <- tag                   = makeTerm loc (Go.Syntax.Field [tag'] (makeTerm loc fields))
                                                        | otherwise                          = makeTerm loc (Go.Syntax.Field [] (makeTerm loc fields))
 
-fieldDeclarationList :: Assignment Term
+fieldDeclarationList :: Assignment (Term Loc)
 fieldDeclarationList = symbol FieldDeclarationList *> children expressions
 
-functionType :: Assignment Term
+functionType :: Assignment (Term Loc)
 functionType = makeTerm <$> symbol FunctionType <*> children (Type.Function <$> params <*> (expression <|> emptyTerm))
   where params = symbol ParameterList *> children (manyTerm expression)
 
-implicitLengthArrayType :: Assignment Term
+implicitLengthArrayType :: Assignment (Term Loc)
 implicitLengthArrayType = makeTerm <$> symbol ImplicitLengthArrayType <*> children (Type.Array Nothing <$> expression)
 
-interfaceType :: Assignment Term
+interfaceType :: Assignment (Term Loc)
 interfaceType = makeTerm <$> symbol InterfaceType <*> children (Type.Interface <$> manyTerm expression)
 
-mapType :: Assignment Term
+mapType :: Assignment (Term Loc)
 mapType = makeTerm <$> symbol MapType <*> children (Type.Map <$> expression <*> expression)
 
-pointerType :: Assignment Term
+pointerType :: Assignment (Term Loc)
 pointerType = makeTerm <$> symbol PointerType <*> children (Type.Pointer <$> expression)
 
-qualifiedType :: Assignment Term
+qualifiedType :: Assignment (Term Loc)
 qualifiedType = makeTerm <$> symbol QualifiedType <*> children (Expression.MemberAccess <$> expression <*> typeIdentifier)
 
-sliceType :: Assignment Term
+sliceType :: Assignment (Term Loc)
 sliceType = makeTerm <$> symbol SliceType <*> children (Type.Slice <$> expression)
 
-structType :: Assignment Term
+structType :: Assignment (Term Loc)
 structType = makeTerm <$> symbol StructType <*> children (Declaration.Constructor [] <$> emptyTerm <*> expressions)
 
-typeAlias :: Assignment Term
+typeAlias :: Assignment (Term Loc)
 typeAlias = makeTerm <$> symbol TypeAlias <*> children (Declaration.TypeAlias [] <$> expression <*> expression)
 
-typeDeclaration :: Assignment Term
+typeDeclaration :: Assignment (Term Loc)
 typeDeclaration = makeTerm <$> symbol TypeDeclaration <*> children (manyTerm ( (makeTerm <$> symbol TypeSpec <*> children (Declaration.Type <$> typeIdentifier <*> expression))
                                                                             <|> typeAlias ))
 
@@ -360,10 +255,10 @@ typeDeclaration = makeTerm <$> symbol TypeDeclaration <*> children (manyTerm ( (
 
 -- Expressions
 
-argumentList :: Assignment Term
+argumentList :: Assignment (Term Loc)
 argumentList = (symbol ArgumentList <|> symbol ArgumentList') *> children expressions
 
-binaryExpression :: Assignment Term
+binaryExpression :: Assignment (Term Loc)
 binaryExpression = makeTerm' <$> symbol BinaryExpression <*> children (infixTerm expression expression
   [ (inject .) . Expression.Plus             <$ symbol AnonPlus
   , (inject .) . Expression.Minus            <$ symbol AnonMinus
@@ -388,34 +283,34 @@ binaryExpression = makeTerm' <$> symbol BinaryExpression <*> children (infixTerm
   where
     invert cons a b = Expression.Not (makeTerm1 (cons a b))
 
-block :: Assignment Term
+block :: Assignment (Term Loc)
 block = symbol Block *> children expressions
 
-defaultCase :: Assignment Term
+defaultCase :: Assignment (Term Loc)
 defaultCase = makeTerm <$> symbol DefaultCase <*> children (Go.Syntax.DefaultPattern <$> (expressions <|> emptyTerm))
 
-defaultExpressionCase :: Assignment Term
+defaultExpressionCase :: Assignment (Term Loc)
 defaultExpressionCase = makeTerm <$> symbol DefaultCase <*> (Go.Syntax.DefaultPattern <$ rawSource <*> (expressions <|> emptyTerm))
 
-callExpression :: Assignment Term
+callExpression :: Assignment (Term Loc)
 callExpression = makeTerm <$> symbol CallExpression <*> children (Expression.Call [] <$> expression <*> manyTerm expression <*> emptyTerm)
 
-expressionCase :: Assignment Term
+expressionCase :: Assignment (Term Loc)
 expressionCase = makeTerm <$> symbol ExpressionCase <*> (Statement.Pattern <$> children expressions <*> expressions)
 
-expressionList :: Assignment Term
+expressionList :: Assignment (Term Loc)
 expressionList = symbol ExpressionList *> children expressions
 
-expressionSwitchStatement :: Assignment Term
+expressionSwitchStatement :: Assignment (Term Loc)
 expressionSwitchStatement
   = makeTerm
   <$> symbol ExpressionSwitchStatement
   <*> children (Statement.Match <$> (makeTerm <$> location <*> manyTermsTill expression (void (symbol ExpressionCase)) <|> emptyTerm) <*> expressions)
 
-fallThroughStatement :: Assignment Term
+fallThroughStatement :: Assignment (Term Loc)
 fallThroughStatement = makeTerm <$> symbol FallthroughStatement <*> (Statement.Pattern <$> (makeTerm <$> location <*> (Syntax.Identifier . name <$> source)) <*> emptyTerm)
 
-functionDeclaration :: Assignment Term
+functionDeclaration :: Assignment (Term Loc)
 functionDeclaration = makeTerm <$> (symbol FunctionDeclaration <|> symbol FuncLiteral) <*> children (mkFunctionDeclaration <$> (term identifier <|> emptyTerm) <*> params <*> returnTypes <*> (term block <|> emptyTerm))
   where
     returnTypes =  pure <$> (term types <|> term identifier <|> term returnParameters)
@@ -424,7 +319,7 @@ functionDeclaration = makeTerm <$> (symbol FunctionDeclaration <|> symbol FuncLi
     mkFunctionDeclaration name' params' types' block' = Declaration.Function types' name' params' block'
     returnParameters = makeTerm <$> symbol ParameterList <*> children (manyTerm expression)
 
-importDeclaration :: Assignment Term
+importDeclaration :: Assignment (Term Loc)
 importDeclaration = makeTerm'' <$> symbol ImportDeclaration <*> children (manyTerm (importSpec <|> importSpecList))
   where
     -- `import . "lib/Math"`
@@ -447,10 +342,10 @@ importDeclaration = makeTerm'' <$> symbol ImportDeclaration <*> children (manyTe
     importSpecList = makeTerm <$> symbol ImportSpecList <*> children (manyTerm (importSpec <|> comment))
     importFromPath = symbol InterpretedStringLiteral *> (importPath <$> source)
 
-indexExpression :: Assignment Term
+indexExpression :: Assignment (Term Loc)
 indexExpression = makeTerm <$> symbol IndexExpression <*> children (Expression.Subscript <$> expression <*> manyTerm expression)
 
-methodDeclaration :: Assignment Term
+methodDeclaration :: Assignment (Term Loc)
 methodDeclaration = makeTerm <$> symbol MethodDeclaration <*> children (mkTypedMethodDeclaration <$> receiver <*> pure publicAccessControl <*> term fieldIdentifier <*> params <*> returnParameters <*> (term block <|> emptyTerm))
   where
     params = symbol ParameterList *> children (manyTerm expression)
@@ -460,7 +355,7 @@ methodDeclaration = makeTerm <$> symbol MethodDeclaration <*> children (mkTypedM
                     <|> pure <$> expression
                     <|> pure []
 
-methodSpec :: Assignment Term
+methodSpec :: Assignment (Term Loc)
 methodSpec =  makeTerm <$> symbol MethodSpec <*> children (mkMethodSpec publicAccessControl <$> expression <*> params <*> (expression <|> emptyTerm))
   where
     params = symbol ParameterList *> children (manyTerm expression)
@@ -469,43 +364,43 @@ methodSpec =  makeTerm <$> symbol MethodSpec <*> children (mkMethodSpec publicAc
 publicAccessControl :: ScopeGraph.AccessControl
 publicAccessControl = ScopeGraph.Public
 
-methodSpecList :: Assignment Term
+methodSpecList :: Assignment (Term Loc)
 methodSpecList = symbol MethodSpecList *> children expressions
 
-packageClause :: Assignment Term
+packageClause :: Assignment (Term Loc)
 packageClause = makeTerm <$> symbol PackageClause <*> children (Go.Syntax.Package <$> expression <*> pure [])
 
-parameters :: Assignment Term
+parameters :: Assignment (Term Loc)
 parameters = symbol ParameterList *> children expressions
 
-parameterDeclaration :: Assignment Term
+parameterDeclaration :: Assignment (Term Loc)
 parameterDeclaration = makeTerm <$> symbol ParameterDeclaration <*> children (manyTerm expression)
 
-parenthesizedExpression :: Assignment Term
+parenthesizedExpression :: Assignment (Term Loc)
 parenthesizedExpression = symbol ParenthesizedExpression *> children expressions
 
-selectorExpression :: Assignment Term
+selectorExpression :: Assignment (Term Loc)
 selectorExpression = makeWithContext <$> symbol SelectorExpression <*> children ((,,) <$> expression <*> optional comment <*> fieldIdentifier)
   where makeWithContext loc (lhs, comment, rhs) = maybe (makeTerm loc (Expression.MemberAccess lhs rhs)) (\c -> makeTerm loc (Syntax.Context (c :| []) (makeTerm loc (Expression.MemberAccess lhs rhs)))) comment
 
-sliceExpression :: Assignment Term
+sliceExpression :: Assignment (Term Loc)
 sliceExpression = makeTerm <$> symbol SliceExpression <*> children (Go.Syntax.Slice <$> expression <* token AnonLBracket <*> (emptyTerm <|> expression) <* token AnonColon <*> (expression <|> emptyTerm) <* optional (token AnonColon) <*> (expression <|> emptyTerm))
 
-typeAssertion :: Assignment Term
+typeAssertion :: Assignment (Term Loc)
 typeAssertion = makeTerm <$> symbol TypeAssertionExpression <*> children (Go.Syntax.TypeAssertion <$> expression <*> expression)
 
-typeCase :: Assignment Term
+typeCase :: Assignment (Term Loc)
 typeCase = symbol TypeCase *> children expressions
 
-typeConversion :: Assignment Term
+typeConversion :: Assignment (Term Loc)
 typeConversion = makeTerm <$> symbol TypeConversionExpression <*> children (Go.Syntax.TypeConversion <$> expression <*> expression)
 
-typeSwitchStatement :: Assignment Term
+typeSwitchStatement :: Assignment (Term Loc)
 typeSwitchStatement = makeTerm <$> symbol TypeSwitchStatement <*> children (Go.Syntax.TypeSwitch <$> typeSwitchSubject <*> expressions)
   where
     typeSwitchSubject = makeTerm <$> location <*> manyTermsTill expression (void (symbol TypeCase)) <|> emptyTerm
 
-unaryExpression :: Assignment Term
+unaryExpression :: Assignment (Term Loc)
 unaryExpression = makeTerm' <$> symbol UnaryExpression <*> (  notExpression
                                                           <|> unaryMinus
                                                           <|> unaryAmpersand
@@ -522,16 +417,16 @@ unaryExpression = makeTerm' <$> symbol UnaryExpression <*> (  notExpression
     unaryPointer    = inject <$> children (Literal.Pointer <$ symbol AnonStar <*> expression)
     unaryReceive    = inject <$> children (Go.Syntax.ReceiveOperator <$ symbol AnonLAngleMinus <*> expression)
 
-varDeclaration :: Assignment Term
+varDeclaration :: Assignment (Term Loc)
 varDeclaration = (symbol ConstDeclaration <|> symbol VarDeclaration) *> children expressions
 
-variadicArgument :: Assignment Term
+variadicArgument :: Assignment (Term Loc)
 variadicArgument = makeTerm <$> symbol VariadicArgument <*> children (Go.Syntax.Variadic [] <$> expressions)
 
-variadicParameterDeclaration :: Assignment Term
+variadicParameterDeclaration :: Assignment (Term Loc)
 variadicParameterDeclaration =  makeTerm <$> symbol VariadicParameterDeclaration <*> children (flip Go.Syntax.Variadic <$> (expression <|> emptyTerm) <* token AnonDotDotDot <*> many expression)
 
-varSpecification :: Assignment Term
+varSpecification :: Assignment (Term Loc)
 varSpecification = makeTerm <$> (symbol ConstSpec <|> symbol VarSpec) <*> children (Statement.Assignment [] <$> (annotatedLHS <|> identifiers) <*> expressions)
     where
       annotatedLHS = makeTerm <$> location <*> (Type.Annotation <$> (makeTerm <$> location <*> manyTermsTill identifier (void (symbol TypeIdentifier))) <*> expression)
@@ -539,7 +434,7 @@ varSpecification = makeTerm <$> (symbol ConstSpec <|> symbol VarSpec) <*> childr
 
 -- Statements
 
-assignment' :: Assignment Term
+assignment' :: Assignment (Term Loc)
 assignment' =  makeTerm' <$> symbol AssignmentStatement <*> children (infixTerm expressionList expressionList
                   [ assign                                   <$ symbol AnonEqual
                   , augmentedAssign Expression.Plus          <$ symbol AnonPlusEqual
@@ -555,95 +450,95 @@ assignment' =  makeTerm' <$> symbol AssignmentStatement <*> children (infixTerm
                   , augmentedAssign (invert Expression.BAnd) <$ symbol AnonAmpersandCaretEqual
                   ])
   where
-    assign :: Term -> Term -> Sum Syntax Term
+    assign :: Term Loc -> Term Loc -> Sum Go.Syntax (Term Loc)
     assign l r = inject (Statement.Assignment [] l r)
 
-    augmentedAssign :: (f :< Syntax) => (Term -> Term -> f Term) -> Term -> Term -> Sum Syntax Term
+    augmentedAssign :: (f :< Go.Syntax) => (Term Loc -> Term Loc -> f (Term Loc)) -> Term Loc -> Term Loc -> Sum Go.Syntax (Term Loc)
     augmentedAssign c l r = assign l (makeTerm1 (c l r))
 
     invert cons a b = Expression.Not (makeTerm1 (cons a b))
 
-breakStatement :: Assignment Term
+breakStatement :: Assignment (Term Loc)
 breakStatement = makeTerm <$> symbol BreakStatement <*> children (Statement.Break <$> (expression <|> emptyTerm))
 
-communicationCase :: Assignment Term
+communicationCase :: Assignment (Term Loc)
 communicationCase = makeTerm <$> symbol CommunicationCase <*> children (Statement.Pattern <$> expression <*> expressions)
 
-continueStatement :: Assignment Term
+continueStatement :: Assignment (Term Loc)
 continueStatement = makeTerm <$> symbol ContinueStatement <*> children (Statement.Continue <$> (expression <|> emptyTerm))
 
-decStatement :: Assignment Term
+decStatement :: Assignment (Term Loc)
 decStatement = makeTerm <$> symbol DecStatement <*> children (Statement.PostDecrement <$> expression)
 
-deferStatement :: Assignment Term
+deferStatement :: Assignment (Term Loc)
 deferStatement = makeTerm <$> symbol DeferStatement <*> children (Go.Syntax.Defer <$> expression)
 
-emptyStatement :: Assignment Term
+emptyStatement :: Assignment (Term Loc)
 emptyStatement = makeTerm <$> token EmptyStatement <*> (Statement.NoOp <$> emptyTerm)
 
-forStatement :: Assignment Term
+forStatement :: Assignment (Term Loc)
 forStatement =  makeTerm' <$> symbol ForStatement <*> children (forClause <|> forSimpleClause <|> rangeClause)
   where
     forClause = inject <$> (symbol ForClause *> children (Statement.For <$> (expression <|> emptyTerm) <*> (expression <|> emptyTerm) <*> (expression <|> emptyTerm)) <*> expression)
     forSimpleClause = inject <$> (Statement.For <$> emptyTerm <*> (expression <|> emptyTerm) <*> emptyTerm <*> expression)
     rangeClause = inject <$> (symbol RangeClause *> children (Statement.ForEach <$> (expression <|> emptyTerm) <*> expression) <*> expression)
 
-goStatement :: Assignment Term
+goStatement :: Assignment (Term Loc)
 goStatement = makeTerm <$> symbol GoStatement <*> children (Go.Syntax.Go <$> expression)
 
-gotoStatement :: Assignment Term
+gotoStatement :: Assignment (Term Loc)
 gotoStatement = makeTerm <$> symbol GotoStatement <*> children (Statement.Goto <$> expression)
 
-ifStatement :: Assignment Term
+ifStatement :: Assignment (Term Loc)
 ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> (makeTerm <$> location <*> manyTermsTill expression (void (symbol Block))) <*> expression <*> (expression <|> emptyTerm))
 
-incStatement :: Assignment Term
+incStatement :: Assignment (Term Loc)
 incStatement = makeTerm <$> symbol IncStatement <*> children (Statement.PostIncrement <$> expression)
 
-keyedElement :: Assignment Term
+keyedElement :: Assignment (Term Loc)
 keyedElement = makeTerm <$> symbol KeyedElement <*> children (Literal.KeyValue <$> expression <*> expression)
 
-labelName :: Assignment Term
+labelName :: Assignment (Term Loc)
 labelName = makeTerm <$> symbol LabelName <*> (Syntax.Identifier . name <$> source)
 
-labeledStatement :: Assignment Term
+labeledStatement :: Assignment (Term Loc)
 labeledStatement = makeTerm <$> (symbol LabeledStatement <|> symbol LabeledStatement') <*> children (Go.Syntax.Label <$> expression <*> (expression <|> emptyTerm))
 
-returnStatement :: Assignment Term
+returnStatement :: Assignment (Term Loc)
 returnStatement = makeTerm <$> symbol ReturnStatement <*> children (Statement.Return <$> (expression <|> emptyTerm))
 
-receiveStatement :: Assignment Term
+receiveStatement :: Assignment (Term Loc)
 receiveStatement = makeTerm <$> symbol ReceiveStatement <*> children (Go.Syntax.Receive <$> (expression <|> emptyTerm) <*> expression)
 
-shortVarDeclaration :: Assignment Term
+shortVarDeclaration :: Assignment (Term Loc)
 shortVarDeclaration = makeTerm <$> symbol ShortVarDeclaration <*> children (Statement.Assignment [] <$> expression <*> expression)
 
-selectStatement :: Assignment Term
+selectStatement :: Assignment (Term Loc)
 selectStatement = makeTerm <$> symbol SelectStatement <*> children (Go.Syntax.Select <$> expressions)
 
-sendStatement :: Assignment Term
+sendStatement :: Assignment (Term Loc)
 sendStatement = makeTerm <$> symbol SendStatement <*> children (Go.Syntax.Send <$> expression <*> expression)
 
 
 -- Helpers
 
 -- | Match infix terms separated by any of a list of operators, assigning any comments following each operand.
-infixTerm :: Assignment Term
-          -> Assignment Term
-          -> [Assignment (Term -> Term -> Sum Syntax Term)]
-          -> Assignment (Sum Syntax Term)
+infixTerm :: Assignment (Term Loc)
+          -> Assignment (Term Loc)
+          -> [Assignment (Term Loc -> Term Loc -> Sum Go.Syntax (Term Loc))]
+          -> Assignment (Sum Go.Syntax (Term Loc))
 infixTerm = infixContext comment
 
 -- | Match a series of terms or comments until a delimiter is matched
-manyTermsTill :: Assignment Term
+manyTermsTill :: Assignment (Term Loc)
               -> Assignment b
-              -> Assignment [Term]
+              -> Assignment [Term Loc]
 manyTermsTill step end = manyTill (step <|> comment) end
 
 -- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
-manyTerm :: Assignment Term -> Assignment [Term]
+manyTerm :: Assignment (Term Loc) -> Assignment [Term Loc]
 manyTerm = many . term
 
 -- | Match a term and contextualize any comments preceding or proceeding the term.
-term :: Assignment Term -> Assignment Term
+term :: Assignment (Term Loc) -> Assignment (Term Loc)
 term term' = contextualize comment term' <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm)

src/Language/Go/Term.hs

@@ -0,0 +1,173 @@
+{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies #-}
+module Language.Go.Term
+( Syntax
+, Term(..)
+) where
+
+import Control.Lens.Lens
+import Data.Abstract.Declarations
+import Data.Abstract.FreeVariables
+import Data.Aeson (ToJSON)
+import Data.Bifunctor
+import Data.Bitraversable
+import Data.Coerce
+import Data.Foldable (fold)
+import Data.Functor.Foldable (Base, Recursive(..))
+import Data.Graph.ControlFlowVertex (VertexDeclaration(..), toVertex1)
+import qualified Data.Sum as Sum
+import qualified Data.Syntax as Syntax
+import qualified Data.Syntax.Comment as Comment
+import qualified Data.Syntax.Declaration as Declaration
+import qualified Data.Syntax.Expression as Expression
+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 Data.Traversable
+import Diffing.Interpreter
+import Language.Go.Syntax as Go.Syntax
+import Language.Go.Type as Go.Type
+import Source.Loc
+import Source.Span
+
+type Syntax =
+  [ Comment.Comment
+  , Declaration.Constructor
+  , Declaration.Function
+  , Declaration.Method
+  , Declaration.MethodSignature
+  , Declaration.Type
+  , Declaration.TypeAlias
+  , Expression.Plus
+  , Expression.Minus
+  , Expression.Times
+  , Expression.DividedBy
+  , Expression.Modulo
+  , Expression.Power
+  , Expression.Negate
+  , Expression.FloorDivision
+  , Expression.BOr
+  , Expression.BAnd
+  , Expression.BXOr
+  , Expression.LShift
+  , Expression.RShift
+  , Expression.UnsignedRShift
+  , Expression.Complement
+  , Expression.Call
+  , Expression.LessThan
+  , Expression.LessThanEqual
+  , Expression.GreaterThan
+  , Expression.GreaterThanEqual
+  , Expression.Equal
+  , Expression.StrictEqual
+  , Expression.Comparison
+  , Expression.Subscript
+  , Expression.Member
+  , Statement.PostDecrement
+  , Statement.PostIncrement
+  , Expression.MemberAccess
+  , Expression.And
+  , Expression.Not
+  , Expression.Or
+  , Expression.XOr
+  , Go.Syntax.Composite
+  , Go.Syntax.DefaultPattern
+  , Go.Syntax.Defer
+  , Go.Syntax.Field
+  , Go.Syntax.Go
+  , Go.Syntax.Label
+  , Go.Syntax.Package
+  , Go.Syntax.Receive
+  , Go.Syntax.ReceiveOperator
+  , Go.Syntax.Rune
+  , Go.Syntax.Select
+  , Go.Syntax.Send
+  , Go.Syntax.Slice
+  , Go.Syntax.TypeAssertion
+  , Go.Syntax.TypeConversion
+  , Go.Syntax.TypeSwitch
+  , Go.Syntax.TypeSwitchGuard
+  , Go.Syntax.Variadic
+  , Go.Type.BidirectionalChannel
+  , Go.Type.ReceiveChannel
+  , Go.Type.SendChannel
+  , Go.Syntax.Import
+  , Go.Syntax.QualifiedImport
+  , Go.Syntax.SideEffectImport
+  , Literal.Array
+  , Literal.Complex
+  , Literal.Float
+  , Literal.Hash
+  , Literal.Integer
+  , Literal.KeyValue
+  , Literal.Pointer
+  , Literal.Reference
+  , Literal.TextElement
+  , Statement.Assignment
+  , Statement.Break
+  , Statement.Continue
+  , Statement.For
+  , Statement.ForEach
+  , Statement.Goto
+  , Statement.If
+  , Statement.Match
+  , Statement.NoOp
+  , Statement.Pattern
+  , Statement.Return
+  , Statement.Statements
+  , Syntax.Context
+  , Syntax.Error
+  , Syntax.Empty
+  , Syntax.Identifier
+  , Type.Annotation
+  , Type.Array
+  , Type.Function
+  , Type.Interface
+  , Type.Map
+  , Type.Parenthesized
+  , Type.Pointer
+  , Type.Slice
+  , []
+  , Literal.String
+  , Literal.EscapeSequence
+  , Literal.Null
+  , Literal.Boolean
+  ]
+
+
+newtype Term ann = Term { getTerm :: Term.TermF (Sum.Sum Syntax) ann (Term ann) }
+  deriving (Eq, Declarations, FreeVariables, Ord, Show, ToJSON)
+
+instance Term.IsTerm Term where
+  type Syntax Term = Sum.Sum Syntax
+  toTermF = coerce
+  fromTermF = coerce
+
+instance Foldable Term where
+  foldMap = foldMapDefault
+
+instance Functor Term where
+  fmap = fmapDefault
+
+instance Traversable Term where
+  traverse f = go where go = fmap Term . bitraverse f go . getTerm
+
+instance VertexDeclaration Term where
+  toVertex info (Term (Term.In ann syntax)) = toVertex1 ann info syntax
+
+instance Syntax.HasErrors Term where
+  getErrors = cata $ \ (Term.In Loc{..} syntax) ->
+    maybe (fold syntax) (pure . Syntax.unError span) (Sum.project syntax)
+
+
+instance DiffTerms Term where
+  diffTermPair = diffTermPair . bimap (cata Term.Term) (cata Term.Term)
+
+type instance Base (Term ann) = Term.TermF (Sum.Sum Syntax) ann
+
+instance Recursive (Term ann) where
+  project = getTerm
+
+instance HasSpan ann => HasSpan (Term ann) where
+  span_ = inner.span_ where inner = lens getTerm (\t i -> t { getTerm = i })
+  {-# INLINE span_ #-}

src/Language/Markdown/Assignment.hs

@@ -1,10 +1,9 @@
-{-# LANGUAGE DataKinds, RankNTypes, TypeOperators #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-} -- FIXME
+{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators #-}
 module Language.Markdown.Assignment
 ( assignment
-, Syntax
+, Markdown.Syntax
 , Grammar
-, Language.Markdown.Assignment.Term
+, Markdown.Term(..)
 ) where
 
 import Prologue
@@ -17,45 +16,18 @@ import qualified Data.Syntax as Syntax
 import qualified Data.Term as Term
 import qualified Data.Text as Text
 import qualified Language.Markdown.Syntax as Markup
+import           Language.Markdown.Term as Markdown
 import           Parsing.CMark as Grammar (Grammar (..))
 
-type Syntax =
-  '[ Markup.Document
-   -- Block elements
-   , Markup.BlockQuote
-   , Markup.Heading
-   , Markup.HTMLBlock
-   , Markup.OrderedList
-   , Markup.Paragraph
-   , Markup.ThematicBreak
-   , Markup.UnorderedList
-   , Markup.Table
-   , Markup.TableRow
-   , Markup.TableCell
-   -- Inline elements
-   , Markup.Code
-   , Markup.Emphasis
-   , Markup.Image
-   , Markup.LineBreak
-   , Markup.Link
-   , Markup.Strong
-   , Markup.Text
-   , Markup.Strikethrough
-   -- Assignment errors; cmark does not provide parse errors.
-   , Syntax.Error
-   , []
-   ]
-
-type Term = Term.Term (Sum Syntax) Loc
 type Assignment = Assignment.Assignment (Term.TermF [] CMarkGFM.NodeType) Grammar
 
-assignment :: Assignment Term
+assignment :: Assignment (Term Loc)
 assignment = Syntax.handleError $ makeTerm <$> symbol Document <*> children (Markup.Document <$> many blockElement)
 
 
 -- Block elements
 
-blockElement :: Assignment Term
+blockElement :: Assignment (Term Loc)
 blockElement = choice
   [ paragraph
   , list
@@ -67,10 +39,10 @@ blockElement = choice
   , table
   ]
 
-paragraph :: Assignment Term
+paragraph :: Assignment (Term Loc)
 paragraph = makeTerm <$> symbol Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
 
-list :: Assignment Term
+list :: Assignment (Term Loc)
 list = Term.termIn <$> symbol List <*> (makeList . Term.termFAnnotation . Term.termFOut <$> currentNode <*> children (many item))
   where
     makeList (CMarkGFM.LIST CMarkGFM.ListAttributes{..}) = case listType of
@@ -78,42 +50,42 @@ list = Term.termIn <$> symbol List <*> (makeList . Term.termFAnnotation . Term.t
       CMarkGFM.ORDERED_LIST -> inject . Markup.OrderedList
     makeList _ = inject . Markup.UnorderedList
 
-item :: Assignment Term
+item :: Assignment (Term Loc)
 item = makeTerm <$> symbol Item <*> children (many blockElement)
 
-heading :: Assignment Term
+heading :: Assignment (Term Loc)
 heading = makeTerm <$> symbol Heading <*> (makeHeading . Term.termFAnnotation . Term.termFOut <$> currentNode <*> children (many inlineElement) <*> manyTill blockElement (void (symbol Heading) <|> eof))
   where
     makeHeading (CMarkGFM.HEADING level) = Markup.Heading level
     makeHeading _ = Markup.Heading 0
 
-blockQuote :: Assignment Term
+blockQuote :: Assignment (Term Loc)
 blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$> many blockElement)
 
-codeBlock :: Assignment Term
+codeBlock :: Assignment (Term Loc)
 codeBlock = makeTerm <$> symbol CodeBlock <*> (makeCode . Term.termFAnnotation . Term.termFOut <$> currentNode <*> source)
   where
     makeCode (CMarkGFM.CODE_BLOCK language _) = Markup.Code (nullText language)
     makeCode _ = Markup.Code Nothing
 
-thematicBreak :: Assignment Term
+thematicBreak :: Assignment (Term Loc)
 thematicBreak = makeTerm <$> token ThematicBreak <*> pure Markup.ThematicBreak
 
-htmlBlock :: Assignment Term
+htmlBlock :: Assignment (Term Loc)
 htmlBlock = makeTerm <$> symbol HTMLBlock <*> (Markup.HTMLBlock <$> source)
 
-table :: Assignment Term
+table :: Assignment (Term Loc)
 table = makeTerm <$> symbol Table <*> children (Markup.Table <$> many tableRow)
 
-tableRow :: Assignment Term
+tableRow :: Assignment (Term Loc)
 tableRow = makeTerm <$> symbol TableRow <*> children (Markup.TableRow <$> many tableCell)
 
-tableCell :: Assignment Term
+tableCell :: Assignment (Term Loc)
 tableCell = makeTerm <$> symbol TableCell <*> children (Markup.TableCell <$> many inlineElement)
 
 -- Inline elements
 
-inlineElement :: Assignment Term
+inlineElement :: Assignment (Term Loc)
 inlineElement = choice
   [ strong
   , emphasis
@@ -127,40 +99,40 @@ inlineElement = choice
   , softBreak
   ]
 
-strong :: Assignment Term
+strong :: Assignment (Term Loc)
 strong = makeTerm <$> symbol Strong <*> children (Markup.Strong <$> many inlineElement)
 
-emphasis :: Assignment Term
+emphasis :: Assignment (Term Loc)
 emphasis = makeTerm <$> symbol Emphasis <*> children (Markup.Emphasis <$> many inlineElement)
 
-strikethrough :: Assignment Term
+strikethrough :: Assignment (Term Loc)
 strikethrough = makeTerm <$> symbol Strikethrough <*> children (Markup.Strikethrough <$> many inlineElement)
 
-text :: Assignment Term
+text :: Assignment (Term Loc)
 text = makeTerm <$> symbol Text <*> (Markup.Text <$> source)
 
-htmlInline :: Assignment Term
+htmlInline :: Assignment (Term Loc)
 htmlInline = makeTerm <$> symbol HTMLInline <*> (Markup.HTMLBlock <$> source)
 
-link :: Assignment Term
+link :: Assignment (Term Loc)
 link = makeTerm <$> symbol Link <*> (makeLink . Term.termFAnnotation . Term.termFOut <$> currentNode) <* advance
   where
     makeLink (CMarkGFM.LINK url title) = Markup.Link url (nullText title)
     makeLink _ = Markup.Link mempty Nothing
 
-image :: Assignment Term
+image :: Assignment (Term Loc)
 image = makeTerm <$> symbol Image <*> (makeImage . Term.termFAnnotation . Term.termFOut <$> currentNode) <* advance
   where
     makeImage (CMarkGFM.IMAGE url title) = Markup.Image url (nullText title)
     makeImage _ = Markup.Image mempty Nothing
 
-code :: Assignment Term
+code :: Assignment (Term Loc)
 code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source)
 
-lineBreak :: Assignment Term
+lineBreak :: Assignment (Term Loc)
 lineBreak = makeTerm <$> token LineBreak <*> pure Markup.LineBreak
 
-softBreak :: Assignment Term
+softBreak :: Assignment (Term Loc)
 softBreak = makeTerm <$> token SoftBreak <*> pure Markup.LineBreak
 
 

src/Language/Markdown/Term.hs

@@ -0,0 +1,84 @@
+{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies #-}
+module Language.Markdown.Term
+( Syntax
+, Term(..)
+) where
+
+import Control.Lens.Lens
+import Data.Abstract.Declarations
+import Data.Aeson (ToJSON)
+import Data.Bifunctor
+import Data.Bitraversable
+import Data.Coerce
+import Data.Foldable (fold)
+import Data.Functor.Foldable (Base, Recursive(..))
+import qualified Data.Sum as Sum
+import qualified Data.Syntax as Syntax
+import qualified Data.Term as Term
+import Data.Traversable
+import Diffing.Interpreter
+import qualified Language.Markdown.Syntax as Markup
+import Source.Loc
+import Source.Span
+
+type Syntax =
+  [ Markup.Document
+  -- Block elements
+  , Markup.BlockQuote
+  , Markup.Heading
+  , Markup.HTMLBlock
+  , Markup.OrderedList
+  , Markup.Paragraph
+  , Markup.ThematicBreak
+  , Markup.UnorderedList
+  , Markup.Table
+  , Markup.TableRow
+  , Markup.TableCell
+  -- Inline elements
+  , Markup.Code
+  , Markup.Emphasis
+  , Markup.Image
+  , Markup.LineBreak
+  , Markup.Link
+  , Markup.Strong
+  , Markup.Text
+  , Markup.Strikethrough
+  -- Assignment errors; cmark does not provide parse errors.
+  , Syntax.Error
+  , []
+  ]
+
+
+newtype Term ann = Term { getTerm :: Term.TermF (Sum.Sum Syntax) ann (Term ann) }
+  deriving (Declarations, Eq, Ord, Show, ToJSON)
+
+instance Term.IsTerm Term where
+  type Syntax Term = Sum.Sum Syntax
+  toTermF = coerce
+  fromTermF = coerce
+
+instance Foldable Term where
+  foldMap = foldMapDefault
+
+instance Functor Term where
+  fmap = fmapDefault
+
+instance Traversable Term where
+  traverse f = go where go = fmap Term . bitraverse f go . getTerm
+
+instance Syntax.HasErrors Term where
+  getErrors = cata $ \ (Term.In Loc{..} syntax) ->
+    maybe (fold syntax) (pure . Syntax.unError span) (Sum.project syntax)
+
+
+instance DiffTerms Term where
+  diffTermPair = diffTermPair . bimap (cata Term.Term) (cata Term.Term)
+
+type instance Base (Term ann) = Term.TermF (Sum.Sum Syntax) ann
+
+instance Recursive (Term ann) where
+  project = getTerm
+
+instance HasSpan ann => HasSpan (Term ann) where
+  span_ = inner.span_ where inner = lens getTerm (\t i -> t { getTerm = i })
+  {-# INLINE span_ #-}

src/Language/PHP/Assignment.hs

@@ -1,10 +1,9 @@
-{-# LANGUAGE DataKinds, RankNTypes, TypeOperators #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-} -- FIXME
+{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators #-}
 module Language.PHP.Assignment
 ( assignment
-, Syntax
+, PHP.Syntax
 , Grammar
-, Term
+, PHP.Term(..)
 ) where
 
 import Prologue
@@ -32,150 +31,23 @@ import qualified Data.Syntax.Expression as Expression
 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 Language.PHP.Syntax as Syntax
+import           Language.PHP.Term as PHP
 import           TreeSitter.PHP as Grammar
 
-type Syntax = '[
-    Comment.Comment
-  , Declaration.Class
-  , Declaration.Function
-  , Declaration.Method
-  , Declaration.VariableDeclaration
-  , Expression.Plus
-  , Expression.Minus
-  , Expression.Times
-  , Expression.DividedBy
-  , Expression.Modulo
-  , Expression.Power
-  , Expression.Negate
-  , Expression.FloorDivision
-  , Expression.BAnd
-  , Expression.BOr
-  , Expression.BXOr
-  , Expression.LShift
-  , Expression.RShift
-  , Expression.And
-  , Expression.Not
-  , Expression.Or
-  , Expression.XOr
-  , Expression.Call
-  , Expression.Cast
-  , Expression.LessThan
-  , Expression.LessThanEqual
-  , Expression.GreaterThan
-  , Expression.GreaterThanEqual
-  , Expression.Equal
-  , Expression.StrictEqual
-  , Expression.Comparison
-  , Expression.InstanceOf
-  , Expression.MemberAccess
-  , Expression.New
-  , Expression.SequenceExpression
-  , Expression.Subscript
-  , Expression.Member
-  , Literal.Array
-  , Literal.Float
-  , Literal.Integer
-  , Literal.KeyValue
-  , Literal.TextElement
-  , Statement.Assignment
-  , Statement.Break
-  , Statement.Catch
-  , Statement.Continue
-  , Statement.DoWhile
-  , Statement.Else
-  , Statement.Finally
-  , Statement.For
-  , Statement.ForEach
-  , Statement.Goto
-  , Statement.If
-  , Statement.Match
-  , Statement.Pattern
-  , Statement.Return
-  , Statement.Statements
-  , Statement.Throw
-  , Statement.Try
-  , Statement.While
-  , Statement.Yield
-  , Syntax.AliasAs
-  , Syntax.ArrayElement
-  , Syntax.BaseTypeDeclaration
-  , Syntax.CastType
-  , Syntax.ClassBaseClause
-  , Syntax.ClassConstDeclaration
-  , Syntax.ClassInterfaceClause
-  , Syntax.ClassModifier
-  , Syntax.Clone
-  , Syntax.ConstDeclaration
-  , Syntax.ConstructorDeclaration
-  , Syntax.Context
-  , Syntax.Declare
-  , Syntax.DeclareDirective
-  , Syntax.DestructorDeclaration
-  , Syntax.Echo
-  , Syntax.Empty
-  , Syntax.EmptyIntrinsic
-  , Syntax.Error
-  , Syntax.ErrorControl
-  , Syntax.EvalIntrinsic
-  , Syntax.ExitIntrinsic
-  , Syntax.GlobalDeclaration
-  , Syntax.Identifier
-  , Syntax.Include
-  , Syntax.IncludeOnce
-  , Syntax.InsteadOf
-  , Syntax.InterfaceBaseClause
-  , Syntax.InterfaceDeclaration
-  , Syntax.IssetIntrinsic
-  , Syntax.LabeledStatement
-  , Syntax.Namespace
-  , Syntax.NamespaceAliasingClause
-  , Syntax.NamespaceName
-  , Syntax.NamespaceUseClause
-  , Syntax.NamespaceUseDeclaration
-  , Syntax.NamespaceUseGroupClause
-  , Syntax.NewVariable
-  , Syntax.PrintIntrinsic
-  , Syntax.PropertyDeclaration
-  , Syntax.PropertyModifier
-  , Syntax.QualifiedName
-  , Syntax.RelativeScope
-  , Syntax.Require
-  , Syntax.RequireOnce
-  , Syntax.ReturnType
-  , Syntax.ScalarType
-  , Syntax.ShellCommand
-  , Syntax.Concat
-  , Syntax.SimpleVariable
-  , Syntax.Static
-  , Syntax.Text
-  , Syntax.TraitDeclaration
-  , Syntax.TraitUseClause
-  , Syntax.TraitUseSpecification
-  , Syntax.TypeDeclaration
-  , Syntax.Unset
-  , Syntax.Update
-  , Syntax.UseClause
-  , Syntax.VariableName
-  , Type.Annotation
-  , []
-  ]
-
-type Term = Term.Term (Sum Syntax) Loc
 type Assignment = Assignment.Assignment [] Grammar
 
 -- | Assignment from AST in PHP's grammar onto a program in PHP's syntax.
-assignment :: Assignment Term
+assignment :: Assignment (Term Loc)
 assignment = handleError $ makeTerm <$> symbol Program <*> children (Statement.Statements <$> (bookend <$> (text <|> emptyTerm) <*> manyTerm statement <*> (text <|> emptyTerm))) <|> parseError
 
-text :: Assignment Term
+text :: Assignment (Term Loc)
 text = makeTerm <$> symbol Text <*> (Syntax.Text <$> source)
 
-textInterpolation :: Assignment Term
+textInterpolation :: Assignment (Term Loc)
 textInterpolation = makeTerm <$> symbol TextInterpolation <*> (Syntax.Text <$> source)
 
-statement :: Assignment Term
+statement :: Assignment (Term Loc)
 statement = handleError everything
   where
     everything = choice [
@@ -200,7 +72,7 @@ statement = handleError everything
       , functionStaticDeclaration
       ]
 
-expression :: Assignment Term
+expression :: Assignment (Term Loc)
 expression = choice [
   assignmentExpression,
   augmentedAssignmentExpression,
@@ -214,7 +86,7 @@ expression = choice [
   unaryExpression
   ]
 
-unaryExpression :: Assignment Term
+unaryExpression :: Assignment (Term Loc)
 unaryExpression = choice [
   cloneExpression,
   exponentiationExpression,
@@ -223,10 +95,10 @@ unaryExpression = choice [
   primaryExpression
   ]
 
-assignmentExpression :: Assignment Term
+assignmentExpression :: Assignment (Term Loc)
 assignmentExpression = makeTerm <$> symbol AssignmentExpression <*> children (Statement.Assignment [] <$> term (variable <|> list <|> arrayCreationExpression) <*> term (expression <|> variable))
 
-augmentedAssignmentExpression :: Assignment Term
+augmentedAssignmentExpression :: Assignment (Term Loc)
 augmentedAssignmentExpression = makeTerm' <$> symbol AugmentedAssignmentExpression <*> children (infixTerm variable (term expression) [
   assign Expression.Power <$ symbol AnonStarStarEqual
   , assign Expression.Times <$ symbol AnonStarEqual
@@ -243,7 +115,7 @@ augmentedAssignmentExpression = makeTerm' <$> symbol AugmentedAssignmentExpressi
   where
     assign c l r = inject (Statement.Assignment [] l (makeTerm1 (c l r)))
 
-binaryExpression  :: Assignment Term
+binaryExpression  :: Assignment (Term Loc)
 binaryExpression = makeTerm' <$> symbol BinaryExpression <*> children (infixTerm expression (term (expression <|> classTypeDesignator))
   [ (inject .) . Expression.And                <$ symbol AnonAnd
   , (inject .) . Expression.Or                 <$ symbol AnonOr
@@ -274,19 +146,19 @@ binaryExpression = makeTerm' <$> symbol BinaryExpression <*> children (infixTerm
   , (inject .) . Expression.InstanceOf         <$ symbol AnonInstanceof
   ]) where invert cons a b = Expression.Not (makeTerm1 (cons a b))
 
-conditionalExpression :: Assignment Term
+conditionalExpression :: Assignment (Term Loc)
 conditionalExpression = makeTerm <$> symbol ConditionalExpression <*> children (Statement.If <$> term (binaryExpression <|> unaryExpression) <*> (term expression <|> emptyTerm) <*> term expression)
 
-list :: Assignment Term
+list :: Assignment (Term Loc)
 list = makeTerm <$> symbol ListLiteral <*> children (Literal.Array <$> manyTerm (list <|> variable))
 
-exponentiationExpression :: Assignment Term
+exponentiationExpression :: Assignment (Term Loc)
 exponentiationExpression = makeTerm <$> symbol ExponentiationExpression <*> children (Expression.Power <$> term (cloneExpression <|> primaryExpression) <*> term (primaryExpression <|> cloneExpression <|> exponentiationExpression))
 
-cloneExpression :: Assignment Term
+cloneExpression :: Assignment (Term Loc)
 cloneExpression = makeTerm <$> symbol CloneExpression <*> children (Syntax.Clone <$> term primaryExpression)
 
-primaryExpression :: Assignment Term
+primaryExpression :: Assignment (Term Loc)
 primaryExpression = choice [
   variable,
   classConstantAccessExpression,
@@ -301,16 +173,16 @@ primaryExpression = choice [
   parenthesizedExpression
   ]
 
-parenthesizedExpression :: Assignment Term
+parenthesizedExpression :: Assignment (Term Loc)
 parenthesizedExpression = symbol ParenthesizedExpression *> children (term expression)
 
-classConstantAccessExpression :: Assignment Term
+classConstantAccessExpression :: Assignment (Term Loc)
 classConstantAccessExpression = makeTerm <$> symbol ClassConstantAccessExpression <*> children (Expression.MemberAccess <$> term scopeResolutionQualifier <*> name)
 
-variable :: Assignment Term
+variable :: Assignment (Term Loc)
 variable = callableVariable <|> scopedPropertyAccessExpression <|> memberAccessExpression <|> castExpression
 
-callableVariable :: Assignment Term
+callableVariable :: Assignment (Term Loc)
 callableVariable = choice [
   simpleVariable',
   subscriptExpression,
@@ -319,18 +191,18 @@ callableVariable = choice [
   functionCallExpression
   ]
 
-memberCallExpression :: Assignment Term
+memberCallExpression :: Assignment (Term Loc)
 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 Term
+scopedCallExpression :: Assignment (Term Loc)
 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 Term
+functionCallExpression :: Assignment (Term Loc)
 functionCallExpression = makeTerm <$> symbol FunctionCallExpression <*> children (Expression.Call [] <$> term (qualifiedName <|> callableExpression) <*> arguments <*> emptyTerm)
 
-callableExpression :: Assignment Term
+callableExpression :: Assignment (Term Loc)
 callableExpression = choice [
   callableVariable,
   expression,
@@ -338,29 +210,29 @@ callableExpression = choice [
   string
   ]
 
-subscriptExpression :: Assignment Term
+subscriptExpression :: Assignment (Term Loc)
 subscriptExpression = makeTerm <$> symbol SubscriptExpression <*> children (Expression.Subscript <$> term dereferencableExpression <*> (pure <$> (term expression <|> emptyTerm)))
 
-memberAccessExpression :: Assignment Term
+memberAccessExpression :: Assignment (Term Loc)
 memberAccessExpression = makeTerm <$> symbol MemberAccessExpression <*> children (Expression.MemberAccess <$> term dereferencableExpression <*> memberName)
 
-dereferencableExpression :: Assignment Term
+dereferencableExpression :: Assignment (Term Loc)
 dereferencableExpression = symbol DereferencableExpression *> children (term (variable <|> expression <|> arrayCreationExpression <|> string))
 
-scopedPropertyAccessExpression :: Assignment Term
+scopedPropertyAccessExpression :: Assignment (Term Loc)
 scopedPropertyAccessExpression = makeTerm <$> symbol ScopedPropertyAccessExpression <*> children (Expression.MemberAccess <$> term scopeResolutionQualifier <*> simpleVariable')
 
-scopeResolutionQualifier :: Assignment Term
+scopeResolutionQualifier :: Assignment (Term Loc)
 scopeResolutionQualifier = choice [
   relativeScope,
   qualifiedName,
   dereferencableExpression
   ]
 
-arrayCreationExpression :: Assignment Term
+arrayCreationExpression :: Assignment (Term Loc)
 arrayCreationExpression = makeTerm <$> symbol ArrayCreationExpression <*> children (Literal.Array <$> manyTerm arrayElementInitializer)
 
-intrinsic :: Assignment Term
+intrinsic :: Assignment (Term Loc)
 intrinsic = choice [
   emptyIntrinsic,
   evalIntrinsic,
@@ -369,68 +241,68 @@ intrinsic = choice [
   printIntrinsic
   ]
 
-emptyIntrinsic :: Assignment Term
+emptyIntrinsic :: Assignment (Term Loc)
 emptyIntrinsic = makeTerm <$> symbol EmptyIntrinsic <*> children (Syntax.EmptyIntrinsic <$> term expression)
 
-evalIntrinsic :: Assignment Term
+evalIntrinsic :: Assignment (Term Loc)
 evalIntrinsic = makeTerm <$> symbol EvalIntrinsic <*> children (Syntax.EvalIntrinsic <$> term expression)
 
-exitIntrinsic :: Assignment Term
+exitIntrinsic :: Assignment (Term Loc)
 exitIntrinsic = makeTerm <$> symbol ExitIntrinsic <*> children (Syntax.ExitIntrinsic <$> (term expression <|> emptyTerm))
 
-issetIntrinsic :: Assignment Term
+issetIntrinsic :: Assignment (Term Loc)
 issetIntrinsic = makeTerm <$> symbol IssetIntrinsic <*> children (Syntax.IssetIntrinsic <$> (makeTerm <$> location <*> someTerm variable))
 
-printIntrinsic :: Assignment Term
+printIntrinsic :: Assignment (Term Loc)
 printIntrinsic = makeTerm <$> symbol PrintIntrinsic <*> children (Syntax.PrintIntrinsic <$> term expression)
 
-anonymousFunctionCreationExpression :: Assignment Term
+anonymousFunctionCreationExpression :: Assignment (Term Loc)
 anonymousFunctionCreationExpression = makeTerm <$> symbol AnonymousFunctionCreationExpression <*> children (makeFunction <$> emptyTerm <*> parameters <*> (term functionUseClause <|> emptyTerm) <*> (term returnType <|> emptyTerm) <*> term compoundStatement)
   where
     makeFunction identifier parameters functionUseClause returnType statement = Declaration.Function [functionUseClause, returnType] identifier parameters statement
 
-parameters :: Assignment [Term]
+parameters :: Assignment [Term Loc]
 parameters = symbol FormalParameters *> children (manyTerm (simpleParameter <|> variadicParameter))
 
-simpleParameter :: Assignment Term
+simpleParameter :: Assignment (Term Loc)
 simpleParameter = makeTerm <$> symbol SimpleParameter <*> children (makeAnnotation <$> (term typeDeclaration <|> emptyTerm) <*> (makeAssignment <$> location <*> term variableName <*> (term defaultArgumentSpecifier <|> emptyTerm)))
   where
     makeAnnotation typeDecl assignment = Type.Annotation assignment typeDecl
     makeAssignment loc name argument = makeTerm loc (Statement.Assignment [] name argument)
 
-defaultArgumentSpecifier :: Assignment Term
+defaultArgumentSpecifier :: Assignment (Term Loc)
 defaultArgumentSpecifier = symbol DefaultArgumentSpecifier *> children (term expression)
 
 
-variadicParameter :: Assignment Term
+variadicParameter :: Assignment (Term Loc)
 variadicParameter = makeTerm <$> symbol VariadicParameter <*> children (makeTypeAnnotation <$> (term typeDeclaration <|> emptyTerm) <*> term variableName)
   where makeTypeAnnotation ty variableName = Type.Annotation variableName ty
 
-functionUseClause :: Assignment Term
+functionUseClause :: Assignment (Term Loc)
 functionUseClause = makeTerm <$> symbol AnonymousFunctionUseClause <*> children (Syntax.UseClause <$> someTerm variableName)
 
-returnType :: Assignment Term
+returnType :: Assignment (Term Loc)
 returnType = makeTerm <$> symbol ReturnType <*> children (Syntax.ReturnType <$> (term typeDeclaration <|> emptyTerm))
 
-typeDeclaration :: Assignment Term
+typeDeclaration :: Assignment (Term Loc)
 typeDeclaration = makeTerm <$> symbol TypeDeclaration <*> children (Syntax.TypeDeclaration <$> term baseTypeDeclaration)
 
-baseTypeDeclaration :: Assignment Term
+baseTypeDeclaration :: Assignment (Term Loc)
 baseTypeDeclaration = makeTerm <$> symbol BaseTypeDeclaration <*> children (Syntax.BaseTypeDeclaration <$> term (scalarType <|> qualifiedName <|> emptyTerm))
 
-scalarType :: Assignment Term
+scalarType :: Assignment (Term Loc)
 scalarType = makeTerm <$> symbol ScalarType <*> (Syntax.ScalarType <$> source)
 
-compoundStatement :: Assignment Term
+compoundStatement :: Assignment (Term Loc)
 compoundStatement = makeTerm <$> symbol CompoundStatement <*> children (manyTerm statement)
 
-objectCreationExpression :: Assignment Term
+objectCreationExpression :: Assignment (Term Loc)
 objectCreationExpression = makeTerm <$> symbol ObjectCreationExpression <*> children (Expression.New <$> term classTypeDesignator <*> emptyTerm <*> (arguments <|> pure []))
 
   <|> (makeTerm <$> symbol ObjectCreationExpression <*> children (makeAnonClass <$ token AnonNew <* token AnonClass <*> emptyTerm <*> (arguments <|> pure []) <*> (term classBaseClause <|> emptyTerm) <*> (term classInterfaceClause <|> emptyTerm) <*> (makeTerm <$> location <*> manyTerm classMemberDeclaration)))
   where makeAnonClass identifier args baseClause interfaceClause declarations = Declaration.Class [] identifier (args <> [baseClause, interfaceClause]) declarations
 
-classMemberDeclaration :: Assignment Term
+classMemberDeclaration :: Assignment (Term Loc)
 classMemberDeclaration = choice [
   classConstDeclaration,
   propertyDeclaration,
@@ -444,7 +316,7 @@ publicAccessControl :: ScopeGraph.AccessControl
 publicAccessControl = ScopeGraph.Public
 
 -- TODO: Update to check for AccessControl.
-methodDeclaration :: Assignment Term
+methodDeclaration :: Assignment (Term Loc)
 methodDeclaration =  (makeTerm <$> symbol MethodDeclaration <*> children (makeMethod1 publicAccessControl <$> manyTerm methodModifier <*> emptyTerm <*> functionDefinitionParts))
                  <|> makeTerm <$> symbol MethodDeclaration <*> children (makeMethod2 publicAccessControl <$> someTerm methodModifier <*> emptyTerm <*> term name <*> parameters <*> term (returnType <|> emptyTerm) <*> emptyTerm)
   where
@@ -452,107 +324,107 @@ methodDeclaration =  (makeTerm <$> symbol MethodDeclaration <*> children (makeMe
     makeMethod1 accessControl modifiers receiver (name, params, returnType, compoundStatement) = Declaration.Method (modifiers <> [returnType]) receiver name params compoundStatement accessControl
     makeMethod2 accessControl modifiers receiver name params returnType compoundStatement      = Declaration.Method (modifiers <> [returnType]) receiver name params compoundStatement accessControl
 
-classBaseClause :: Assignment Term
+classBaseClause :: Assignment (Term Loc)
 classBaseClause = makeTerm <$> symbol ClassBaseClause <*> children (Syntax.ClassBaseClause <$> term qualifiedName)
 
-classInterfaceClause :: Assignment Term
+classInterfaceClause :: Assignment (Term Loc)
 classInterfaceClause = makeTerm <$> symbol ClassInterfaceClause <*> children (Syntax.ClassInterfaceClause <$> someTerm qualifiedName)
 
-classConstDeclaration :: Assignment Term
+classConstDeclaration :: Assignment (Term Loc)
 classConstDeclaration = makeTerm <$> symbol ClassConstDeclaration <*> children (Syntax.ClassConstDeclaration <$> (term accessControlModifier <|> emptyTerm) <*> manyTerm constElement)
 
 -- TODO: Update to ScopeGraph.AccessControl
-accessControlModifier :: Assignment Term
+accessControlModifier :: Assignment (Term Loc)
 accessControlModifier = makeTerm <$> symbol VisibilityModifier <*> (Syntax.Identifier . Name.name <$> source)
 
-constElement :: Assignment Term
+constElement :: Assignment (Term Loc)
 constElement = makeTerm <$> symbol ConstElement <*> children (Statement.Assignment [] <$> term name <*> term expression)
 
-arguments :: Assignment [Term]
+arguments :: Assignment [Term Loc]
 arguments = symbol Arguments *> children (manyTerm (variadicUnpacking <|> expression))
 
-variadicUnpacking :: Assignment Term
+variadicUnpacking :: Assignment (Term Loc)
 variadicUnpacking = symbol VariadicUnpacking *> children (term expression)
 
-classTypeDesignator :: Assignment Term
+classTypeDesignator :: Assignment (Term Loc)
 classTypeDesignator = qualifiedName <|> newVariable
 
-newVariable :: Assignment Term
+newVariable :: Assignment (Term Loc)
 newVariable = makeTerm <$> symbol NewVariable <*> children (Syntax.NewVariable <$> ((pure <$> term simpleVariable') <|> ((\a b -> [a, b]) <$> term (newVariable <|> qualifiedName <|> relativeScope) <*> term (expression <|> memberName <|> emptyTerm))))
 
-memberName :: Assignment Term
+memberName :: Assignment (Term Loc)
 memberName = name <|> simpleVariable' <|> expression
 
-relativeScope :: Assignment Term
+relativeScope :: Assignment (Term Loc)
 relativeScope = makeTerm <$> symbol RelativeScope <*> (Syntax.RelativeScope <$> source)
 
-qualifiedName :: Assignment Term
+qualifiedName :: Assignment (Term Loc)
 qualifiedName = makeTerm <$> symbol QualifiedName <*> children (Syntax.QualifiedName <$> (term namespaceNameAsPrefix <|> emptyTerm) <*> term name)
 
-namespaceNameAsPrefix :: Assignment Term
+namespaceNameAsPrefix :: Assignment (Term Loc)
 namespaceNameAsPrefix = symbol NamespaceNameAsPrefix *> children (term namespaceName <|> emptyTerm)
 
-namespaceName :: Assignment Term
+namespaceName :: Assignment (Term Loc)
 namespaceName = makeTerm <$> symbol NamespaceName <*> children (Syntax.NamespaceName <$> someTerm' name)
 
-namespaceName' :: Assignment (NonEmpty Term)
+namespaceName' :: Assignment (NonEmpty (Term Loc))
 namespaceName' = symbol NamespaceName *> children (someTerm' name)
 
-updateExpression :: Assignment Term
+updateExpression :: Assignment (Term Loc)
 updateExpression = makeTerm <$> symbol UpdateExpression <*> children (Syntax.Update <$> term expression)
 
-shellCommandExpression :: Assignment Term
+shellCommandExpression :: Assignment (Term Loc)
 shellCommandExpression = makeTerm <$> symbol ShellCommandExpression <*> (Syntax.ShellCommand <$> source)
 
-literal :: Assignment Term
+literal :: Assignment (Term Loc)
 literal = integer <|> float <|> string
 
-float :: Assignment Term
+float :: Assignment (Term Loc)
 float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
 
-integer :: Assignment Term
+integer :: Assignment (Term Loc)
 integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> source)
 
-unaryOpExpression :: Assignment Term
+unaryOpExpression :: Assignment (Term Loc)
 unaryOpExpression = symbol UnaryOpExpression >>= \ loc ->
   makeTerm loc . Expression.Not <$> children ((symbol AnonTilde <|> symbol AnonBang) *> term expression)
   <|> makeTerm loc . Expression.Negate <$> children ((symbol AnonMinus <|> symbol AnonPlus) *> term expression)
   <|> makeTerm loc . Syntax.ErrorControl <$> children (symbol AnonAt *> term expression)
 
-castExpression :: Assignment Term
+castExpression :: Assignment (Term Loc)
 castExpression = makeTerm <$> (symbol CastExpression <|> symbol CastExpression') <*> children (flip Expression.Cast <$> term castType <*> term unaryExpression)
 
-castType :: Assignment Term
+castType :: Assignment (Term Loc)
 castType = makeTerm <$> symbol CastType <*> (Syntax.CastType <$> source)
 
-expressionStatement :: Assignment Term
+expressionStatement :: Assignment (Term Loc)
 expressionStatement = symbol ExpressionStatement *> children (term expression)
 
-namedLabelStatement :: Assignment Term
+namedLabelStatement :: Assignment (Term Loc)
 namedLabelStatement = makeTerm <$> symbol NamedLabelStatement <*> children (Syntax.LabeledStatement <$> term name)
 
-selectionStatement :: Assignment Term
+selectionStatement :: Assignment (Term Loc)
 selectionStatement = ifStatement <|> switchStatement
 
-ifStatement :: Assignment Term
+ifStatement :: Assignment (Term Loc)
 ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> term expression <*> (makeTerm <$> location <*> manyTerm statement) <*> (makeTerm <$> location <*> ((\as b -> as <> [b]) <$> manyTerm elseIfClause <*> (term elseClause <|> emptyTerm))))
 
-switchStatement :: Assignment Term
+switchStatement :: Assignment (Term Loc)
 switchStatement = makeTerm <$> symbol SwitchStatement <*> children (Statement.Match <$> term expression <*> (makeTerm <$> location <*> manyTerm (caseStatement <|> defaultStatement)))
 
-caseStatement :: Assignment Term
+caseStatement :: Assignment (Term Loc)
 caseStatement = makeTerm <$> symbol CaseStatement <*> children (Statement.Pattern <$> term expression <*> (makeTerm <$> location <*> manyTerm statement))
 
-defaultStatement :: Assignment Term
+defaultStatement :: Assignment (Term Loc)
 defaultStatement = makeTerm <$> symbol DefaultStatement <*> children (Statement.Pattern <$> emptyTerm <*> (makeTerm <$> location <*> manyTerm statement))
 
-elseIfClause :: Assignment Term
+elseIfClause :: Assignment (Term Loc)
 elseIfClause = makeTerm <$> symbol ElseIfClause <*> children (Statement.Else <$> term expression <*> (makeTerm <$> location <*> manyTerm statement))
 
-elseClause :: Assignment Term
+elseClause :: Assignment (Term Loc)
 elseClause = makeTerm <$> symbol ElseClause <*> children (Statement.Else <$> emptyTerm <*> (makeTerm <$> location <*> manyTerm statement))
 
-iterationStatement :: Assignment Term
+iterationStatement :: Assignment (Term Loc)
 iterationStatement = choice [
   whileStatement,
   doStatement,
@@ -560,23 +432,23 @@ iterationStatement = choice [
   foreachStatement
   ]
 
-whileStatement :: Assignment Term
+whileStatement :: Assignment (Term Loc)
 whileStatement = makeTerm <$> symbol WhileStatement <*> children (Statement.While <$> expression <*> (term (statement <|> (makeTerm <$> location <*> manyTerm statement)) <|> emptyTerm))
 
-doStatement :: Assignment Term
+doStatement :: Assignment (Term Loc)
 doStatement = makeTerm <$> symbol DoStatement <*> children (Statement.DoWhile <$> term statement <*> term expression)
 
-forStatement :: Assignment Term
+forStatement :: Assignment (Term Loc)
 forStatement = makeTerm <$> symbol ForStatement <*> children (Statement.For <$> (term expressions <|> emptyTerm) <*> (term expressions <|> emptyTerm) <*> (term expressions <|> emptyTerm) <*> (makeTerm <$> location <*> manyTerm statement))
 
-foreachStatement :: Assignment Term
+foreachStatement :: Assignment (Term Loc)
 foreachStatement = makeTerm <$> symbol ForeachStatement <*> children (forEachStatement' <$> term expression <*> term (pair <|> expression <|> list) <*> (makeTerm <$> location <*> manyTerm statement))
   where forEachStatement' array value body = Statement.ForEach value array body
 
-pair :: Assignment Term
+pair :: Assignment (Term Loc)
 pair = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> term expression <*> term (expression <|> list))
 
-jumpStatement :: Assignment Term
+jumpStatement :: Assignment (Term Loc)
 jumpStatement = choice [
   gotoStatement,
   continueStatement,
@@ -585,81 +457,81 @@ jumpStatement = choice [
   throwStatement
   ]
 
-gotoStatement :: Assignment Term
+gotoStatement :: Assignment (Term Loc)
 gotoStatement = makeTerm <$> symbol GotoStatement <*> children (Statement.Goto <$> term name)
 
-continueStatement :: Assignment Term
+continueStatement :: Assignment (Term Loc)
 continueStatement = makeTerm <$> symbol ContinueStatement <*> children (Statement.Continue <$> (term breakoutLevel <|> emptyTerm))
 
-breakoutLevel :: Assignment Term
+breakoutLevel :: Assignment (Term Loc)
 breakoutLevel = integer
 
-breakStatement :: Assignment Term
+breakStatement :: Assignment (Term Loc)
 breakStatement = makeTerm <$> symbol BreakStatement <*> children (Statement.Break <$> (term breakoutLevel <|> emptyTerm))
 
-returnStatement :: Assignment Term
+returnStatement :: Assignment (Term Loc)
 returnStatement = makeTerm <$> symbol ReturnStatement <*> children (Statement.Return <$> (term expression <|> emptyTerm))
 
-throwStatement :: Assignment Term
+throwStatement :: Assignment (Term Loc)
 throwStatement = makeTerm <$> symbol ThrowStatement <*> children (Statement.Throw <$> term expression)
 
 
-tryStatement :: Assignment Term
+tryStatement :: Assignment (Term Loc)
 tryStatement = makeTerm <$> symbol TryStatement <*> children (Statement.Try <$> term compoundStatement <*> (((\as b -> as <> [b]) <$> someTerm catchClause <*> term finallyClause) <|>  someTerm catchClause <|> someTerm finallyClause))
 
-catchClause :: Assignment Term
+catchClause :: Assignment (Term Loc)
 catchClause = makeTerm <$> symbol CatchClause <*> children (Statement.Catch <$> (makeTerm <$> location <*> ((\a b -> [a, b]) <$> term qualifiedName <*> term variableName)) <*> term compoundStatement)
 
-finallyClause :: Assignment Term
+finallyClause :: Assignment (Term Loc)
 finallyClause = makeTerm <$> symbol FinallyClause <*> children (Statement.Finally <$> term compoundStatement)
 
-declareStatement :: Assignment Term
+declareStatement :: Assignment (Term Loc)
 declareStatement = makeTerm <$> symbol DeclareStatement <*> children (Syntax.Declare <$> term declareDirective <*> (makeTerm <$> location <*> manyTerm statement))
 
 
 -- | TODO: Figure out how to parse assignment token
-declareDirective :: Assignment Term
+declareDirective :: Assignment (Term Loc)
 declareDirective = makeTerm <$> symbol DeclareDirective <*> children (Syntax.DeclareDirective <$> literal)
 
 
-echoStatement :: Assignment Term
+echoStatement :: Assignment (Term Loc)
 echoStatement = makeTerm <$> symbol EchoStatement <*> children (Syntax.Echo <$> term expressions)
 
-unsetStatement :: Assignment Term
+unsetStatement :: Assignment (Term Loc)
 unsetStatement = makeTerm <$> symbol UnsetStatement <*> children (Syntax.Unset <$> (makeTerm <$> location <*> someTerm variable))
 
-expressions :: Assignment Term
+expressions :: Assignment (Term Loc)
 expressions = expression <|> sequenceExpression
 
-sequenceExpression :: Assignment Term
+sequenceExpression :: Assignment (Term Loc)
 sequenceExpression = makeTerm <$> symbol SequenceExpression <*> children (Expression.SequenceExpression <$> term expression <*> term expressions)
 
-constDeclaration :: Assignment Term
+constDeclaration :: Assignment (Term Loc)
 constDeclaration = makeTerm <$> symbol ConstDeclaration <*> children (Syntax.ConstDeclaration <$> someTerm constElement)
 
-functionDefinition :: Assignment Term
+functionDefinition :: Assignment (Term Loc)
 functionDefinition = makeTerm <$> symbol FunctionDefinition <*> children (makeFunction <$> term name <*> parameters <*> (term returnType <|> emptyTerm) <*> term compoundStatement)
   where
     makeFunction identifier parameters returnType statement = Declaration.Function [returnType] identifier parameters statement
 
-classDeclaration :: Assignment Term
+classDeclaration :: Assignment (Term Loc)
 classDeclaration = makeTerm <$> symbol ClassDeclaration <*> children (makeClass <$> (term classModifier <|> emptyTerm) <*> term name <*> (term classBaseClause <|> emptyTerm) <*> (term classInterfaceClause <|> emptyTerm) <*> (makeTerm <$> location <*> manyTerm classMemberDeclaration))
   where
     makeClass modifier name baseClause interfaceClause declarations = Declaration.Class [modifier] name [baseClause, interfaceClause] declarations
 
-interfaceDeclaration :: Assignment Term
+interfaceDeclaration :: Assignment (Term Loc)
 interfaceDeclaration = makeTerm <$> symbol InterfaceDeclaration <*> children (Syntax.InterfaceDeclaration <$> term name <*> (term interfaceBaseClause <|> emptyTerm) <*> manyTerm interfaceMemberDeclaration)
 
-interfaceBaseClause :: Assignment Term
+interfaceBaseClause :: Assignment (Term Loc)
 interfaceBaseClause = makeTerm <$> symbol InterfaceBaseClause <*> children (Syntax.InterfaceBaseClause <$> someTerm qualifiedName)
 
-interfaceMemberDeclaration :: Assignment Term
+interfaceMemberDeclaration :: Assignment (Term Loc)
 interfaceMemberDeclaration = methodDeclaration <|> classConstDeclaration
 
-traitDeclaration :: Assignment Term
+traitDeclaration :: Assignment (Term Loc)
 traitDeclaration = makeTerm <$> symbol TraitDeclaration <*> children (Syntax.TraitDeclaration <$> term name <*> manyTerm traitMemberDeclaration)
 
-traitMemberDeclaration :: Assignment Term
+traitMemberDeclaration :: Assignment (Term Loc)
 traitMemberDeclaration = choice [
   propertyDeclaration,
   methodDeclaration,
@@ -668,119 +540,119 @@ traitMemberDeclaration = choice [
   traitUseClause
   ]
 
-propertyDeclaration :: Assignment Term
+propertyDeclaration :: Assignment (Term Loc)
 propertyDeclaration = makeTerm <$> symbol PropertyDeclaration <*> children (Syntax.PropertyDeclaration <$> term propertyModifier <*> someTerm propertyElement)
 
-propertyModifier :: Assignment Term
+propertyModifier :: Assignment (Term Loc)
 propertyModifier = (makeTerm <$> symbol PropertyModifier <*> children (Syntax.PropertyModifier <$> (term accessControlModifier <|> emptyTerm) <*> (term staticModifier <|> emptyTerm))) <|> term (makeTerm <$> symbol PropertyModifier <*> (Syntax.Identifier . Name.name <$> source))
 
-propertyElement :: Assignment Term
+propertyElement :: Assignment (Term Loc)
 propertyElement = makeTerm <$> symbol PropertyElement <*> children (Statement.Assignment [] <$> term variableName <*> term propertyInitializer) <|> (symbol PropertyElement *> children (term variableName))
   where propertyInitializer = symbol PropertyInitializer *> children (term expression)
 
-constructorDeclaration :: Assignment Term
+constructorDeclaration :: Assignment (Term Loc)
 constructorDeclaration = makeTerm <$> symbol ConstructorDeclaration <*> children (Syntax.ConstructorDeclaration <$> someTerm methodModifier <*> parameters <*> term compoundStatement)
 
-destructorDeclaration :: Assignment Term
+destructorDeclaration :: Assignment (Term Loc)
 destructorDeclaration = makeTerm <$> symbol DestructorDeclaration <*> children (Syntax.DestructorDeclaration <$> someTerm methodModifier <*> term compoundStatement)
 
-methodModifier :: Assignment Term
+methodModifier :: Assignment (Term Loc)
 methodModifier = choice [
   accessControlModifier,
   classModifier,
   staticModifier
   ]
 
-staticModifier :: Assignment Term
+staticModifier :: Assignment (Term Loc)
 staticModifier = makeTerm <$> symbol StaticModifier <*> (Syntax.Static <$> source)
 
-classModifier :: Assignment Term
+classModifier :: Assignment (Term Loc)
 classModifier = makeTerm <$> symbol ClassModifier <*> (Syntax.ClassModifier <$> source)
 
-traitUseClause :: Assignment Term
+traitUseClause :: Assignment (Term Loc)
 traitUseClause = makeTerm <$> symbol TraitUseClause <*> children (Syntax.TraitUseClause <$> someTerm qualifiedName <*> (term traitUseSpecification <|> emptyTerm))
 
-traitUseSpecification :: Assignment Term
+traitUseSpecification :: Assignment (Term Loc)
 traitUseSpecification = makeTerm <$> symbol TraitUseSpecification <*> children (Syntax.TraitUseSpecification <$> manyTerm traitSelectAndAliasClause)
 
-traitSelectAndAliasClause :: Assignment Term
+traitSelectAndAliasClause :: Assignment (Term Loc)
 traitSelectAndAliasClause = traitSelectInsteadOfClause <|> traitAliasAsClause
 
-traitSelectInsteadOfClause :: Assignment Term
+traitSelectInsteadOfClause :: Assignment (Term Loc)
 traitSelectInsteadOfClause = makeTerm <$> symbol TraitSelectInsteadOfClause <*> children (Syntax.InsteadOf <$> term (classConstantAccessExpression <|> name) <*> term name)
 
-traitAliasAsClause :: Assignment Term
+traitAliasAsClause :: Assignment (Term Loc)
 traitAliasAsClause = makeTerm <$> symbol TraitAliasAsClause <*> children (Syntax.AliasAs <$> term (classConstantAccessExpression <|> name) <*> (term accessControlModifier <|> emptyTerm) <*> (term name <|> emptyTerm))
 
-namespaceDefinition :: Assignment Term
+namespaceDefinition :: Assignment (Term Loc)
 namespaceDefinition = makeTerm <$> symbol NamespaceDefinition <*> children (Syntax.Namespace <$> (toList <$> namespaceName' <|> pure []) <*> (term compoundStatement <|> emptyTerm))
 
-namespaceUseDeclaration :: Assignment Term
+namespaceUseDeclaration :: Assignment (Term Loc)
 namespaceUseDeclaration = makeTerm <$> symbol NamespaceUseDeclaration <*> children (Syntax.NamespaceUseDeclaration <$>
   ((mappend <$> (pure <$> (term namespaceFunctionOrConst <|> emptyTerm)) <*> someTerm namespaceUseClause) <|> ((\a b cs -> a : b : cs) <$> term namespaceFunctionOrConst <*> term namespaceName <*> someTerm namespaceUseGroupClause1) <|> ((:) <$> term namespaceName <*> someTerm namespaceUseGroupClause2)))
 
-namespaceUseClause :: Assignment Term
+namespaceUseClause :: Assignment (Term Loc)
 namespaceUseClause = makeTerm <$> symbol NamespaceUseClause <*> children (fmap Syntax.NamespaceUseClause $ (\a b -> [a, b]) <$> term qualifiedName <*> (term namespaceAliasingClause <|> emptyTerm))
 
-namespaceUseGroupClause1 :: Assignment Term
+namespaceUseGroupClause1 :: Assignment (Term Loc)
 namespaceUseGroupClause1 = makeTerm <$> symbol NamespaceUseGroupClause_1 <*> children (fmap Syntax.NamespaceUseGroupClause $ (\a b -> [a, b]) <$> term namespaceName <*> (term namespaceAliasingClause <|> emptyTerm))
 
-namespaceUseGroupClause2 :: Assignment Term
+namespaceUseGroupClause2 :: Assignment (Term Loc)
 namespaceUseGroupClause2 = makeTerm <$> symbol NamespaceUseGroupClause_2 <*> children (fmap Syntax.NamespaceUseGroupClause $ (\a b c -> [a, b, c]) <$> (term namespaceFunctionOrConst <|> emptyTerm) <*> term namespaceName <*> (term namespaceAliasingClause <|> emptyTerm))
 
-namespaceAliasingClause :: Assignment Term
+namespaceAliasingClause :: Assignment (Term Loc)
 namespaceAliasingClause = makeTerm <$> symbol NamespaceAliasingClause <*> children (Syntax.NamespaceAliasingClause <$> term name)
 
 -- | TODO Do something better than Identifier
-namespaceFunctionOrConst :: Assignment Term
+namespaceFunctionOrConst :: Assignment (Term Loc)
 namespaceFunctionOrConst = makeTerm <$> symbol NamespaceFunctionOrConst <*> (Syntax.Identifier . Name.name <$> source)
 
-globalDeclaration :: Assignment Term
+globalDeclaration :: Assignment (Term Loc)
 globalDeclaration = makeTerm <$> symbol GlobalDeclaration <*> children (Syntax.GlobalDeclaration <$> manyTerm simpleVariable')
 
-simpleVariable :: Assignment Term
+simpleVariable :: Assignment (Term Loc)
 simpleVariable = makeTerm <$> symbol SimpleVariable <*> children (Syntax.SimpleVariable <$> term (simpleVariable' <|> expression))
 
-simpleVariable' :: Assignment Term
+simpleVariable' :: Assignment (Term Loc)
 simpleVariable' = choice [simpleVariable, variableName]
 
 
-yieldExpression :: Assignment Term
+yieldExpression :: Assignment (Term Loc)
 yieldExpression = makeTerm <$> symbol YieldExpression <*> children (Statement.Yield <$> term (arrayElementInitializer <|> expression))
 
-arrayElementInitializer :: Assignment Term
+arrayElementInitializer :: Assignment (Term Loc)
 arrayElementInitializer = makeTerm <$> symbol ArrayElementInitializer <*> children (Literal.KeyValue <$> term expression <*> term expression) <|> (symbol ArrayElementInitializer *> children (term expression))
 
-includeExpression :: Assignment Term
+includeExpression :: Assignment (Term Loc)
 includeExpression = makeTerm <$> symbol IncludeExpression <*> children (Syntax.Include <$> term expression)
 
 
-includeOnceExpression :: Assignment Term
+includeOnceExpression :: Assignment (Term Loc)
 includeOnceExpression = makeTerm <$> symbol IncludeOnceExpression <*> children (Syntax.IncludeOnce <$> term expression)
 
-requireExpression :: Assignment Term
+requireExpression :: Assignment (Term Loc)
 requireExpression = makeTerm <$> symbol RequireExpression <*> children (Syntax.Require <$> term expression)
 
 
-requireOnceExpression :: Assignment Term
+requireOnceExpression :: Assignment (Term Loc)
 requireOnceExpression = makeTerm <$> symbol RequireOnceExpression <*> children (Syntax.RequireOnce <$> term expression)
 
-variableName :: Assignment Term
+variableName :: Assignment (Term Loc)
 variableName = makeTerm <$> symbol VariableName <*> children (Syntax.VariableName <$> term name)
 
-name :: Assignment Term
+name :: Assignment (Term Loc)
 name = makeTerm <$> (symbol Name <|> symbol Name') <*> (Syntax.Identifier . Name.name <$> source)
 
-functionStaticDeclaration :: Assignment Term
+functionStaticDeclaration :: Assignment (Term Loc)
 functionStaticDeclaration = makeTerm <$> symbol FunctionStaticDeclaration <*> children (Declaration.VariableDeclaration <$> manyTerm staticVariableDeclaration)
 
-staticVariableDeclaration :: Assignment Term
+staticVariableDeclaration :: Assignment (Term Loc)
 staticVariableDeclaration = makeTerm <$> symbol StaticVariableDeclaration <*> children (Statement.Assignment [] <$> term variableName <*> (term expression <|> emptyTerm))
 
-comment :: Assignment Term
+comment :: Assignment (Term Loc)
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
-string :: Assignment Term
+string :: Assignment (Term Loc)
 string = makeTerm <$> (symbol Grammar.String <|> symbol Heredoc) <*> (Literal.TextElement <$> source)
 
 
@@ -792,25 +664,25 @@ append x xs = xs <> [x]
 bookend :: a -> [a] -> a -> [a]
 bookend head_ list last_ = head_ : append last_ list
 
-term :: Assignment Term -> Assignment Term
+term :: Assignment (Term Loc) -> Assignment (Term Loc)
 term term = contextualize (comment <|> textInterpolation) (postContextualize (comment <|> textInterpolation) term)
 
-commentedTerm :: Assignment Term -> Assignment Term
+commentedTerm :: Assignment (Term Loc) -> Assignment (Term Loc)
 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 Term -> Assignment [Term]
+manyTerm :: Assignment (Term Loc) -> Assignment [Term Loc]
 manyTerm = many . commentedTerm
 
-someTerm :: Assignment Term -> Assignment [Term]
+someTerm :: Assignment (Term Loc) -> Assignment [Term Loc]
 someTerm = fmap NonEmpty.toList . someTerm'
 
-someTerm' :: Assignment Term -> Assignment (NonEmpty Term)
+someTerm' :: Assignment (Term Loc) -> Assignment (NonEmpty (Term Loc))
 someTerm' = NonEmpty.some1 . commentedTerm
 
 -- | Match infix terms separated by any of a list of operators, assigning any comments following each operand.
-infixTerm :: Assignment Term
-          -> Assignment Term
-          -> [Assignment (Term -> Term -> Sum Syntax Term)]
-          -> Assignment (Sum Syntax Term)
+infixTerm :: Assignment (Term Loc)
+          -> Assignment (Term Loc)
+          -> [Assignment (Term Loc -> Term Loc -> Sum PHP.Syntax (Term Loc))]
+          -> Assignment (Sum PHP.Syntax (Term Loc))
 infixTerm = infixContext (comment <|> textInterpolation)

src/Language/PHP/Term.hs

@@ -0,0 +1,194 @@
+{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies #-}
+module Language.PHP.Term
+( Syntax
+, Term(..)
+) where
+
+import Control.Lens.Lens
+import Data.Abstract.Declarations
+import Data.Abstract.FreeVariables
+import Data.Aeson (ToJSON)
+import Data.Bifunctor
+import Data.Bitraversable
+import Data.Coerce
+import Data.Foldable (fold)
+import Data.Functor.Foldable (Base, Recursive(..))
+import Data.Graph.ControlFlowVertex (VertexDeclaration(..), toVertex1)
+import qualified Data.Sum as Sum
+import qualified Data.Syntax as Syntax
+import qualified Data.Syntax.Comment as Comment
+import qualified Data.Syntax.Declaration as Declaration
+import qualified Data.Syntax.Expression as Expression
+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 Data.Traversable
+import Diffing.Interpreter
+import qualified Language.PHP.Syntax as Syntax
+import Source.Loc
+import Source.Span
+
+type Syntax =
+  [ Comment.Comment
+  , Declaration.Class
+  , Declaration.Function
+  , Declaration.Method
+  , Declaration.VariableDeclaration
+  , Expression.Plus
+  , Expression.Minus
+  , Expression.Times
+  , Expression.DividedBy
+  , Expression.Modulo
+  , Expression.Power
+  , Expression.Negate
+  , Expression.FloorDivision
+  , Expression.BAnd
+  , Expression.BOr
+  , Expression.BXOr
+  , Expression.LShift
+  , Expression.RShift
+  , Expression.And
+  , Expression.Not
+  , Expression.Or
+  , Expression.XOr
+  , Expression.Call
+  , Expression.Cast
+  , Expression.LessThan
+  , Expression.LessThanEqual
+  , Expression.GreaterThan
+  , Expression.GreaterThanEqual
+  , Expression.Equal
+  , Expression.StrictEqual
+  , Expression.Comparison
+  , Expression.InstanceOf
+  , Expression.MemberAccess
+  , Expression.New
+  , Expression.SequenceExpression
+  , Expression.Subscript
+  , Expression.Member
+  , Literal.Array
+  , Literal.Float
+  , Literal.Integer
+  , Literal.KeyValue
+  , Literal.TextElement
+  , Statement.Assignment
+  , Statement.Break
+  , Statement.Catch
+  , Statement.Continue
+  , Statement.DoWhile
+  , Statement.Else
+  , Statement.Finally
+  , Statement.For
+  , Statement.ForEach
+  , Statement.Goto
+  , Statement.If
+  , Statement.Match
+  , Statement.Pattern
+  , Statement.Return
+  , Statement.Statements
+  , Statement.Throw
+  , Statement.Try
+  , Statement.While
+  , Statement.Yield
+  , Syntax.AliasAs
+  , Syntax.ArrayElement
+  , Syntax.BaseTypeDeclaration
+  , Syntax.CastType
+  , Syntax.ClassBaseClause
+  , Syntax.ClassConstDeclaration
+  , Syntax.ClassInterfaceClause
+  , Syntax.ClassModifier
+  , Syntax.Clone
+  , Syntax.ConstDeclaration
+  , Syntax.ConstructorDeclaration
+  , Syntax.Context
+  , Syntax.Declare
+  , Syntax.DeclareDirective
+  , Syntax.DestructorDeclaration
+  , Syntax.Echo
+  , Syntax.Empty
+  , Syntax.EmptyIntrinsic
+  , Syntax.Error
+  , Syntax.ErrorControl
+  , Syntax.EvalIntrinsic
+  , Syntax.ExitIntrinsic
+  , Syntax.GlobalDeclaration
+  , Syntax.Identifier
+  , Syntax.Include
+  , Syntax.IncludeOnce
+  , Syntax.InsteadOf
+  , Syntax.InterfaceBaseClause
+  , Syntax.InterfaceDeclaration
+  , Syntax.IssetIntrinsic
+  , Syntax.LabeledStatement
+  , Syntax.Namespace
+  , Syntax.NamespaceAliasingClause
+  , Syntax.NamespaceName
+  , Syntax.NamespaceUseClause
+  , Syntax.NamespaceUseDeclaration
+  , Syntax.NamespaceUseGroupClause
+  , Syntax.NewVariable
+  , Syntax.PrintIntrinsic
+  , Syntax.PropertyDeclaration
+  , Syntax.PropertyModifier
+  , Syntax.QualifiedName
+  , Syntax.RelativeScope
+  , Syntax.Require
+  , Syntax.RequireOnce
+  , Syntax.ReturnType
+  , Syntax.ScalarType
+  , Syntax.ShellCommand
+  , Syntax.Concat
+  , Syntax.SimpleVariable
+  , Syntax.Static
+  , Syntax.Text
+  , Syntax.TraitDeclaration
+  , Syntax.TraitUseClause
+  , Syntax.TraitUseSpecification
+  , Syntax.TypeDeclaration
+  , Syntax.Unset
+  , Syntax.Update
+  , Syntax.UseClause
+  , Syntax.VariableName
+  , Type.Annotation
+  , []
+  ]
+
+
+newtype Term ann = Term { getTerm :: Term.TermF (Sum.Sum Syntax) ann (Term ann) }
+  deriving (Eq, Declarations, FreeVariables, Ord, Show, ToJSON)
+
+instance Term.IsTerm Term where
+  type Syntax Term = Sum.Sum Syntax
+  toTermF = coerce
+  fromTermF = coerce
+
+instance Foldable Term where
+  foldMap = foldMapDefault
+
+instance Functor Term where
+  fmap = fmapDefault
+
+instance Traversable Term where
+  traverse f = go where go = fmap Term . bitraverse f go . getTerm
+
+instance VertexDeclaration Term where
+  toVertex info (Term (Term.In ann syntax)) = toVertex1 ann info syntax
+
+instance Syntax.HasErrors Term where
+  getErrors = cata $ \ (Term.In Loc{..} syntax) ->
+    maybe (fold syntax) (pure . Syntax.unError span) (Sum.project syntax)
+
+
+instance DiffTerms Term where
+  diffTermPair = diffTermPair . bimap (cata Term.Term) (cata Term.Term)
+
+type instance Base (Term ann) = Term.TermF (Sum.Sum Syntax) ann
+
+instance Recursive (Term ann) where
+  project = getTerm
+
+instance HasSpan ann => HasSpan (Term ann) where
+  span_ = inner.span_ where inner = lens getTerm (\t i -> t { getTerm = i })
+  {-# INLINE span_ #-}

src/Language/Python/Assignment.hs

@@ -1,10 +1,9 @@
-{-# LANGUAGE DataKinds, RankNTypes, TypeOperators #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-} -- FIXME
+{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators #-}
 module Language.Python.Assignment
 ( assignment
-, Syntax
+, Python.Syntax
 , Grammar
-, Term
+, Python.Term(..)
 ) where
 
 import           Assigning.Assignment hiding (Assignment, Error)
@@ -31,104 +30,21 @@ import qualified Data.Syntax.Expression as Expression
 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           Language.Python.Syntax as Python.Syntax
+import           Language.Python.Term as Python
 import           Prologue
 import           TreeSitter.Python as Grammar
 
-
--- | The type of Python syntax.
-type Syntax =
-  '[ Comment.Comment
-   , Declaration.Class
-   , Declaration.Comprehension
-   , Declaration.Decorator
-   , Declaration.Function
-   , Declaration.RequiredParameter
-   , Expression.Plus
-   , Expression.Minus
-   , Expression.Times
-   , Expression.DividedBy
-   , Expression.Modulo
-   , Expression.Power
-   , Expression.Negate
-   , Expression.FloorDivision
-   , Expression.And
-   , Expression.Not
-   , Expression.Or
-   , Expression.XOr
-   , Expression.BAnd
-   , Expression.BOr
-   , Expression.BXOr
-   , Expression.LShift
-   , Expression.RShift
-   , Expression.Complement
-   , Expression.Call
-   , Expression.LessThan
-   , Expression.LessThanEqual
-   , Expression.GreaterThan
-   , Expression.GreaterThanEqual
-   , Expression.Equal
-   , Expression.StrictEqual
-   , Expression.Comparison
-   , Expression.Enumeration
-   , Expression.ScopeResolution
-   , Expression.MemberAccess
-   , Expression.Subscript
-   , Expression.Member
-   , Literal.Array
-   , Literal.Boolean
-   , Literal.Float
-   , Literal.Hash
-   , Literal.Integer
-   , Literal.KeyValue
-   , Literal.Null
-   , Literal.Set
-   , Literal.String
-   , Literal.TextElement
-   , Literal.Tuple
-   , Python.Syntax.Alias
-   , Python.Syntax.Ellipsis
-   , Python.Syntax.FutureImport
-   , Python.Syntax.Import
-   , Python.Syntax.QualifiedImport
-   , Python.Syntax.QualifiedAliasedImport
-   , Python.Syntax.Redirect
-   , Statement.Assignment
-   , Statement.Break
-   , Statement.Catch
-   , Statement.Continue
-   , Statement.Else
-   , Statement.Finally
-   , Statement.ForEach
-   , Statement.If
-   , Statement.Let
-   , Statement.NoOp
-   , Statement.Return
-   , Statement.Statements
-   , Statement.Throw
-   , Statement.Try
-   , Statement.While
-   , Statement.Yield
-   , Syntax.Context
-   , Syntax.Empty
-   , Syntax.Error
-   , Syntax.Identifier
-   , Type.Annotation
-   , []
-   ]
-
-type Term = Term.Term (Sum Syntax) Loc
 type Assignment = Assignment.Assignment [] Grammar
 
 -- | Assignment from AST in Python's grammar onto a program in Python's syntax.
-assignment :: Assignment Term
+assignment :: Assignment (Term Loc)
 assignment = handleError $ makeTerm <$> symbol Module <*> children (Statement.Statements <$> manyTerm expression) <|> parseError
 
-expression :: Assignment Term
+expression :: Assignment (Term Loc)
 expression = handleError (choice expressionChoices)
 
-expressionChoices :: [Assignment Term]
+expressionChoices :: [Assignment (Term Loc)]
 expressionChoices =
   -- Long-term, can we de/serialize assignments and avoid paying the cost of construction altogether?
   [ argumentList
@@ -196,34 +112,34 @@ expressionChoices =
   , yield
   ]
 
-expressions :: Assignment Term
+expressions :: Assignment (Term Loc)
 expressions = makeTerm'' <$> location <*> manyTerm expression
 
-block :: Assignment Term
+block :: Assignment (Term Loc)
 block = symbol Block *> children (makeTerm'' <$> location <*> manyTerm expression)
 
-block' :: Assignment Term
+block' :: Assignment (Term Loc)
 block' = symbol Block *> children (makeTerm <$> location <*> manyTerm expression)
 
-expressionStatement :: Assignment Term
+expressionStatement :: Assignment (Term Loc)
 expressionStatement = makeTerm'' <$> symbol ExpressionStatement <*> children (someTerm expression)
 
-expressionList :: Assignment Term
+expressionList :: Assignment (Term Loc)
 expressionList = makeTerm'' <$> symbol ExpressionList <*> children (someTerm expression)
 
-listSplat :: Assignment Term
+listSplat :: Assignment (Term Loc)
 listSplat = makeTerm <$> symbol ListSplat <*> (Syntax.Identifier . name <$> source)
 
-dictionarySplat :: Assignment Term
+dictionarySplat :: Assignment (Term Loc)
 dictionarySplat = makeTerm <$> symbol DictionarySplat <*> (Syntax.Identifier . name <$> source)
 
-keywordArgument :: Assignment Term
+keywordArgument :: Assignment (Term Loc)
 keywordArgument = makeTerm <$> symbol KeywordArgument <*> children (Statement.Assignment [] <$> term expression <*> term expression)
 
-parenthesizedExpression :: Assignment Term
+parenthesizedExpression :: Assignment (Term Loc)
 parenthesizedExpression = symbol ParenthesizedExpression *> children expressions
 
-parameter :: Assignment Term
+parameter :: Assignment (Term Loc)
 parameter =  makeTerm <$> symbol DefaultParameter <*> children (Statement.Assignment [] <$> term expression <*> term expression)
          <|> makeTerm <$> symbol TypedParameter <*> children (Type.Annotation <$> term expression <*> term type')
          <|> makeAnnotation <$> symbol TypedDefaultParameter <*> children ((,,) <$> term expression <*> term expression <*> term expression)
@@ -231,45 +147,45 @@ parameter =  makeTerm <$> symbol DefaultParameter <*> children (Statement.Assign
     makeAnnotation loc (identifier', type', value') = makeTerm loc (Type.Annotation (makeAssignment loc identifier' value') type')
     makeAssignment loc identifier' value' = makeTerm loc (Statement.Assignment [] identifier' value')
 
-decoratedDefinition :: Assignment Term
+decoratedDefinition :: Assignment (Term Loc)
 decoratedDefinition = symbol DecoratedDefinition *> children (term decorator)
   where
     decorator = makeTerm <$> symbol Decorator <*> (children (Declaration.Decorator <$> term expression <*> manyTerm expression) <*> term (decorator <|> functionDefinition <|> classDefinition))
 
-argumentList :: Assignment Term
+argumentList :: Assignment (Term Loc)
 argumentList = symbol ArgumentList *> children expressions
 
-withStatement :: Assignment Term
+withStatement :: Assignment (Term Loc)
 withStatement = symbol WithStatement *> children (flip (foldr make) <$> some withItem <*> term block')
   where
     make (val, name) = makeTerm1 . Statement.Let name val
     withItem = symbol WithItem *> children ((,) <$> term expression <*> term (expression <|> emptyTerm))
 
-forStatement :: Assignment Term
+forStatement :: Assignment (Term Loc)
 forStatement = symbol ForStatement >>= \ loc -> children (make loc <$> (symbol Variables *> children expressions) <*> term expressionList <*> term block' <*> optional (symbol ElseClause *> children expressions))
   where
     make loc binding subject body forElseClause = case forElseClause of
       Nothing -> makeTerm loc (Statement.ForEach binding subject body)
       Just a -> makeTerm loc (Statement.Else (makeTerm loc $ Statement.ForEach binding subject body) a)
 
-whileStatement :: Assignment Term
+whileStatement :: Assignment (Term Loc)
 whileStatement = symbol WhileStatement >>= \ loc -> children (make loc <$> term expression <*> term block <*> optional (symbol ElseClause *> children expressions))
   where
     make loc whileCondition whileBody whileElseClause = case whileElseClause of
       Nothing -> makeTerm loc (Statement.While whileCondition whileBody)
       Just a -> makeTerm loc (Statement.Else (makeTerm loc $ Statement.While whileCondition whileBody) a)
 
-tryStatement :: Assignment Term
+tryStatement :: Assignment (Term Loc)
 tryStatement = makeTerm <$> symbol TryStatement <*> children (Statement.Try <$> term block <*> manyTerm (expression <|> elseClause))
   where elseClause = makeTerm <$> symbol ElseClause <*> children (Statement.Else <$> emptyTerm <*> term block)
 
-exceptClause :: Assignment Term
+exceptClause :: Assignment (Term Loc)
 exceptClause = makeTerm <$> symbol ExceptClause <*> children
   (Statement.Catch <$> term ((makeTerm <$> location <*> (uncurry (flip Statement.Let) <$> ((,) <$> term expression <* symbol AnonAs <*> term expression) <*> emptyTerm))
                       <|> expressions)
                    <*> expressions)
 
-functionParam :: Assignment Term
+functionParam :: Assignment (Term Loc)
 functionParam = (makeParameter <$> location <*> identifier)
   <|> tuple
   <|> parameter
@@ -277,7 +193,7 @@ functionParam = (makeParameter <$> location <*> identifier)
   <|> dictionarySplat
   where makeParameter loc term = makeTerm loc (Declaration.RequiredParameter term)
 
-functionDefinition :: Assignment Term
+functionDefinition :: Assignment (Term Loc)
 functionDefinition =
       makeFunctionDeclaration <$> symbol FunctionDefinition <*> children ((,,,) <$> term expression <* symbol Parameters <*> children (manyTerm functionParam) <*> optional (symbol Type *> children (term expression)) <*> term block')
   <|> makeFunctionDeclaration <$> (symbol Lambda' <|> symbol Lambda) <*> children ((,,,) <$ token AnonLambda <*> emptyTerm <*> (symbol LambdaParameters *> children (manyTerm expression) <|> pure []) <*> optional (symbol Type *> children (term expression)) <*> expressions')
@@ -287,22 +203,22 @@ functionDefinition =
       = let fn = makeTerm loc (Declaration.Function [] functionName' functionParameters functionBody)
         in maybe fn (makeTerm loc . Type.Annotation fn) ty
 
-classDefinition :: Assignment Term
+classDefinition :: Assignment (Term Loc)
 classDefinition = makeTerm <$> symbol ClassDefinition <*> children (Declaration.Class [] <$> term expression <*> argumentList <*> term block')
   where
     argumentList = symbol ArgumentList *> children (manyTerm expression)
                     <|> pure []
 
-type' :: Assignment Term
+type' :: Assignment (Term Loc)
 type' = symbol Type *> children (term expression)
 
-finallyClause :: Assignment Term
+finallyClause :: Assignment (Term Loc)
 finallyClause = makeTerm <$> symbol FinallyClause <*> children (Statement.Finally <$> expressions)
 
-ellipsis :: Assignment Term
+ellipsis :: Assignment (Term Loc)
 ellipsis = makeTerm <$> token Grammar.Ellipsis <*> pure Python.Syntax.Ellipsis
 
-comparisonOperator :: Assignment Term
+comparisonOperator :: Assignment (Term Loc)
 comparisonOperator = symbol ComparisonOperator *> children (expression `chainl1Term` choice
   [ (makeTerm1 .) . Expression.LessThan         <$ token AnonLAngle
   , (makeTerm1 .) . Expression.LessThanEqual    <$ token AnonLAngleEqual
@@ -317,19 +233,19 @@ comparisonOperator = symbol ComparisonOperator *> children (expression `chainl1T
   ])
   where invert cons a b = Expression.Not (makeTerm1 (cons a b))
 
-notOperator :: Assignment Term
+notOperator :: Assignment (Term Loc)
 notOperator = makeTerm <$> symbol NotOperator <*> children (Expression.Not <$> term expression)
 
-tuple :: Assignment Term
+tuple :: Assignment (Term Loc)
 tuple = makeTerm <$> symbol Tuple <*> children (Literal.Tuple <$> manyTerm expression)
 
-unaryOperator :: Assignment Term
+unaryOperator :: Assignment (Term Loc)
 unaryOperator = symbol UnaryOperator >>= \ location -> arithmetic location <|> bitwise location <|> children ( symbol AnonPlus *> term expression )
   where
     arithmetic location = makeTerm location . Expression.Negate <$> children ( symbol AnonMinus *> term expression )
     bitwise location    = makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> term expression )
 
-binaryOperator :: Assignment Term
+binaryOperator :: Assignment (Term Loc)
 binaryOperator = makeTerm' <$> symbol BinaryOperator <*> children (infixTerm expression (term expression)
   [ (inject .) . Expression.Plus      <$ symbol AnonPlus
   , (inject .) . Expression.Minus     <$ symbol AnonMinus
@@ -346,13 +262,13 @@ binaryOperator = makeTerm' <$> symbol BinaryOperator <*> children (infixTerm exp
   , (inject .) . Expression.RShift    <$ symbol AnonRAngleRAngle
   ])
 
-booleanOperator :: Assignment Term
+booleanOperator :: Assignment (Term Loc)
 booleanOperator = makeTerm' <$> symbol BooleanOperator <*> children (infixTerm expression (term expression)
   [ (inject .) . Expression.And <$ symbol AnonAnd
   , (inject .) . Expression.Or  <$ symbol AnonOr
   ])
 
-assignment' :: Assignment Term
+assignment' :: Assignment (Term Loc)
 assignment' =  makeAssignment <$> symbol Assignment <*> children ((,,) <$> term expressionList <*> optional (symbol Type *> children (term expression)) <*> term rvalue)
            <|> makeTerm' <$> symbol AugmentedAssignment <*> children (infixTerm expressionList (term rvalue)
                   [ assign Expression.Plus      <$ symbol AnonPlusEqual
@@ -371,43 +287,43 @@ assignment' =  makeAssignment <$> symbol Assignment <*> children ((,,) <$> term
                   ])
   where rvalue = expressionList <|> assignment' <|> yield <|> emptyTerm
         makeAssignment loc (lhs, maybeType, rhs) = makeTerm loc (Statement.Assignment (maybeToList maybeType) lhs rhs)
-        assign :: (f :< Syntax) => (Term -> Term -> f Term) -> Term -> Term -> Sum Syntax Term
+        assign :: (f :< Python.Syntax) => (Term Loc -> Term Loc -> f (Term Loc)) -> Term Loc -> Term Loc -> Sum Python.Syntax (Term Loc)
         assign c l r = inject (Statement.Assignment [] l (makeTerm1 (c l r)))
 
-yield :: Assignment Term
+yield :: Assignment (Term Loc)
 yield = makeTerm <$> symbol Yield <*> (Statement.Yield <$> children (term ( expression <|> emptyTerm )))
 
-identifier :: Assignment Term
+identifier :: Assignment (Term Loc)
 identifier = makeTerm <$> (symbol Identifier <|> symbol DottedName) <*> (Syntax.Identifier . name <$> source)
 
-set :: Assignment Term
+set :: Assignment (Term Loc)
 set = makeTerm <$> symbol Set <*> children (Literal.Set <$> manyTerm expression)
 
-dictionary :: Assignment Term
+dictionary :: Assignment (Term Loc)
 dictionary = makeTerm <$> symbol Dictionary <*> children (Literal.Hash <$> manyTerm expression)
 
-pair :: Assignment Term
+pair :: Assignment (Term Loc)
 pair = makeTerm' <$> symbol Pair <*> children (infixTerm expression (term expression) [ (inject .) . Literal.KeyValue <$ symbol AnonColon ])
 
-list' :: Assignment Term
+list' :: Assignment (Term Loc)
 list' = makeTerm <$> symbol List <*> children (Literal.Array <$> manyTerm expression)
 
-string :: Assignment Term
+string :: Assignment (Term Loc)
 string = makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
 
-concatenatedString :: Assignment Term
+concatenatedString :: Assignment (Term Loc)
 concatenatedString = makeTerm <$> symbol ConcatenatedString <*> children (manyTerm string)
 
-float :: Assignment Term
+float :: Assignment (Term Loc)
 float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
 
-integer :: Assignment Term
+integer :: Assignment (Term Loc)
 integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> source)
 
-comment :: Assignment Term
+comment :: Assignment (Term Loc)
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
-import' :: Assignment Term
+import' :: Assignment (Term Loc)
 import' =   makeTerm'' <$> symbol ImportStatement <*> children (manyTerm (aliasedImport <|> plainImport))
         <|> makeTerm <$> symbol ImportFromStatement <*> children (Python.Syntax.Import <$> importPath <*> (wildcard <|> some (aliasImportSymbol <|> importSymbol)))
         <|> makeTerm <$> symbol FutureImportStatement <*> children (Python.Syntax.FutureImport <$> some (aliasImportSymbol <|> importSymbol))
@@ -432,10 +348,10 @@ import' =   makeTerm'' <$> symbol ImportStatement <*> children (manyTerm (aliase
     makeNameAliasPair location alias = makeTerm location (Python.Syntax.Alias alias alias)
     mkIdentifier location source = makeTerm location (Syntax.Identifier (name source))
 
-assertStatement :: Assignment Term
+assertStatement :: Assignment (Term Loc)
 assertStatement = makeTerm <$> symbol AssertStatement <*> children (Expression.Call [] <$> (makeTerm <$> symbol AnonAssert <*> (Syntax.Identifier . name <$> source)) <*> manyTerm expression <*> emptyTerm)
 
-printStatement :: Assignment Term
+printStatement :: Assignment (Term Loc)
 printStatement = do
   location <- symbol PrintStatement
   children $ do
@@ -446,26 +362,26 @@ printStatement = do
     redirectCallTerm location identifier = makeTerm location <$ symbol Chevron <*> (flip Python.Syntax.Redirect <$> children (term expression) <*> term (printCallTerm location identifier))
     printCallTerm location identifier = makeTerm location <$> (Expression.Call [] identifier <$> manyTerm expression <*> emptyTerm)
 
-nonlocalStatement :: Assignment Term
+nonlocalStatement :: Assignment (Term Loc)
 nonlocalStatement = makeTerm <$> symbol NonlocalStatement <*> children (Expression.Call [] <$> term (makeTerm <$> symbol AnonNonlocal <*> (Syntax.Identifier . name <$> source)) <*> manyTerm expression <*> emptyTerm)
 
-globalStatement :: Assignment Term
+globalStatement :: Assignment (Term Loc)
 globalStatement = makeTerm <$> symbol GlobalStatement <*> children (Expression.Call [] <$> term (makeTerm <$> symbol AnonGlobal <*> (Syntax.Identifier . name <$> source)) <*> manyTerm expression <*> emptyTerm)
 
-await :: Assignment Term
+await :: Assignment (Term Loc)
 await = makeTerm <$> symbol Await <*> children (Expression.Call [] <$> term (makeTerm <$> symbol AnonAwait <*> (Syntax.Identifier . name <$> source)) <*> manyTerm expression <*> emptyTerm)
 
-returnStatement :: Assignment Term
+returnStatement :: Assignment (Term Loc)
 returnStatement = makeTerm <$> symbol ReturnStatement <*> children (Statement.Return <$> term (expressionList <|> emptyTerm))
 
-deleteStatement :: Assignment Term
+deleteStatement :: Assignment (Term Loc)
 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 Term
+raiseStatement :: Assignment (Term Loc)
 raiseStatement = makeTerm <$> symbol RaiseStatement <*> children (Statement.Throw <$> expressions)
 
-ifStatement :: Assignment Term
+ifStatement :: Assignment (Term Loc)
 ifStatement = makeTerm <$> symbol IfStatement <*> children if'
   where
     if' = Statement.If <$> term expression <*> thenClause <*> (elseClause <|> emptyTerm)
@@ -474,86 +390,86 @@ ifStatement = makeTerm <$> symbol IfStatement <*> children if'
     elif = makeTerm <$> symbol ElifClause <*> children if'
     else' = symbol ElseClause *> children expressions
 
-execStatement :: Assignment Term
+execStatement :: Assignment (Term Loc)
 execStatement = makeTerm <$> symbol ExecStatement <*> children (Expression.Call [] <$> term (makeTerm <$> location <*> (Syntax.Identifier . name <$> source)) <*> manyTerm (string <|> expression) <*> emptyTerm)
 
-passStatement :: Assignment Term
+passStatement :: Assignment (Term Loc)
 passStatement = makeTerm <$> symbol PassStatement <*> (Statement.NoOp <$> emptyTerm <* advance)
 
-breakStatement :: Assignment Term
+breakStatement :: Assignment (Term Loc)
 breakStatement = makeTerm <$> symbol BreakStatement <*> (Statement.Break <$> emptyTerm <* advance)
 
-continueStatement :: Assignment Term
+continueStatement :: Assignment (Term Loc)
 continueStatement = makeTerm <$> symbol ContinueStatement <*> (Statement.Continue <$> emptyTerm <* advance)
 
-memberAccess :: Assignment Term
+memberAccess :: Assignment (Term Loc)
 memberAccess = makeTerm <$> symbol Attribute <*> children (Expression.MemberAccess <$> term expression <*> identifier)
 
-subscript :: Assignment Term
+subscript :: Assignment (Term Loc)
 subscript = makeTerm <$> symbol Subscript <*> children (Expression.Subscript <$> term expression <*> manyTerm expression)
 
-slice :: Assignment Term
+slice :: Assignment (Term Loc)
 slice = makeTerm <$> symbol Slice <*> children
   (Expression.Enumeration <$> ((emptyTerm <* token AnonColon) <|> (term expression <* token AnonColon))
                           <*> ((emptyTerm <* token AnonColon) <|> (term expression <* token AnonColon) <|> (term expression <|> emptyTerm))
                           <*> (term expression <|> emptyTerm))
 
-call :: Assignment Term
+call :: Assignment (Term Loc)
 call = makeTerm <$> symbol Call <*> children (Expression.Call [] <$> term (identifier <|> expression) <*> (symbol ArgumentList *> children (manyTerm expression) <|> someTerm comprehension) <*> emptyTerm)
 
-boolean :: Assignment Term
+boolean :: Assignment (Term Loc)
 boolean =  makeTerm <$> token Grammar.True <*> pure Literal.true
        <|> makeTerm <$> token Grammar.False <*> pure Literal.false
 
-none :: Assignment Term
+none :: Assignment (Term Loc)
 none = makeTerm <$> symbol None <*> (Literal.Null <$ rawSource)
 
-comprehension :: Assignment Term
+comprehension :: Assignment (Term Loc)
 comprehension =  makeTerm <$> symbol ListComprehension       <*> children (Declaration.Comprehension <$> term expression <*> expressions)
              <|> makeTerm <$> symbol GeneratorExpression     <*> children (Declaration.Comprehension <$> term expression <*> expressions)
              <|> makeTerm <$> symbol SetComprehension        <*> children (Declaration.Comprehension <$> term expression <*> expressions)
              <|> makeTerm <$> symbol DictionaryComprehension <*> children (Declaration.Comprehension <$> term expression <*> expressions)
 
-forInClause :: Assignment Term
+forInClause :: Assignment (Term Loc)
 forInClause = symbol ForInClause *> children expressions
 
-variables :: Assignment Term
+variables :: Assignment (Term Loc)
 variables = symbol Variables *> children expressions
 
-ifClause :: Assignment Term
+ifClause :: Assignment (Term Loc)
 ifClause = symbol IfClause *> children expressions
 
-conditionalExpression :: Assignment Term
+conditionalExpression :: Assignment (Term Loc)
 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 Term -> Assignment [Term]
+manyTerm :: Assignment (Term Loc) -> Assignment [Term Loc]
 manyTerm term = many (contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm))
 
-someTerm :: Assignment Term -> Assignment [Term]
+someTerm :: Assignment (Term Loc) -> Assignment [Term Loc]
 someTerm term = some (contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm))
 
-term :: Assignment Term -> Assignment Term
+term :: Assignment (Term Loc) -> Assignment (Term Loc)
 term term = contextualize comment (postContextualize comment term)
 
-term' :: Assignment Term -> Assignment Term
+term' :: Assignment (Term Loc) -> Assignment (Term Loc)
 term' term = contextualize comment' (postContextualize comment' term)
   where comment' = choice [ comment, symbol AnonLambda *> empty ]
 
 -- | Match a left-associated infix chain of terms, optionally followed by comments. Like 'chainl1' but assigning comment nodes automatically.
-chainl1Term :: Assignment Term -> Assignment (Term -> Term -> Term) -> Assignment Term
+chainl1Term :: Assignment (Term Loc) -> Assignment (Term Loc -> Term Loc -> Term Loc) -> Assignment (Term Loc)
 chainl1Term expr op = term' expr `chainl1` op
 
 -- | Match a series of terms or comments until a delimiter is matched.
-manyTermsTill :: Assignment Term -> Assignment b -> Assignment [Term]
+manyTermsTill :: Assignment (Term Loc) -> Assignment b -> Assignment [Term Loc]
 manyTermsTill step end = manyTill (step <|> comment) end
 
 -- | Match infix terms separated by any of a list of operators, assigning any comments following each operand.
-infixTerm :: Assignment Term
-          -> Assignment Term
-          -> [Assignment (Term -> Term -> Sum Syntax Term)]
-          -> Assignment (Sum Syntax Term)
+infixTerm :: Assignment (Term Loc)
+          -> Assignment (Term Loc)
+          -> [Assignment (Term Loc -> Term Loc -> Sum Python.Syntax (Term Loc))]
+          -> Assignment (Sum Python.Syntax (Term Loc))
 infixTerm = infixContext comment

src/Language/Python/Term.hs

@@ -0,0 +1,148 @@
+{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies #-}
+module Language.Python.Term
+( Syntax
+, Term(..)
+) where
+
+import Control.Lens.Lens
+import Data.Abstract.Declarations
+import Data.Abstract.FreeVariables
+import Data.Aeson (ToJSON)
+import Data.Bifunctor
+import Data.Bitraversable
+import Data.Coerce
+import Data.Foldable (fold)
+import Data.Functor.Foldable (Base, Recursive(..))
+import Data.Graph.ControlFlowVertex (VertexDeclaration(..), toVertex1)
+import qualified Data.Sum as Sum
+import qualified Data.Syntax as Syntax
+import qualified Data.Syntax.Comment as Comment
+import qualified Data.Syntax.Declaration as Declaration
+import qualified Data.Syntax.Expression as Expression
+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 Data.Traversable
+import Diffing.Interpreter
+import Language.Python.Syntax as Python.Syntax
+import Source.Loc
+import Source.Span
+
+type Syntax =
+  [ Comment.Comment
+  , Declaration.Class
+  , Declaration.Comprehension
+  , Declaration.Decorator
+  , Declaration.Function
+  , Declaration.RequiredParameter
+  , Expression.Plus
+  , Expression.Minus
+  , Expression.Times
+  , Expression.DividedBy
+  , Expression.Modulo
+  , Expression.Power
+  , Expression.Negate
+  , Expression.FloorDivision
+  , Expression.And
+  , Expression.Not
+  , Expression.Or
+  , Expression.XOr
+  , Expression.BAnd
+  , Expression.BOr
+  , Expression.BXOr
+  , Expression.LShift
+  , Expression.RShift
+  , Expression.Complement
+  , Expression.Call
+  , Expression.LessThan
+  , Expression.LessThanEqual
+  , Expression.GreaterThan
+  , Expression.GreaterThanEqual
+  , Expression.Equal
+  , Expression.StrictEqual
+  , Expression.Comparison
+  , Expression.Enumeration
+  , Expression.ScopeResolution
+  , Expression.MemberAccess
+  , Expression.Subscript
+  , Expression.Member
+  , Literal.Array
+  , Literal.Boolean
+  , Literal.Float
+  , Literal.Hash
+  , Literal.Integer
+  , Literal.KeyValue
+  , Literal.Null
+  , Literal.Set
+  , Literal.String
+  , Literal.TextElement
+  , Literal.Tuple
+  , Python.Syntax.Alias
+  , Python.Syntax.Ellipsis
+  , Python.Syntax.FutureImport
+  , Python.Syntax.Import
+  , Python.Syntax.QualifiedImport
+  , Python.Syntax.QualifiedAliasedImport
+  , Python.Syntax.Redirect
+  , Statement.Assignment
+  , Statement.Break
+  , Statement.Catch
+  , Statement.Continue
+  , Statement.Else
+  , Statement.Finally
+  , Statement.ForEach
+  , Statement.If
+  , Statement.Let
+  , Statement.NoOp
+  , Statement.Return
+  , Statement.Statements
+  , Statement.Throw
+  , Statement.Try
+  , Statement.While
+  , Statement.Yield
+  , Syntax.Context
+  , Syntax.Empty
+  , Syntax.Error
+  , Syntax.Identifier
+  , Type.Annotation
+  , []
+  ]
+
+
+newtype Term ann = Term { getTerm :: Term.TermF (Sum.Sum Syntax) ann (Term ann) }
+  deriving (Eq, Declarations, FreeVariables, Ord, Show, ToJSON)
+
+instance Term.IsTerm Term where
+  type Syntax Term = Sum.Sum Syntax
+  toTermF = coerce
+  fromTermF = coerce
+
+instance Foldable Term where
+  foldMap = foldMapDefault
+
+instance Functor Term where
+  fmap = fmapDefault
+
+instance Traversable Term where
+  traverse f = go where go = fmap Term . bitraverse f go . getTerm
+
+instance VertexDeclaration Term where
+  toVertex info (Term (Term.In ann syntax)) = toVertex1 ann info syntax
+
+instance Syntax.HasErrors Term where
+  getErrors = cata $ \ (Term.In Loc{..} syntax) ->
+    maybe (fold syntax) (pure . Syntax.unError span) (Sum.project syntax)
+
+
+instance DiffTerms Term where
+  diffTermPair = diffTermPair . bimap (cata Term.Term) (cata Term.Term)
+
+type instance Base (Term ann) = Term.TermF (Sum.Sum Syntax) ann
+
+instance Recursive (Term ann) where
+  project = getTerm
+
+instance HasSpan ann => HasSpan (Term ann) where
+  span_ = inner.span_ where inner = lens getTerm (\t i -> t { getTerm = i })
+  {-# INLINE span_ #-}

src/Language/Ruby/Assignment.hs

@@ -1,10 +1,9 @@
-{-# LANGUAGE DataKinds, RankNTypes, TypeOperators #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-} -- FIXME
+{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators #-}
 module Language.Ruby.Assignment
 ( assignment
-, Syntax
+, Ruby.Syntax
 , Grammar
-, Term
+, Ruby.Term(..)
 ) where
 
 import Prologue hiding (for, unless)
@@ -34,112 +33,20 @@ import qualified Data.Syntax.Directive as Directive
 import qualified Data.Syntax.Expression as Expression
 import qualified Data.Syntax.Literal as Literal
 import qualified Data.Syntax.Statement as Statement
-import qualified Data.Term as Term
 import qualified Language.Ruby.Syntax as Ruby.Syntax
+import           Language.Ruby.Term as Ruby
 import           TreeSitter.Ruby as Grammar
 
--- | The type of Ruby syntax.
-type Syntax = '[
-    Comment.Comment
-  , Declaration.Function
-  , Declaration.Method
-  , Directive.File
-  , Directive.Line
-  , Expression.Plus
-  , Expression.Minus
-  , Expression.Times
-  , Expression.DividedBy
-  , Expression.Modulo
-  , Expression.Power
-  , Expression.Negate
-  , Expression.FloorDivision
-  , Expression.BAnd
-  , Expression.BOr
-  , Expression.BXOr
-  , Expression.LShift
-  , Expression.RShift
-  , Expression.Complement
-  , Expression.And
-  , Expression.Not
-  , Expression.Or
-  , Expression.XOr
-  , Expression.Call
-  , Expression.LessThan
-  , Expression.LessThanEqual
-  , Expression.GreaterThan
-  , Expression.GreaterThanEqual
-  , Expression.Equal
-  , Expression.StrictEqual
-  , Expression.Comparison
-  , Expression.Enumeration
-  , Expression.Matches
-  , Expression.NotMatches
-  , Expression.MemberAccess
-  , Expression.ScopeResolution
-  , Expression.Subscript
-  , Expression.Member
-  , Expression.This
-  , Literal.Array
-  , Literal.Boolean
-  , Literal.Character
-  , Literal.Complex
-  , Literal.EscapeSequence
-  , Literal.Float
-  , Literal.Hash
-  , Literal.Integer
-  , Literal.InterpolationElement
-  , Literal.KeyValue
-  , Literal.Null
-  , Literal.Rational
-  , Literal.Regex
-  , Literal.String
-  , Literal.Symbol
-  , Literal.SymbolElement
-  , Literal.TextElement
-  , Ruby.Syntax.Assignment
-  , Statement.Break
-  , Statement.Catch
-  , Statement.Continue
-  , Statement.Else
-  , Statement.Finally
-  , Statement.ForEach
-  , Statement.If
-  , Statement.Match
-  , Statement.Pattern
-  , Statement.Retry
-  , Statement.Return
-  , Statement.ScopeEntry
-  , Statement.ScopeExit
-  , Statement.Statements
-  , Statement.Try
-  , Statement.While
-  , Statement.Yield
-  , Syntax.Context
-  , Syntax.Empty
-  , Syntax.Error
-  , Syntax.Identifier
-  , Ruby.Syntax.Class
-  , Ruby.Syntax.Load
-  , Ruby.Syntax.LowPrecedenceAnd
-  , Ruby.Syntax.LowPrecedenceOr
-  , Ruby.Syntax.Module
-  , Ruby.Syntax.Require
-  , Ruby.Syntax.Send
-  , Ruby.Syntax.ZSuper
-  , []
-  ]
-
-type Term = Term.Term (Sum Syntax) Loc
 type Assignment = Assignment.Assignment [] Grammar
 
 -- | Assignment from AST in Ruby’s grammar onto a program in Ruby’s syntax.
-assignment :: Assignment Term
+assignment :: Assignment (Term Loc)
 assignment = handleError $ makeTerm <$> symbol Program <*> children (Statement.Statements <$> many expression) <|> parseError
 
-expression :: Assignment Term
+expression :: Assignment (Term Loc)
 expression = term (handleError (choice expressionChoices))
 
-expressionChoices :: [Assignment Term]
+expressionChoices :: [Assignment (Term Loc)]
 expressionChoices =
   [ alias
   , assignment'
@@ -187,10 +94,10 @@ expressionChoices =
   where
     mk s construct = makeTerm <$> symbol s <*> children ((construct .) . fromMaybe <$> emptyTerm <*> optional (symbol ArgumentList *> children expressions))
 
-expressions :: Assignment Term
+expressions :: Assignment (Term Loc)
 expressions = makeTerm'' <$> location <*> many expression
 
-parenthesizedExpressions :: Assignment Term
+parenthesizedExpressions :: Assignment (Term Loc)
 parenthesizedExpressions = makeTerm'' <$> symbol ParenthesizedStatements <*> children (many expression)
 
 withExtendedScope :: Assignment a -> Assignment a
@@ -206,7 +113,7 @@ withNewScope inner = withExtendedScope $ do
   inner
 
 -- Looks up identifiers in the list of locals to determine vcall vs. local identifier.
-identifier :: Assignment Term
+identifier :: Assignment (Term Loc)
 identifier =
       vcallOrLocal
   <|> zsuper
@@ -234,11 +141,11 @@ identifier =
             then pure identTerm
             else pure $ makeTerm loc (Ruby.Syntax.Send Nothing (Just identTerm) [] Nothing)
 
-self :: Assignment Term
+self :: Assignment (Term Loc)
 self = makeTerm <$> symbol Self <*> (Expression.This <$ source)
 
 -- TODO: Handle interpolation in all literals that support it (strings, regexes, symbols, subshells, etc).
-literal :: Assignment Term
+literal :: Assignment (Term Loc)
 literal =
       makeTerm <$> token  Grammar.True     <*> pure Literal.true
   <|> makeTerm <$> token  Grammar.False    <*> pure Literal.false
@@ -261,47 +168,47 @@ literal =
   <|> makeTerm <$> symbol Regex <*> (Literal.Regex <$> source)
 
   where
-    string :: Assignment Term
+    string :: Assignment (Term Loc)
     string = makeTerm' <$> (symbol String <|> symbol BareString) <*>
       (children (inject . Literal.String <$> some (interpolation <|> escapeSequence)) <|> inject . Literal.TextElement <$> source)
 
-    symbol' :: Assignment Term
+    symbol' :: Assignment (Term Loc)
     symbol' = makeTerm' <$> (symbol Symbol <|> symbol Symbol' <|> symbol BareSymbol) <*>
       (children (inject . Literal.Symbol <$> some interpolation) <|> inject . Literal.SymbolElement <$> source)
 
-interpolation :: Assignment Term
+interpolation :: Assignment (Term Loc)
 interpolation = makeTerm <$> symbol Interpolation <*> children (Literal.InterpolationElement <$> expression)
 
-escapeSequence :: Assignment Term
+escapeSequence :: Assignment (Term Loc)
 escapeSequence = makeTerm <$> symbol EscapeSequence <*> (Literal.EscapeSequence <$> source)
 
-heredoc :: Assignment Term
+heredoc :: Assignment (Term Loc)
 heredoc =  makeTerm <$> symbol HeredocBeginning <*> (Literal.TextElement <$> source)
        <|> makeTerm <$> symbol HeredocBody <*> children (some (interpolation <|> escapeSequence <|> heredocEnd))
   where heredocEnd = makeTerm <$> symbol HeredocEnd <*> (Literal.TextElement <$> source)
 
-beginBlock :: Assignment Term
+beginBlock :: Assignment (Term Loc)
 beginBlock = makeTerm <$> symbol BeginBlock <*> children (Statement.ScopeEntry <$> many expression)
 
-endBlock :: Assignment Term
+endBlock :: Assignment (Term Loc)
 endBlock = makeTerm <$> symbol EndBlock <*> children (Statement.ScopeExit <$> many expression)
 
-class' :: Assignment Term
+class' :: Assignment (Term Loc)
 class' = makeTerm <$> symbol Class <*> (withNewScope . children) (Ruby.Syntax.Class <$> expression <*> optional superclass <*> expressions)
   where
-    superclass :: Assignment Term
+    superclass :: Assignment (Term Loc)
     superclass = symbol Superclass *> children expression
 
-singletonClass :: Assignment Term
+singletonClass :: Assignment (Term Loc)
 singletonClass = makeTerm <$> symbol SingletonClass <*> (withNewScope . children) (Ruby.Syntax.Class <$> expression <*> pure Nothing <*> expressions)
 
-module' :: Assignment Term
+module' :: Assignment (Term Loc)
 module' = makeTerm <$> symbol Module <*> (withNewScope . children) (Ruby.Syntax.Module <$> expression <*> many expression)
 
-scopeResolution :: Assignment Term
+scopeResolution :: Assignment (Term Loc)
 scopeResolution = makeTerm <$> symbol ScopeResolution <*> children (Expression.ScopeResolution <$> NonEmpty.some1 expression)
 
-parameter :: Assignment Term
+parameter :: Assignment (Term Loc)
 parameter = postContextualize comment (term uncontextualizedParameter)
   where
     uncontextualizedParameter =
@@ -328,40 +235,40 @@ parameter = postContextualize comment (term uncontextualizedParameter)
 publicAccessControl :: ScopeGraph.AccessControl
 publicAccessControl = ScopeGraph.Public
 
-method :: Assignment Term
+method :: Assignment (Term Loc)
 method = makeTerm <$> symbol Method <*> (withNewScope . children) (Declaration.Method [] <$> emptyTerm <*> methodSelector <*> params <*> expressions' <*> pure publicAccessControl)
   where params = symbol MethodParameters *> children (many parameter) <|> pure []
         expressions' = makeTerm <$> location <*> many expression
 
-singletonMethod :: Assignment Term
+singletonMethod :: Assignment (Term Loc)
 singletonMethod = makeTerm <$> symbol SingletonMethod <*> (withNewScope . children) (Declaration.Method [] <$> expression <*> methodSelector <*> params <*> expressions <*> pure publicAccessControl)
   where params = symbol MethodParameters *> children (many parameter) <|> pure []
 
-lambda :: Assignment Term
+lambda :: Assignment (Term Loc)
 lambda = makeTerm <$> symbol Lambda <*> (withExtendedScope . children) (
   Declaration.Function [] <$> emptyTerm
                           <*> ((symbol BlockParameters <|> symbol LambdaParameters) *> children (many parameter) <|> pure [])
                           <*> expressions)
 
-block :: Assignment Term
+block :: Assignment (Term Loc)
 block =  makeTerm <$> symbol DoBlock <*> scopedBlockChildren
      <|> makeTerm <$> symbol Block <*> scopedBlockChildren
   where scopedBlockChildren = withExtendedScope blockChildren
         blockChildren = children (Declaration.Function [] <$> emptyTerm <*> params <*> expressions)
         params = symbol BlockParameters *> children (many parameter) <|> pure []
 
-comment :: Assignment Term
+comment :: Assignment (Term Loc)
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
-alias :: Assignment Term
+alias :: Assignment (Term Loc)
 alias = makeTerm <$> symbol Alias <*> children (Expression.Call [] <$> name' <*> some expression <*> emptyTerm)
   where name' = makeTerm <$> location <*> (Syntax.Identifier . name <$> source)
 
-undef :: Assignment Term
+undef :: Assignment (Term Loc)
 undef = makeTerm <$> symbol Undef <*> children (Expression.Call [] <$> name' <*> some expression <*> emptyTerm)
   where name' = makeTerm <$> location <*> (Syntax.Identifier . name <$> source)
 
-if' :: Assignment Term
+if' :: Assignment (Term Loc)
 if' = ifElsif If
     <|> makeTerm <$> symbol IfModifier <*> children (flip Statement.If <$> expression <*> expression <*> emptyTerm)
   where
@@ -370,30 +277,30 @@ if' = ifElsif If
     expressions' = makeTerm <$> location <*> manyTermsTill expression (void (symbol Else) <|> void (symbol Elsif) <|> eof)
     else' = postContextualize comment (symbol Else *> children expressions)
 
-then' :: Assignment Term
+then' :: Assignment (Term Loc)
 then' = postContextualize comment (symbol Then *> children expressions)
 
-unless :: Assignment Term
+unless :: Assignment (Term Loc)
 unless =   makeTerm <$> symbol Unless         <*> children      (Statement.If <$> invert expression <*> expressions' <*> (else' <|> emptyTerm))
        <|> makeTerm <$> symbol UnlessModifier <*> children (flip Statement.If <$> expression <*> invert expression <*> emptyTerm)
   where expressions' = makeTerm <$> location <*> manyTermsTill expression (void (symbol Else) <|> eof)
         else' = postContextualize comment (symbol Else *> children expressions)
 
-while' :: Assignment Term
+while' :: Assignment (Term Loc)
 while' =
       makeTerm <$> symbol While         <*> children      (Statement.While <$> expression <*> expressions)
   <|> makeTerm <$> symbol WhileModifier <*> children (flip Statement.While <$> expression <*> expression)
 
-until' :: Assignment Term
+until' :: Assignment (Term Loc)
 until' =
       makeTerm <$> symbol Until         <*> children      (Statement.While <$> invert expression <*> expressions)
   <|> makeTerm <$> symbol UntilModifier <*> children (flip Statement.While <$> expression <*> invert expression)
 
-for :: Assignment Term
+for :: Assignment (Term Loc)
 for = makeTerm <$> symbol For <*> children (Statement.ForEach <$> (makeTerm <$> location <*> manyTermsTill expression (symbol In)) <*> inClause <*> expressions)
   where inClause = symbol In *> children expression
 
-case' :: Assignment Term
+case' :: Assignment (Term Loc)
 case' = makeTerm <$> symbol Case <*> children (Statement.Match <$> (symbol When *> emptyTerm <|> expression) <*> whens)
   where
     whens = makeTerm <$> location <*> many (when' <|> else' <|> expression)
@@ -401,16 +308,16 @@ case' = makeTerm <$> symbol Case <*> children (Statement.Match <$> (symbol When
     pattern' = postContextualize comment (symbol Pattern *> children ((symbol SplatArgument *> children expression) <|> expression))
     else' = postContextualize comment (symbol Else *> children expressions)
 
-subscript :: Assignment Term
+subscript :: Assignment (Term Loc)
 subscript = makeTerm <$> symbol ElementReference <*> children (Expression.Subscript <$> expression <*> many expression)
 
-pair :: Assignment Term
+pair :: Assignment (Term Loc)
 pair =   makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> expression <*> (expression <|> emptyTerm))
 
-args :: Assignment [Term]
+args :: Assignment [Term Loc]
 args = (symbol ArgumentList <|> symbol ArgumentListWithParens) *> children (many expression) <|> many expression
 
-methodCall :: Assignment Term
+methodCall :: Assignment (Term Loc)
 methodCall = makeTerm' <$> symbol MethodCall <*> children (require <|> load <|> send)
   where
     send = inject <$> ((regularCall <|> funcCall <|> scopeCall <|> dotCall) <*> optional block)
@@ -431,7 +338,7 @@ methodCall = makeTerm' <$> symbol MethodCall <*> children (require <|> load <|>
       (symbol ArgumentList <|> symbol ArgumentListWithParens) *> children (Ruby.Syntax.Load <$> expression <*> optional expression)
     nameExpression = (symbol ArgumentList <|> symbol ArgumentListWithParens) *> children expression
 
-methodSelector :: Assignment Term
+methodSelector :: Assignment (Term Loc)
 methodSelector = makeTerm <$> symbols <*> (Syntax.Identifier <$> (name <$> source))
   where
     symbols = symbol Identifier
@@ -440,12 +347,12 @@ methodSelector = makeTerm <$> symbols <*> (Syntax.Identifier <$> (name <$> sourc
           <|> symbol Setter
           <|> symbol Super -- TODO(@charliesome): super calls are *not* method calls and need to be assigned into their own syntax terms
 
-call :: Assignment Term
+call :: Assignment (Term Loc)
 call = makeTerm <$> symbol Call <*> children (
     (Ruby.Syntax.Send <$> (Just <$> term expression) <*> (Just <$> methodSelector) <*> pure [] <*> pure Nothing) <|>
     (Ruby.Syntax.Send <$> (Just <$> term expression) <*> pure Nothing <*> args <*> pure Nothing))
 
-rescue :: Assignment Term
+rescue :: Assignment (Term Loc)
 rescue =  rescue'
       <|> makeTerm <$> symbol RescueModifier <*> children (Statement.Try <$> expression <*> many (makeTerm <$> location <*> (Statement.Catch <$> expression <*> emptyTerm)))
       <|> makeTerm <$> symbol Ensure <*> children (Statement.Finally <$> expressions)
@@ -456,10 +363,10 @@ rescue =  rescue'
     ex =  makeTerm <$> symbol Exceptions <*> children (many expression)
       <|> makeTerm <$> symbol ExceptionVariable <*> children (many expression)
 
-begin :: Assignment Term
+begin :: Assignment (Term Loc)
 begin = makeTerm <$> symbol Begin <*> children (Statement.Try <$> expressions <*> many rescue)
 
-assignment' :: Assignment Term
+assignment' :: Assignment (Term Loc)
 assignment' = makeTerm  <$> symbol Assignment         <*> children (Ruby.Syntax.Assignment [] <$> lhs <*> rhs)
           <|> makeTerm' <$> symbol OperatorAssignment <*> children (infixTerm lhs expression
                 [ assign Expression.Plus      <$ symbol AnonPlusEqual
@@ -477,7 +384,7 @@ assignment' = makeTerm  <$> symbol Assignment         <*> children (Ruby.Syntax.
                 , assign Expression.BXOr      <$ symbol AnonCaretEqual
                 ])
   where
-    assign :: (f :< Syntax) => (Term -> Term -> f Term) -> Term -> Term -> Sum Syntax Term
+    assign :: (f :< Ruby.Syntax) => (Term Loc -> Term Loc -> f (Term Loc)) -> Term Loc -> Term Loc -> Sum Ruby.Syntax (Term Loc)
     assign c l r = inject (Ruby.Syntax.Assignment [] l (makeTerm1 (c l r)))
 
     lhs  = makeTerm <$> symbol LeftAssignmentList  <*> children (many expr) <|> expr
@@ -495,13 +402,13 @@ identWithLocals = do
   ident <- source
   pure (loc, ident, locals)
 
-lhsIdent :: Assignment Term
+lhsIdent :: Assignment (Term Loc)
 lhsIdent = do
   (loc, ident, locals) <- identWithLocals
   putLocals (ident : locals)
   pure $ makeTerm loc (Syntax.Identifier (name ident))
 
-unary :: Assignment Term
+unary :: Assignment (Term Loc)
 unary = symbol Unary >>= \ location ->
       makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> expression )
   <|> makeTerm location . Expression.Not <$> children ( symbol AnonBang *> expression )
@@ -511,7 +418,7 @@ unary = symbol Unary >>= \ location ->
   <|> children ( symbol AnonPlus *> expression )
 
 -- TODO: Distinguish `===` from `==` ?
-binary :: Assignment Term
+binary :: Assignment (Term Loc)
 binary = makeTerm' <$> symbol Binary <*> children (infixTerm expression expression
   [ (inject .) . Expression.Plus              <$ symbol AnonPlus
   , (inject .) . Expression.Minus             <$ (symbol AnonMinus <|> symbol AnonMinus' <|> symbol AnonMinus'')
@@ -544,30 +451,30 @@ binary = makeTerm' <$> symbol Binary <*> children (infixTerm expression expressi
   ])
   where invert cons a b = Expression.Not (makeTerm1 (cons a b))
 
-conditional :: Assignment Term
+conditional :: Assignment (Term Loc)
 conditional = makeTerm <$> symbol Conditional <*> children (Statement.If <$> expression <*> expression <*> expression)
 
-emptyStatement :: Assignment Term
+emptyStatement :: Assignment (Term Loc)
 emptyStatement = makeTerm <$> symbol EmptyStatement <*> (Syntax.Empty <$ rawSource <|> pure Syntax.Empty)
 
 
 -- Helpers
 
-invert :: Assignment Term -> Assignment Term
+invert :: Assignment (Term Loc) -> Assignment (Term Loc)
 invert term = makeTerm <$> location <*> fmap Expression.Not term
 
 -- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
-term :: Assignment Term -> Assignment Term
+term :: Assignment (Term Loc) -> Assignment (Term Loc)
 term term = contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 (comment <|> heredocEnd) <*> emptyTerm)
   where heredocEnd = makeTerm <$> symbol HeredocEnd <*> (Literal.TextElement <$> source)
 
 -- | Match a series of terms or comments until a delimiter is matched.
-manyTermsTill :: Assignment Term -> Assignment b -> Assignment [Term]
+manyTermsTill :: Assignment (Term Loc) -> Assignment b -> Assignment [Term Loc]
 manyTermsTill step end = manyTill (step <|> comment) end
 
 -- | Match infix terms separated by any of a list of operators, assigning any comments following each operand.
-infixTerm :: Assignment Term
-          -> Assignment Term
-          -> [Assignment (Term -> Term -> Sum Syntax Term)]
-          -> Assignment (Sum Syntax Term)
+infixTerm :: Assignment (Term Loc)
+          -> Assignment (Term Loc)
+          -> [Assignment (Term Loc -> Term Loc -> Sum Ruby.Syntax (Term Loc))]
+          -> Assignment (Sum Ruby.Syntax (Term Loc))
 infixTerm = infixContext comment

src/Language/Ruby/Term.hs

@@ -0,0 +1,158 @@
+{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies #-}
+module Language.Ruby.Term
+( Syntax
+, Term(..)
+) where
+
+import Control.Lens.Lens
+import Data.Abstract.Declarations
+import Data.Abstract.FreeVariables
+import Data.Aeson (ToJSON)
+import Data.Bifunctor
+import Data.Bitraversable
+import Data.Coerce
+import Data.Foldable (fold)
+import Data.Functor.Foldable (Base, Recursive(..))
+import Data.Graph.ControlFlowVertex (VertexDeclaration(..), toVertex1)
+import qualified Data.Sum as Sum
+import qualified Data.Syntax as Syntax
+import qualified Data.Syntax.Comment as Comment
+import qualified Data.Syntax.Declaration as Declaration
+import qualified Data.Syntax.Directive as Directive
+import qualified Data.Syntax.Expression as Expression
+import qualified Data.Syntax.Literal as Literal
+import qualified Data.Syntax.Statement as Statement
+import qualified Data.Term as Term
+import Data.Traversable
+import Diffing.Interpreter
+import qualified Language.Ruby.Syntax as Ruby.Syntax
+import Source.Loc
+import Source.Span
+
+type Syntax =
+  [ Comment.Comment
+  , Declaration.Function
+  , Declaration.Method
+  , Directive.File
+  , Directive.Line
+  , Expression.Plus
+  , Expression.Minus
+  , Expression.Times
+  , Expression.DividedBy
+  , Expression.Modulo
+  , Expression.Power
+  , Expression.Negate
+  , Expression.FloorDivision
+  , Expression.BAnd
+  , Expression.BOr
+  , Expression.BXOr
+  , Expression.LShift
+  , Expression.RShift
+  , Expression.Complement
+  , Expression.And
+  , Expression.Not
+  , Expression.Or
+  , Expression.XOr
+  , Expression.Call
+  , Expression.LessThan
+  , Expression.LessThanEqual
+  , Expression.GreaterThan
+  , Expression.GreaterThanEqual
+  , Expression.Equal
+  , Expression.StrictEqual
+  , Expression.Comparison
+  , Expression.Enumeration
+  , Expression.Matches
+  , Expression.NotMatches
+  , Expression.MemberAccess
+  , Expression.ScopeResolution
+  , Expression.Subscript
+  , Expression.Member
+  , Expression.This
+  , Literal.Array
+  , Literal.Boolean
+  , Literal.Character
+  , Literal.Complex
+  , Literal.EscapeSequence
+  , Literal.Float
+  , Literal.Hash
+  , Literal.Integer
+  , Literal.InterpolationElement
+  , Literal.KeyValue
+  , Literal.Null
+  , Literal.Rational
+  , Literal.Regex
+  , Literal.String
+  , Literal.Symbol
+  , Literal.SymbolElement
+  , Literal.TextElement
+  , Ruby.Syntax.Assignment
+  , Statement.Break
+  , Statement.Catch
+  , Statement.Continue
+  , Statement.Else
+  , Statement.Finally
+  , Statement.ForEach
+  , Statement.If
+  , Statement.Match
+  , Statement.Pattern
+  , Statement.Retry
+  , Statement.Return
+  , Statement.ScopeEntry
+  , Statement.ScopeExit
+  , Statement.Statements
+  , Statement.Try
+  , Statement.While
+  , Statement.Yield
+  , Syntax.Context
+  , Syntax.Empty
+  , Syntax.Error
+  , Syntax.Identifier
+  , Ruby.Syntax.Class
+  , Ruby.Syntax.Load
+  , Ruby.Syntax.LowPrecedenceAnd
+  , Ruby.Syntax.LowPrecedenceOr
+  , Ruby.Syntax.Module
+  , Ruby.Syntax.Require
+  , Ruby.Syntax.Send
+  , Ruby.Syntax.ZSuper
+  , []
+  ]
+
+
+newtype Term ann = Term { getTerm :: Term.TermF (Sum.Sum Syntax) ann (Term ann) }
+  deriving (Eq, Declarations, FreeVariables, Ord, Show, ToJSON)
+
+instance Term.IsTerm Term where
+  type Syntax Term = Sum.Sum Syntax
+  toTermF = coerce
+  fromTermF = coerce
+
+instance Foldable Term where
+  foldMap = foldMapDefault
+
+instance Functor Term where
+  fmap = fmapDefault
+
+instance Traversable Term where
+  traverse f = go where go = fmap Term . bitraverse f go . getTerm
+
+instance VertexDeclaration Term where
+  toVertex info (Term (Term.In ann syntax)) = toVertex1 ann info syntax
+
+instance Syntax.HasErrors Term where
+  getErrors = cata $ \ (Term.In Loc{..} syntax) ->
+    maybe (fold syntax) (pure . Syntax.unError span) (Sum.project syntax)
+
+
+instance DiffTerms Term where
+  diffTermPair = diffTermPair . bimap (cata Term.Term) (cata Term.Term)
+
+type instance Base (Term ann) = Term.TermF (Sum.Sum Syntax) ann
+
+instance Recursive (Term ann) where
+  project = getTerm
+
+instance HasSpan ann => HasSpan (Term ann) where
+  span_ = inner.span_ where inner = lens getTerm (\t i -> t { getTerm = i })
+  {-# INLINE span_ #-}

src/Language/TSX/Assignment.hs

@@ -1,10 +1,9 @@
-{-# LANGUAGE DataKinds, RankNTypes, TypeOperators #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-} -- FIXME
+{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators #-}
 module Language.TSX.Assignment
 ( assignment
-, Syntax
+, TSX.Syntax
 , Grammar
-, Term
+, TSX.Term(..)
 ) where
 
 import Assigning.Assignment hiding (Assignment, Error)
@@ -31,191 +30,19 @@ import qualified Data.Syntax.Expression as Expression
 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 Language.TSX.Syntax as TSX.Syntax
 import qualified Language.TypeScript.Resolution as TypeScript.Resolution
+import Language.TSX.Term as TSX
 import Prologue
 import TreeSitter.TSX as Grammar
 
--- | The type of TSX syntax.
-type Syntax = '[
-    Comment.Comment
-  , Comment.HashBang
-  , Declaration.Class
-  , Declaration.Function
-  , Declaration.Method
-  , Declaration.MethodSignature
-  , Declaration.InterfaceDeclaration
-  , Declaration.PublicFieldDefinition
-  , Declaration.VariableDeclaration
-  , Declaration.TypeAlias
-  , Expression.Plus
-  , Expression.Minus
-  , Expression.Times
-  , Expression.DividedBy
-  , Expression.Modulo
-  , Expression.Power
-  , Expression.Negate
-  , Expression.FloorDivision
-  , Expression.BAnd
-  , Expression.BOr
-  , Expression.BXOr
-  , Expression.LShift
-  , Expression.RShift
-  , Expression.UnsignedRShift
-  , Expression.Complement
-  , Expression.And
-  , Expression.Not
-  , Expression.Or
-  , Expression.XOr
-  , Expression.Call
-  , Expression.Cast
-  , Expression.LessThan
-  , Expression.LessThanEqual
-  , Expression.GreaterThan
-  , Expression.GreaterThanEqual
-  , Expression.Equal
-  , Expression.StrictEqual
-  , Expression.Comparison
-  , Expression.Enumeration
-  , Expression.MemberAccess
-  , Expression.NonNullExpression
-  , Expression.ScopeResolution
-  , Expression.SequenceExpression
-  , Expression.Subscript
-  , Expression.Member
-  , Expression.Delete
-  , Expression.Void
-  , Expression.Typeof
-  , Expression.InstanceOf
-  , Expression.New
-  , Expression.Await
-  , Expression.This
-  , Literal.Array
-  , Literal.Boolean
-  , Literal.Float
-  , Literal.Hash
-  , Literal.Integer
-  , Literal.KeyValue
-  , Literal.Null
-  , Literal.String
-  , Literal.TextElement
-  , Literal.Regex
-  , Statement.Assignment
-  , Statement.Break
-  , Statement.Catch
-  , Statement.Continue
-  , Statement.DoWhile
-  , Statement.Else
-  , Statement.Finally
-  , Statement.For
-  , Statement.ForEach
-  , Statement.If
-  , Statement.Match
-  , Statement.Pattern
-  , Statement.Retry
-  , Statement.Return
-  , Statement.ScopeEntry
-  , Statement.ScopeExit
-  , Statement.Statements
-  , Statement.Throw
-  , Statement.Try
-  , Statement.While
-  , Statement.Yield
-  , Syntax.AccessibilityModifier
-  , Syntax.Empty
-  , Syntax.Error
-  , Syntax.Identifier
-  , Syntax.Context
-  , Type.Readonly
-  , Type.TypeParameters
-  , TSX.Syntax.TypeParameter
-  , TSX.Syntax.Constraint
-  , TSX.Syntax.ParenthesizedType
-  , TSX.Syntax.DefaultType
-  , TSX.Syntax.PredefinedType
-  , TSX.Syntax.TypeIdentifier
-  , TSX.Syntax.NestedIdentifier
-  , TSX.Syntax.NestedTypeIdentifier
-  , TSX.Syntax.GenericType
-  , TSX.Syntax.TypeArguments
-  , TSX.Syntax.TypePredicate
-  , TSX.Syntax.CallSignature
-  , TSX.Syntax.ConstructSignature
-  , TSX.Syntax.ArrayType
-  , TSX.Syntax.LookupType
-  , TSX.Syntax.FlowMaybeType
-  , TSX.Syntax.TypeQuery
-  , TSX.Syntax.IndexTypeQuery
-  , TSX.Syntax.ThisType
-  , TSX.Syntax.ExistentialType
-  , TSX.Syntax.AbstractMethodSignature
-  , TSX.Syntax.IndexSignature
-  , TSX.Syntax.ObjectType
-  , TSX.Syntax.LiteralType
-  , TSX.Syntax.Union
-  , TSX.Syntax.Intersection
-  , TSX.Syntax.Module
-  , TSX.Syntax.InternalModule
-  , TSX.Syntax.FunctionType
-  , TSX.Syntax.Tuple
-  , TSX.Syntax.Constructor
-  , TSX.Syntax.TypeAssertion
-  , TSX.Syntax.ImportAlias
-  , TSX.Syntax.Debugger
-  , TSX.Syntax.ShorthandPropertyIdentifier
-  , TSX.Syntax.Super
-  , TSX.Syntax.Undefined
-  , TSX.Syntax.ClassHeritage
-  , TSX.Syntax.AbstractClass
-  , TSX.Syntax.ImplementsClause
-  , TSX.Syntax.JsxElement
-  , TSX.Syntax.JsxSelfClosingElement
-  , TSX.Syntax.JsxOpeningElement
-  , TSX.Syntax.JsxText
-  , TSX.Syntax.JsxClosingElement
-  , TSX.Syntax.JsxExpression
-  , TSX.Syntax.JsxAttribute
-  , TSX.Syntax.JsxFragment
-  , TSX.Syntax.JsxNamespaceName
-  , TSX.Syntax.OptionalParameter
-  , TSX.Syntax.RequiredParameter
-  , TSX.Syntax.RestParameter
-  , TSX.Syntax.PropertySignature
-  , TSX.Syntax.AmbientDeclaration
-  , TSX.Syntax.EnumDeclaration
-  , TSX.Syntax.ExtendsClause
-  , TSX.Syntax.AmbientFunction
-  , TSX.Syntax.ImportRequireClause
-  , TSX.Syntax.ImportClause
-  , TSX.Syntax.LabeledStatement
-  , TSX.Syntax.Annotation
-  , TSX.Syntax.With
-  , TSX.Syntax.ForOf
-  , TSX.Syntax.Update
-  , TSX.Syntax.ComputedPropertyName
-  , TSX.Syntax.Decorator
-  , TSX.Syntax.Import
-  , TSX.Syntax.QualifiedAliasedImport
-  , TSX.Syntax.SideEffectImport
-  , TSX.Syntax.DefaultExport
-  , TSX.Syntax.QualifiedExport
-  , TSX.Syntax.QualifiedExportFrom
-  , TSX.Syntax.JavaScriptRequire
-  , []
-  , Statement.StatementBlock
-  , TSX.Syntax.MetaProperty
-  , TSX.Syntax.AnnotatedExpression
-  ]
-
-type Term = Term.Term (Sum Syntax) Loc
 type Assignment = Assignment.Assignment [] Grammar
 
 -- | Assignment from AST in TSX’s grammar onto a program in TSX’s syntax.
-assignment :: Assignment Term
+assignment :: Assignment (Term Loc)
 assignment = handleError $ makeTerm <$> symbol Program <*> children (Statement.Statements <$> manyTerm statement) <|> parseError
 
-expression :: Assignment Term
+expression :: Assignment (Term Loc)
 expression = handleError everything
   where
     everything = choice [
@@ -256,13 +83,13 @@ expression = handleError everything
       identifier
       ]
 
-undefined' :: Assignment Term
+undefined' :: Assignment (Term Loc)
 undefined' = makeTerm <$> symbol Grammar.Undefined <*> (TSX.Syntax.Undefined <$ rawSource)
 
-assignmentExpression :: Assignment Term
+assignmentExpression :: Assignment (Term Loc)
 assignmentExpression = makeTerm <$> symbol AssignmentExpression <*> children (Statement.Assignment [] <$> term (memberExpression <|> subscriptExpression <|> identifier <|> destructuringPattern) <*> expression)
 
-augmentedAssignmentExpression :: Assignment Term
+augmentedAssignmentExpression :: Assignment (Term Loc)
 augmentedAssignmentExpression = makeTerm' <$> symbol AugmentedAssignmentExpression <*> children (infixTerm (memberExpression <|> subscriptExpression <|> identifier <|> destructuringPattern) (term expression) [
     assign Expression.Plus <$ symbol AnonPlusEqual
   , assign Expression.Minus <$ symbol AnonMinusEqual
@@ -276,14 +103,14 @@ augmentedAssignmentExpression = makeTerm' <$> symbol AugmentedAssignmentExpressi
   , assign Expression.UnsignedRShift <$ symbol AnonRAngleRAngleRAngleEqual
   , assign Expression.LShift <$ symbol AnonLAngleLAngleEqual
   , assign Expression.BOr <$ symbol AnonPipeEqual ])
-  where assign :: (f :< Syntax) => (Term -> Term -> f Term) -> Term -> Term -> Sum Syntax Term
+  where assign :: (f :< TSX.Syntax) => (Term Loc -> Term Loc -> f (Term Loc)) -> Term Loc -> Term Loc -> Sum TSX.Syntax (Term Loc)
         assign c l r = inject (Statement.Assignment [] l (makeTerm1 (c l r)))
 
 
-awaitExpression :: Assignment Term
+awaitExpression :: Assignment (Term Loc)
 awaitExpression = makeTerm <$> symbol Grammar.AwaitExpression <*> children (Expression.Await <$> term expression)
 
-unaryExpression :: Assignment Term
+unaryExpression :: Assignment (Term Loc)
 unaryExpression = symbol Grammar.UnaryExpression >>= \ loc ->
   makeTerm loc . Expression.Not <$> children (symbol AnonBang *> term expression)
   <|> makeTerm loc . Expression.Complement <$> children (symbol AnonTilde *> term expression)
@@ -292,16 +119,16 @@ unaryExpression = symbol Grammar.UnaryExpression >>= \ loc ->
   <|> makeTerm loc . Expression.Void <$> children (symbol AnonVoid *> term expression)
   <|> makeTerm loc . Expression.Delete <$> children (symbol AnonDelete *> term expression)
 
-ternaryExpression :: Assignment Term
+ternaryExpression :: Assignment (Term Loc)
 ternaryExpression = makeTerm <$> symbol Grammar.TernaryExpression <*> children (Statement.If <$> term expression <*> term expression <*> term expression)
 
-memberExpression :: Assignment Term
+memberExpression :: Assignment (Term Loc)
 memberExpression = makeTerm <$> (symbol Grammar.MemberExpression <|> symbol Grammar.MemberExpression') <*> children (Expression.MemberAccess <$> term expression <*> propertyIdentifier)
 
-newExpression :: Assignment Term
+newExpression :: Assignment (Term Loc)
 newExpression = makeTerm <$> symbol Grammar.NewExpression <*> children (Expression.New  <$> term constructableExpression <*> (typeArguments' <|> emptyTerm) <*> (arguments <|> pure []))
 
-constructableExpression :: Assignment Term
+constructableExpression :: Assignment (Term Loc)
 constructableExpression = choice [
     this
   , identifier
@@ -325,77 +152,77 @@ constructableExpression = choice [
   , newExpression
   ]
 
-metaProperty :: Assignment Term
+metaProperty :: Assignment (Term Loc)
 metaProperty = makeTerm <$> symbol Grammar.MetaProperty <*> (TSX.Syntax.MetaProperty <$ rawSource)
 
-updateExpression :: Assignment Term
+updateExpression :: Assignment (Term Loc)
 updateExpression = makeTerm <$> symbol Grammar.UpdateExpression <*> children (TSX.Syntax.Update <$> term expression)
 
-yieldExpression :: Assignment Term
+yieldExpression :: Assignment (Term Loc)
 yieldExpression = makeTerm <$> symbol Grammar.YieldExpression <*> children (Statement.Yield <$> term (expression <|> emptyTerm))
 
-this :: Assignment Term
+this :: Assignment (Term Loc)
 this = makeTerm <$> symbol Grammar.This <*> (Expression.This <$ rawSource)
 
-regex :: Assignment Term
+regex :: Assignment (Term Loc)
 regex = makeTerm <$> symbol Grammar.Regex <*> (Literal.Regex <$> source)
 
-null' :: Assignment Term
+null' :: Assignment (Term Loc)
 null' = makeTerm <$> symbol Null <*> (Literal.Null <$ rawSource)
 
-abstractClass :: Assignment Term
+abstractClass :: Assignment (Term Loc)
 abstractClass = makeTerm <$> symbol Grammar.AbstractClassDeclaration <*> children (TSX.Syntax.AbstractClass <$> term typeIdentifier <*> (term typeParameters <|> emptyTerm) <*> (classHeritage' <|> pure []) <*> classBodyStatements)
 
-abstractMethodSignature :: Assignment Term
+abstractMethodSignature :: Assignment (Term Loc)
 abstractMethodSignature = makeSignature <$> symbol Grammar.AbstractMethodSignature <*> children ((,,) <$> accessibilityModifier' <*> term propertyName <*> callSignatureParts)
   where makeSignature loc (modifier, propertyName, (typeParams, params, annotation)) = makeTerm loc (TSX.Syntax.AbstractMethodSignature [typeParams, annotation] propertyName params modifier)
 
-classHeritage' :: Assignment [Term]
+classHeritage' :: Assignment [Term Loc]
 classHeritage' = symbol Grammar.ClassHeritage *> children ((mappend `on` toList) <$> optional (term extendsClause) <*> optional (term implementsClause'))
 
-extendsClause :: Assignment Term
+extendsClause :: Assignment (Term Loc)
 extendsClause = makeTerm <$> symbol Grammar.ExtendsClause <*> children (TSX.Syntax.ExtendsClause <$> manyTerm (typeReference <|> expression))
 
-typeReference :: Assignment Term
+typeReference :: Assignment (Term Loc)
 typeReference = typeIdentifier <|> nestedTypeIdentifier <|> genericType
 
-implementsClause' :: Assignment Term
+implementsClause' :: Assignment (Term Loc)
 implementsClause' = makeTerm <$> symbol Grammar.ImplementsClause <*> children (TSX.Syntax.ImplementsClause <$> manyTerm ty)
 
-super :: Assignment Term
+super :: Assignment (Term Loc)
 super = makeTerm <$> symbol Grammar.Super <*> (TSX.Syntax.Super <$ rawSource)
 
-asExpression :: Assignment Term
+asExpression :: Assignment (Term Loc)
 asExpression = makeTerm <$> symbol AsExpression <*> children (Expression.Cast <$> term expression <*> term (ty <|> templateString))
 
-templateString :: Assignment Term
+templateString :: Assignment (Term Loc)
 templateString = makeTerm <$> symbol TemplateString <*> children (Literal.String <$> manyTerm templateSubstitution)
 
-templateSubstitution :: Assignment Term
+templateSubstitution :: Assignment (Term Loc)
 templateSubstitution = symbol TemplateSubstitution *> children (term expressions)
 
-nonNullExpression' :: Assignment Term
+nonNullExpression' :: Assignment (Term Loc)
 nonNullExpression' = makeTerm <$> symbol Grammar.NonNullExpression <*> children (Expression.NonNullExpression <$> term expression)
 
-importAlias' :: Assignment Term
+importAlias' :: Assignment (Term Loc)
 importAlias' = makeTerm <$> symbol Grammar.ImportAlias <*> children (TSX.Syntax.ImportAlias <$> term identifier <*> term (identifier <|> nestedIdentifier))
 
-number :: Assignment Term
+number :: Assignment (Term Loc)
 number = makeTerm <$> symbol Grammar.Number <*> (Literal.Float <$> source)
 
-string :: Assignment Term
+string :: Assignment (Term Loc)
 string = makeTerm <$> symbol Grammar.String <*> (Literal.TextElement <$> source)
 
-true :: Assignment Term
+true :: Assignment (Term Loc)
 true = makeTerm <$> symbol Grammar.True <*> (Literal.true <$ rawSource)
 
-false :: Assignment Term
+false :: Assignment (Term Loc)
 false = makeTerm <$> symbol Grammar.False <*> (Literal.false <$ rawSource)
 
-identifier :: Assignment Term
+identifier :: Assignment (Term Loc)
 identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier . name <$> source)
 
-class' :: Assignment Term
+class' :: Assignment (Term Loc)
 class' = makeClass <$> (symbol Class <|> symbol ClassDeclaration) <*> children ((,,,,) <$> manyTerm decorator
                                                                                        <*> (term typeIdentifier <|> emptyTerm)
                                                                                        <*> (symbol TypeParameters *> children (manyTerm typeParameter') <|> pure [])
@@ -403,66 +230,66 @@ class' = makeClass <$> (symbol Class <|> symbol ClassDeclaration) <*> children (
                                                                                        <*> classBodyStatements)
   where makeClass loc (decorators, expression, typeParams, classHeritage, statements) = makeTerm loc (Declaration.Class (decorators <> typeParams) expression classHeritage statements)
 
-object :: Assignment Term
+object :: Assignment (Term Loc)
 object = makeTerm <$> (symbol Object <|> symbol ObjectPattern) <*> children (Literal.Hash <$> manyTerm (pair <|> spreadElement <|> methodDefinition <|> assignmentPattern <|> shorthandPropertyIdentifier))
 
-array :: Assignment Term
+array :: Assignment (Term Loc)
 array = makeTerm <$> (symbol Array <|> symbol ArrayPattern) <*> children (Literal.Array <$> manyTerm (expression <|> spreadElement))
 
-jsxElement' :: Assignment Term
+jsxElement' :: Assignment (Term Loc)
 jsxElement' = choice [ jsxElement, jsxSelfClosingElement ]
 
-jsxElement :: Assignment Term
+jsxElement :: Assignment (Term Loc)
 jsxElement = makeTerm <$> symbol Grammar.JsxElement <*> children (TSX.Syntax.JsxElement <$> term jsxOpeningElement' <*> manyTerm jsxChild <*> term jsxClosingElement')
 
-jsxFragment :: Assignment Term
+jsxFragment :: Assignment (Term Loc)
 jsxFragment = makeTerm <$> symbol Grammar.JsxFragment <*> children (TSX.Syntax.JsxFragment <$> manyTerm jsxChild)
 
-jsxChild :: Assignment Term
+jsxChild :: Assignment (Term Loc)
 jsxChild = choice [ jsxElement', jsxExpression', jsxText ]
 
-jsxSelfClosingElement :: Assignment Term
+jsxSelfClosingElement :: Assignment (Term Loc)
 jsxSelfClosingElement = makeTerm <$> symbol Grammar.JsxSelfClosingElement <*> children (TSX.Syntax.JsxSelfClosingElement <$> term jsxElementName <*> manyTerm jsxAttribute')
 
-jsxAttribute' :: Assignment Term
+jsxAttribute' :: Assignment (Term Loc)
 jsxAttribute' = jsxAttribute <|> jsxExpression'
 
-jsxOpeningElement' :: Assignment Term
+jsxOpeningElement' :: Assignment (Term Loc)
 jsxOpeningElement' = makeTerm <$> symbol Grammar.JsxOpeningElement <*> children (TSX.Syntax.JsxOpeningElement <$> term jsxElementName <*> term (typeArguments' <|> emptyTerm) <*> manyTerm jsxAttribute')
 
-jsxElementName :: Assignment Term
+jsxElementName :: Assignment (Term Loc)
 jsxElementName = choice [ identifier, nestedIdentifier, jsxNamespaceName ]
 
-jsxNamespaceName :: Assignment Term
+jsxNamespaceName :: Assignment (Term Loc)
 jsxNamespaceName = makeTerm <$> symbol Grammar.JsxNamespaceName <*> children (TSX.Syntax.JsxNamespaceName <$> identifier <*> identifier)
 
-jsxExpression' :: Assignment Term
+jsxExpression' :: Assignment (Term Loc)
 jsxExpression' = makeTerm <$> symbol Grammar.JsxExpression <*> children (TSX.Syntax.JsxExpression <$> term (expressions <|> spreadElement <|> emptyTerm))
 
-jsxText :: Assignment Term
+jsxText :: Assignment (Term Loc)
 jsxText = makeTerm <$> symbol Grammar.JsxText <*> (TSX.Syntax.JsxText <$> source)
 
-jsxClosingElement' :: Assignment Term
+jsxClosingElement' :: Assignment (Term Loc)
 jsxClosingElement' = makeTerm <$> symbol Grammar.JsxClosingElement <*> children (TSX.Syntax.JsxClosingElement <$> term jsxElementName)
 
-jsxAttribute :: Assignment Term
+jsxAttribute :: Assignment (Term Loc)
 jsxAttribute = makeTerm <$> symbol Grammar.JsxAttribute <*> children (TSX.Syntax.JsxAttribute <$> term (propertyIdentifier <|> jsxNamespaceName) <*> (term jsxAttributeValue <|> emptyTerm))
   where jsxAttributeValue = choice [ string, jsxExpression', jsxElement', jsxFragment ]
 
-propertyIdentifier :: Assignment Term
+propertyIdentifier :: Assignment (Term Loc)
 propertyIdentifier = makeTerm <$> symbol PropertyIdentifier <*> (Syntax.Identifier . name <$> source)
 
-sequenceExpression :: Assignment Term
+sequenceExpression :: Assignment (Term Loc)
 sequenceExpression = makeTerm <$> symbol Grammar.SequenceExpression <*> children (Expression.SequenceExpression <$> term expression <*> term expressions)
 
-expressions :: Assignment Term
+expressions :: Assignment (Term Loc)
 expressions = annotatedExpression <|> expression <|> sequenceExpression
 
-annotatedExpression :: Assignment Term
+annotatedExpression :: Assignment (Term Loc)
 annotatedExpression = mkAnnotated <$> location <*> expression <*> typeAnnotation'
   where mkAnnotated loc expr ann = makeTerm loc (TSX.Syntax.AnnotatedExpression expr ann)
 
-parameter :: Assignment Term
+parameter :: Assignment (Term Loc)
 parameter =  requiredParameter
          <|> restParameter
          <|> optionalParameter
@@ -475,23 +302,23 @@ accessibilityModifier' = (symbol AccessibilityModifier >> children (public <|> p
         default'  = pure ScopeGraph.Public
 
 
-destructuringPattern :: Assignment Term
+destructuringPattern :: Assignment (Term Loc)
 destructuringPattern = object <|> array
 
-spreadElement :: Assignment Term
+spreadElement :: Assignment (Term Loc)
 spreadElement = symbol SpreadElement *> children (term expression)
 
-readonly' :: Assignment Term
+readonly' :: Assignment (Term Loc)
 readonly' = makeTerm <$> symbol Readonly <*> (Type.Readonly <$ rawSource)
 
-methodDefinition :: Assignment Term
+methodDefinition :: Assignment (Term Loc)
 methodDefinition = makeMethod <$>
   symbol MethodDefinition
   <*> children ((,,,,,) <$> accessibilityModifier' <*> (term readonly' <|> emptyTerm) <*> emptyTerm <*> term propertyName <*> callSignatureParts <*> term statementBlock)
   where
     makeMethod loc (modifier, readonly, receiver, propertyName', (typeParameters', params, ty'), statements) = makeTerm loc (Declaration.Method [readonly, typeParameters', ty'] receiver propertyName' params statements modifier)
 
-callSignatureParts :: Assignment (Term, [Term], Term)
+callSignatureParts :: Assignment (Term Loc, [Term Loc], Term Loc)
 callSignatureParts = contextualize' <$> Assignment.manyThrough comment (postContextualize' <$> callSignature' <*> many comment)
   where
     callSignature' = (,,) <$> (term typeParameters <|> emptyTerm) <*> formalParameters <*> (term typeAnnotation' <|> emptyTerm)
@@ -502,20 +329,20 @@ callSignatureParts = contextualize' <$> Assignment.manyThrough comment (postCont
       Just cs -> (typeParams, formalParams, makeTerm1 (Syntax.Context cs annotation))
       Nothing -> (typeParams, formalParams, annotation)
 
-callSignature :: Assignment Term
+callSignature :: Assignment (Term Loc)
 callSignature =  makeTerm <$> symbol Grammar.CallSignature <*> children (TSX.Syntax.CallSignature <$> (fromMaybe <$> emptyTerm <*> optional (term typeParameters)) <*> formalParameters <*> (fromMaybe <$> emptyTerm <*> optional (term typeAnnotation')))
 
-constructSignature :: Assignment Term
+constructSignature :: Assignment (Term Loc)
 constructSignature = makeTerm <$> symbol Grammar.ConstructSignature <*> children (TSX.Syntax.ConstructSignature <$> (fromMaybe <$> emptyTerm <*> optional (term typeParameters)) <*> formalParameters <*> (fromMaybe <$> emptyTerm <*> optional (term typeAnnotation')))
 
-indexSignature :: Assignment Term
+indexSignature :: Assignment (Term Loc)
 indexSignature = makeTerm <$> symbol Grammar.IndexSignature <*> children (TSX.Syntax.IndexSignature <$> term identifier <*> predefinedTy <*> term typeAnnotation')
 
-methodSignature :: Assignment Term
+methodSignature :: Assignment (Term Loc)
 methodSignature = makeMethodSignature <$> symbol Grammar.MethodSignature <*> children ((,,,) <$> accessibilityModifier' <*> (term readonly' <|> emptyTerm) <*> term propertyName <*> callSignatureParts)
   where makeMethodSignature loc (accessControl, readonly, propertyName, (typeParams, params, annotation)) = makeTerm loc (Declaration.MethodSignature [readonly, typeParams, annotation] propertyName params accessControl)
 
-formalParameters :: Assignment [Term]
+formalParameters :: Assignment [Term Loc]
 formalParameters = symbol FormalParameters *> children (contextualize' <$> Assignment.manyThrough comment (postContextualize' <$> (concat <$> many ((\as b -> as <> [b]) <$> manyTerm decorator <*> term parameter)) <*> many comment))
   where
     contextualize' (cs, formalParams) = case nonEmpty cs of
@@ -526,37 +353,37 @@ formalParameters = symbol FormalParameters *> children (contextualize' <$> Assig
       Nothing -> formalParams
 
 
-decorator :: Assignment Term
+decorator :: Assignment (Term Loc)
 decorator = makeTerm <$> symbol Grammar.Decorator <*> children (TSX.Syntax.Decorator <$> term (identifier <|> memberExpression <|> callExpression))
 
-typeParameters :: Assignment Term
+typeParameters :: Assignment (Term Loc)
 typeParameters = makeTerm <$> symbol TypeParameters <*> children (Type.TypeParameters <$> manyTerm typeParameter')
 
-typeAnnotation' :: Assignment Term
+typeAnnotation' :: Assignment (Term Loc)
 typeAnnotation' = makeTerm <$> symbol TypeAnnotation <*> children (TSX.Syntax.Annotation <$> term ty)
 
-typeParameter' :: Assignment Term
+typeParameter' :: Assignment (Term Loc)
 typeParameter' = makeTerm <$> symbol Grammar.TypeParameter <*> children (TSX.Syntax.TypeParameter <$> term typeIdentifier <*> term (constraint <|> emptyTerm) <*> term (defaultType <|> emptyTerm))
 
-defaultType :: Assignment Term
+defaultType :: Assignment (Term Loc)
 defaultType = makeTerm <$> symbol Grammar.DefaultType <*> children (TSX.Syntax.DefaultType <$> term ty)
 
-constraint :: Assignment Term
+constraint :: Assignment (Term Loc)
 constraint = makeTerm <$> symbol Grammar.Constraint <*> children (TSX.Syntax.Constraint <$> term ty)
 
-function :: Assignment Term
+function :: Assignment (Term Loc)
 function = makeFunction <$> (symbol Grammar.Function <|> symbol Grammar.FunctionDeclaration <|> symbol Grammar.GeneratorFunction <|> symbol Grammar.GeneratorFunctionDeclaration) <*> children ((,,) <$> term (identifier <|> emptyTerm) <*> callSignatureParts <*> term statementBlock)
   where makeFunction loc (id, (typeParams, params, annotation), statements) = makeTerm loc (Declaration.Function [typeParams, annotation] id params statements)
 
 -- TODO: FunctionSignatures can, but don't have to be ambient functions.
-ambientFunction :: Assignment Term
+ambientFunction :: Assignment (Term Loc)
 ambientFunction = makeAmbientFunction <$> symbol Grammar.FunctionSignature <*> children ((,) <$> term identifier <*> callSignatureParts)
   where makeAmbientFunction loc (id, (typeParams, params, annotation)) = makeTerm loc (TSX.Syntax.AmbientFunction [typeParams, annotation] id params)
 
-ty :: Assignment Term
+ty :: Assignment (Term Loc)
 ty = primaryType <|> unionType <|> intersectionType <|> functionTy <|> constructorTy
 
-primaryType :: Assignment Term
+primaryType :: Assignment (Term Loc)
 primaryType =  arrayTy
            <|> existentialType
            <|> flowMaybeTy
@@ -574,76 +401,76 @@ primaryType =  arrayTy
            <|> typePredicate
            <|> typeQuery
 
-parenthesizedTy :: Assignment Term
+parenthesizedTy :: Assignment (Term Loc)
 parenthesizedTy = makeTerm <$> symbol Grammar.ParenthesizedType <*> children (TSX.Syntax.ParenthesizedType <$> term ty)
 
-predefinedTy :: Assignment Term
+predefinedTy :: Assignment (Term Loc)
 predefinedTy = makeTerm <$> symbol Grammar.PredefinedType <*> (TSX.Syntax.PredefinedType <$> source)
 
-typeIdentifier :: Assignment Term
+typeIdentifier :: Assignment (Term Loc)
 typeIdentifier = makeTerm <$> symbol Grammar.TypeIdentifier <*> (TSX.Syntax.TypeIdentifier <$> source)
 
-nestedIdentifier :: Assignment Term
+nestedIdentifier :: Assignment (Term Loc)
 nestedIdentifier = makeTerm <$> symbol Grammar.NestedIdentifier <*> children (TSX.Syntax.NestedIdentifier <$> term (identifier <|> nestedIdentifier) <*> term identifier)
 
-nestedTypeIdentifier :: Assignment Term
+nestedTypeIdentifier :: Assignment (Term Loc)
 nestedTypeIdentifier = makeTerm <$> symbol Grammar.NestedTypeIdentifier <*> children (TSX.Syntax.NestedTypeIdentifier <$> term (identifier <|> nestedIdentifier) <*> term typeIdentifier)
 
-genericType :: Assignment Term
+genericType :: Assignment (Term Loc)
 genericType = makeTerm <$> symbol Grammar.GenericType <*> children (TSX.Syntax.GenericType <$> term (typeIdentifier <|> nestedTypeIdentifier) <*> term typeArguments')
 
-typeArguments' :: Assignment Term
+typeArguments' :: Assignment (Term Loc)
 typeArguments' = makeTerm <$> symbol Grammar.TypeArguments <*> children (TSX.Syntax.TypeArguments <$> some (term ty))
 
-typePredicate :: Assignment Term
+typePredicate :: Assignment (Term Loc)
 typePredicate = makeTerm <$> symbol Grammar.TypePredicate <*> children (TSX.Syntax.TypePredicate <$> term identifier <*> term ty)
 
-objectType :: Assignment Term
+objectType :: Assignment (Term Loc)
 objectType = makeTerm <$> symbol Grammar.ObjectType <*> children (TSX.Syntax.ObjectType <$> manyTerm (exportStatement <|> propertySignature <|> callSignature <|> constructSignature <|> indexSignature <|> methodSignature))
 
-arrayTy :: Assignment Term
+arrayTy :: Assignment (Term Loc)
 arrayTy = makeTerm <$> symbol Grammar.ArrayType <*> children (TSX.Syntax.ArrayType <$> term ty)
 
-lookupType :: Assignment Term
+lookupType :: Assignment (Term Loc)
 lookupType = makeTerm <$> symbol Grammar.LookupType <*> children (TSX.Syntax.LookupType <$> term (typeIdentifier <|> nestedTypeIdentifier) <*> term ty)
 
-flowMaybeTy :: Assignment Term
+flowMaybeTy :: Assignment (Term Loc)
 flowMaybeTy = makeTerm <$> symbol Grammar.FlowMaybeType <*> children (TSX.Syntax.FlowMaybeType <$> term primaryType)
 
-typeQuery :: Assignment Term
+typeQuery :: Assignment (Term Loc)
 typeQuery = makeTerm <$> symbol Grammar.TypeQuery <*> children (TSX.Syntax.TypeQuery <$> term (identifier <|> nestedIdentifier))
 
-indexTypeQuery :: Assignment Term
+indexTypeQuery :: Assignment (Term Loc)
 indexTypeQuery = makeTerm <$> symbol Grammar.IndexTypeQuery <*> children (TSX.Syntax.IndexTypeQuery <$> term (typeIdentifier <|> nestedTypeIdentifier))
 
-existentialType :: Assignment Term
+existentialType :: Assignment (Term Loc)
 existentialType = makeTerm <$> symbol Grammar.ExistentialType <*> (TSX.Syntax.ExistentialType <$> source)
 
-literalType :: Assignment Term
+literalType :: Assignment (Term Loc)
 literalType = makeTerm <$> symbol Grammar.LiteralType <*> children (TSX.Syntax.LiteralType <$> term (number <|> string <|> true <|> false))
 
-unionType :: Assignment Term
+unionType :: Assignment (Term Loc)
 unionType = makeTerm <$> symbol UnionType <*> children (TSX.Syntax.Union <$> (term ty <|> emptyTerm) <*> term ty)
 
-intersectionType :: Assignment Term
+intersectionType :: Assignment (Term Loc)
 intersectionType = makeTerm <$> symbol IntersectionType <*> children (TSX.Syntax.Intersection <$> term ty <*> term ty)
 
-functionTy :: Assignment Term
+functionTy :: Assignment (Term Loc)
 functionTy = makeTerm <$> symbol Grammar.FunctionType <*> children (TSX.Syntax.FunctionType <$> (fromMaybe <$> emptyTerm <*> optional (term typeParameters)) <*> formalParameters <*> term ty)
 
-tupleType :: Assignment Term
+tupleType :: Assignment (Term Loc)
 tupleType = makeTerm <$> symbol TupleType <*> children (TSX.Syntax.Tuple <$> manyTerm ty)
 
-constructorTy :: Assignment Term
+constructorTy :: Assignment (Term Loc)
 constructorTy = makeTerm <$> symbol ConstructorType <*> children (TSX.Syntax.Constructor <$> (fromMaybe <$> emptyTerm <*> optional (term typeParameters)) <*> formalParameters <*> term ty)
 
-statementTerm :: Assignment Term
+statementTerm :: Assignment (Term Loc)
 statementTerm = makeTerm <$> symbol StatementBlock <*> children (Statement.Statements <$> manyTerm statement)
 
-statementBlock :: Assignment Term
+statementBlock :: Assignment (Term Loc)
 statementBlock = makeTerm <$> symbol StatementBlock <*> children (Statement.StatementBlock <$> manyTerm statement)
 
-classBodyStatements :: Assignment Term
+classBodyStatements :: Assignment (Term Loc)
 classBodyStatements = makeTerm'' <$> symbol ClassBody <*> children (contextualize' <$> Assignment.manyThrough comment (postContextualize' <$> (concat <$> many ((\as b -> as <> [b]) <$> manyTerm decorator <*> term (methodDefinition <|> publicFieldDefinition <|> methodSignature <|> indexSignature <|> abstractMethodSignature))) <*> many comment))
   where
     contextualize' (cs, formalParams) = case nonEmpty cs of
@@ -653,12 +480,12 @@ classBodyStatements = makeTerm'' <$> symbol ClassBody <*> children (contextualiz
       Just cs -> formalParams <> toList cs
       Nothing -> formalParams
 
-publicFieldDefinition :: Assignment Term
+publicFieldDefinition :: Assignment (Term Loc)
 publicFieldDefinition = makeField <$> symbol Grammar.PublicFieldDefinition <*> children ((,,,,) <$> accessibilityModifier' <*> (term readonly' <|> emptyTerm) <*> term propertyName <*> (term typeAnnotation' <|> emptyTerm) <*> (term expression <|> emptyTerm))
   where makeField loc (accessControl, readonly, propertyName, annotation, expression) = makeTerm loc (Declaration.PublicFieldDefinition [readonly, annotation] propertyName expression accessControl)
 
 
-statement :: Assignment Term
+statement :: Assignment (Term Loc)
 statement = handleError everything
   where
     everything = choice [
@@ -684,37 +511,37 @@ statement = handleError everything
       , emptyStatement
       , labeledStatement ]
 
-forInStatement :: Assignment Term
+forInStatement :: Assignment (Term Loc)
 forInStatement = makeTerm <$> symbol ForInStatement <*> children (Statement.ForEach <$> term expression <*> term expression <*> term statement)
 
-doStatement :: Assignment Term
+doStatement :: Assignment (Term Loc)
 doStatement = makeTerm <$> symbol DoStatement <*> children (flip Statement.DoWhile <$> term statement <*> term parenthesizedExpression)
 
-continueStatement :: Assignment Term
+continueStatement :: Assignment (Term Loc)
 continueStatement = makeTerm <$> symbol ContinueStatement <*> children (Statement.Continue <$> (statementIdentifier <|> term emptyTerm))
 
-breakStatement :: Assignment Term
+breakStatement :: Assignment (Term Loc)
 breakStatement = makeTerm <$> symbol BreakStatement <*> children (Statement.Break <$> (statementIdentifier <|> term emptyTerm))
 
-withStatement :: Assignment Term
+withStatement :: Assignment (Term Loc)
 withStatement = makeTerm <$> symbol WithStatement <*> children (TSX.Syntax.With <$> term parenthesizedExpression <*> term statement)
 
-returnStatement :: Assignment Term
+returnStatement :: Assignment (Term Loc)
 returnStatement = makeTerm <$> symbol ReturnStatement <*> children (Statement.Return <$> (term expressions <|> term emptyTerm))
 
-throwStatement :: Assignment Term
+throwStatement :: Assignment (Term Loc)
 throwStatement = makeTerm <$> symbol Grammar.ThrowStatement <*> children (Statement.Throw <$> term expressions)
 
-hashBang :: Assignment Term
+hashBang :: Assignment (Term Loc)
 hashBang = makeTerm <$> symbol HashBangLine <*> (Comment.HashBang <$> source)
 
-labeledStatement :: Assignment Term
+labeledStatement :: Assignment (Term Loc)
 labeledStatement = makeTerm <$> symbol Grammar.LabeledStatement <*> children (TSX.Syntax.LabeledStatement <$> statementIdentifier <*> term statement)
 
-statementIdentifier :: Assignment Term
+statementIdentifier :: Assignment (Term Loc)
 statementIdentifier = makeTerm <$> symbol StatementIdentifier <*> (Syntax.Identifier . name <$> source)
 
-importStatement :: Assignment Term
+importStatement :: Assignment (Term Loc)
 importStatement =   makeImportTerm <$> symbol Grammar.ImportStatement <*> children ((,) <$> importClause <*> fromClause)
                 <|> makeTerm' <$> symbol Grammar.ImportStatement <*> children (requireImport <|> sideEffectImport)
   where
@@ -746,16 +573,16 @@ importStatement =   makeImportTerm <$> symbol Grammar.ImportStatement <*> childr
     makeNameAliasPair from (Just alias) = (from, alias)
     makeNameAliasPair from Nothing = (from, from)
 
-    -- TODO: Need to validate that inline comments are still handled with this change in assigning to Path and not a Term.
+    -- TODO: Need to validate that inline comments are still handled with this change in assigning to Path and not a Term.Term (Sum TSX.Syntax).
     fromClause = symbol Grammar.String *> (TypeScript.Resolution.importPath <$> source)
 
-debuggerStatement :: Assignment Term
+debuggerStatement :: Assignment (Term Loc)
 debuggerStatement = makeTerm <$> symbol Grammar.DebuggerStatement <*> (TSX.Syntax.Debugger <$ rawSource)
 
-expressionStatement' :: Assignment Term
+expressionStatement' :: Assignment (Term Loc)
 expressionStatement' = symbol ExpressionStatement *> children (term expressions)
 
-declaration :: Assignment Term
+declaration :: Assignment (Term Loc)
 declaration = everything
   where
     everything = choice [
@@ -774,24 +601,24 @@ declaration = everything
       ambientDeclaration
       ]
 
-typeAliasDeclaration :: Assignment Term
+typeAliasDeclaration :: Assignment (Term Loc)
 typeAliasDeclaration = makeTypeAliasDecl <$> symbol Grammar.TypeAliasDeclaration <*> children ((,,) <$> term typeIdentifier <*> (term typeParameters <|> emptyTerm) <*> term ty)
   where makeTypeAliasDecl loc (identifier, typeParams, body) = makeTerm loc (Declaration.TypeAlias [typeParams] identifier body)
 
-enumDeclaration :: Assignment Term
+enumDeclaration :: Assignment (Term Loc)
 enumDeclaration = makeTerm <$> symbol Grammar.EnumDeclaration <*> children (TSX.Syntax.EnumDeclaration <$> term identifier <*> (symbol EnumBody *> children (manyTerm (propertyName <|> enumAssignment))))
 
-enumAssignment :: Assignment Term
+enumAssignment :: Assignment (Term Loc)
 enumAssignment = makeTerm <$> symbol Grammar.EnumAssignment <*> children (Statement.Assignment [] <$> term propertyName <*> term expression)
 
-interfaceDeclaration :: Assignment Term
+interfaceDeclaration :: Assignment (Term Loc)
 interfaceDeclaration = makeInterfaceDecl <$> symbol Grammar.InterfaceDeclaration <*> children ((,,,) <$> term typeIdentifier <*> (term typeParameters <|> emptyTerm) <*> optional (term extendsClause) <*> term objectType)
   where makeInterfaceDecl loc (identifier, typeParams, clause, objectType) = makeTerm loc (Declaration.InterfaceDeclaration [typeParams] identifier (toList clause) objectType)
 
-ambientDeclaration :: Assignment Term
+ambientDeclaration :: Assignment (Term Loc)
 ambientDeclaration = makeTerm <$> symbol Grammar.AmbientDeclaration <*> children (TSX.Syntax.AmbientDeclaration <$> term (choice [propertyIdentifier *> ty, declaration, statementBlock]))
 
-exportStatement :: Assignment Term
+exportStatement :: Assignment (Term Loc)
 exportStatement = makeTerm <$> symbol Grammar.ExportStatement <*> children (flip TSX.Syntax.QualifiedExportFrom <$> exportClause <*> fromClause)
   <|> makeTerm <$> symbol Grammar.ExportStatement <*> children (TSX.Syntax.QualifiedExport <$> exportClause)
   <|> makeTerm <$> symbol Grammar.ExportStatement <*> children (TSX.Syntax.DefaultExport <$> contextualize decorator (term (declaration <|> expression <|> identifier <|> importAlias')))
@@ -802,26 +629,26 @@ exportStatement = makeTerm <$> symbol Grammar.ExportStatement <*> children (flip
     makeNameAliasPair from (Just alias) = TSX.Syntax.Alias from alias
     makeNameAliasPair from Nothing = TSX.Syntax.Alias from from
     rawIdentifier = symbol Identifier *> (name <$> source)
-    -- TODO: Need to validate that inline comments are still handled with this change in assigning to Path and not a Term.
+    -- TODO: Need to validate that inline comments are still handled with this change in assigning to Path and not a Term.Term (Sum TSX.Syntax).
     fromClause = symbol Grammar.String *> (TypeScript.Resolution.importPath <$> source)
 
-propertySignature :: Assignment Term
+propertySignature :: Assignment (Term Loc)
 propertySignature = makePropertySignature <$> symbol Grammar.PropertySignature <*> children ((,,,) <$> accessibilityModifier' <*> (term readonly' <|> emptyTerm) <*> term propertyName <*> (term typeAnnotation' <|> emptyTerm))
   where makePropertySignature loc (modifier, readonly, propertyName, annotation) = makeTerm loc (TSX.Syntax.PropertySignature [readonly, annotation] propertyName modifier)
 
-propertyName :: Assignment Term
+propertyName :: Assignment (Term Loc)
 propertyName = term (propertyIdentifier <|> string <|> number <|> computedPropertyName)
 
-computedPropertyName :: Assignment Term
+computedPropertyName :: Assignment (Term Loc)
 computedPropertyName = makeTerm <$> symbol Grammar.ComputedPropertyName <*> children (TSX.Syntax.ComputedPropertyName <$> term expression)
 
-assignmentPattern :: Assignment Term
+assignmentPattern :: Assignment (Term Loc)
 assignmentPattern = makeTerm <$> symbol AssignmentPattern <*> children (Statement.Assignment [] <$> term shorthandPropertyIdentifier <*> term expression)
 
-shorthandPropertyIdentifier :: Assignment Term
+shorthandPropertyIdentifier :: Assignment (Term Loc)
 shorthandPropertyIdentifier = makeTerm <$> symbol Grammar.ShorthandPropertyIdentifier <*> (TSX.Syntax.ShorthandPropertyIdentifier <$> source)
 
-requiredParameter :: Assignment Term
+requiredParameter :: Assignment (Term Loc)
 requiredParameter = makeRequiredParameter
                  <$> symbol Grammar.RequiredParameter
                  <*> children ( (,,,,)
@@ -833,44 +660,44 @@ requiredParameter = makeRequiredParameter
   where
     makeRequiredParameter loc (modifier, readonly, identifier, annotation, initializer) = makeTerm loc (TSX.Syntax.RequiredParameter [readonly, annotation] identifier initializer modifier)
 
-restParameter :: Assignment Term
+restParameter :: Assignment (Term Loc)
 restParameter = makeRestParameter <$> symbol Grammar.RestParameter <*> children ((,) <$> term identifier <*> (term typeAnnotation' <|> emptyTerm))
   where makeRestParameter loc (identifier, annotation) = makeTerm loc (TSX.Syntax.RestParameter [annotation] identifier)
 
-optionalParameter :: Assignment Term
+optionalParameter :: Assignment (Term Loc)
 optionalParameter = makeOptionalParam <$> symbol Grammar.OptionalParameter <*> children ((,,,,) <$> accessibilityModifier' <*> (term readonly' <|> emptyTerm) <*> (term identifier <|> destructuringPattern) <*> (term typeAnnotation' <|> emptyTerm) <*> (term expression <|> emptyTerm))
   where makeOptionalParam loc (modifier, readonly, subject, annotation, initializer) = makeTerm loc (TSX.Syntax.OptionalParameter [readonly, annotation] (makeTerm loc (Statement.Assignment [] subject initializer)) modifier)
 
-internalModule :: Assignment Term
+internalModule :: Assignment (Term Loc)
 internalModule = makeTerm <$> symbol Grammar.InternalModule <*> children (TSX.Syntax.InternalModule <$> term (string <|> identifier <|> nestedIdentifier) <*> statements)
 
-module' :: Assignment Term
+module' :: Assignment (Term Loc)
 module' = makeTerm <$> symbol Module <*> children (TSX.Syntax.Module <$> term (string <|> identifier <|> nestedIdentifier) <*> (statements <|> pure []))
 
 
-statements :: Assignment [Term]
+statements :: Assignment [Term Loc]
 statements = symbol StatementBlock *> children (manyTerm statement)
 
-arrowFunction :: Assignment Term
+arrowFunction :: Assignment (Term Loc)
 arrowFunction = makeArrowFun <$> symbol ArrowFunction <*> children ((,,) <$> emptyTerm <*> (((\a b c -> (a, [b], c)) <$> emptyTerm <*> term identifier <*> emptyTerm) <|> callSignatureParts) <*> term (expression <|> statementBlock))
   where makeArrowFun loc (identifier, (typeParams, params, returnTy), body) = makeTerm loc (Declaration.Function [ typeParams, returnTy ] identifier params body)
 
-comment :: Assignment Term
+comment :: Assignment (Term Loc)
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
-ifStatement :: Assignment Term
+ifStatement :: Assignment (Term Loc)
 ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> term parenthesizedExpression <*> term statement <*> (term statement <|> emptyTerm))
 
-whileStatement :: Assignment Term
+whileStatement :: Assignment (Term Loc)
 whileStatement = makeTerm <$> symbol WhileStatement <*> children (Statement.While <$> term expression <*> term statement)
 
-forStatement :: Assignment Term
+forStatement :: Assignment (Term Loc)
 forStatement = makeTerm <$> symbol ForStatement <*> children (Statement.For <$> term (variableDeclaration <|> expressionStatement' <|> emptyStatement) <*> term (expressionStatement' <|> emptyStatement) <*> term (expressions <|> emptyTerm) <*> term statement)
 
-variableDeclaration :: Assignment Term
+variableDeclaration :: Assignment (Term Loc)
 variableDeclaration = makeTerm <$> (symbol Grammar.VariableDeclaration <|> symbol Grammar.LexicalDeclaration) <*> children (Declaration.VariableDeclaration <$> manyTerm variableDeclarator)
 
-variableDeclarator :: Assignment Term
+variableDeclarator :: Assignment (Term Loc)
 variableDeclarator =
       makeTerm <$> symbol VariableDeclarator <*> children (TSX.Syntax.JavaScriptRequire <$> identifier <*> requireCall)
   <|> makeVarDecl <$> symbol VariableDeclarator <*> children ((,,) <$> term (identifier <|> destructuringPattern) <*> (term typeAnnotation' <|> emptyTerm) <*> (term expression <|> emptyTerm))
@@ -884,37 +711,37 @@ variableDeclarator =
       )
 
 
-parenthesizedExpression :: Assignment Term
+parenthesizedExpression :: Assignment (Term Loc)
 parenthesizedExpression = symbol ParenthesizedExpression *> children (term expressions)
 
-switchStatement :: Assignment Term
+switchStatement :: Assignment (Term Loc)
 switchStatement = makeTerm <$> symbol SwitchStatement <*> children (Statement.Match <$> term parenthesizedExpression <*> term switchBody)
   where
     switchBody =  symbol SwitchBody *> children (makeTerm <$> location <*> manyTerm switchCase)
     switchCase = makeTerm <$> (symbol SwitchCase <|> symbol SwitchDefault) <*> children (Statement.Pattern <$> (term expressions <|> emptyTerm) <*> (makeTerm <$> location <*> manyTerm statement))
 
-subscriptExpression :: Assignment Term
+subscriptExpression :: Assignment (Term Loc)
 subscriptExpression = makeTerm <$> symbol SubscriptExpression <*> children (Expression.Subscript <$> term expression <*> (pure <$> term expressions))
 
-pair :: Assignment Term
+pair :: Assignment (Term Loc)
 pair = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> term propertyName <*> term expression)
 
-callExpression :: Assignment Term
+callExpression :: Assignment (Term Loc)
 callExpression = makeCall <$> (symbol CallExpression <|> symbol CallExpression') <*> children ((,,,) <$> term (expression <|> super <|> function) <*> (typeArguments <|> pure []) <*> (arguments <|> (pure <$> term templateString)) <*> emptyTerm)
   where makeCall loc (subject, typeArgs, args, body) = makeTerm loc (Expression.Call typeArgs subject args body)
         typeArguments = symbol Grammar.TypeArguments *> children (some (term ty))
 
-arguments :: Assignment [Term]
+arguments :: Assignment [Term Loc]
 arguments = symbol Arguments *> children (manyTerm (expression <|> spreadElement))
 
-tryStatement :: Assignment Term
+tryStatement :: Assignment (Term Loc)
 tryStatement = makeTry <$> symbol TryStatement <*> children ((,,) <$> term statementTerm <*> optional (term catchClause) <*> optional (term finallyClause))
   where
     makeTry loc (statementBlock', catch, finally) = makeTerm loc (Statement.Try statementBlock' (catMaybes [catch, finally]))
     catchClause = makeTerm <$> symbol CatchClause <*> children (Statement.Catch <$> (identifier <|> emptyTerm) <*> statementTerm)
     finallyClause = makeTerm <$> symbol FinallyClause <*> children (Statement.Finally <$> statementTerm)
 
-binaryExpression  :: Assignment Term
+binaryExpression  :: Assignment (Term Loc)
 binaryExpression = makeTerm' <$> symbol BinaryExpression <*> children (infixTerm expression (term expression)
   [ (inject .) . Expression.Plus               <$ symbol AnonPlus
   , (inject .) . Expression.Minus              <$ symbol AnonMinus
@@ -946,18 +773,18 @@ binaryExpression = makeTerm' <$> symbol BinaryExpression <*> children (infixTerm
 -- Helpers
 
 -- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
-manyTerm :: Assignment Term -> Assignment [Term]
+manyTerm :: Assignment (Term Loc) -> Assignment [Term Loc]
 manyTerm term = many (contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm))
 
-term :: Assignment Term -> Assignment Term
+term :: Assignment (Term Loc) -> Assignment (Term Loc)
 term term = contextualize comment (postContextualize comment term)
 
-emptyStatement :: Assignment Term
+emptyStatement :: Assignment (Term Loc)
 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 Term
-          -> Assignment Term
-          -> [Assignment (Term -> Term -> Sum Syntax Term)]
-          -> Assignment (Sum Syntax Term)
+infixTerm :: Assignment (Term Loc)
+          -> Assignment (Term Loc)
+          -> [Assignment (Term Loc -> Term Loc -> Sum TSX.Syntax (Term Loc))]
+          -> Assignment (Sum TSX.Syntax (Term Loc))
 infixTerm = infixContext comment

src/Language/TSX/Term.hs

@@ -0,0 +1,238 @@
+{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies #-}
+module Language.TSX.Term
+( Syntax
+, Term(..)
+) where
+
+import Control.Lens.Lens
+import Data.Abstract.Declarations
+import Data.Abstract.FreeVariables
+import Data.Aeson (ToJSON)
+import Data.Bifunctor
+import Data.Bitraversable
+import Data.Coerce
+import Data.Foldable (fold)
+import Data.Functor.Foldable (Base, Recursive(..))
+import Data.Graph.ControlFlowVertex (VertexDeclaration(..), toVertex1)
+import qualified Data.Sum as Sum
+import qualified Data.Syntax as Syntax
+import qualified Data.Syntax.Comment as Comment
+import qualified Data.Syntax.Declaration as Declaration
+import qualified Data.Syntax.Expression as Expression
+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 Data.Traversable
+import Diffing.Interpreter
+import qualified Language.TSX.Syntax as TSX.Syntax
+import Source.Loc
+import Source.Span
+
+type Syntax =
+  [ Comment.Comment
+  , Comment.HashBang
+  , Declaration.Class
+  , Declaration.Function
+  , Declaration.Method
+  , Declaration.MethodSignature
+  , Declaration.InterfaceDeclaration
+  , Declaration.PublicFieldDefinition
+  , Declaration.VariableDeclaration
+  , Declaration.TypeAlias
+  , Expression.Plus
+  , Expression.Minus
+  , Expression.Times
+  , Expression.DividedBy
+  , Expression.Modulo
+  , Expression.Power
+  , Expression.Negate
+  , Expression.FloorDivision
+  , Expression.BAnd
+  , Expression.BOr
+  , Expression.BXOr
+  , Expression.LShift
+  , Expression.RShift
+  , Expression.UnsignedRShift
+  , Expression.Complement
+  , Expression.And
+  , Expression.Not
+  , Expression.Or
+  , Expression.XOr
+  , Expression.Call
+  , Expression.Cast
+  , Expression.LessThan
+  , Expression.LessThanEqual
+  , Expression.GreaterThan
+  , Expression.GreaterThanEqual
+  , Expression.Equal
+  , Expression.StrictEqual
+  , Expression.Comparison
+  , Expression.Enumeration
+  , Expression.MemberAccess
+  , Expression.NonNullExpression
+  , Expression.ScopeResolution
+  , Expression.SequenceExpression
+  , Expression.Subscript
+  , Expression.Member
+  , Expression.Delete
+  , Expression.Void
+  , Expression.Typeof
+  , Expression.InstanceOf
+  , Expression.New
+  , Expression.Await
+  , Expression.This
+  , Literal.Array
+  , Literal.Boolean
+  , Literal.Float
+  , Literal.Hash
+  , Literal.Integer
+  , Literal.KeyValue
+  , Literal.Null
+  , Literal.String
+  , Literal.TextElement
+  , Literal.Regex
+  , Statement.Assignment
+  , Statement.Break
+  , Statement.Catch
+  , Statement.Continue
+  , Statement.DoWhile
+  , Statement.Else
+  , Statement.Finally
+  , Statement.For
+  , Statement.ForEach
+  , Statement.If
+  , Statement.Match
+  , Statement.Pattern
+  , Statement.Retry
+  , Statement.Return
+  , Statement.ScopeEntry
+  , Statement.ScopeExit
+  , Statement.Statements
+  , Statement.Throw
+  , Statement.Try
+  , Statement.While
+  , Statement.Yield
+  , Syntax.AccessibilityModifier
+  , Syntax.Empty
+  , Syntax.Error
+  , Syntax.Identifier
+  , Syntax.Context
+  , Type.Readonly
+  , Type.TypeParameters
+  , TSX.Syntax.TypeParameter
+  , TSX.Syntax.Constraint
+  , TSX.Syntax.ParenthesizedType
+  , TSX.Syntax.DefaultType
+  , TSX.Syntax.PredefinedType
+  , TSX.Syntax.TypeIdentifier
+  , TSX.Syntax.NestedIdentifier
+  , TSX.Syntax.NestedTypeIdentifier
+  , TSX.Syntax.GenericType
+  , TSX.Syntax.TypeArguments
+  , TSX.Syntax.TypePredicate
+  , TSX.Syntax.CallSignature
+  , TSX.Syntax.ConstructSignature
+  , TSX.Syntax.ArrayType
+  , TSX.Syntax.LookupType
+  , TSX.Syntax.FlowMaybeType
+  , TSX.Syntax.TypeQuery
+  , TSX.Syntax.IndexTypeQuery
+  , TSX.Syntax.ThisType
+  , TSX.Syntax.ExistentialType
+  , TSX.Syntax.AbstractMethodSignature
+  , TSX.Syntax.IndexSignature
+  , TSX.Syntax.ObjectType
+  , TSX.Syntax.LiteralType
+  , TSX.Syntax.Union
+  , TSX.Syntax.Intersection
+  , TSX.Syntax.Module
+  , TSX.Syntax.InternalModule
+  , TSX.Syntax.FunctionType
+  , TSX.Syntax.Tuple
+  , TSX.Syntax.Constructor
+  , TSX.Syntax.TypeAssertion
+  , TSX.Syntax.ImportAlias
+  , TSX.Syntax.Debugger
+  , TSX.Syntax.ShorthandPropertyIdentifier
+  , TSX.Syntax.Super
+  , TSX.Syntax.Undefined
+  , TSX.Syntax.ClassHeritage
+  , TSX.Syntax.AbstractClass
+  , TSX.Syntax.ImplementsClause
+  , TSX.Syntax.JsxElement
+  , TSX.Syntax.JsxSelfClosingElement
+  , TSX.Syntax.JsxOpeningElement
+  , TSX.Syntax.JsxText
+  , TSX.Syntax.JsxClosingElement
+  , TSX.Syntax.JsxExpression
+  , TSX.Syntax.JsxAttribute
+  , TSX.Syntax.JsxFragment
+  , TSX.Syntax.JsxNamespaceName
+  , TSX.Syntax.OptionalParameter
+  , TSX.Syntax.RequiredParameter
+  , TSX.Syntax.RestParameter
+  , TSX.Syntax.PropertySignature
+  , TSX.Syntax.AmbientDeclaration
+  , TSX.Syntax.EnumDeclaration
+  , TSX.Syntax.ExtendsClause
+  , TSX.Syntax.AmbientFunction
+  , TSX.Syntax.ImportRequireClause
+  , TSX.Syntax.ImportClause
+  , TSX.Syntax.LabeledStatement
+  , TSX.Syntax.Annotation
+  , TSX.Syntax.With
+  , TSX.Syntax.ForOf
+  , TSX.Syntax.Update
+  , TSX.Syntax.ComputedPropertyName
+  , TSX.Syntax.Decorator
+  , TSX.Syntax.Import
+  , TSX.Syntax.QualifiedAliasedImport
+  , TSX.Syntax.SideEffectImport
+  , TSX.Syntax.DefaultExport
+  , TSX.Syntax.QualifiedExport
+  , TSX.Syntax.QualifiedExportFrom
+  , TSX.Syntax.JavaScriptRequire
+  , []
+  , Statement.StatementBlock
+  , TSX.Syntax.MetaProperty
+  , TSX.Syntax.AnnotatedExpression
+  ]
+
+
+newtype Term ann = Term { getTerm :: Term.TermF (Sum.Sum Syntax) ann (Term ann) }
+  deriving (Eq, Declarations, FreeVariables, Ord, Show, ToJSON)
+
+instance Term.IsTerm Term where
+  type Syntax Term = Sum.Sum Syntax
+  toTermF = coerce
+  fromTermF = coerce
+
+instance Foldable Term where
+  foldMap = foldMapDefault
+
+instance Functor Term where
+  fmap = fmapDefault
+
+instance Traversable Term where
+  traverse f = go where go = fmap Term . bitraverse f go . getTerm
+
+instance VertexDeclaration Term where
+  toVertex info (Term (Term.In ann syntax)) = toVertex1 ann info syntax
+
+instance Syntax.HasErrors Term where
+  getErrors = cata $ \ (Term.In Loc{..} syntax) ->
+    maybe (fold syntax) (pure . Syntax.unError span) (Sum.project syntax)
+
+
+instance DiffTerms Term where
+  diffTermPair = diffTermPair . bimap (cata Term.Term) (cata Term.Term)
+
+type instance Base (Term ann) = Term.TermF (Sum.Sum Syntax) ann
+
+instance Recursive (Term ann) where
+  project = getTerm
+
+instance HasSpan ann => HasSpan (Term ann) where
+  span_ = inner.span_ where inner = lens getTerm (\t i -> t { getTerm = i })
+  {-# INLINE span_ #-}

src/Language/TypeScript/Assignment.hs

@@ -1,10 +1,9 @@
-{-# LANGUAGE DataKinds, RankNTypes, TypeOperators #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-} -- FIXME
+{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators #-}
 module Language.TypeScript.Assignment
 ( assignment
-, Syntax
+, TypeScript.Syntax
 , Grammar
-, Term
+, TypeScript.Term(..)
 ) where
 
 import Assigning.Assignment hiding (Assignment, Error)
@@ -31,182 +30,19 @@ import qualified Data.Syntax.Expression as Expression
 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 Language.TypeScript.Syntax as TypeScript.Syntax
 import qualified Language.TypeScript.Resolution as TypeScript.Resolution
+import Language.TypeScript.Term as TypeScript
 import Prologue
 import TreeSitter.TypeScript as Grammar
 
--- | The type of TypeScript syntax.
-type Syntax = '[
-    Comment.Comment
-  , Comment.HashBang
-  , Declaration.Class
-  , Declaration.Function
-  , Declaration.Method
-  , Declaration.MethodSignature
-  , Declaration.InterfaceDeclaration
-  , Declaration.PublicFieldDefinition
-  , Declaration.VariableDeclaration
-  , Declaration.TypeAlias
-  , Expression.Plus
-  , Expression.Minus
-  , Expression.Times
-  , Expression.DividedBy
-  , Expression.Modulo
-  , Expression.Power
-  , Expression.Negate
-  , Expression.FloorDivision
-  , Expression.BAnd
-  , Expression.BOr
-  , Expression.BXOr
-  , Expression.LShift
-  , Expression.RShift
-  , Expression.UnsignedRShift
-  , Expression.Complement
-  , Expression.And
-  , Expression.Not
-  , Expression.Or
-  , Expression.XOr
-  , Expression.Call
-  , Expression.Cast
-  , Expression.LessThan
-  , Expression.LessThanEqual
-  , Expression.GreaterThan
-  , Expression.GreaterThanEqual
-  , Expression.Equal
-  , Expression.StrictEqual
-  , Expression.Comparison
-  , Expression.Enumeration
-  , Expression.MemberAccess
-  , Expression.NonNullExpression
-  , Expression.ScopeResolution
-  , Expression.SequenceExpression
-  , Expression.Subscript
-  , Expression.Member
-  , Expression.Delete
-  , Expression.Void
-  , Expression.Typeof
-  , Expression.InstanceOf
-  , Expression.New
-  , Expression.Await
-  , Expression.This
-  , Literal.Array
-  , Literal.Boolean
-  , Literal.Float
-  , Literal.Hash
-  , Literal.Integer
-  , Literal.KeyValue
-  , Literal.Null
-  , Literal.String
-  , Literal.TextElement
-  , Literal.Regex
-  , Statement.Assignment
-  , Statement.Break
-  , Statement.Catch
-  , Statement.Continue
-  , Statement.DoWhile
-  , Statement.Else
-  , Statement.Finally
-  , Statement.For
-  , Statement.ForEach
-  , Statement.If
-  , Statement.Match
-  , Statement.Pattern
-  , Statement.Retry
-  , Statement.Return
-  , Statement.ScopeEntry
-  , Statement.ScopeExit
-  , Statement.Statements
-  , Statement.Throw
-  , Statement.Try
-  , Statement.While
-  , Statement.Yield
-  , Syntax.AccessibilityModifier
-  , Syntax.Empty
-  , Syntax.Error
-  , Syntax.Identifier
-  , Syntax.Context
-  , Type.Readonly
-  , Type.TypeParameters
-  , TypeScript.Syntax.TypeParameter
-  , TypeScript.Syntax.Constraint
-  , TypeScript.Syntax.ParenthesizedType
-  , TypeScript.Syntax.DefaultType
-  , TypeScript.Syntax.PredefinedType
-  , TypeScript.Syntax.TypeIdentifier
-  , TypeScript.Syntax.NestedIdentifier
-  , TypeScript.Syntax.NestedTypeIdentifier
-  , TypeScript.Syntax.GenericType
-  , TypeScript.Syntax.TypeArguments
-  , TypeScript.Syntax.TypePredicate
-  , TypeScript.Syntax.CallSignature
-  , TypeScript.Syntax.ConstructSignature
-  , TypeScript.Syntax.ArrayType
-  , TypeScript.Syntax.LookupType
-  , TypeScript.Syntax.FlowMaybeType
-  , TypeScript.Syntax.TypeQuery
-  , TypeScript.Syntax.IndexTypeQuery
-  , TypeScript.Syntax.ThisType
-  , TypeScript.Syntax.ExistentialType
-  , TypeScript.Syntax.AbstractMethodSignature
-  , TypeScript.Syntax.IndexSignature
-  , TypeScript.Syntax.ObjectType
-  , TypeScript.Syntax.LiteralType
-  , TypeScript.Syntax.Union
-  , TypeScript.Syntax.Intersection
-  , TypeScript.Syntax.Module
-  , TypeScript.Syntax.InternalModule
-  , TypeScript.Syntax.FunctionType
-  , TypeScript.Syntax.Tuple
-  , TypeScript.Syntax.Constructor
-  , TypeScript.Syntax.TypeAssertion
-  , TypeScript.Syntax.ImportAlias
-  , TypeScript.Syntax.Debugger
-  , TypeScript.Syntax.ShorthandPropertyIdentifier
-  , TypeScript.Syntax.Super
-  , TypeScript.Syntax.Undefined
-  , TypeScript.Syntax.ClassHeritage
-  , TypeScript.Syntax.AbstractClass
-  , TypeScript.Syntax.ImplementsClause
-  , TypeScript.Syntax.OptionalParameter
-  , TypeScript.Syntax.RequiredParameter
-  , TypeScript.Syntax.RestParameter
-  , TypeScript.Syntax.PropertySignature
-  , TypeScript.Syntax.AmbientDeclaration
-  , TypeScript.Syntax.EnumDeclaration
-  , TypeScript.Syntax.ExtendsClause
-  , TypeScript.Syntax.AmbientFunction
-  , TypeScript.Syntax.ImportRequireClause
-  , TypeScript.Syntax.ImportClause
-  , TypeScript.Syntax.LabeledStatement
-  , TypeScript.Syntax.Annotation
-  , TypeScript.Syntax.With
-  , TypeScript.Syntax.ForOf
-  , TypeScript.Syntax.Update
-  , TypeScript.Syntax.ComputedPropertyName
-  , TypeScript.Syntax.Decorator
-  , TypeScript.Syntax.Import
-  , TypeScript.Syntax.QualifiedAliasedImport
-  , TypeScript.Syntax.SideEffectImport
-  , TypeScript.Syntax.DefaultExport
-  , TypeScript.Syntax.QualifiedExport
-  , TypeScript.Syntax.QualifiedExportFrom
-  , TypeScript.Syntax.JavaScriptRequire
-  , []
-  , Statement.StatementBlock
-  , TypeScript.Syntax.MetaProperty
-  , TypeScript.Syntax.AnnotatedExpression
-  ]
-
-type Term = Term.Term (Sum Syntax) Loc
 type Assignment = Assignment.Assignment [] Grammar
 
 -- | Assignment from AST in TypeScript’s grammar onto a program in TypeScript’s syntax.
-assignment :: Assignment Term
+assignment :: Assignment (Term Loc)
 assignment = handleError $ makeTerm <$> symbol Program <*> children (Statement.Statements <$> manyTerm statement) <|> parseError
 
-expression :: Assignment Term
+expression :: Assignment (Term Loc)
 expression = handleError everything
   where
     everything = choice [
@@ -246,13 +82,13 @@ expression = handleError everything
       identifier
       ]
 
-undefined' :: Assignment Term
+undefined' :: Assignment (Term Loc)
 undefined' = makeTerm <$> symbol Grammar.Undefined <*> (TypeScript.Syntax.Undefined <$ rawSource)
 
-assignmentExpression :: Assignment Term
+assignmentExpression :: Assignment (Term Loc)
 assignmentExpression = makeTerm <$> symbol AssignmentExpression <*> children (Statement.Assignment [] <$> term (memberExpression <|> subscriptExpression <|> identifier <|> destructuringPattern) <*> expression)
 
-augmentedAssignmentExpression :: Assignment Term
+augmentedAssignmentExpression :: Assignment (Term Loc)
 augmentedAssignmentExpression = makeTerm' <$> symbol AugmentedAssignmentExpression <*> children (infixTerm (memberExpression <|> subscriptExpression <|> identifier <|> destructuringPattern) (term expression) [
     assign Expression.Plus <$ symbol AnonPlusEqual
   , assign Expression.Minus <$ symbol AnonMinusEqual
@@ -266,14 +102,14 @@ augmentedAssignmentExpression = makeTerm' <$> symbol AugmentedAssignmentExpressi
   , assign Expression.UnsignedRShift <$ symbol AnonRAngleRAngleRAngleEqual
   , assign Expression.LShift <$ symbol AnonLAngleLAngleEqual
   , assign Expression.BOr <$ symbol AnonPipeEqual ])
-  where assign :: (f :< Syntax) => (Term -> Term -> f Term) -> Term -> Term -> Sum Syntax Term
+  where assign :: (f :< TypeScript.Syntax) => (Term Loc -> Term Loc -> f (Term Loc)) -> Term Loc -> Term Loc -> Sum TypeScript.Syntax (Term Loc)
         assign c l r = inject (Statement.Assignment [] l (makeTerm1 (c l r)))
 
 
-awaitExpression :: Assignment Term
+awaitExpression :: Assignment (Term Loc)
 awaitExpression = makeTerm <$> symbol Grammar.AwaitExpression <*> children (Expression.Await <$> term expression)
 
-unaryExpression :: Assignment Term
+unaryExpression :: Assignment (Term Loc)
 unaryExpression = symbol Grammar.UnaryExpression >>= \ loc ->
   makeTerm loc . Expression.Not <$> children (symbol AnonBang *> term expression)
   <|> makeTerm loc . Expression.Complement <$> children (symbol AnonTilde *> term expression)
@@ -282,16 +118,16 @@ unaryExpression = symbol Grammar.UnaryExpression >>= \ loc ->
   <|> makeTerm loc . Expression.Void <$> children (symbol AnonVoid *> term expression)
   <|> makeTerm loc . Expression.Delete <$> children (symbol AnonDelete *> term expression)
 
-ternaryExpression :: Assignment Term
+ternaryExpression :: Assignment (Term Loc)
 ternaryExpression = makeTerm <$> symbol Grammar.TernaryExpression <*> children (Statement.If <$> term expression <*> term expression <*> term expression)
 
-memberExpression :: Assignment Term
+memberExpression :: Assignment (Term Loc)
 memberExpression = makeTerm <$> (symbol Grammar.MemberExpression <|> symbol Grammar.MemberExpression') <*> children (Expression.MemberAccess <$> term expression <*> propertyIdentifier)
 
-newExpression :: Assignment Term
+newExpression :: Assignment (Term Loc)
 newExpression = makeTerm <$> symbol Grammar.NewExpression <*> children (Expression.New  <$> term constructableExpression <*> (typeArguments' <|> emptyTerm) <*> (arguments <|> pure []))
 
-constructableExpression :: Assignment Term
+constructableExpression :: Assignment (Term Loc)
 constructableExpression = choice [
     this
   , identifier
@@ -315,80 +151,80 @@ constructableExpression = choice [
   , newExpression
   ]
 
-metaProperty :: Assignment Term
+metaProperty :: Assignment (Term Loc)
 metaProperty = makeTerm <$> symbol Grammar.MetaProperty <*> (TypeScript.Syntax.MetaProperty <$ rawSource)
 
-updateExpression :: Assignment Term
+updateExpression :: Assignment (Term Loc)
 updateExpression = makeTerm <$> symbol Grammar.UpdateExpression <*> children (TypeScript.Syntax.Update <$> term expression)
 
-yieldExpression :: Assignment Term
+yieldExpression :: Assignment (Term Loc)
 yieldExpression = makeTerm <$> symbol Grammar.YieldExpression <*> children (Statement.Yield <$> term (expression <|> emptyTerm))
 
-this :: Assignment Term
+this :: Assignment (Term Loc)
 this = makeTerm <$> symbol Grammar.This <*> (Expression.This <$ rawSource)
 
-regex :: Assignment Term
+regex :: Assignment (Term Loc)
 regex = makeTerm <$> symbol Grammar.Regex <*> (Literal.Regex <$> source)
 
-null' :: Assignment Term
+null' :: Assignment (Term Loc)
 null' = makeTerm <$> symbol Null <*> (Literal.Null <$ rawSource)
 
-abstractClass :: Assignment Term
+abstractClass :: Assignment (Term Loc)
 abstractClass = makeTerm <$> symbol Grammar.AbstractClassDeclaration <*> children (TypeScript.Syntax.AbstractClass <$> term typeIdentifier <*> (term typeParameters <|> emptyTerm) <*> (classHeritage' <|> pure []) <*> classBodyStatements)
 
-abstractMethodSignature :: Assignment Term
+abstractMethodSignature :: Assignment (Term Loc)
 abstractMethodSignature = makeSignature <$> symbol Grammar.AbstractMethodSignature <*> children ((,,) <$> accessibilityModifier' <*> term propertyName <*> callSignatureParts)
   where makeSignature loc (modifier, propertyName, (typeParams, params, annotation)) = makeTerm loc (TypeScript.Syntax.AbstractMethodSignature [typeParams, annotation] propertyName params modifier)
 
-classHeritage' :: Assignment [Term]
+classHeritage' :: Assignment [Term Loc]
 classHeritage' = symbol Grammar.ClassHeritage *> children ((mappend `on` toList) <$> optional (term extendsClause) <*> optional (term implementsClause'))
 
-extendsClause :: Assignment Term
+extendsClause :: Assignment (Term Loc)
 extendsClause = makeTerm <$> symbol Grammar.ExtendsClause <*> children (TypeScript.Syntax.ExtendsClause <$> manyTerm (typeReference <|> expression))
 
-typeReference :: Assignment Term
+typeReference :: Assignment (Term Loc)
 typeReference = typeIdentifier <|> nestedTypeIdentifier <|> genericType
 
-implementsClause' :: Assignment Term
+implementsClause' :: Assignment (Term Loc)
 implementsClause' = makeTerm <$> symbol Grammar.ImplementsClause <*> children (TypeScript.Syntax.ImplementsClause <$> manyTerm ty)
 
-super :: Assignment Term
+super :: Assignment (Term Loc)
 super = makeTerm <$> symbol Grammar.Super <*> (TypeScript.Syntax.Super <$ rawSource)
 
-typeAssertion :: Assignment Term
+typeAssertion :: Assignment (Term Loc)
 typeAssertion = makeTerm <$> symbol Grammar.TypeAssertion <*> children (TypeScript.Syntax.TypeAssertion <$> term typeArguments' <*> term expression)
 
-asExpression :: Assignment Term
+asExpression :: Assignment (Term Loc)
 asExpression = makeTerm <$> symbol AsExpression <*> children (Expression.Cast <$> term expression <*> term (ty <|> templateString))
 
-templateString :: Assignment Term
+templateString :: Assignment (Term Loc)
 templateString = makeTerm <$> symbol TemplateString <*> children (Literal.String <$> manyTerm templateSubstitution)
 
-templateSubstitution :: Assignment Term
+templateSubstitution :: Assignment (Term Loc)
 templateSubstitution = symbol TemplateSubstitution *> children (term expressions)
 
-nonNullExpression' :: Assignment Term
+nonNullExpression' :: Assignment (Term Loc)
 nonNullExpression' = makeTerm <$> symbol Grammar.NonNullExpression <*> children (Expression.NonNullExpression <$> term expression)
 
-importAlias' :: Assignment Term
+importAlias' :: Assignment (Term Loc)
 importAlias' = makeTerm <$> symbol Grammar.ImportAlias <*> children (TypeScript.Syntax.ImportAlias <$> term identifier <*> term (identifier <|> nestedIdentifier))
 
-number :: Assignment Term
+number :: Assignment (Term Loc)
 number = makeTerm <$> symbol Grammar.Number <*> (Literal.Float <$> source)
 
-string :: Assignment Term
+string :: Assignment (Term Loc)
 string = makeTerm <$> symbol Grammar.String <*> (Literal.TextElement <$> source)
 
-true :: Assignment Term
+true :: Assignment (Term Loc)
 true = makeTerm <$> symbol Grammar.True <*> (Literal.true <$ rawSource)
 
-false :: Assignment Term
+false :: Assignment (Term Loc)
 false = makeTerm <$> symbol Grammar.False <*> (Literal.false <$ rawSource)
 
-identifier :: Assignment Term
+identifier :: Assignment (Term Loc)
 identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier . name <$> source)
 
-class' :: Assignment Term
+class' :: Assignment (Term Loc)
 class' = makeClass <$> (symbol Class <|> symbol ClassDeclaration) <*> children ((,,,,) <$> manyTerm decorator
                                                                                        <*> (term typeIdentifier <|> emptyTerm)
                                                                                        <*> (symbol TypeParameters *> children (manyTerm typeParameter') <|> pure [])
@@ -396,26 +232,26 @@ class' = makeClass <$> (symbol Class <|> symbol ClassDeclaration) <*> children (
                                                                                        <*> classBodyStatements)
   where makeClass loc (decorators, expression, typeParams, classHeritage, statements) = makeTerm loc (Declaration.Class (decorators <> typeParams) expression classHeritage statements)
 
-object :: Assignment Term
+object :: Assignment (Term Loc)
 object = makeTerm <$> (symbol Object <|> symbol ObjectPattern) <*> children (Literal.Hash <$> manyTerm (pair <|> spreadElement <|> methodDefinition <|> assignmentPattern <|> shorthandPropertyIdentifier))
 
-array :: Assignment Term
+array :: Assignment (Term Loc)
 array = makeTerm <$> (symbol Array <|> symbol ArrayPattern) <*> children (Literal.Array <$> manyTerm (expression <|> spreadElement))
 
-propertyIdentifier :: Assignment Term
+propertyIdentifier :: Assignment (Term Loc)
 propertyIdentifier = makeTerm <$> symbol PropertyIdentifier <*> (Syntax.Identifier . name <$> source)
 
-sequenceExpression :: Assignment Term
+sequenceExpression :: Assignment (Term Loc)
 sequenceExpression = makeTerm <$> symbol Grammar.SequenceExpression <*> children (Expression.SequenceExpression <$> term expression <*> term expressions)
 
-expressions :: Assignment Term
+expressions :: Assignment (Term Loc)
 expressions = annotatedExpression <|> expression <|> sequenceExpression
 
-annotatedExpression :: Assignment Term
+annotatedExpression :: Assignment (Term Loc)
 annotatedExpression = mkAnnotated <$> location <*> expression <*> typeAnnotation'
   where mkAnnotated loc expr ann = makeTerm loc (TypeScript.Syntax.AnnotatedExpression expr ann)
 
-parameter :: Assignment Term
+parameter :: Assignment (Term Loc)
 parameter =  requiredParameter
          <|> restParameter
          <|> optionalParameter
@@ -428,23 +264,23 @@ accessibilityModifier' = (symbol AccessibilityModifier >> children (public <|> p
         default'  = pure ScopeGraph.Public
 
 
-destructuringPattern :: Assignment Term
+destructuringPattern :: Assignment (Term Loc)
 destructuringPattern = object <|> array
 
-spreadElement :: Assignment Term
+spreadElement :: Assignment (Term Loc)
 spreadElement = symbol SpreadElement *> children (term expression)
 
-readonly' :: Assignment Term
+readonly' :: Assignment (Term Loc)
 readonly' = makeTerm <$> symbol Readonly <*> (Type.Readonly <$ rawSource)
 
-methodDefinition :: Assignment Term
+methodDefinition :: Assignment (Term Loc)
 methodDefinition = makeMethod <$>
   symbol MethodDefinition
   <*> children ((,,,,,) <$> accessibilityModifier' <*> (term readonly' <|> emptyTerm) <*> emptyTerm <*> term propertyName <*> callSignatureParts <*> term statementBlock)
   where
     makeMethod loc (modifier, readonly, receiver, propertyName', (typeParameters', params, ty'), statements) = makeTerm loc (Declaration.Method [readonly, typeParameters', ty'] receiver propertyName' params statements modifier)
 
-callSignatureParts :: Assignment (Term, [Term], Term)
+callSignatureParts :: Assignment (Term Loc, [Term Loc], Term Loc)
 callSignatureParts = contextualize' <$> Assignment.manyThrough comment (postContextualize' <$> callSignature' <*> many comment)
   where
     callSignature' = (,,) <$> (term typeParameters <|> emptyTerm) <*> formalParameters <*> (term typeAnnotation' <|> emptyTerm)
@@ -455,20 +291,20 @@ callSignatureParts = contextualize' <$> Assignment.manyThrough comment (postCont
       Just cs -> (typeParams, formalParams, makeTerm1 (Syntax.Context cs annotation))
       Nothing -> (typeParams, formalParams, annotation)
 
-callSignature :: Assignment Term
+callSignature :: Assignment (Term Loc)
 callSignature =  makeTerm <$> symbol Grammar.CallSignature <*> children (TypeScript.Syntax.CallSignature <$> (fromMaybe <$> emptyTerm <*> optional (term typeParameters)) <*> formalParameters <*> (fromMaybe <$> emptyTerm <*> optional (term typeAnnotation')))
 
-constructSignature :: Assignment Term
+constructSignature :: Assignment (Term Loc)
 constructSignature = makeTerm <$> symbol Grammar.ConstructSignature <*> children (TypeScript.Syntax.ConstructSignature <$> (fromMaybe <$> emptyTerm <*> optional (term typeParameters)) <*> formalParameters <*> (fromMaybe <$> emptyTerm <*> optional (term typeAnnotation')))
 
-indexSignature :: Assignment Term
+indexSignature :: Assignment (Term Loc)
 indexSignature = makeTerm <$> symbol Grammar.IndexSignature <*> children (TypeScript.Syntax.IndexSignature <$> term identifier <*> predefinedTy <*> term typeAnnotation')
 
-methodSignature :: Assignment Term
+methodSignature :: Assignment (Term Loc)
 methodSignature = makeMethodSignature <$> symbol Grammar.MethodSignature <*> children ((,,,) <$> accessibilityModifier' <*> (term readonly' <|> emptyTerm) <*> term propertyName <*> callSignatureParts)
   where makeMethodSignature loc (accessControl, readonly, propertyName, (typeParams, params, annotation)) = makeTerm loc (Declaration.MethodSignature [readonly, typeParams, annotation] propertyName params accessControl)
 
-formalParameters :: Assignment [Term]
+formalParameters :: Assignment [Term Loc]
 formalParameters = symbol FormalParameters *> children (contextualize' <$> Assignment.manyThrough comment (postContextualize' <$> (concat <$> many ((\as b -> as <> [b]) <$> manyTerm decorator <*> term parameter)) <*> many comment))
   where
     contextualize' (cs, formalParams) = case nonEmpty cs of
@@ -479,37 +315,37 @@ formalParameters = symbol FormalParameters *> children (contextualize' <$> Assig
       Nothing -> formalParams
 
 
-decorator :: Assignment Term
+decorator :: Assignment (Term Loc)
 decorator = makeTerm <$> symbol Grammar.Decorator <*> children (TypeScript.Syntax.Decorator <$> term (identifier <|> memberExpression <|> callExpression))
 
-typeParameters :: Assignment Term
+typeParameters :: Assignment (Term Loc)
 typeParameters = makeTerm <$> symbol TypeParameters <*> children (Type.TypeParameters <$> manyTerm typeParameter')
 
-typeAnnotation' :: Assignment Term
+typeAnnotation' :: Assignment (Term Loc)
 typeAnnotation' = makeTerm <$> symbol TypeAnnotation <*> children (TypeScript.Syntax.Annotation <$> term ty)
 
-typeParameter' :: Assignment Term
+typeParameter' :: Assignment (Term Loc)
 typeParameter' = makeTerm <$> symbol Grammar.TypeParameter <*> children (TypeScript.Syntax.TypeParameter <$> term typeIdentifier <*> term (constraint <|> emptyTerm) <*> term (defaultType <|> emptyTerm))
 
-defaultType :: Assignment Term
+defaultType :: Assignment (Term Loc)
 defaultType = makeTerm <$> symbol Grammar.DefaultType <*> children (TypeScript.Syntax.DefaultType <$> term ty)
 
-constraint :: Assignment Term
+constraint :: Assignment (Term Loc)
 constraint = makeTerm <$> symbol Grammar.Constraint <*> children (TypeScript.Syntax.Constraint <$> term ty)
 
-function :: Assignment Term
+function :: Assignment (Term Loc)
 function = makeFunction <$> (symbol Grammar.Function <|> symbol Grammar.FunctionDeclaration <|> symbol Grammar.GeneratorFunction <|> symbol Grammar.GeneratorFunctionDeclaration) <*> children ((,,) <$> term (identifier <|> emptyTerm) <*> callSignatureParts <*> term statementBlock)
   where makeFunction loc (id, (typeParams, params, annotation), statements) = makeTerm loc (Declaration.Function [typeParams, annotation] id params statements)
 
 -- TODO: FunctionSignatures can, but don't have to be ambient functions.
-ambientFunction :: Assignment Term
+ambientFunction :: Assignment (Term Loc)
 ambientFunction = makeAmbientFunction <$> symbol Grammar.FunctionSignature <*> children ((,) <$> term identifier <*> callSignatureParts)
   where makeAmbientFunction loc (id, (typeParams, params, annotation)) = makeTerm loc (TypeScript.Syntax.AmbientFunction [typeParams, annotation] id params)
 
-ty :: Assignment Term
+ty :: Assignment (Term Loc)
 ty = primaryType <|> unionType <|> intersectionType <|> functionTy <|> constructorTy
 
-primaryType :: Assignment Term
+primaryType :: Assignment (Term Loc)
 primaryType =  arrayTy
            <|> existentialType
            <|> flowMaybeTy
@@ -527,76 +363,76 @@ primaryType =  arrayTy
            <|> typePredicate
            <|> typeQuery
 
-parenthesizedTy :: Assignment Term
+parenthesizedTy :: Assignment (Term Loc)
 parenthesizedTy = makeTerm <$> symbol Grammar.ParenthesizedType <*> children (TypeScript.Syntax.ParenthesizedType <$> term ty)
 
-predefinedTy :: Assignment Term
+predefinedTy :: Assignment (Term Loc)
 predefinedTy = makeTerm <$> symbol Grammar.PredefinedType <*> (TypeScript.Syntax.PredefinedType <$> source)
 
-typeIdentifier :: Assignment Term
+typeIdentifier :: Assignment (Term Loc)
 typeIdentifier = makeTerm <$> symbol Grammar.TypeIdentifier <*> (TypeScript.Syntax.TypeIdentifier <$> source)
 
-nestedIdentifier :: Assignment Term
+nestedIdentifier :: Assignment (Term Loc)
 nestedIdentifier = makeTerm <$> symbol Grammar.NestedIdentifier <*> children (TypeScript.Syntax.NestedIdentifier <$> term (identifier <|> nestedIdentifier) <*> term identifier)
 
-nestedTypeIdentifier :: Assignment Term
+nestedTypeIdentifier :: Assignment (Term Loc)
 nestedTypeIdentifier = makeTerm <$> symbol Grammar.NestedTypeIdentifier <*> children (TypeScript.Syntax.NestedTypeIdentifier <$> term (identifier <|> nestedIdentifier) <*> term typeIdentifier)
 
-genericType :: Assignment Term
+genericType :: Assignment (Term Loc)
 genericType = makeTerm <$> symbol Grammar.GenericType <*> children (TypeScript.Syntax.GenericType <$> term (typeIdentifier <|> nestedTypeIdentifier) <*> term typeArguments')
 
-typeArguments' :: Assignment Term
+typeArguments' :: Assignment (Term Loc)
 typeArguments' = makeTerm <$> symbol Grammar.TypeArguments <*> children (TypeScript.Syntax.TypeArguments <$> some (term ty))
 
-typePredicate :: Assignment Term
+typePredicate :: Assignment (Term Loc)
 typePredicate = makeTerm <$> symbol Grammar.TypePredicate <*> children (TypeScript.Syntax.TypePredicate <$> term identifier <*> term ty)
 
-objectType :: Assignment Term
+objectType :: Assignment (Term Loc)
 objectType = makeTerm <$> symbol Grammar.ObjectType <*> children (TypeScript.Syntax.ObjectType <$> manyTerm (exportStatement <|> propertySignature <|> callSignature <|> constructSignature <|> indexSignature <|> methodSignature))
 
-arrayTy :: Assignment Term
+arrayTy :: Assignment (Term Loc)
 arrayTy = makeTerm <$> symbol Grammar.ArrayType <*> children (TypeScript.Syntax.ArrayType <$> term ty)
 
-lookupType :: Assignment Term
+lookupType :: Assignment (Term Loc)
 lookupType = makeTerm <$> symbol Grammar.LookupType <*> children (TypeScript.Syntax.LookupType <$> term (typeIdentifier <|> nestedTypeIdentifier) <*> term ty)
 
-flowMaybeTy :: Assignment Term
+flowMaybeTy :: Assignment (Term Loc)
 flowMaybeTy = makeTerm <$> symbol Grammar.FlowMaybeType <*> children (TypeScript.Syntax.FlowMaybeType <$> term primaryType)
 
-typeQuery :: Assignment Term
+typeQuery :: Assignment (Term Loc)
 typeQuery = makeTerm <$> symbol Grammar.TypeQuery <*> children (TypeScript.Syntax.TypeQuery <$> term (identifier <|> nestedIdentifier))
 
-indexTypeQuery :: Assignment Term
+indexTypeQuery :: Assignment (Term Loc)
 indexTypeQuery = makeTerm <$> symbol Grammar.IndexTypeQuery <*> children (TypeScript.Syntax.IndexTypeQuery <$> term (typeIdentifier <|> nestedTypeIdentifier))
 
-existentialType :: Assignment Term
+existentialType :: Assignment (Term Loc)
 existentialType = makeTerm <$> symbol Grammar.ExistentialType <*> (TypeScript.Syntax.ExistentialType <$> source)
 
-literalType :: Assignment Term
+literalType :: Assignment (Term Loc)
 literalType = makeTerm <$> symbol Grammar.LiteralType <*> children (TypeScript.Syntax.LiteralType <$> term (number <|> string <|> true <|> false))
 
-unionType :: Assignment Term
+unionType :: Assignment (Term Loc)
 unionType = makeTerm <$> symbol UnionType <*> children (TypeScript.Syntax.Union <$> (term ty <|> emptyTerm) <*> term ty)
 
-intersectionType :: Assignment Term
+intersectionType :: Assignment (Term Loc)
 intersectionType = makeTerm <$> symbol IntersectionType <*> children (TypeScript.Syntax.Intersection <$> term ty <*> term ty)
 
-functionTy :: Assignment Term
+functionTy :: Assignment (Term Loc)
 functionTy = makeTerm <$> symbol Grammar.FunctionType <*> children (TypeScript.Syntax.FunctionType <$> (fromMaybe <$> emptyTerm <*> optional (term typeParameters)) <*> formalParameters <*> term ty)
 
-tupleType :: Assignment Term
+tupleType :: Assignment (Term Loc)
 tupleType = makeTerm <$> symbol TupleType <*> children (TypeScript.Syntax.Tuple <$> manyTerm ty)
 
-constructorTy :: Assignment Term
+constructorTy :: Assignment (Term Loc)
 constructorTy = makeTerm <$> symbol ConstructorType <*> children (TypeScript.Syntax.Constructor <$> (fromMaybe <$> emptyTerm <*> optional (term typeParameters)) <*> formalParameters <*> term ty)
 
-statementTerm :: Assignment Term
+statementTerm :: Assignment (Term Loc)
 statementTerm = makeTerm <$> symbol StatementBlock <*> children (Statement.Statements <$> manyTerm statement)
 
-statementBlock :: Assignment Term
+statementBlock :: Assignment (Term Loc)
 statementBlock = makeTerm <$> symbol StatementBlock <*> children (Statement.StatementBlock <$> manyTerm statement)
 
-classBodyStatements :: Assignment Term
+classBodyStatements :: Assignment (Term Loc)
 classBodyStatements = makeTerm'' <$> symbol ClassBody <*> children (contextualize' <$> Assignment.manyThrough comment (postContextualize' <$> (concat <$> many ((\as b -> as <> [b]) <$> manyTerm decorator <*> term (methodDefinition <|> publicFieldDefinition <|> methodSignature <|> indexSignature <|> abstractMethodSignature))) <*> many comment))
   where
     contextualize' (cs, formalParams) = case nonEmpty cs of
@@ -606,12 +442,12 @@ classBodyStatements = makeTerm'' <$> symbol ClassBody <*> children (contextualiz
       Just cs -> formalParams <> toList cs
       Nothing -> formalParams
 
-publicFieldDefinition :: Assignment Term
+publicFieldDefinition :: Assignment (Term Loc)
 publicFieldDefinition = makeField <$> symbol Grammar.PublicFieldDefinition <*> children ((,,,,) <$> accessibilityModifier' <*> (term readonly' <|> emptyTerm) <*> term propertyName <*> (term typeAnnotation' <|> emptyTerm) <*> (term expression <|> emptyTerm))
   where makeField loc (accessControl, readonly, propertyName, annotation, expression) = makeTerm loc (Declaration.PublicFieldDefinition [readonly, annotation] propertyName expression accessControl)
 
 
-statement :: Assignment Term
+statement :: Assignment (Term Loc)
 statement = handleError everything
   where
     everything = choice [
@@ -637,37 +473,37 @@ statement = handleError everything
       , emptyStatement
       , labeledStatement ]
 
-forInStatement :: Assignment Term
+forInStatement :: Assignment (Term Loc)
 forInStatement = makeTerm <$> symbol ForInStatement <*> children (Statement.ForEach <$> term expression <*> term expression <*> term statement)
 
-doStatement :: Assignment Term
+doStatement :: Assignment (Term Loc)
 doStatement = makeTerm <$> symbol DoStatement <*> children (flip Statement.DoWhile <$> term statement <*> term parenthesizedExpression)
 
-continueStatement :: Assignment Term
+continueStatement :: Assignment (Term Loc)
 continueStatement = makeTerm <$> symbol ContinueStatement <*> children (Statement.Continue <$> (statementIdentifier <|> term emptyTerm))
 
-breakStatement :: Assignment Term
+breakStatement :: Assignment (Term Loc)
 breakStatement = makeTerm <$> symbol BreakStatement <*> children (Statement.Break <$> (statementIdentifier <|> term emptyTerm))
 
-withStatement :: Assignment Term
+withStatement :: Assignment (Term Loc)
 withStatement = makeTerm <$> symbol WithStatement <*> children (TypeScript.Syntax.With <$> term parenthesizedExpression <*> term statement)
 
-returnStatement :: Assignment Term
+returnStatement :: Assignment (Term Loc)
 returnStatement = makeTerm <$> symbol ReturnStatement <*> children (Statement.Return <$> (term expressions <|> term emptyTerm))
 
-throwStatement :: Assignment Term
+throwStatement :: Assignment (Term Loc)
 throwStatement = makeTerm <$> symbol Grammar.ThrowStatement <*> children (Statement.Throw <$> term expressions)
 
-hashBang :: Assignment Term
+hashBang :: Assignment (Term Loc)
 hashBang = makeTerm <$> symbol HashBangLine <*> (Comment.HashBang <$> source)
 
-labeledStatement :: Assignment Term
+labeledStatement :: Assignment (Term Loc)
 labeledStatement = makeTerm <$> symbol Grammar.LabeledStatement <*> children (TypeScript.Syntax.LabeledStatement <$> statementIdentifier <*> term statement)
 
-statementIdentifier :: Assignment Term
+statementIdentifier :: Assignment (Term Loc)
 statementIdentifier = makeTerm <$> symbol StatementIdentifier <*> (Syntax.Identifier . name <$> source)
 
-importStatement :: Assignment Term
+importStatement :: Assignment (Term Loc)
 importStatement =   makeImportTerm <$> symbol Grammar.ImportStatement <*> children ((,) <$> importClause <*> fromClause)
                 <|> makeTerm' <$> symbol Grammar.ImportStatement <*> children (requireImport <|> sideEffectImport)
   where
@@ -702,13 +538,13 @@ importStatement =   makeImportTerm <$> symbol Grammar.ImportStatement <*> childr
     -- TODO: Need to validate that inline comments are still handled with this change in assigning to Path and not a Term.
     fromClause = symbol Grammar.String *> (TypeScript.Resolution.importPath <$> source)
 
-debuggerStatement :: Assignment Term
+debuggerStatement :: Assignment (Term Loc)
 debuggerStatement = makeTerm <$> symbol Grammar.DebuggerStatement <*> (TypeScript.Syntax.Debugger <$ rawSource)
 
-expressionStatement' :: Assignment Term
+expressionStatement' :: Assignment (Term Loc)
 expressionStatement' = symbol ExpressionStatement *> children (term expressions)
 
-declaration :: Assignment Term
+declaration :: Assignment (Term Loc)
 declaration = everything
   where
     everything = choice [
@@ -727,24 +563,24 @@ declaration = everything
       ambientDeclaration
       ]
 
-typeAliasDeclaration :: Assignment Term
+typeAliasDeclaration :: Assignment (Term Loc)
 typeAliasDeclaration = makeTypeAliasDecl <$> symbol Grammar.TypeAliasDeclaration <*> children ((,,) <$> term typeIdentifier <*> (term typeParameters <|> emptyTerm) <*> term ty)
   where makeTypeAliasDecl loc (identifier, typeParams, body) = makeTerm loc (Declaration.TypeAlias [typeParams] identifier body)
 
-enumDeclaration :: Assignment Term
+enumDeclaration :: Assignment (Term Loc)
 enumDeclaration = makeTerm <$> symbol Grammar.EnumDeclaration <*> children (TypeScript.Syntax.EnumDeclaration <$> term identifier <*> (symbol EnumBody *> children (manyTerm (propertyName <|> enumAssignment))))
 
-enumAssignment :: Assignment Term
+enumAssignment :: Assignment (Term Loc)
 enumAssignment = makeTerm <$> symbol Grammar.EnumAssignment <*> children (Statement.Assignment [] <$> term propertyName <*> term expression)
 
-interfaceDeclaration :: Assignment Term
+interfaceDeclaration :: Assignment (Term Loc)
 interfaceDeclaration = makeInterfaceDecl <$> symbol Grammar.InterfaceDeclaration <*> children ((,,,) <$> term typeIdentifier <*> (term typeParameters <|> emptyTerm) <*> optional (term extendsClause) <*> term objectType)
   where makeInterfaceDecl loc (identifier, typeParams, clause, objectType) = makeTerm loc (Declaration.InterfaceDeclaration [typeParams] identifier (toList clause) objectType)
 
-ambientDeclaration :: Assignment Term
+ambientDeclaration :: Assignment (Term Loc)
 ambientDeclaration = makeTerm <$> symbol Grammar.AmbientDeclaration <*> children (TypeScript.Syntax.AmbientDeclaration <$> term (choice [propertyIdentifier *> ty, declaration, statementBlock]))
 
-exportStatement :: Assignment Term
+exportStatement :: Assignment (Term Loc)
 exportStatement = makeTerm <$> symbol Grammar.ExportStatement <*> children (flip TypeScript.Syntax.QualifiedExportFrom <$> exportClause <*> fromClause)
   <|> makeTerm <$> symbol Grammar.ExportStatement <*> children (TypeScript.Syntax.QualifiedExport <$> exportClause)
   <|> makeTerm <$> symbol Grammar.ExportStatement <*> children (TypeScript.Syntax.DefaultExport <$> contextualize decorator (term (declaration <|> expression <|> identifier <|> importAlias')))
@@ -758,23 +594,23 @@ exportStatement = makeTerm <$> symbol Grammar.ExportStatement <*> children (flip
     -- TODO: Need to validate that inline comments are still handled with this change in assigning to Path and not a Term.
     fromClause = symbol Grammar.String *> (TypeScript.Resolution.importPath <$> source)
 
-propertySignature :: Assignment Term
+propertySignature :: Assignment (Term Loc)
 propertySignature = makePropertySignature <$> symbol Grammar.PropertySignature <*> children ((,,,) <$> accessibilityModifier' <*> (term readonly' <|> emptyTerm) <*> term propertyName <*> (term typeAnnotation' <|> emptyTerm))
   where makePropertySignature loc (modifier, readonly, propertyName, annotation) = makeTerm loc (TypeScript.Syntax.PropertySignature [readonly, annotation] propertyName modifier)
 
-propertyName :: Assignment Term
+propertyName :: Assignment (Term Loc)
 propertyName = term (propertyIdentifier <|> string <|> number <|> computedPropertyName)
 
-computedPropertyName :: Assignment Term
+computedPropertyName :: Assignment (Term Loc)
 computedPropertyName = makeTerm <$> symbol Grammar.ComputedPropertyName <*> children (TypeScript.Syntax.ComputedPropertyName <$> term expression)
 
-assignmentPattern :: Assignment Term
+assignmentPattern :: Assignment (Term Loc)
 assignmentPattern = makeTerm <$> symbol AssignmentPattern <*> children (Statement.Assignment [] <$> term shorthandPropertyIdentifier <*> term expression)
 
-shorthandPropertyIdentifier :: Assignment Term
+shorthandPropertyIdentifier :: Assignment (Term Loc)
 shorthandPropertyIdentifier = makeTerm <$> symbol Grammar.ShorthandPropertyIdentifier <*> (TypeScript.Syntax.ShorthandPropertyIdentifier <$> source)
 
-requiredParameter :: Assignment Term
+requiredParameter :: Assignment (Term Loc)
 requiredParameter = makeRequiredParameter
                  <$> symbol Grammar.RequiredParameter
                  <*> children ( (,,,,)
@@ -786,44 +622,44 @@ requiredParameter = makeRequiredParameter
   where
     makeRequiredParameter loc (modifier, readonly, identifier, annotation, initializer) = makeTerm loc (TypeScript.Syntax.RequiredParameter [readonly, annotation] identifier initializer modifier)
 
-restParameter :: Assignment Term
+restParameter :: Assignment (Term Loc)
 restParameter = makeRestParameter <$> symbol Grammar.RestParameter <*> children ((,) <$> term identifier <*> (term typeAnnotation' <|> emptyTerm))
   where makeRestParameter loc (identifier, annotation) = makeTerm loc (TypeScript.Syntax.RestParameter [annotation] identifier)
 
-optionalParameter :: Assignment Term
+optionalParameter :: Assignment (Term Loc)
 optionalParameter = makeOptionalParam <$> symbol Grammar.OptionalParameter <*> children ((,,,,) <$> accessibilityModifier' <*> (term readonly' <|> emptyTerm) <*> (term identifier <|> destructuringPattern) <*> (term typeAnnotation' <|> emptyTerm) <*> (term expression <|> emptyTerm))
   where makeOptionalParam loc (modifier, readonly, subject, annotation, initializer) = makeTerm loc (TypeScript.Syntax.OptionalParameter [readonly, annotation] (makeTerm loc (Statement.Assignment [] subject initializer)) modifier)
 
-internalModule :: Assignment Term
+internalModule :: Assignment (Term Loc)
 internalModule = makeTerm <$> symbol Grammar.InternalModule <*> children (TypeScript.Syntax.InternalModule <$> term (string <|> identifier <|> nestedIdentifier) <*> statements)
 
-module' :: Assignment Term
+module' :: Assignment (Term Loc)
 module' = makeTerm <$> symbol Module <*> children (TypeScript.Syntax.Module <$> term (string <|> identifier <|> nestedIdentifier) <*> (statements <|> pure []))
 
 
-statements :: Assignment [Term]
+statements :: Assignment [Term Loc]
 statements = symbol StatementBlock *> children (manyTerm statement)
 
-arrowFunction :: Assignment Term
+arrowFunction :: Assignment (Term Loc)
 arrowFunction = makeArrowFun <$> symbol ArrowFunction <*> children ((,,) <$> emptyTerm <*> (((\a b c -> (a, [b], c)) <$> emptyTerm <*> term identifier <*> emptyTerm) <|> callSignatureParts) <*> term (expression <|> statementBlock))
   where makeArrowFun loc (identifier, (typeParams, params, returnTy), body) = makeTerm loc (Declaration.Function [ typeParams, returnTy ] identifier params body)
 
-comment :: Assignment Term
+comment :: Assignment (Term Loc)
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
-ifStatement :: Assignment Term
+ifStatement :: Assignment (Term Loc)
 ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> term parenthesizedExpression <*> term statement <*> (term statement <|> emptyTerm))
 
-whileStatement :: Assignment Term
+whileStatement :: Assignment (Term Loc)
 whileStatement = makeTerm <$> symbol WhileStatement <*> children (Statement.While <$> term expression <*> term statement)
 
-forStatement :: Assignment Term
+forStatement :: Assignment (Term Loc)
 forStatement = makeTerm <$> symbol ForStatement <*> children (Statement.For <$> term (variableDeclaration <|> expressionStatement' <|> emptyStatement) <*> term (expressionStatement' <|> emptyStatement) <*> term (expressions <|> emptyTerm) <*> term statement)
 
-variableDeclaration :: Assignment Term
+variableDeclaration :: Assignment (Term Loc)
 variableDeclaration = makeTerm <$> (symbol Grammar.VariableDeclaration <|> symbol Grammar.LexicalDeclaration) <*> children (Declaration.VariableDeclaration <$> manyTerm variableDeclarator)
 
-variableDeclarator :: Assignment Term
+variableDeclarator :: Assignment (Term Loc)
 variableDeclarator =
       makeTerm <$> symbol VariableDeclarator <*> children (TypeScript.Syntax.JavaScriptRequire <$> identifier <*> requireCall)
   <|> makeVarDecl <$> symbol VariableDeclarator <*> children ((,,) <$> term (identifier <|> destructuringPattern) <*> (term typeAnnotation' <|> emptyTerm) <*> (term expression <|> emptyTerm))
@@ -837,37 +673,37 @@ variableDeclarator =
       )
 
 
-parenthesizedExpression :: Assignment Term
+parenthesizedExpression :: Assignment (Term Loc)
 parenthesizedExpression = symbol ParenthesizedExpression *> children (term expressions)
 
-switchStatement :: Assignment Term
+switchStatement :: Assignment (Term Loc)
 switchStatement = makeTerm <$> symbol SwitchStatement <*> children (Statement.Match <$> term parenthesizedExpression <*> term switchBody)
   where
     switchBody =  symbol SwitchBody *> children (makeTerm <$> location <*> manyTerm switchCase)
     switchCase = makeTerm <$> (symbol SwitchCase <|> symbol SwitchDefault) <*> children (Statement.Pattern <$> (term expressions <|> emptyTerm) <*> (makeTerm <$> location <*> manyTerm statement))
 
-subscriptExpression :: Assignment Term
+subscriptExpression :: Assignment (Term Loc)
 subscriptExpression = makeTerm <$> symbol SubscriptExpression <*> children (Expression.Subscript <$> term expression <*> (pure <$> term expressions))
 
-pair :: Assignment Term
+pair :: Assignment (Term Loc)
 pair = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> term propertyName <*> term expression)
 
-callExpression :: Assignment Term
+callExpression :: Assignment (Term Loc)
 callExpression = makeCall <$> (symbol CallExpression <|> symbol CallExpression') <*> children ((,,,) <$> term (expression <|> super <|> function) <*> (typeArguments <|> pure []) <*> (arguments <|> (pure <$> term templateString)) <*> emptyTerm)
   where makeCall loc (subject, typeArgs, args, body) = makeTerm loc (Expression.Call typeArgs subject args body)
         typeArguments = symbol Grammar.TypeArguments *> children (some (term ty))
 
-arguments :: Assignment [Term]
+arguments :: Assignment [Term Loc]
 arguments = symbol Arguments *> children (manyTerm (expression <|> spreadElement))
 
-tryStatement :: Assignment Term
+tryStatement :: Assignment (Term Loc)
 tryStatement = makeTry <$> symbol TryStatement <*> children ((,,) <$> term statementTerm <*> optional (term catchClause) <*> optional (term finallyClause))
   where
     makeTry loc (statementBlock', catch, finally) = makeTerm loc (Statement.Try statementBlock' (catMaybes [catch, finally]))
     catchClause = makeTerm <$> symbol CatchClause <*> children (Statement.Catch <$> (identifier <|> emptyTerm) <*> statementTerm)
     finallyClause = makeTerm <$> symbol FinallyClause <*> children (Statement.Finally <$> statementTerm)
 
-binaryExpression  :: Assignment Term
+binaryExpression  :: Assignment (Term Loc)
 binaryExpression = makeTerm' <$> symbol BinaryExpression <*> children (infixTerm expression (term expression)
   [ (inject .) . Expression.Plus               <$ symbol AnonPlus
   , (inject .) . Expression.Minus              <$ symbol AnonMinus
@@ -899,18 +735,18 @@ binaryExpression = makeTerm' <$> symbol BinaryExpression <*> children (infixTerm
 -- Helpers
 
 -- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
-manyTerm :: Assignment Term -> Assignment [Term]
+manyTerm :: Assignment (Term Loc) -> Assignment [Term Loc]
 manyTerm term = many (contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm))
 
-term :: Assignment Term -> Assignment Term
+term :: Assignment (Term Loc) -> Assignment (Term Loc)
 term term = contextualize comment (postContextualize comment term)
 
-emptyStatement :: Assignment Term
+emptyStatement :: Assignment (Term Loc)
 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 Term
-          -> Assignment Term
-          -> [Assignment (Term -> Term -> Sum Syntax Term)]
-          -> Assignment (Sum Syntax Term)
+infixTerm :: Assignment (Term Loc)
+          -> Assignment (Term Loc)
+          -> [Assignment (Term Loc -> Term Loc -> Sum TypeScript.Syntax (Term Loc))]
+          -> Assignment (Sum TypeScript.Syntax (Term Loc))
 infixTerm = infixContext comment

src/Language/TypeScript/Term.hs

@@ -0,0 +1,229 @@
+{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies #-}
+module Language.TypeScript.Term
+( Syntax
+, Term(..)
+) where
+
+import Control.Lens.Lens
+import Data.Abstract.Declarations
+import Data.Abstract.FreeVariables
+import Data.Aeson (ToJSON)
+import Data.Bifunctor
+import Data.Bitraversable
+import Data.Coerce
+import Data.Foldable (fold)
+import Data.Functor.Foldable (Base, Recursive(..))
+import Data.Graph.ControlFlowVertex (VertexDeclaration(..), toVertex1)
+import qualified Data.Sum as Sum
+import qualified Data.Syntax as Syntax
+import qualified Data.Syntax.Comment as Comment
+import qualified Data.Syntax.Declaration as Declaration
+import qualified Data.Syntax.Expression as Expression
+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 Data.Traversable
+import Diffing.Interpreter
+import qualified Language.TypeScript.Syntax as TypeScript.Syntax
+import Source.Loc
+import Source.Span
+
+type Syntax =
+  [ Comment.Comment
+  , Comment.HashBang
+  , Declaration.Class
+  , Declaration.Function
+  , Declaration.Method
+  , Declaration.MethodSignature
+  , Declaration.InterfaceDeclaration
+  , Declaration.PublicFieldDefinition
+  , Declaration.VariableDeclaration
+  , Declaration.TypeAlias
+  , Expression.Plus
+  , Expression.Minus
+  , Expression.Times
+  , Expression.DividedBy
+  , Expression.Modulo
+  , Expression.Power
+  , Expression.Negate
+  , Expression.FloorDivision
+  , Expression.BAnd
+  , Expression.BOr
+  , Expression.BXOr
+  , Expression.LShift
+  , Expression.RShift
+  , Expression.UnsignedRShift
+  , Expression.Complement
+  , Expression.And
+  , Expression.Not
+  , Expression.Or
+  , Expression.XOr
+  , Expression.Call
+  , Expression.Cast
+  , Expression.LessThan
+  , Expression.LessThanEqual
+  , Expression.GreaterThan
+  , Expression.GreaterThanEqual
+  , Expression.Equal
+  , Expression.StrictEqual
+  , Expression.Comparison
+  , Expression.Enumeration
+  , Expression.MemberAccess
+  , Expression.NonNullExpression
+  , Expression.ScopeResolution
+  , Expression.SequenceExpression
+  , Expression.Subscript
+  , Expression.Member
+  , Expression.Delete
+  , Expression.Void
+  , Expression.Typeof
+  , Expression.InstanceOf
+  , Expression.New
+  , Expression.Await
+  , Expression.This
+  , Literal.Array
+  , Literal.Boolean
+  , Literal.Float
+  , Literal.Hash
+  , Literal.Integer
+  , Literal.KeyValue
+  , Literal.Null
+  , Literal.String
+  , Literal.TextElement
+  , Literal.Regex
+  , Statement.Assignment
+  , Statement.Break
+  , Statement.Catch
+  , Statement.Continue
+  , Statement.DoWhile
+  , Statement.Else
+  , Statement.Finally
+  , Statement.For
+  , Statement.ForEach
+  , Statement.If
+  , Statement.Match
+  , Statement.Pattern
+  , Statement.Retry
+  , Statement.Return
+  , Statement.ScopeEntry
+  , Statement.ScopeExit
+  , Statement.Statements
+  , Statement.Throw
+  , Statement.Try
+  , Statement.While
+  , Statement.Yield
+  , Syntax.AccessibilityModifier
+  , Syntax.Empty
+  , Syntax.Error
+  , Syntax.Identifier
+  , Syntax.Context
+  , Type.Readonly
+  , Type.TypeParameters
+  , TypeScript.Syntax.TypeParameter
+  , TypeScript.Syntax.Constraint
+  , TypeScript.Syntax.ParenthesizedType
+  , TypeScript.Syntax.DefaultType
+  , TypeScript.Syntax.PredefinedType
+  , TypeScript.Syntax.TypeIdentifier
+  , TypeScript.Syntax.NestedIdentifier
+  , TypeScript.Syntax.NestedTypeIdentifier
+  , TypeScript.Syntax.GenericType
+  , TypeScript.Syntax.TypeArguments
+  , TypeScript.Syntax.TypePredicate
+  , TypeScript.Syntax.CallSignature
+  , TypeScript.Syntax.ConstructSignature
+  , TypeScript.Syntax.ArrayType
+  , TypeScript.Syntax.LookupType
+  , TypeScript.Syntax.FlowMaybeType
+  , TypeScript.Syntax.TypeQuery
+  , TypeScript.Syntax.IndexTypeQuery
+  , TypeScript.Syntax.ThisType
+  , TypeScript.Syntax.ExistentialType
+  , TypeScript.Syntax.AbstractMethodSignature
+  , TypeScript.Syntax.IndexSignature
+  , TypeScript.Syntax.ObjectType
+  , TypeScript.Syntax.LiteralType
+  , TypeScript.Syntax.Union
+  , TypeScript.Syntax.Intersection
+  , TypeScript.Syntax.Module
+  , TypeScript.Syntax.InternalModule
+  , TypeScript.Syntax.FunctionType
+  , TypeScript.Syntax.Tuple
+  , TypeScript.Syntax.Constructor
+  , TypeScript.Syntax.TypeAssertion
+  , TypeScript.Syntax.ImportAlias
+  , TypeScript.Syntax.Debugger
+  , TypeScript.Syntax.ShorthandPropertyIdentifier
+  , TypeScript.Syntax.Super
+  , TypeScript.Syntax.Undefined
+  , TypeScript.Syntax.ClassHeritage
+  , TypeScript.Syntax.AbstractClass
+  , TypeScript.Syntax.ImplementsClause
+  , TypeScript.Syntax.OptionalParameter
+  , TypeScript.Syntax.RequiredParameter
+  , TypeScript.Syntax.RestParameter
+  , TypeScript.Syntax.PropertySignature
+  , TypeScript.Syntax.AmbientDeclaration
+  , TypeScript.Syntax.EnumDeclaration
+  , TypeScript.Syntax.ExtendsClause
+  , TypeScript.Syntax.AmbientFunction
+  , TypeScript.Syntax.ImportRequireClause
+  , TypeScript.Syntax.ImportClause
+  , TypeScript.Syntax.LabeledStatement
+  , TypeScript.Syntax.Annotation
+  , TypeScript.Syntax.With
+  , TypeScript.Syntax.ForOf
+  , TypeScript.Syntax.Update
+  , TypeScript.Syntax.ComputedPropertyName
+  , TypeScript.Syntax.Decorator
+  , TypeScript.Syntax.Import
+  , TypeScript.Syntax.QualifiedAliasedImport
+  , TypeScript.Syntax.SideEffectImport
+  , TypeScript.Syntax.DefaultExport
+  , TypeScript.Syntax.QualifiedExport
+  , TypeScript.Syntax.QualifiedExportFrom
+  , TypeScript.Syntax.JavaScriptRequire
+  , []
+  , Statement.StatementBlock
+  , TypeScript.Syntax.MetaProperty
+  , TypeScript.Syntax.AnnotatedExpression
+  ]
+
+
+newtype Term ann = Term { getTerm :: Term.TermF (Sum.Sum Syntax) ann (Term ann) }
+  deriving (Eq, Declarations, FreeVariables, Ord, Show, ToJSON)
+
+instance Term.IsTerm Term where
+  type Syntax Term = Sum.Sum Syntax
+  toTermF = coerce
+  fromTermF = coerce
+
+instance Foldable Term where
+  foldMap = foldMapDefault
+
+instance Functor Term where
+  fmap = fmapDefault
+
+instance Traversable Term where
+  traverse f = go where go = fmap Term . bitraverse f go . getTerm
+
+instance VertexDeclaration Term where
+  toVertex info (Term (Term.In ann syntax)) = toVertex1 ann info syntax
+
+instance Syntax.HasErrors Term where
+  getErrors = cata $ \ (Term.In Loc{..} syntax) ->
+    maybe (fold syntax) (pure . Syntax.unError span) (Sum.project syntax)
+
+
+instance DiffTerms Term where
+  diffTermPair = diffTermPair . bimap (cata Term.Term) (cata Term.Term)
+
+type instance Base (Term ann) = Term.TermF (Sum.Sum Syntax) ann
+
+instance Recursive (Term ann) where
+  project = getTerm
+
+instance HasSpan ann => HasSpan (Term ann) where
+  span_ = inner.span_ where inner = lens getTerm (\t i -> t { getTerm = i })
+  {-# INLINE span_ #-}

src/Parsing/Parser.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstraintKinds, GADTs, TypeOperators #-}
+{-# LANGUAGE ConstraintKinds, DataKinds, GADTs, TypeFamilies #-}
 module Parsing.Parser
 ( Parser(..)
 -- * À la carte parsers
@@ -26,6 +26,8 @@ module Parsing.Parser
 , rubyParser'
 , tsxParser'
 , typescriptParser'
+  -- * Modes by term type
+, TermMode
   -- * Canonical sets of parsers
 , aLaCarteParsers
 , preciseParsers
@@ -37,17 +39,16 @@ import qualified CMarkGFM
 import           Data.AST
 import           Data.Language
 import qualified Data.Map as Map
-import           Data.Sum
 import qualified Data.Syntax as Syntax
 import           Data.Term
 import           Foreign.Ptr
 import qualified Language.Go.Assignment as Go
-import qualified Language.Java as PreciseJava
-import qualified Language.JSON as PreciseJSON
+import qualified Language.Java as Java
+import qualified Language.JSON as JSON
 import qualified Language.Markdown.Assignment as Markdown
 import qualified Language.PHP.Assignment as PHP
-import qualified Language.Python as PrecisePython
-import qualified Language.Python.Assignment as Python
+import qualified Language.Python as PythonPrecise
+import qualified Language.Python.Assignment as PythonALaCarte
 import qualified Language.Ruby.Assignment as Ruby
 import qualified Language.TSX.Assignment as TSX
 import qualified Language.TypeScript.Assignment as TypeScript
@@ -69,44 +70,44 @@ data Parser term where
   -- | A parser 'Unmarshal'ing to a precise AST type using a 'TS.Language'.
   UnmarshalParser :: Unmarshal t => Ptr TS.Language -> Parser (t Loc)
   -- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type.
-  AssignmentParser :: (Enum grammar, Ix grammar, Show grammar, TS.Symbol grammar, Syntax.Error :< fs, Eq1 ast, Apply Foldable fs, Apply Functor fs, Foldable ast, Functor ast)
-                   => Parser (AST ast grammar)                   -- ^ A parser producing AST.
-                   -> Assignment ast grammar (Term (Sum fs) Loc) -- ^ An assignment from AST onto 'Term's.
-                   -> Parser (Term (Sum fs) Loc)                 -- ^ A parser producing 'Term's.
+  AssignmentParser :: (TS.Symbol grammar, Syntax.HasErrors term, Eq1 ast, Foldable term, Foldable ast, Functor ast)
+                   => Parser (AST ast grammar)          -- ^ A parser producing AST.
+                   -> Assignment ast grammar (term Loc) -- ^ An assignment from AST onto 'Term's.
+                   -> Parser (term Loc)                 -- ^ A parser producing 'Term's.
   -- | A parser for 'Markdown' using cmark.
   MarkdownParser :: Parser (AST (TermF [] CMarkGFM.NodeType) Markdown.Grammar)
 
 
-goParser :: Parser Go.Term
+goParser :: Parser (Go.Term Loc)
 goParser = AssignmentParser (ASTParser tree_sitter_go) Go.assignment
 
-rubyParser :: Parser Ruby.Term
+rubyParser :: Parser (Ruby.Term Loc)
 rubyParser = AssignmentParser (ASTParser tree_sitter_ruby) Ruby.assignment
 
-phpParser :: Parser PHP.Term
+phpParser :: Parser (PHP.Term Loc)
 phpParser = AssignmentParser (ASTParser tree_sitter_php) PHP.assignment
 
-pythonParser :: Parser Python.Term
-pythonParser = AssignmentParser (ASTParser tree_sitter_python) Python.assignment
+pythonParser :: Parser (PythonALaCarte.Term Loc)
+pythonParser = AssignmentParser (ASTParser tree_sitter_python) PythonALaCarte.assignment
 
-typescriptParser :: Parser TypeScript.Term
+typescriptParser :: Parser (TypeScript.Term Loc)
 typescriptParser = AssignmentParser (ASTParser tree_sitter_typescript) TypeScript.assignment
 
-tsxParser :: Parser TSX.Term
+tsxParser :: Parser (TSX.Term Loc)
 tsxParser = AssignmentParser (ASTParser tree_sitter_tsx) TSX.assignment
 
-markdownParser :: Parser Markdown.Term
+markdownParser :: Parser (Markdown.Term Loc)
 markdownParser = AssignmentParser MarkdownParser Markdown.assignment
 
 
-javaParserPrecise :: Parser (PreciseJava.Term Loc)
-javaParserPrecise = UnmarshalParser PreciseJava.tree_sitter_java
+javaParserPrecise :: Parser (Java.Term Loc)
+javaParserPrecise = UnmarshalParser Java.tree_sitter_java
 
-jsonParserPrecise :: Parser (PreciseJSON.Term Loc)
-jsonParserPrecise = UnmarshalParser PreciseJSON.tree_sitter_json
+jsonParserPrecise :: Parser (JSON.Term Loc)
+jsonParserPrecise = UnmarshalParser JSON.tree_sitter_json
 
-pythonParserPrecise :: Parser (PrecisePython.Term Loc)
-pythonParserPrecise = UnmarshalParser PrecisePython.tree_sitter_python
+pythonParserPrecise :: Parser (PythonPrecise.Term Loc)
+pythonParserPrecise = UnmarshalParser PythonPrecise.tree_sitter_python
 
 
 -- $abstract
@@ -140,57 +141,65 @@ pythonParserPrecise = UnmarshalParser PrecisePython.tree_sitter_python
 data SomeParser c a where
   SomeParser :: c t => Parser (t a) -> SomeParser c a
 
-goParser' :: c (Term (Sum Go.Syntax)) => (Language, SomeParser c Loc)
+goParser' :: c Go.Term => (Language, SomeParser c Loc)
 goParser' = (Go, SomeParser goParser)
 
-javaParser' :: c PreciseJava.Term => (Language, SomeParser c Loc)
+javaParser' :: c Java.Term => (Language, SomeParser c Loc)
 javaParser' = (Java, SomeParser javaParserPrecise)
 
-javascriptParser' :: c (Term (Sum TSX.Syntax)) => (Language, SomeParser c Loc)
+javascriptParser' :: c TSX.Term => (Language, SomeParser c Loc)
 javascriptParser' = (JavaScript, SomeParser tsxParser)
 
-jsonParserPrecise' :: c PreciseJSON.Term => (Language, SomeParser c Loc)
+jsonParserPrecise' :: c JSON.Term => (Language, SomeParser c Loc)
 jsonParserPrecise' = (JSON, SomeParser jsonParserPrecise)
 
-jsxParser' :: c (Term (Sum TSX.Syntax)) => (Language, SomeParser c Loc)
+jsxParser' :: c TSX.Term => (Language, SomeParser c Loc)
 jsxParser' = (JSX, SomeParser tsxParser)
 
-markdownParser' :: c (Term (Sum Markdown.Syntax)) => (Language, SomeParser c Loc)
+markdownParser' :: c Markdown.Term => (Language, SomeParser c Loc)
 markdownParser' = (Markdown, SomeParser markdownParser)
 
-phpParser' :: c (Term (Sum PHP.Syntax)) => (Language, SomeParser c Loc)
+phpParser' :: c PHP.Term => (Language, SomeParser c Loc)
 phpParser' = (PHP, SomeParser phpParser)
 
-pythonParserALaCarte' :: c (Term (Sum Python.Syntax)) => (Language, SomeParser c Loc)
+pythonParserALaCarte' :: c PythonALaCarte.Term => (Language, SomeParser c Loc)
 pythonParserALaCarte' = (Python, SomeParser pythonParser)
 
-pythonParserPrecise' :: c PrecisePython.Term => (Language, SomeParser c Loc)
+pythonParserPrecise' :: c PythonPrecise.Term => (Language, SomeParser c Loc)
 pythonParserPrecise' = (Python, SomeParser pythonParserPrecise)
 
-pythonParser' :: (c (Term (Sum Python.Syntax)), c PrecisePython.Term) => PerLanguageModes -> (Language, SomeParser c Loc)
+pythonParser' :: (c PythonALaCarte.Term, c PythonPrecise.Term) => PerLanguageModes -> (Language, SomeParser c Loc)
 pythonParser' modes = case pythonMode modes of
   ALaCarte -> (Python, SomeParser pythonParser)
   Precise  -> (Python, SomeParser pythonParserPrecise)
 
-rubyParser' :: c (Term (Sum Ruby.Syntax)) => (Language, SomeParser c Loc)
+rubyParser' :: c Ruby.Term => (Language, SomeParser c Loc)
 rubyParser' = (Ruby, SomeParser rubyParser)
 
-tsxParser' :: c (Term (Sum TSX.Syntax)) => (Language, SomeParser c Loc)
+tsxParser' :: c TSX.Term => (Language, SomeParser c Loc)
 tsxParser' = (TSX, SomeParser tsxParser)
 
-typescriptParser' :: c (Term (Sum TypeScript.Syntax)) => (Language, SomeParser c Loc)
+typescriptParser' :: c TypeScript.Term => (Language, SomeParser c Loc)
 typescriptParser' = (TypeScript, SomeParser typescriptParser)
 
 
+-- | A type family selecting the language mode for a given term type.
+type family TermMode term where
+  TermMode Java.Term          = 'Precise
+  TermMode JSON.Term          = 'Precise
+  TermMode PythonPrecise.Term = 'Precise
+  TermMode _                  = 'ALaCarte
+
+
 -- | The canonical set of parsers producing à la carte terms.
 aLaCarteParsers
-  :: ( c (Term (Sum Go.Syntax))
-     , c (Term (Sum Markdown.Syntax))
-     , c (Term (Sum PHP.Syntax))
-     , c (Term (Sum Python.Syntax))
-     , c (Term (Sum Ruby.Syntax))
-     , c (Term (Sum TSX.Syntax))
-     , c (Term (Sum TypeScript.Syntax))
+  :: ( c Go.Term
+     , c Markdown.Term
+     , c PHP.Term
+     , c PythonALaCarte.Term
+     , c Ruby.Term
+     , c TSX.Term
+     , c TypeScript.Term
      )
   => Map Language (SomeParser c Loc)
 aLaCarteParsers = Map.fromList
@@ -207,9 +216,9 @@ aLaCarteParsers = Map.fromList
 
 -- | The canonical set of parsers producing precise terms.
 preciseParsers
-  :: ( c PreciseJava.Term
-     , c PreciseJSON.Term
-     , c PrecisePython.Term
+  :: ( c Java.Term
+     , c JSON.Term
+     , c PythonPrecise.Term
      )
   => Map Language (SomeParser c Loc)
 preciseParsers = Map.fromList
@@ -220,16 +229,16 @@ preciseParsers = Map.fromList
 
 -- | The canonical set of all parsers for the passed per-language modes.
 allParsers
-  :: ( c (Term (Sum Go.Syntax))
-     , c PreciseJava.Term
-     , c PreciseJSON.Term
-     , c (Term (Sum Markdown.Syntax))
-     , c (Term (Sum PHP.Syntax))
-     , c (Term (Sum Python.Syntax))
-     , c PrecisePython.Term
-     , c (Term (Sum Ruby.Syntax))
-     , c (Term (Sum TSX.Syntax))
-     , c (Term (Sum TypeScript.Syntax))
+  :: ( c Go.Term
+     , c Java.Term
+     , c JSON.Term
+     , c Markdown.Term
+     , c PHP.Term
+     , c PythonALaCarte.Term
+     , c PythonPrecise.Term
+     , c Ruby.Term
+     , c TSX.Term
+     , c TypeScript.Term
      )
   => PerLanguageModes
   -> Map Language (SomeParser c Loc)

src/Semantic/Api/Diffs.hs

@@ -1,10 +1,7 @@
-{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, LambdaCase, MonoLocalBinds, QuantifiedConstraints, RankNTypes #-}
+{-# LANGUAGE AllowAmbiguousTypes, MonoLocalBinds, RankNTypes, UndecidableInstances #-}
 module Semantic.Api.Diffs
   ( parseDiffBuilder
   , DiffOutputFormat(..)
-  , diffGraph
-
-  , DiffEffects
 
   , diffTerms
   ) where
@@ -18,14 +15,14 @@ import           Control.Lens
 import           Control.Monad.IO.Class
 import           Data.Blob
 import           Data.ByteString.Builder
+import           Data.Diff
 import           Data.Edit
 import           Data.Graph
-import           Data.JSON.Fields
+import           Data.JSON.Fields (ToJSONFields1)
 import           Data.Language
 import           Data.ProtoLens (defMessage)
-import           Data.Term
+import           Data.Term (IsTerm(..))
 import qualified Data.Text as T
-import           Diffing.Algorithm (Diffable)
 import           Diffing.Interpreter (DiffTerms(..))
 import           Parsing.Parser
 import           Prologue
@@ -51,26 +48,26 @@ data DiffOutputFormat
   | DiffDotGraph
   deriving (Eq, Show)
 
-parseDiffBuilder :: (Traversable t, DiffEffects sig m) => DiffOutputFormat -> t BlobPair -> m Builder
+parseDiffBuilder :: (Traversable t, Member (Error SomeException) sig, Member (Reader Config) sig, Member Telemetry sig, Member Distribute sig, Member Parse sig, Carrier sig m, MonadIO m) => DiffOutputFormat -> t BlobPair -> m Builder
 parseDiffBuilder DiffJSONTree    = distributeFoldMap jsonDiff >=> serialize Format.JSON -- NB: Serialize happens at the top level for these two JSON formats to collect results of multiple blob pairs.
 parseDiffBuilder DiffJSONGraph   = diffGraph >=> serialize Format.JSON
-parseDiffBuilder DiffSExpression = distributeFoldMap (diffWith sexprDiffParsers sexprDiff)
-parseDiffBuilder DiffShow        = distributeFoldMap (diffWith showDiffParsers showDiff)
-parseDiffBuilder DiffDotGraph    = distributeFoldMap (diffWith dotGraphDiffParsers dotGraphDiff)
+parseDiffBuilder DiffSExpression = distributeFoldMap (parsePairWith diffParsers sexprDiff)
+parseDiffBuilder DiffShow        = distributeFoldMap (parsePairWith diffParsers showDiff)
+parseDiffBuilder DiffDotGraph    = distributeFoldMap (parsePairWith diffParsers dotGraphDiff)
 
-jsonDiff :: DiffEffects sig m => BlobPair -> m (Rendering.JSON.JSON "diffs" SomeJSON)
-jsonDiff blobPair = diffWith jsonTreeDiffParsers (pure . jsonTreeDiff blobPair) blobPair `catchError` jsonError blobPair
+jsonDiff :: (Member (Error SomeException) sig, Member Telemetry sig, Member Parse sig, Carrier sig m, MonadIO m) => BlobPair -> m (Rendering.JSON.JSON "diffs" SomeJSON)
+jsonDiff blobPair = parsePairWith diffParsers jsonTreeDiff blobPair `catchError` jsonError blobPair
 
 jsonError :: Applicative m => BlobPair -> SomeException -> m (Rendering.JSON.JSON "diffs" SomeJSON)
 jsonError blobPair (SomeException e) = pure $ renderJSONDiffError blobPair (show e)
 
-diffGraph :: (Traversable t, DiffEffects sig m) => t BlobPair -> m DiffTreeGraphResponse
+diffGraph :: (Traversable t, Member (Error SomeException) sig, Member Telemetry sig, Member Distribute sig, Member Parse sig, Carrier sig m, MonadIO m) => t BlobPair -> m DiffTreeGraphResponse
 diffGraph blobs = do
   graph <- distributeFor blobs go
   pure $ defMessage & P.files .~ toList graph
   where
-    go :: DiffEffects sig m => BlobPair -> m DiffTreeFileGraph
-    go blobPair = diffWith jsonGraphDiffParsers (pure . jsonGraphDiff blobPair) blobPair
+    go :: (Member (Error SomeException) sig, Member Telemetry sig, Member Parse sig, Carrier sig m, MonadIO m) => BlobPair -> m DiffTreeFileGraph
+    go blobPair = parsePairWith diffParsers jsonGraphDiff blobPair
       `catchError` \(SomeException e) ->
         pure $ defMessage
           & P.path .~ path
@@ -82,84 +79,78 @@ diffGraph blobs = do
         path = T.pack $ pathForBlobPair blobPair
         lang = bridging # languageForBlobPair blobPair
 
-type DiffEffects sig m = (Member (Error SomeException) sig, Member (Reader Config) sig, Member Telemetry sig, Member Distribute sig, Member Parse sig, Carrier sig m, MonadIO m)
+
+class DOTGraphDiff term where
+  dotGraphDiff :: (Carrier sig m, Member (Reader Config) sig, Member Telemetry sig, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m Builder
+
+instance (DiffTerms term, ConstructorName (Syntax term), Foldable (Syntax term), Functor (Syntax term)) => DOTGraphDiff term where
+  dotGraphDiff = serialize (DOT (diffStyle "diffs")) . renderTreeGraph <=< diffTerms
 
 
-dotGraphDiffParsers :: Map Language (SomeParser DOTGraphDiff Loc)
-dotGraphDiffParsers = aLaCarteParsers
+class JSONGraphDiff term where
+  jsonGraphDiff :: (Carrier sig m, Member Telemetry sig, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m DiffTreeFileGraph
 
-class DiffTerms term => DOTGraphDiff term where
-  dotGraphDiff :: (Carrier sig m, Member (Reader Config) sig) => DiffFor term Loc Loc -> m Builder
-
-instance (ConstructorName syntax, Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => DOTGraphDiff (Term syntax) where
-  dotGraphDiff = serialize (DOT (diffStyle "diffs")) . renderTreeGraph
+instance (DiffTerms term, ConstructorName (Syntax term), Foldable (Syntax term), Functor (Syntax term)) => JSONGraphDiff term where
+  jsonGraphDiff terms = do
+    diff <- diffTerms terms
+    let blobPair = bimap fst fst terms
+        graph = renderTreeGraph diff
+        toEdge (Edge (a, b)) = defMessage & P.source .~ a^.diffVertexId & P.target .~ b^.diffVertexId
+        path = T.pack $ pathForBlobPair blobPair
+        lang = bridging # languageForBlobPair blobPair
+    pure $! defMessage
+      & P.path     .~ path
+      & P.language .~ lang
+      & P.vertices .~ vertexList graph
+      & P.edges    .~ fmap toEdge (edgeList graph)
+      & P.errors   .~ mempty
 
 
-jsonGraphDiffParsers :: Map Language (SomeParser JSONGraphDiff Loc)
-jsonGraphDiffParsers = aLaCarteParsers
+class JSONTreeDiff term where
+  jsonTreeDiff :: (Carrier sig m, Member Telemetry sig, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m (Rendering.JSON.JSON "diffs" SomeJSON)
 
-class DiffTerms term => JSONGraphDiff term where
-  jsonGraphDiff :: BlobPair -> DiffFor term Loc Loc -> DiffTreeFileGraph
-
-instance (ConstructorName syntax, Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => JSONGraphDiff (Term syntax) where
-  jsonGraphDiff blobPair diff
-    = let graph = renderTreeGraph diff
-          toEdge (Edge (a, b)) = defMessage & P.source .~ a^.diffVertexId & P.target .~ b^.diffVertexId
-          path = T.pack $ pathForBlobPair blobPair
-          lang = bridging # languageForBlobPair blobPair
-      in defMessage
-           & P.path .~ path
-           & P.language .~ lang
-           & P.vertices .~ vertexList graph
-           & P.edges .~ fmap toEdge (edgeList graph)
-           & P.errors .~ mempty
+instance (DiffTerms term, Foldable (Syntax term), ToJSONFields1 (Syntax term)) => JSONTreeDiff term where
+  jsonTreeDiff terms = renderJSONDiff (bimap fst fst terms) <$> diffTerms terms
 
 
-jsonTreeDiffParsers :: Map Language (SomeParser JSONTreeDiff Loc)
-jsonTreeDiffParsers = aLaCarteParsers
+class SExprDiff term where
+  sexprDiff :: (Carrier sig m, Member (Reader Config) sig, Member Telemetry sig, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m Builder
 
-class DiffTerms term => JSONTreeDiff term where
-  jsonTreeDiff :: BlobPair -> DiffFor term Loc Loc -> Rendering.JSON.JSON "diffs" SomeJSON
-
-instance (Diffable syntax, Eq1 syntax, Hashable1 syntax, ToJSONFields1 syntax, Traversable syntax) => JSONTreeDiff (Term syntax) where
-  jsonTreeDiff = renderJSONDiff
+instance (DiffTerms term, ConstructorName (Syntax term), Foldable (Syntax term), Functor (Syntax term)) => SExprDiff term where
+  sexprDiff = serialize (SExpression ByConstructorName) <=< diffTerms
 
 
-sexprDiffParsers :: Map Language (SomeParser SExprDiff Loc)
-sexprDiffParsers = aLaCarteParsers
+class ShowDiff term where
+  showDiff :: (Carrier sig m, Member (Reader Config) sig, Member Telemetry sig, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m Builder
 
-class DiffTerms term => SExprDiff term where
-  sexprDiff :: (Carrier sig m, Member (Reader Config) sig) => DiffFor term Loc Loc -> m Builder
-
-instance (ConstructorName syntax, Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => SExprDiff (Term syntax) where
-  sexprDiff = serialize (SExpression ByConstructorName)
+instance (DiffTerms term, Foldable (Syntax term), Show1 (Syntax term)) => ShowDiff term where
+  showDiff = serialize Show <=< diffTerms
 
 
-showDiffParsers :: Map Language (SomeParser ShowDiff Loc)
-showDiffParsers = aLaCarteParsers
-
-class DiffTerms term => ShowDiff term where
-  showDiff :: (Carrier sig m, Member (Reader Config) sig) => DiffFor term Loc Loc -> m Builder
-
-instance (Diffable syntax, Eq1 syntax, Hashable1 syntax, Show1 syntax, Traversable syntax) => ShowDiff (Term syntax) where
-  showDiff = serialize Show
-
-
--- | Parse a 'BlobPair' using one of the provided parsers, diff the resulting terms, and run an action on the abstracted diff.
---
--- This allows us to define features using an abstract interface, and use them with diffs for any parser whose terms support that interface.
-diffWith
-  :: (forall term . c term => DiffTerms term, DiffEffects sig m)
-  => Map Language (SomeParser c Loc)                            -- ^ The set of parsers to select from.
-  -> (forall term . c term => DiffFor term Loc Loc -> m output) -- ^ A function to run on the computed diff. Note that the diff is abstract (it’s the diff type corresponding to an abstract term type), but the term type is constrained by @c@, allowing you to do anything @c@ allows, and requiring that all the input parsers produce terms supporting @c@.
-  -> BlobPair                                                   -- ^ The blob pair to parse.
-  -> m output
-diffWith parsers render = parsePairWith parsers (render <=< diffTerms)
-
-diffTerms :: (DiffTerms term, Member Telemetry sig, Carrier sig m, MonadIO m)
-  => Edit (Blob, term ann) (Blob, term ann) -> m (DiffFor term ann ann)
+diffTerms :: (DiffTerms term, Foldable (Syntax term), Member Telemetry sig, Carrier sig m, MonadIO m)
+  => Edit (Blob, term ann) (Blob, term ann) -> m (Diff (Syntax term) ann ann)
 diffTerms terms = time "diff" languageTag $ do
   let diff = diffTermPair (bimap snd snd terms)
   diff <$ writeStat (Stat.count "diff.nodes" (bilength diff) languageTag)
   where languageTag = languageTagForBlobPair blobs
         blobs = bimap fst fst terms
+
+diffParsers :: Map Language (SomeParser Anything Loc)
+diffParsers = aLaCarteParsers
+
+class
+  ( DiffTerms term
+  , ConstructorName (Syntax term)
+  , Foldable (Syntax term)
+  , Functor (Syntax term)
+  , Show1 (Syntax term)
+  , ToJSONFields1 (Syntax term)
+  ) => Anything term
+instance
+  ( DiffTerms term
+  , ConstructorName (Syntax term)
+  , Foldable (Syntax term)
+  , Functor (Syntax term)
+  , Show1 (Syntax term)
+  , ToJSONFields1 (Syntax term)
+  ) => Anything term

src/Semantic/Api/Symbols.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DerivingVia, MonoLocalBinds, RankNTypes, StandaloneDeriving #-}
+{-# LANGUAGE AllowAmbiguousTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
 module Semantic.Api.Symbols
   ( legacyParseSymbols
   , parseSymbols
@@ -10,15 +10,13 @@ import           Control.Effect.Parse
 import           Control.Effect.Reader
 import           Control.Exception
 import           Control.Lens
+import           Data.Abstract.Declarations
 import           Data.Blob hiding (File (..))
 import           Data.ByteString.Builder
 import           Data.Language
 import           Data.ProtoLens (defMessage)
-import           Data.Term
+import           Data.Term (IsTerm(..), TermF)
 import           Data.Text (pack)
-import qualified Language.Java as Java
-import qualified Language.JSON as JSON
-import qualified Language.Python as Python
 import qualified Parsing.Parser as Parser
 import           Prologue
 import           Proto.Semantic as P hiding (Blob, BlobPair)
@@ -31,7 +29,6 @@ import           Semantic.Task
 import           Serializing.Format (Format)
 import           Source.Loc as Loc
 import           Source.Source
-import           Tags.Taggable
 import           Tags.Tagging
 import qualified Tags.Tagging.Precise as Precise
 
@@ -108,19 +105,17 @@ symbolsToSummarize = ["Function", "Method", "Class", "Module", "Call", "Send"]
 class ToTags t where
   tags :: Language -> [Text] -> Source -> t Loc -> [Tag]
 
-instance IsTaggable syntax => ToTags (Term syntax) where
-  tags = runTagging
+instance (Parser.TermMode term ~ strategy, ToTagsBy strategy term) => ToTags term where
+  tags = tagsBy @strategy
 
+class ToTagsBy (strategy :: LanguageMode) term where
+  tagsBy :: Language -> [Text] -> Source -> term Loc -> [Tag]
 
-deriving via (ViaPrecise Java.Term)   instance ToTags Java.Term
-deriving via (ViaPrecise JSON.Term)   instance ToTags JSON.Term
-deriving via (ViaPrecise Python.Term) instance ToTags Python.Term
+instance (IsTerm term, IsTaggable (Syntax term), Base (term Loc) ~ TermF (Syntax term) Loc, Recursive (term Loc), Declarations (term Loc)) => ToTagsBy 'ALaCarte term where
+  tagsBy = runTagging
 
-
-newtype ViaPrecise t a = ViaPrecise (t a)
-
-instance Precise.ToTags t => ToTags (ViaPrecise t) where
-  tags _ _ src (ViaPrecise t) = Precise.tags src t
+instance Precise.ToTags term => ToTagsBy 'Precise term where
+  tagsBy _ _ = Precise.tags
 
 
 toTagsParsers :: PerLanguageModes -> Map Language (Parser.SomeParser ToTags Loc)

src/Semantic/Api/TOCSummaries.hs

@@ -1,10 +1,10 @@
-{-# LANGUAGE DerivingVia, LambdaCase, MonoLocalBinds, StandaloneDeriving, TupleSections #-}
+{-# LANGUAGE AllowAmbiguousTypes, DataKinds, LambdaCase, ScopedTypeVariables, TupleSections, TypeFamilies, UndecidableInstances #-}
 module Semantic.Api.TOCSummaries
 ( diffSummary
 , legacyDiffSummary
 , diffSummaryBuilder
-, SummarizeDiff(..)
-, summarizeDiffParsers
+, SummarizeTerms(..)
+, summarizeTermParsers
 ) where
 
 import           Analysis.Decorator (decoratorWithAlgebra)
@@ -21,22 +21,18 @@ import           Data.ByteString.Builder
 import           Data.Edit
 import           Data.Either (partitionEithers)
 import           Data.Function (on)
-import           Data.Functor.Classes
-import           Data.Hashable.Lifted
-import           Data.Language (Language, PerLanguageModes)
+import           Data.Functor.Foldable (Base, Recursive)
+import           Data.Language (Language, LanguageMode(..), PerLanguageModes)
 import           Data.Map (Map)
 import qualified Data.Map.Monoidal as Map
 import           Data.Maybe (mapMaybe)
 import           Data.ProtoLens (defMessage)
 import           Data.Semilattice.Lower
-import           Data.Term (Term)
+import           Data.Term (IsTerm(..), TermF)
 import qualified Data.Text as T
-import           Diffing.Algorithm (Diffable)
 import qualified Diffing.Algorithm.SES as SES
-import qualified Language.Java as Java
-import qualified Language.JSON as JSON
-import qualified Language.Python as Python
-import           Parsing.Parser (SomeParser, allParsers)
+import           Diffing.Interpreter (DiffTerms)
+import           Parsing.Parser (SomeParser, TermMode, allParsers)
 import           Proto.Semantic as P hiding (Blob, BlobPair)
 import           Proto.Semantic_Fields as P
 import           Rendering.TOC
@@ -57,7 +53,7 @@ legacyDiffSummary :: (Carrier sig m, Member Distribute sig, Member (Error SomeEx
 legacyDiffSummary = distributeFoldMap go
   where
     go :: (Carrier sig m, Member (Error SomeException) sig, Member Parse sig, Member (Reader PerLanguageModes) sig, Member Telemetry sig, MonadIO m) => BlobPair -> m Summaries
-    go blobPair = asks summarizeDiffParsers >>= \ p -> parsePairWith p (fmap (uncurry (flip Summaries) . bimap toMap toMap . partitionEithers) . summarizeTerms) blobPair
+    go blobPair = asks summarizeTermParsers >>= \ p -> parsePairWith p (fmap (uncurry (flip Summaries) . bimap toMap toMap . partitionEithers) . summarizeTerms) blobPair
       `catchError` \(SomeException e) ->
         pure $ Summaries mempty (toMap [ErrorSummary (T.pack (show e)) lowerBound lang])
       where path = T.pack $ pathKeyForBlobPair blobPair
@@ -74,7 +70,7 @@ diffSummary blobs = do
   pure $ defMessage & P.files .~ diff
   where
     go :: (Carrier sig m, Member (Error SomeException) sig, Member Parse sig, Member (Reader PerLanguageModes) sig, Member Telemetry sig, MonadIO m) => BlobPair -> m TOCSummaryFile
-    go blobPair = asks summarizeDiffParsers >>= \ p -> parsePairWith p (fmap (uncurry toFile . partitionEithers . map (bimap toError toChange)) . summarizeTerms) blobPair
+    go blobPair = asks summarizeTermParsers >>= \ p -> parsePairWith p (fmap (uncurry toFile . partitionEithers . map (bimap toError toChange)) . summarizeTerms) blobPair
       `catchError` \(SomeException e) ->
         pure $ toFile [defMessage & P.error .~ T.pack (show e) & P.maybe'span .~ Nothing] []
       where toFile errors changes = defMessage
@@ -103,28 +99,27 @@ toError ErrorSummary{..} = defMessage
   & P.maybe'span ?~ converting # span
 
 
-summarizeDiffParsers :: PerLanguageModes -> Map Language (SomeParser SummarizeDiff Loc)
-summarizeDiffParsers = allParsers
+summarizeTermParsers :: PerLanguageModes -> Map Language (SomeParser SummarizeTerms Loc)
+summarizeTermParsers = allParsers
 
-class SummarizeDiff term where
+class SummarizeTerms term where
   summarizeTerms :: (Member Telemetry sig, Carrier sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m [Either ErrorSummary TOCSummary]
 
-instance (Diffable syntax, Eq1 syntax, HasDeclaration syntax, Hashable1 syntax, Traversable syntax) => SummarizeDiff (Term syntax) where
-  summarizeTerms = fmap diffTOC . diffTerms . bimap decorateTerm decorateTerm where
-    decorateTerm :: (Foldable syntax, Functor syntax, HasDeclaration syntax) => (Blob, Term syntax Loc) -> (Blob, Term syntax (Maybe Declaration))
+instance (TermMode term ~ strategy, SummarizeTermsBy strategy term) => SummarizeTerms term where
+  summarizeTerms = summarizeTermsBy @strategy
+
+class SummarizeTermsBy (strategy :: LanguageMode) term where
+  summarizeTermsBy :: (Member Telemetry sig, Carrier sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m [Either ErrorSummary TOCSummary]
+
+instance (DiffTerms term, HasDeclaration (Syntax term), Traversable (Syntax term), Recursive (term Loc), Base (term Loc) ~ TermF (Syntax term) Loc) => SummarizeTermsBy 'ALaCarte term where
+  summarizeTermsBy = fmap diffTOC . diffTerms . bimap decorateTerm decorateTerm where
+    decorateTerm :: (Blob, term Loc) -> (Blob, term (Maybe Declaration))
     decorateTerm (blob, term) = (blob, decoratorWithAlgebra (declarationAlgebra blob) term)
 
 
-deriving via (ViaTags Java.Term)   instance SummarizeDiff Java.Term
-deriving via (ViaTags JSON.Term)   instance SummarizeDiff JSON.Term
-deriving via (ViaTags Python.Term) instance SummarizeDiff Python.Term
-
-
-newtype ViaTags t a = ViaTags (t a)
-
-instance Tagging.ToTags t => SummarizeDiff (ViaTags t) where
-  summarizeTerms terms = pure . map (uncurry summarizeChange) . dedupe . mapMaybe toChange . edit (map Delete) (map Insert) (SES.ses compare) . bimap (uncurry go) (uncurry go) $ terms where
-    go blob (ViaTags t) = Tagging.tags (blobSource blob) t
+instance Tagging.ToTags term => SummarizeTermsBy 'Precise term where
+  summarizeTermsBy terms = pure . map (uncurry summarizeChange) . dedupe . mapMaybe toChange . edit (map Delete) (map Insert) (SES.ses compare) . bimap (uncurry go) (uncurry go) $ terms where
+    go = Tagging.tags . blobSource
     lang = languageForBlobPair (bimap fst fst terms)
     (s1, s2) = edit (,mempty) (mempty,) (,) (bimap (blobSource . fst) (blobSource . fst) terms)
     compare = liftA2 (&&) <$> ((==) `on` Tag.kind) <*> ((==) `on` Tag.name)

src/Semantic/Api/Terms.hs

@@ -1,22 +1,21 @@
-{-# LANGUAGE ConstraintKinds, MonoLocalBinds, RankNTypes #-}
+{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
 module Semantic.Api.Terms
   ( termGraph
   , parseTermBuilder
   , TermOutputFormat(..)
   ) where
 
-import           Analysis.ConstructorName (ConstructorName)
 import           Control.Effect.Error
 import           Control.Effect.Parse
 import           Control.Effect.Reader
 import           Control.Lens
 import           Control.Monad
 import           Control.Monad.IO.Class
+import           Data.Aeson (ToJSON)
 import           Data.Blob
 import           Data.ByteString.Builder
 import           Data.Either
 import           Data.Graph
-import           Data.JSON.Fields
 import           Data.Language
 import           Data.ProtoLens (defMessage)
 import           Data.Quieterm
@@ -35,22 +34,22 @@ import           Semantic.Config
 import           Semantic.Task
 import           Serializing.Format hiding (JSON)
 import qualified Serializing.Format as Format
-import qualified Serializing.SExpression as SExpr (serializeSExpression)
+import qualified Serializing.SExpression as SExpr
 import qualified Serializing.SExpression.Precise as SExpr.Precise (serializeSExpression)
 import           Source.Loc
 
 import qualified Language.Java as Java
 import qualified Language.JSON as JSON
-import qualified Language.Python as Python
+import qualified Language.Python as PythonPrecise
 
 
-termGraph :: (Traversable t, Member Distribute sig, ParseEffects sig m) => t Blob -> m ParseTreeGraphResponse
+termGraph :: (Traversable t, Member Distribute sig, Member (Error SomeException) sig, Member Parse sig, Carrier sig m) => t Blob -> m ParseTreeGraphResponse
 termGraph blobs = do
   terms <- distributeFor blobs go
   pure $ defMessage
     & P.files .~ toList terms
   where
-    go :: ParseEffects sig m => Blob -> m ParseTreeFileGraph
+    go :: (Member (Error SomeException) sig, Member Parse sig, Carrier sig m) => Blob -> m ParseTreeFileGraph
     go blob = parseWith jsonGraphTermParsers (pure . jsonGraphTerm blob) blob
       `catchError` \(SomeException e) ->
         pure $ defMessage
@@ -72,7 +71,7 @@ data TermOutputFormat
   | TermQuiet
   deriving (Eq, Show)
 
-parseTermBuilder :: (Traversable t, Member Distribute sig, ParseEffects sig m, MonadIO m)
+parseTermBuilder :: (Traversable t, Member Distribute sig, Member (Error SomeException) sig, Member (Reader PerLanguageModes) sig, Member Parse sig, Member (Reader Config) sig, Carrier sig m, MonadIO m)
   => TermOutputFormat -> t Blob -> m Builder
 parseTermBuilder TermJSONTree    = distributeFoldMap jsonTerm >=> serialize Format.JSON -- NB: Serialize happens at the top level for these two JSON formats to collect results of multiple blobs.
 parseTermBuilder TermJSONGraph   = termGraph >=> serialize Format.JSON
@@ -81,13 +80,13 @@ parseTermBuilder TermDotGraph    = distributeFoldMap (parseWith dotGraphTermPars
 parseTermBuilder TermShow        = distributeFoldMap (\ blob -> asks showTermParsers >>= \ parsers -> parseWith parsers showTerm blob)
 parseTermBuilder TermQuiet       = distributeFoldMap quietTerm
 
-jsonTerm :: ParseEffects sig m => Blob -> m (Rendering.JSON.JSON "trees" SomeJSON)
+jsonTerm :: (Member (Error SomeException) sig, Member Parse sig, Carrier sig m) => Blob -> m (Rendering.JSON.JSON "trees" SomeJSON)
 jsonTerm blob = parseWith jsonTreeTermParsers (pure . jsonTreeTerm blob) blob `catchError` jsonError blob
 
 jsonError :: Applicative m => Blob -> SomeException -> m (Rendering.JSON.JSON "trees" SomeJSON)
 jsonError blob (SomeException e) = pure $ renderJSONError blob (show e)
 
-quietTerm :: (ParseEffects sig m, MonadIO m) => Blob -> m Builder
+quietTerm :: (Member (Error SomeException) sig, Member (Reader PerLanguageModes) sig, Member Parse sig, Member (Reader Config) sig, Carrier sig m, MonadIO m) => Blob -> m Builder
 quietTerm blob = showTiming blob <$> time' ( asks showTermParsers >>= \ parsers -> parseWith parsers (fmap (const (Right ())) . showTerm) blob `catchError` timingError )
   where
     timingError (SomeException e) = pure (Left (show e))
@@ -96,26 +95,29 @@ quietTerm blob = showTiming blob <$> time' ( asks showTermParsers >>= \ parsers
       in stringUtf8 (status <> "\t" <> show (blobLanguage blob) <> "\t" <> blobPath blob <> "\t" <> show duration <> " ms\n")
 
 
-type ParseEffects sig m = (Member (Error SomeException) sig, Member (Reader PerLanguageModes) sig, Member Parse sig, Member (Reader Config) sig, Carrier sig m)
-
-
 showTermParsers :: PerLanguageModes -> Map Language (SomeParser ShowTerm Loc)
 showTermParsers = allParsers
 
 class ShowTerm term where
   showTerm :: (Carrier sig m, Member (Reader Config) sig) => term Loc -> m Builder
 
-instance (Functor syntax, Show1 syntax) => ShowTerm (Term syntax) where
-  showTerm = serialize Show . quieterm
+instance (TermMode term ~ strategy, ShowTermBy strategy term) => ShowTerm term where
+  showTerm = showTermBy @strategy
 
-instance ShowTerm Java.Term where
-  showTerm = serialize Show . void . Java.getTerm
+class ShowTermBy (strategy :: LanguageMode) term where
+  showTermBy :: (Carrier sig m, Member (Reader Config) sig) => term Loc -> m Builder
 
-instance ShowTerm JSON.Term where
-  showTerm = serialize Show . void . JSON.getTerm
+instance ShowTermBy 'Precise Java.Term where
+  showTermBy = serialize Show . void . Java.getTerm
 
-instance ShowTerm Python.Term where
-  showTerm = serialize Show . void . Python.getTerm
+instance ShowTermBy 'Precise JSON.Term where
+  showTermBy = serialize Show . void . JSON.getTerm
+
+instance ShowTermBy 'Precise PythonPrecise.Term where
+  showTermBy = serialize Show . void . PythonPrecise.getTerm
+
+instance (Recursive (term Loc), Show1 syntax, Base (term Loc) ~ TermF syntax Loc) => ShowTermBy 'ALaCarte term where
+  showTermBy = serialize Show . quieterm
 
 
 sexprTermParsers :: PerLanguageModes -> Map Language (SomeParser SExprTerm Loc)
@@ -124,17 +126,23 @@ sexprTermParsers = allParsers
 class SExprTerm term where
   sexprTerm :: term Loc -> Builder
 
-instance (ConstructorName syntax, Foldable syntax, Functor syntax) => SExprTerm (Term syntax) where
-  sexprTerm = SExpr.serializeSExpression ByConstructorName
+instance (TermMode term ~ strategy, SExprTermBy strategy term) => SExprTerm term where
+  sexprTerm = sexprTermBy @strategy
 
-instance SExprTerm Java.Term where
-  sexprTerm = SExpr.Precise.serializeSExpression . Java.getTerm
+class SExprTermBy (strategy :: LanguageMode) term where
+  sexprTermBy :: term Loc -> Builder
 
-instance SExprTerm JSON.Term where
-  sexprTerm = SExpr.Precise.serializeSExpression . JSON.getTerm
+instance SExprTermBy 'Precise Java.Term where
+  sexprTermBy = SExpr.Precise.serializeSExpression . Java.getTerm
 
-instance SExprTerm Python.Term where
-  sexprTerm = SExpr.Precise.serializeSExpression . Python.getTerm
+instance SExprTermBy 'Precise JSON.Term where
+  sexprTermBy = SExpr.Precise.serializeSExpression . JSON.getTerm
+
+instance SExprTermBy 'Precise PythonPrecise.Term where
+  sexprTermBy = SExpr.Precise.serializeSExpression . PythonPrecise.getTerm
+
+instance (Recursive (term Loc), SExpr.ToSExpression (Base (term Loc))) => SExprTermBy 'ALaCarte term where
+  sexprTermBy = SExpr.serializeSExpression ByConstructorName
 
 
 dotGraphTermParsers :: Map Language (SomeParser DOTGraphTerm Loc)
@@ -143,7 +151,7 @@ dotGraphTermParsers = aLaCarteParsers
 class DOTGraphTerm term where
   dotGraphTerm :: (Carrier sig m, Member (Reader Config) sig) => term Loc -> m Builder
 
-instance (ConstructorName syntax, Foldable syntax, Functor syntax) => DOTGraphTerm (Term syntax) where
+instance (Recursive (term Loc), ToTreeGraph TermVertex (Base (term Loc))) => DOTGraphTerm term where
   dotGraphTerm = serialize (DOT (termStyle "terms")) . renderTreeGraph
 
 
@@ -153,7 +161,7 @@ jsonTreeTermParsers = aLaCarteParsers
 class JSONTreeTerm term where
   jsonTreeTerm :: Blob -> term Loc -> Rendering.JSON.JSON "trees" SomeJSON
 
-instance ToJSONFields1 syntax => JSONTreeTerm (Term syntax) where
+instance ToJSON (term Loc) => JSONTreeTerm term where
   jsonTreeTerm = renderJSONTerm
 
 
@@ -163,15 +171,15 @@ jsonGraphTermParsers = aLaCarteParsers
 class JSONGraphTerm term where
   jsonGraphTerm :: Blob -> term Loc -> ParseTreeFileGraph
 
-instance (Foldable syntax, Functor syntax, ConstructorName syntax) => JSONGraphTerm (Term syntax) where
+instance (Recursive (term Loc), ToTreeGraph TermVertex (Base (term Loc))) => JSONGraphTerm term where
   jsonGraphTerm blob t
     = let graph = renderTreeGraph t
           toEdge (Edge (a, b)) = defMessage & P.source .~ a^.vertexId & P.target .~ b^.vertexId
           path = T.pack $ blobPath blob
           lang = bridging # blobLanguage blob
       in defMessage
-          & P.path .~ path
+          & P.path     .~ path
           & P.language .~ lang
           & P.vertices .~ vertexList graph
-          & P.edges .~ fmap toEdge (edgeList graph)
-          & P.errors .~ mempty
+          & P.edges    .~ fmap toEdge (edgeList graph)
+          & P.errors   .~ mempty

src/Tags/Taggable.hs

@@ -63,29 +63,31 @@ emitIden loc docsLiteralRange name = yield (Iden (formatName name) loc docsLiter
 
 class Taggable constr where
   docsLiteral ::
-    ( Foldable syntax
-    , HasTextElement syntax
+    ( Foldable (Syntax term)
+    , IsTerm term
+    , HasTextElement (Syntax term)
     )
-    => Language -> constr (Term syntax Loc) -> Maybe Range
+    => Language -> constr (term Loc) -> Maybe Range
 
-  snippet :: Foldable syntax => Loc -> constr (Term syntax Loc) -> Range
+  snippet :: (IsTerm term, Foldable (Syntax term)) => Loc -> constr (term Loc) -> Range
 
-  symbolName :: Declarations1 syntax => constr (Term syntax Loc) -> Maybe Name
+  symbolName :: (IsTerm term, Declarations (term Loc)) => constr (term Loc) -> Maybe Name
 
 data Strategy = Default | Custom
 
 class TaggableBy (strategy :: Strategy) constr where
   docsLiteral' ::
-    ( Foldable syntax
-    , HasTextElement syntax
+    ( Foldable (Syntax term)
+    , IsTerm term
+    , HasTextElement (Syntax term)
     )
-    => Language -> constr (Term syntax Loc) -> Maybe Range
+    => Language -> constr (term Loc) -> Maybe Range
   docsLiteral' _ _ = Nothing
 
-  snippet' :: (Foldable syntax) => Loc -> constr (Term syntax Loc) -> Range
+  snippet' :: (IsTerm term, Foldable (Syntax term)) => Loc -> constr (term Loc) -> Range
   snippet' ann _ = byteRange ann
 
-  symbolName' :: Declarations1 syntax => constr (Term syntax Loc) -> Maybe Name
+  symbolName' :: (IsTerm term, Declarations (term Loc)) => constr (term Loc) -> Maybe Name
   symbolName' _ = Nothing
 
 type IsTaggable syntax =
@@ -93,22 +95,23 @@ type IsTaggable syntax =
   , Foldable syntax
   , Taggable syntax
   , ConstructorName syntax
-  , Declarations1 syntax
   , HasTextElement syntax
   )
 
-tagging :: (Monad m, IsTaggable syntax)
+tagging :: (Monad m, IsTerm term, IsTaggable (Syntax term), Base (term Loc) ~ TermF (Syntax term) Loc, Recursive (term Loc), Declarations (term Loc))
         => Language
-        -> Term syntax Loc
+        -> term Loc
         -> Stream (Of Token) m ()
 tagging = foldSubterms . descend
 
 descend ::
-  ( ConstructorName (TermF syntax Loc)
-  , IsTaggable syntax
+  ( ConstructorName (TermF (Syntax term) Loc)
+  , Declarations (term Loc)
+  , IsTerm term
+  , IsTaggable (Syntax term)
   , Monad m
   )
-  => Language -> SubtermAlgebra (TermF syntax Loc) (Term syntax Loc) (Tagger m ())
+  => Language -> SubtermAlgebra (TermF (Syntax term) Loc) (term Loc) (Tagger m ())
 descend lang t@(In loc _) = do
   let term = fmap subterm t
   let snippetRange = snippet loc term
@@ -156,54 +159,60 @@ instance Taggable a => TaggableBy 'Custom (TermF a Loc) where
   symbolName' t = symbolName (termFOut t)
 
 instance TaggableBy 'Custom Syntax.Context where
-  snippet' ann (Syntax.Context _ (Term (In subj _))) = subtractLoc ann subj
+  snippet' ann (Syntax.Context _ subj) = subtractLoc ann (termAnnotation subj)
 
 instance TaggableBy 'Custom Declaration.Function where
-  docsLiteral' Python (Declaration.Function _ _ _ (Term (In _ bodyF)))
-    | (Term (In exprAnn exprF):_) <- toList bodyF
+  docsLiteral' Python (Declaration.Function _ _ _ body)
+    | bodyF <- termOut body
+    , expr:_ <- toList bodyF
+    , In exprAnn exprF <- toTermF expr
     , isTextElement exprF = Just (byteRange exprAnn)
     | otherwise           = Nothing
   docsLiteral' _ _         = Nothing
-  snippet' ann (Declaration.Function _ _ _ (Term (In body _))) = subtractLoc ann body
+  snippet' ann (Declaration.Function _ _ _ body) = subtractLoc ann (termAnnotation body)
   symbolName' = declaredName . Declaration.functionName
 
 instance TaggableBy 'Custom Declaration.Method where
-  docsLiteral' Python (Declaration.Method _ _ _ _ (Term (In _ bodyF)) _)
-    | (Term (In exprAnn exprF):_) <- toList bodyF
+  docsLiteral' Python (Declaration.Method _ _ _ _ body _)
+    | bodyF <- termOut body
+    , expr:_ <- toList bodyF
+    , In exprAnn exprF <- toTermF expr
     , isTextElement exprF = Just (byteRange exprAnn)
     | otherwise           = Nothing
   docsLiteral' _ _         = Nothing
-  snippet' ann (Declaration.Method _ _ _ _ (Term (In body _)) _) = subtractLoc ann body
+  snippet' ann (Declaration.Method _ _ _ _ body _) = subtractLoc ann (termAnnotation body)
   symbolName' = declaredName . Declaration.methodName
 
 instance TaggableBy 'Custom Declaration.Class where
-  docsLiteral' Python (Declaration.Class _ _ _ (Term (In _ bodyF)))
-    | (Term (In exprAnn exprF):_) <- toList bodyF
+  docsLiteral' Python (Declaration.Class _ _ _ body)
+    | bodyF <- termOut body
+    , expr:_ <- toList bodyF
+    , In exprAnn exprF <- toTermF expr
     , isTextElement exprF = Just (byteRange exprAnn)
     | otherwise           = Nothing
   docsLiteral' _ _         = Nothing
-  snippet' ann (Declaration.Class _ _ _ (Term (In body _))) = subtractLoc ann body
+  snippet' ann (Declaration.Class _ _ _ body) = subtractLoc ann (termAnnotation body)
   symbolName' = declaredName . Declaration.classIdentifier
 
 instance TaggableBy 'Custom Ruby.Class where
-  snippet' ann (Ruby.Class _ _ (Term (In body _))) = subtractLoc ann body
+  snippet' ann (Ruby.Class _ _ body) = subtractLoc ann (termAnnotation body)
   symbolName' = declaredName . Ruby.classIdentifier
 
 instance TaggableBy 'Custom Ruby.Module where
-  snippet' ann (Ruby.Module _ (Term (In body _):_)) = subtractLoc ann body
+  snippet' ann (Ruby.Module _ (body:_)) = subtractLoc ann (termAnnotation body)
   snippet' ann (Ruby.Module _ _)                    = byteRange ann
   symbolName' = declaredName . Ruby.moduleIdentifier
 
 instance TaggableBy 'Custom TypeScript.Module where
-  snippet' ann (TypeScript.Module _ (Term (In body _):_)) = subtractLoc ann body
+  snippet' ann (TypeScript.Module _ (body:_)) = subtractLoc ann (termAnnotation body)
   snippet' ann (TypeScript.Module _ _                   ) = byteRange ann
   symbolName' = declaredName . TypeScript.moduleIdentifier
 
 instance TaggableBy 'Custom Expression.Call where
-  snippet' ann (Expression.Call _ _ _ (Term (In body _))) = subtractLoc ann body
+  snippet' ann (Expression.Call _ _ _ body) = subtractLoc ann (termAnnotation body)
   symbolName' = declaredName . Expression.callFunction
 
 instance TaggableBy 'Custom Ruby.Send where
-  snippet' ann (Ruby.Send _ _ _ (Just (Term (In body _)))) = subtractLoc ann body
+  snippet' ann (Ruby.Send _ _ _ (Just body)) = subtractLoc ann (termAnnotation body)
   snippet' ann _                                           = byteRange ann
   symbolName' Ruby.Send{..} = declaredName =<< sendSelector

src/Tags/Tagging.hs

@@ -3,6 +3,7 @@ module Tags.Tagging
 ( runTagging
 , Tag(..)
 , Kind(..)
+, IsTaggable
 )
 where
 
@@ -10,6 +11,7 @@ import Prelude hiding (fail, filter, log)
 import Prologue hiding (Element, hash)
 
 import           Control.Effect.State as Eff
+import           Data.Abstract.Declarations (Declarations)
 import           Data.Text as T hiding (empty)
 import           Streaming
 import qualified Streaming.Prelude as Streaming
@@ -21,11 +23,11 @@ import qualified Source.Source as Source
 import           Tags.Tag
 import           Tags.Taggable
 
-runTagging :: (IsTaggable syntax)
+runTagging :: (IsTerm term, IsTaggable (Syntax term), Base (term Loc) ~ TermF (Syntax term) Loc, Recursive (term Loc), Declarations (term Loc))
            => Language
            -> [Text]
            -> Source.Source
-           -> Term syntax Loc
+           -> term Loc
            -> [Tag]
 runTagging lang symbolsToSummarize source
   = Eff.run

test/Rendering/TOC/Spec.hs

@@ -4,6 +4,7 @@ module Rendering.TOC.Spec (spec) where
 import Analysis.TOCSummary
 import Control.Effect.Parse
 import Control.Effect.Reader
+import Control.Monad.IO.Class
 import Data.Aeson hiding (defaultOptions)
 import Data.Bifunctor
 import Data.Diff
@@ -16,7 +17,7 @@ import Prelude
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Declaration as Declaration
 import Rendering.TOC
-import Semantic.Api (DiffEffects, diffSummaryBuilder, summarizeTerms, summarizeDiffParsers)
+import Semantic.Api (diffSummaryBuilder, summarizeTerms, summarizeTermParsers)
 import Serializing.Format as Format
 import Source.Loc
 import Source.Span
@@ -216,7 +217,7 @@ blankDiff = merge (Nothing, Nothing) (inject [ inserting (termIn Nothing (inject
 
 -- Diff helpers
 summarize
-  :: DiffEffects sig m
+  :: (Member (Error SomeException) sig, Member Parse sig, Member Telemetry sig, Carrier sig m, MonadIO m)
   => BlobPair
   -> m [Either ErrorSummary TOCSummary]
-summarize = parsePairWith (summarizeDiffParsers defaultLanguageModes) summarizeTerms
+summarize = parsePairWith (summarizeTermParsers defaultLanguageModes) summarizeTerms