Merge branch 'shelly-git-action' into alternative-schema

.licenses/semantic/cabal/ghc-boot-th.txt

@@ -1,9 +1,9 @@
 ---
 type: cabal
 name: ghc-boot-th
-version: 8.6.3
+version: 8.6.4
 summary: Shared functionality between GHC and the @template-haskell@
-homepage: 
+
 license: bsd-3-clause
 ---
 The Glasgow Haskell Compiler License

.licenses/semantic/cabal/ghc-boot.txt

@@ -1,9 +1,9 @@
 ---
 type: cabal
 name: ghc-boot
-version: 8.6.3
+version: 8.6.4
 summary: Shared functionality between GHC and its boot libraries
-homepage: 
+
 license: bsd-3-clause
 ---
 The Glasgow Haskell Compiler License

.licenses/semantic/cabal/ghc-heap.txt

@@ -1,9 +1,9 @@
 ---
 type: cabal
 name: ghc-heap
-version: 8.6.3
+version: 8.6.4
 summary: Functions for walking GHC's heap
-homepage: 
+
 license: bsd-3-clause
 ---
 Copyright (c) 2012-2013, Joachim Breitner

.licenses/semantic/cabal/ghc.txt

@@ -1,7 +1,7 @@
 ---
 type: cabal
 name: ghc
-version: 8.6.3
+version: 8.6.4
 summary: The GHC API
 homepage: https://www.haskell.org/ghc/
 license: bsd-3-clause

.licenses/semantic/cabal/ghci.txt

@@ -1,9 +1,9 @@
 ---
 type: cabal
 name: ghci
-version: 8.6.3
+version: 8.6.4
 summary: The library supporting GHC's interactive interpreter
-homepage: 
+
 license: bsd-3-clause
 ---
 The Glasgow Haskell Compiler License

.licenses/semantic/cabal/http-types.txt

@@ -1,7 +1,7 @@
 ---
 type: cabal
 name: http-types
-version: 0.12.2
+version: 0.12.3
 summary: Generic HTTP types for Haskell (for both client and server code).
 homepage: https://github.com/aristidb/http-types
 license: bsd-3-clause

.licenses/semantic/cabal/process.txt

@@ -1,9 +1,9 @@
 ---
 type: cabal
 name: process
-version: 1.6.3.0
+version: 1.6.5.0
 summary: Process libraries
-homepage: 
+
 license: bsd-3-clause
 ---
 This library (libraries/process) is derived from code from two

.licenses/semantic/cabal/recursion-schemes.txt

@@ -1,7 +1,7 @@
 ---
 type: cabal
 name: recursion-schemes
-version: 5.1.1
+version: 5.1.2
 summary: Generalized bananas, lenses and barbed wire
 homepage: https://github.com/ekmett/recursion-schemes/
 license: bsd-2-clause

.licenses/semantic/cabal/th-abstraction.txt

@@ -1,7 +1,7 @@
 ---
 type: cabal
 name: th-abstraction
-version: 0.2.10.0
+version: 0.2.11.0
 summary: Nicer interface for reified information about data types
 homepage: https://github.com/glguy/th-abstraction
 license: isc

.licenses/semantic/cabal/transformers.txt

@@ -1,9 +1,9 @@
 ---
 type: cabal
 name: transformers
-version: 0.5.5.0
+version: 0.5.6.2
 summary: Concrete functor and monad transformers
-homepage: 
+
 license: bsd-3-clause
 ---
 The Glasgow Haskell Compiler License

semantic.cabal

@@ -54,6 +54,7 @@ common dependencies
                      , network
                      , recursion-schemes
                      , scientific
+                     , safe-exceptions
                      , semilattices
                      , text
                      , these
@@ -97,7 +98,6 @@ library
                      , Control.Abstract.ScopeGraph
                      , Control.Abstract.Value
                      -- Effects
-                     , Control.Effect.Catch
                      , Control.Effect.Interpose
                      , Control.Effect.REPL
                      , Control.Rewriting
@@ -132,6 +132,7 @@ library
                      , Data.Duration
                      , Data.Error
                      , Data.File
+                     , Data.Flag
                      , Data.Functor.Both
                      , Data.Functor.Classes.Generic
                      , Proto3.Google.Timestamp
@@ -370,6 +371,7 @@ test-suite test
                      , Graphing.Calls.Spec
                      , Integration.Spec
                      , Numeric.Spec
+                     , Parsing.Spec
                      , Reprinting.Spec
                      , Rewriting.Go.Spec
                      , Rewriting.JSON.Spec
@@ -383,6 +385,7 @@ test-suite test
                      , SpecHelpers
                      , Test.Hspec.LeanCheck
   build-depends:       semantic
+                     , tree-sitter-json
                      , hspec >= 2.4.1
                      , hspec-core
                      , hspec-expectations-pretty-diff

src/Analysis/TOCSummary.hs

@@ -10,7 +10,8 @@ import Prologue hiding (project)
 import           Control.Arrow
 import           Control.Rewriting
 import           Data.Blob
-import           Data.Error (Error (..), showExpectation)
+import           Data.Error (Error (..), Colourize (..), showExpectation)
+import           Data.Flag
 import           Data.Language as Language
 import           Data.Location
 import           Data.Range
@@ -86,7 +87,7 @@ instance CustomHasDeclaration whole Markdown.Heading where
 instance CustomHasDeclaration whole Syntax.Error where
   customToDeclaration Blob{..} ann err@Syntax.Error{}
     = Just $ ErrorDeclaration (T.pack (formatTOCError (Syntax.unError (locationSpan ann) err))) mempty (locationSpan ann) blobLanguage
-    where formatTOCError e = showExpectation False (errorExpected e) (errorActual e) ""
+    where formatTOCError e = showExpectation (flag Colourize False) (errorExpected e) (errorActual e) ""
 
 -- | Produce a 'FunctionDeclaration' for 'Declaration.Function' nodes so long as their identifier is non-empty (defined as having a non-empty 'Range').
 instance CustomHasDeclaration whole Declaration.Function where

src/Control/Abstract/Primitive.hs

@@ -45,9 +45,9 @@ defineBuiltIn declaration rel accessControl value = withCurrentCallStack callSta
   -- TODO: This span is still wrong.
   declare declaration rel accessControl emptySpan ScopeGraph.Unknown (Just associatedScope)
 
-  param <- gensym
   withScope associatedScope $ do
-    declare (Declaration param) rel accessControl emptySpan ScopeGraph.Unknown Nothing
+    param <- gensym
+    declare (Declaration param) ScopeGraph.Gensym accessControl emptySpan ScopeGraph.Unknown Nothing
 
   slot <- lookupSlot declaration
   value <- builtIn associatedScope value

src/Control/Abstract/ScopeGraph.hs

@@ -3,6 +3,7 @@
 module Control.Abstract.ScopeGraph
   ( lookup
   , declare
+  , declareMaybeName
   , reference
   , newScope
   , newPreludeScope
@@ -79,6 +80,27 @@ declare decl rel accessControl span kind scope = do
   moduleInfo <- ask @ModuleInfo
   modify (fst . ScopeGraph.declare decl moduleInfo rel accessControl span kind scope currentAddress)
 
+-- | If the provided name is 'Nothing' we want to reflect that the declaration's name was a generated name (gensym).
+-- We use the 'Gensym' relation to indicate that. Otherwise, we use the provided 'relation'.
+declareMaybeName :: ( Carrier sig m
+                    , Member (State (ScopeGraph address)) sig
+                    , Member (Reader (CurrentScope address)) sig
+                    , Member (Reader ModuleInfo) sig
+                    , Member Fresh sig
+                    , Ord address
+                    )
+                 => Maybe Name
+                 -> Relation
+                 -> AccessControl
+                 -> Span
+                 -> Kind
+                 -> Maybe address
+                 -> Evaluator term address value m Name
+declareMaybeName maybeName relation ac span kind scope = do
+  case maybeName of
+    Just name -> declare (Declaration name) relation ac span kind scope >> pure name
+    _         -> gensym >>= \name -> declare (Declaration name) Gensym ac span kind scope >> pure name
+
 putDeclarationScope :: ( Ord address
                        , Member (Reader (CurrentScope address)) sig
                        , Member (State (ScopeGraph address)) sig

src/Control/Effect/Catch.hs

@@ -1,61 +0,0 @@
-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving,
-             MultiParamTypeClasses, RankNTypes, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
-
--- | An effect that enables catching exceptions thrown from
--- impure computations such as IO.
-module Control.Effect.Catch
-  ( Catch (..)
-  , catch
-  , runCatch
-  , CatchC (..)
-  ) where
-
-import           Control.Effect.Carrier
-import           Control.Effect.Reader
-import           Control.Effect.Sum
-import qualified Control.Exception as Exc
-import           Control.Monad.IO.Class
-
-data Catch m k
-  = forall output e . Exc.Exception e => CatchIO (m output) (e -> m output) (output -> k)
-
-deriving instance Functor (Catch m)
-
-instance HFunctor Catch where
-  hmap f (CatchIO go cleanup k) = CatchIO (f go) (f . cleanup) k
-
-instance Effect Catch where
-  handle state handler (CatchIO go cleanup k)
-    = CatchIO (handler (go <$ state)) (\se -> handler (cleanup se <$ state)) (handler . fmap k)
-
--- | Like 'Control.Effect.Error.catchError', but delegating to
--- 'Control.Exception.catch' under the hood, which allows catching
--- errors that might occur when lifting 'IO' computations.
--- Unhandled errors are rethrown. Use 'SomeException' if you want
--- to catch all errors.
-catch :: (Member Catch sig, Carrier sig m, Exc.Exception e)
-        => m a
-        -> (e -> m a)
-        -> m a
-catch go cleanup = send (CatchIO go cleanup pure)
-
-
--- | Evaulate a 'Catch' effect.
-runCatch :: (forall x . m x -> IO x)
-           -> CatchC m a
-           -> m a
-runCatch handler = runReader (Handler handler) . runCatchC
-
-newtype Handler m = Handler (forall x . m x -> IO x)
-
-runHandler :: Handler m -> CatchC m a -> IO a
-runHandler h@(Handler handler) = handler . runReader h . runCatchC
-
-newtype CatchC m a = CatchC { runCatchC :: ReaderC (Handler m) m a }
-  deriving (Functor, Applicative, Monad, MonadIO)
-
-instance (Carrier sig m, MonadIO m) => Carrier (Catch :+: sig) (CatchC m) where
-  eff (L (CatchIO act cleanup k)) = do
-    handler <- CatchC ask
-    liftIO (Exc.catch (runHandler handler act) (runHandler handler . cleanup)) >>= k
-  eff (R other) = CatchC (eff (R (handleCoercible other)))

src/Data/Abstract/Evaluatable.hs

@@ -30,7 +30,7 @@ import Data.Abstract.Declarations as X
 import Data.Abstract.FreeVariables as X
 import Data.Abstract.Module
 import Data.Abstract.Name as X
-import qualified Data.Abstract.ScopeGraph as ScopeGraph 
+import qualified Data.Abstract.ScopeGraph as ScopeGraph
 import Data.Abstract.ScopeGraph (Relation(..))
 import Data.Abstract.AccessControls.Class as X
 import Data.Language
@@ -192,7 +192,7 @@ defineSelf :: ( Carrier sig m
            => Evaluator term address value m ()
 defineSelf = do
   let self = Declaration X.__self
-  declare self Default Public emptySpan ScopeGraph.Unknown Nothing
+  declare self ScopeGraph.Gensym Public emptySpan ScopeGraph.Unknown Nothing
   slot <- lookupSlot self
   assign slot =<< object =<< currentFrame
 

src/Data/Abstract/ScopeGraph.hs

@@ -86,7 +86,7 @@ instance Ord AccessControl where
   (<=) Public _            = False
 
 
-data Relation = Default | Instance | Prelude
+data Relation = Default | Instance | Prelude | Gensym
   deriving (Eq, Show, Ord, Generic, NFData)
 
 instance Lower Relation where

src/Data/Blob.hs

@@ -33,6 +33,7 @@ data Blob = Blob
   { blobSource   :: Source   -- ^ The UTF-8 encoded source text of the blob.
   , blobPath     :: FilePath -- ^ The file path to the blob.
   , blobLanguage :: Language -- ^ The language of this blob.
+  , blobOid      :: Text     -- ^ Git OID for this blob, mempty if blob is not from a git db.
   }
   deriving (Show, Eq, Generic)
 
@@ -49,12 +50,12 @@ nullBlob :: Blob -> Bool
 nullBlob Blob{..} = nullSource blobSource
 
 sourceBlob :: FilePath -> Language -> Source -> Blob
-sourceBlob filepath language source = Blob source filepath language
+sourceBlob filepath language source = Blob source filepath language mempty
 
 inferringLanguage :: Source -> FilePath -> Language -> Blob
 inferringLanguage src pth lang
-  | knownLanguage lang = Blob src pth lang
-  | otherwise = Blob src pth (languageForFilePath pth)
+  | knownLanguage lang = Blob src pth lang mempty
+  | otherwise = Blob src pth (languageForFilePath pth) mempty
 
 decodeBlobs :: BL.ByteString -> Either String [Blob]
 decodeBlobs = fmap blobs <$> eitherDecode

src/Data/Error.hs

@@ -6,6 +6,9 @@ module Data.Error
   , showExpectation
   , showExcerpt
   , withSGRCode
+  -- * Flags affecting 'Error' values
+  , LogPrintSource (..)
+  , Colourize (..)
   ) where
 
 import Prologue
@@ -16,9 +19,13 @@ import Data.List (intersperse, isSuffixOf)
 import System.Console.ANSI
 
 import Data.Blob
+import Data.Flag as Flag
 import Data.Source
 import Data.Span
 
+data LogPrintSource = LogPrintSource
+data Colourize = Colourize
+
 -- | Rather than using the Error constructor directly, you probably
 -- want to call 'makeError', which takes care of inserting the call
 -- stack for you.
@@ -38,21 +45,18 @@ instance Exception (Error String)
 makeError :: HasCallStack => Span -> [grammar] -> Maybe grammar -> Error grammar
 makeError s e a = withFrozenCallStack (Error s e a callStack)
 
-type IncludeSource = Bool
-type Colourize = Bool
-
 -- | Format an 'Error', optionally with reference to the source where it occurred.
-formatError :: IncludeSource -> Colourize -> Blob -> Error String -> String
+formatError :: Flag LogPrintSource -> Flag Colourize -> Blob -> Error String -> String
 formatError includeSource colourize blob@Blob{..} Error{..}
   = ($ "")
   $ withSGRCode colourize [SetConsoleIntensity BoldIntensity] (showSpan path errorSpan . showString ": ")
   . withSGRCode colourize [SetColor Foreground Vivid Red] (showString "error") . showString ": " . showExpectation colourize errorExpected errorActual . showChar '\n'
-  . (if includeSource then showExcerpt colourize errorSpan blob else id)
+  . (if Flag.toBool LogPrintSource includeSource then showExcerpt colourize errorSpan blob else id)
   . showCallStack colourize callStack . showChar '\n'
   where
-    path = Just $ if includeSource then blobPath else "<filtered>"
+    path = Just $ if Flag.toBool LogPrintSource includeSource then blobPath else "<filtered>"
 
-showExcerpt :: Colourize -> Span -> Blob -> ShowS
+showExcerpt :: Flag Colourize -> Span -> Blob -> ShowS
 showExcerpt colourize Span{..} Blob{..}
   = showString context . (if "\n" `isSuffixOf` context then id else showChar '\n')
   . showString (replicate (caretPaddingWidth + lineNumberDigits) ' ') . withSGRCode colourize [SetColor Foreground Vivid Green] (showString caret) . showChar '\n'
@@ -67,23 +71,19 @@ showExcerpt colourize Span{..} Blob{..}
         caret | posLine spanStart == posLine spanEnd = replicate (max 1 (posColumn spanEnd - posColumn spanStart)) '^'
               | otherwise                            = "^..."
 
-withSGRCode :: Colourize -> [SGR] -> ShowS -> ShowS
-withSGRCode useColour code content =
-  if useColour then
-    showString (setSGRCode code)
-    . content
-    . showString (setSGRCode [])
-  else
-    content
+withSGRCode :: Flag Colourize -> [SGR] -> ShowS -> ShowS
+withSGRCode useColour code content
+  | Flag.toBool Colourize useColour = showString (setSGRCode code) . content . showString (setSGRCode [])
+  | otherwise = content
 
-showExpectation :: Colourize -> [String] -> Maybe String -> ShowS
+showExpectation :: Flag Colourize -> [String] -> Maybe String -> ShowS
 showExpectation colourize = go
   where go [] Nothing = showString "no rule to match at " . showActual "end of branch"
         go expected Nothing = showString "expected " . showSymbols colourize expected . showString " at " . showActual "end of branch"
         go expected (Just actual) = showString "expected " . showSymbols colourize expected . showString ", but got " . showActual actual
         showActual = withSGRCode colourize [SetColor Foreground Vivid Green] . showString
 
-showSymbols :: Colourize -> [String] -> ShowS
+showSymbols :: Flag Colourize -> [String] -> ShowS
 showSymbols colourize = go
   where go []        = showString "end of input nodes"
         go [symbol]  = showSymbol symbol
@@ -96,8 +96,8 @@ showSpan :: Maybe FilePath -> Span -> ShowS
 showSpan path Span{..} = maybe (showParen True (showString "interactive")) showString path . showChar ':' . (if spanStart == spanEnd then showPos spanStart else showPos spanStart . showChar '-' . showPos spanEnd)
   where showPos Pos{..} = shows posLine . showChar ':' . shows posColumn
 
-showCallStack :: Colourize -> CallStack -> ShowS
+showCallStack :: Flag Colourize -> CallStack -> ShowS
 showCallStack colourize callStack = foldr (.) id (intersperse (showChar '\n') (uncurry (showCallSite colourize) <$> getCallStack callStack))
 
-showCallSite :: Colourize -> String -> SrcLoc -> ShowS
+showCallSite :: Flag Colourize -> String -> SrcLoc -> ShowS
 showCallSite colourize symbol loc@SrcLoc{..} = showString symbol . showChar ' ' . withSGRCode colourize [SetConsoleIntensity BoldIntensity] (showParen True (showSpan (Just srcLocFile) (spanFromSrcLoc loc)))

src/Data/File.hs

@@ -32,7 +32,7 @@ file path = File path (languageForFilePath path)
 -- This is kind of a wart; Blob and File should be two views of
 -- the same higher-kinded datatype.
 toFile :: Blob -> File
-toFile (Blob _ p l) = File p l
+toFile (Blob _ p l _) = File p l
 
 -- | Read a utf8-encoded file to a 'Blob'.
 readBlobFromFile :: forall m. MonadIO m => File -> m (Maybe Blob)

src/Data/Flag.hs

@@ -0,0 +1,44 @@
+{-# LANGUAGE RankNTypes, KindSignatures #-}
+
+-- | -- This technique is due to Oleg Grenrus: <http://oleg.fi/gists/posts/2019-03-21-flag.html>
+-- The implementation is clean-room due to unclear licensing of the original post.
+module Data.Flag
+  ( Flag
+  , flag
+  , toBool
+  , switch
+  , choose
+  ) where
+
+import Data.Coerce
+
+-- | To declare a new flag, declare a singly-inhabited type:
+-- @data MyFlag = MyFlag@
+-- then use the @flag MyFlag@ to create one from a 'Bool'.
+-- This is more verbose than using 'Bool' for everything but prevents classes of errors when
+-- working with multiple flag values in flight, as the 'toBool' deconstructor provides a witness
+-- that you really want the given semantic flag value from the flag datum.
+newtype Flag (t :: *) = Flag Bool
+
+-- | The constructor for a 'Flag'. You specify @t@ with a visible type application.
+flag :: t -> Bool -> Flag t
+flag _ = Flag
+{-# INLINE flag #-}
+
+-- | The destructor for a 'Flag'. You pass in the inhabitant of @t@ to
+-- avoid boolean blindness.
+toBool :: t -> Flag t -> Bool
+toBool _ = coerce
+{-# INLINE toBool #-}
+
+switch :: a -> b -> Flag a -> Flag b
+switch _ _ = coerce
+
+-- | Case analysis, like 'bool'.
+choose :: t -- ^ Witness
+       -> a -- ^ False case
+       -> a -- ^ True case
+       -> Flag t
+       -> a
+choose _ f t flag = if coerce flag then t else f
+{-# INLINE choose #-}

src/Data/Syntax/Declaration.hs

@@ -28,15 +28,10 @@ instance Diffable Function where
 
 instance Evaluatable Function where
   eval _ _ Function{..} = do
-    name <- maybeM (throwNoNameError functionName) (declaredName functionName)
     span <- ask @Span
-    associatedScope <- declareFunction name ScopeGraph.Public span ScopeGraph.Function
+    (name, associatedScope) <- declareFunction (declaredName functionName) ScopeGraph.Public span ScopeGraph.Function
 
-    params <- withScope associatedScope . for functionParameters $ \paramNode -> do
-      param <- maybeM (throwNoNameError paramNode) (declaredName paramNode)
-
-      let paramSpan = getSpan paramNode
-      param <$ declare (Declaration param) Default ScopeGraph.Public paramSpan ScopeGraph.Parameter Nothing
+    params <- withScope associatedScope . for functionParameters $ \paramNode -> declareMaybeName (declaredName paramNode) Default ScopeGraph.Public (getSpan paramNode) ScopeGraph.Parameter Nothing
 
     addr <- lookupSlot (Declaration name)
     v <- function name params functionBody associatedScope
@@ -50,17 +45,17 @@ declareFunction :: ( Carrier sig m
                    , Member Fresh sig
                    , Ord address
                    )
-                => Name
+                => Maybe Name
                 -> ScopeGraph.AccessControl
                 -> Span
                 -> ScopeGraph.Kind
-                -> Evaluator term address value m address
+                -> Evaluator term address value m (Name, address)
 declareFunction name accessControl span kind = do
   currentScope' <- currentScope
   let lexicalEdges = Map.singleton Lexical [ currentScope' ]
   associatedScope <- newScope lexicalEdges
-  declare (Declaration name) Default accessControl span kind (Just associatedScope)
-  pure associatedScope
+  name' <- declareMaybeName name Default accessControl span kind (Just associatedScope)
+  pure (name', associatedScope)
 
 instance Tokenize Function where
   tokenize Function{..} = within' Scope.Function $ do
@@ -92,16 +87,13 @@ instance Diffable Method where
 -- local environment.
 instance Evaluatable Method where
   eval _ _ Method{..} = do
-    name <- maybeM (throwNoNameError methodName) (declaredName methodName)
     span <- ask @Span
-    associatedScope <- declareFunction name methodAccessControl span ScopeGraph.Method
+    (name, associatedScope) <- declareFunction (declaredName methodName) methodAccessControl span ScopeGraph.Method
 
     params <- withScope associatedScope $ do
       -- TODO: Should we give `self` a special Relation?
-      declare (Declaration __self) Prelude ScopeGraph.Public emptySpan ScopeGraph.Unknown Nothing
-      for methodParameters $ \paramNode -> do
-        param <- maybeM (throwNoNameError paramNode) (declaredName paramNode)
-        param <$ declare (Declaration param) Default ScopeGraph.Public span ScopeGraph.Parameter Nothing
+      declare (Declaration __self) ScopeGraph.Prelude ScopeGraph.Public emptySpan ScopeGraph.Unknown Nothing
+      for methodParameters $ \paramNode -> declareMaybeName (declaredName paramNode) Default ScopeGraph.Public (getSpan paramNode) ScopeGraph.Parameter Nothing
 
     addr <- lookupSlot (Declaration name)
     v <- function name params methodBody associatedScope
@@ -144,9 +136,8 @@ instance Declarations1 RequiredParameter where
 -- TODO: Implement Eval instance for RequiredParameter
 instance Evaluatable RequiredParameter where
   eval _ _ RequiredParameter{..} = do
-    name <- maybeM (throwNoNameError requiredParameter) (declaredName requiredParameter)
     span <- ask @Span
-    declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.RequiredParameter Nothing
+    _ <- declareMaybeName (declaredName requiredParameter) Default ScopeGraph.Public span ScopeGraph.RequiredParameter Nothing
     unit
 
 
@@ -170,9 +161,8 @@ instance Evaluatable VariableDeclaration where
   eval _    _ (VariableDeclaration [])   = unit
   eval eval _ (VariableDeclaration decs) = do
     for_ decs $ \declaration -> do
-      name <- maybeM (throwNoNameError declaration) (declaredName declaration)
-      let declarationSpan = getSpan declaration
-      declare (Declaration name) Default ScopeGraph.Public declarationSpan ScopeGraph.VariableDeclaration Nothing
+      let span = getSpan declaration
+      _ <- declareMaybeName (declaredName declaration) Default ScopeGraph.Public span ScopeGraph.VariableDeclaration Nothing
       eval declaration
     unit
 
@@ -209,10 +199,8 @@ data PublicFieldDefinition a = PublicFieldDefinition
 instance Evaluatable PublicFieldDefinition where
   eval eval _ PublicFieldDefinition{..} = do
     span <- ask @Span
-    propertyName <- maybeM (throwNoNameError publicFieldPropertyName) (declaredName publicFieldPropertyName)
-
-    declare (Declaration propertyName) Instance publicFieldAccessControl span ScopeGraph.PublicField Nothing
-    slot <- lookupSlot (Declaration propertyName)
+    name <- declareMaybeName (declaredName publicFieldPropertyName) Instance publicFieldAccessControl span ScopeGraph.PublicField Nothing
+    slot <- lookupSlot (Declaration name)
     value <- eval publicFieldValue
     assign slot value
     unit
@@ -236,12 +224,13 @@ instance Diffable Class where
 
 instance Evaluatable Class where
   eval eval _ Class{..} = do
-    name <- maybeM (throwNoNameError classIdentifier) (declaredName classIdentifier)
     span <- ask @Span
     currentScope' <- currentScope
 
     superScopes <- for classSuperclasses $ \superclass -> do
-      name <- maybeM (throwNoNameError superclass) (declaredName superclass)
+      name <- case declaredName superclass of
+                Just name -> pure name
+                Nothing   -> gensym
       scope <- associatedScope (Declaration name)
       slot <- lookupSlot (Declaration name)
       superclassFrame <- scopedEnvironment =<< deref slot
@@ -253,7 +242,7 @@ instance Evaluatable Class where
         current = (Lexical, ) <$> pure (pure currentScope')
         edges = Map.fromList (superclassEdges <> current)
     classScope <- newScope edges
-    declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.Class (Just classScope)
+    name <- declareMaybeName (declaredName classIdentifier) Default ScopeGraph.Public span ScopeGraph.Class (Just classScope)
 
     let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes))
     classFrame <- newFrame classScope frameEdges
@@ -323,13 +312,11 @@ data TypeAlias a = TypeAlias { typeAliasContext :: ![a], typeAliasIdentifier ::
 
 instance Evaluatable TypeAlias where
   eval _ _ TypeAlias{..} = do
-    name <- maybeM (throwNoNameError typeAliasIdentifier) (declaredName typeAliasIdentifier)
+    -- This use of `throwNoNameError` is good -- we aren't declaring something new so `declareMaybeName` is not useful here.
     kindName <- maybeM (throwNoNameError typeAliasKind) (declaredName typeAliasKind)
-
     span <- ask @Span
     assocScope <- associatedScope (Declaration kindName)
-    -- TODO: Should we consider a special Relation for `TypeAlias`?
-    declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.TypeAlias assocScope
+    name <- declareMaybeName (declaredName typeAliasIdentifier) Default ScopeGraph.Public span ScopeGraph.TypeAlias assocScope
 
     slot <- lookupSlot (Declaration name)
     kindSlot <- lookupSlot (Declaration kindName)

src/Data/Syntax/Expression.hs

@@ -427,6 +427,7 @@ instance Evaluatable MemberAccess where
     let lhsAccessControl = fromMaybe Public (termToAccessControl lhs)
     infos <- declarationsByAccessControl rhsScope lhsAccessControl
 
+    -- This means we always throw an 'AccessControlError' whenever we have a rhs term whose 'declaredName' is 'Nothing'.
     rhsName <- maybeM (throwNoNameError rhs) (declaredName rhs)
     rhsValue' <- case find (\Info{..} -> Declaration rhsName == infoDeclaration) infos of
       Just _  -> pure rhsValue

src/Data/Syntax/Statement.hs

@@ -121,13 +121,13 @@ data Let a  = Let { letVariable :: !a, letValue :: !a, letBody :: !a }
 
 instance Evaluatable Let where
   eval eval _ Let{..} = do
-    name <- maybeM (throwNoNameError letVariable) (declaredName letVariable)
-    letSpan <- ask @Span
+    -- This use of 'throwNoNameError' is okay until we have a better way of mapping gensym names to terms in the scope graph.
     valueName <- maybeM (throwNoNameError letValue) (declaredName letValue)
     assocScope <- associatedScope (Declaration valueName)
 
     _ <- withLexicalScopeAndFrame $ do
-      declare (Declaration name) Default Public letSpan ScopeGraph.Let assocScope
+      letSpan <- ask @Span
+      name <- declareMaybeName (declaredName letVariable) Default Public letSpan ScopeGraph.Let assocScope
       letVal <- eval letValue
       slot <- lookupSlot (Declaration name)
       assign slot letVal

src/Language/Go/Syntax.hs

@@ -75,11 +75,10 @@ data QualifiedImport a = QualifiedImport { qualifiedImportFrom :: !ImportPath, q
 instance Evaluatable QualifiedImport where
   eval _ _ (QualifiedImport importPath aliasTerm) = do
     paths <- resolveGoImport importPath
-    alias <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm)
     span <- ask @Span
     scopeAddress <- newScope mempty
-    declare (Declaration alias) Default Public span ScopeGraph.QualifiedImport (Just scopeAddress)
-    aliasSlot <- lookupSlot (Declaration alias)
+    name <- declareMaybeName (declaredName aliasTerm) Default Public span ScopeGraph.QualifiedImport (Just scopeAddress)
+    aliasSlot <- lookupSlot (Declaration name)
 
     withScope scopeAddress $ do
       let

src/Language/PHP/Syntax.hs

@@ -172,6 +172,7 @@ data QualifiedName a = QualifiedName { name :: a, identifier :: a }
 
 instance Evaluatable QualifiedName where
   eval _ _ (QualifiedName obj iden) = do
+    -- TODO: Consider gensym'ed names used for References.
     name <- maybeM (throwNoNameError obj) (declaredName obj)
     let objSpan = getSpan obj
     reference (Reference name) objSpan ScopeGraph.Identifier (Declaration name)

src/Language/Python/Syntax.hs

@@ -187,6 +187,7 @@ newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: NonEmpty a
 -- import a.b.c
 instance Evaluatable QualifiedImport where
   eval _ _ (QualifiedImport qualifiedNames) = do
+    -- TODO: Consider gensym'ed names for imports.
     qualifiedName <- fmap (T.unpack . formatName) <$> traverse (\term -> maybeM (throwNoNameError term) (declaredName term)) qualifiedNames
     modulePaths <- resolvePythonModules (QualifiedName qualifiedName)
     let namesAndPaths = toList (NonEmpty.zip (NonEmpty.zip qualifiedNames (Data.Abstract.Evaluatable.name . T.pack <$> qualifiedName)) modulePaths)

src/Language/Ruby/Syntax.hs

@@ -181,7 +181,9 @@ instance Diffable Class where
 
 instance Evaluatable Class where
   eval eval _ Class{..} = do
-    name <- maybeM (throwNoNameError classIdentifier) (declaredName classIdentifier)
+    (name, relation) <- case declaredName classIdentifier of
+                          Just name -> pure (name, Default)
+                          _         -> gensym >>= \name -> pure (name, Gensym)
     span <- ask @Span
     currentScope' <- currentScope
 
@@ -210,7 +212,7 @@ instance Evaluatable Class where
             current = (Lexical, ) <$> pure (pure currentScope')
             edges = Map.fromList (superclassEdges <> current)
         classScope <- newScope edges
-        declare (Declaration name) Default Public span ScopeGraph.Class (Just classScope)
+        declare (Declaration name) relation Public span ScopeGraph.Class (Just classScope)
 
         let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes))
         childFrame <- newFrame classScope frameEdges
@@ -241,7 +243,9 @@ data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] }
 
 instance Evaluatable Module where
   eval eval _ Module{..} =  do
-    name <- maybeM (throwNoNameError moduleIdentifier) (declaredName moduleIdentifier)
+    (name, relation) <- case declaredName moduleIdentifier of
+                          Just name -> pure (name, Default)
+                          _         -> gensym >>= \name -> pure (name, Gensym)
     span <- ask @Span
     currentScope' <- currentScope
 
@@ -260,7 +264,7 @@ instance Evaluatable Module where
       Nothing -> do
         let edges = Map.singleton Lexical [ currentScope' ]
         classScope <- newScope edges
-        declare (Declaration name) Default Public span ScopeGraph.Module (Just classScope)
+        declare (Declaration name) relation Public span ScopeGraph.Module (Just classScope)
 
         currentFrame' <- currentFrame
         let frameEdges = Map.singleton Lexical (Map.singleton currentScope' currentFrame')
@@ -323,10 +327,12 @@ instance Declarations1 Assignment where
 
 instance Evaluatable Assignment where
   eval eval ref Assignment{..} = do
-    lhsName <- maybeM (throwNoNameError assignmentTarget) (declaredName assignmentTarget)
+    (lhsName, relation) <- case declaredName assignmentTarget of
+                             Just name -> pure (name, Default)
+                             _         -> gensym >>= \name -> pure (name, Gensym)
     maybeSlot <- maybeLookupDeclaration (Declaration lhsName)
     assignmentSpan <- ask @Span
-    maybe (declare (Declaration lhsName) Default Public assignmentSpan ScopeGraph.Assignment Nothing) (const (pure ())) maybeSlot
+    maybe (declare (Declaration lhsName) relation Public assignmentSpan ScopeGraph.Assignment Nothing) (const (pure ())) maybeSlot
 
     lhs <- ref assignmentTarget
     rhs <- eval assignmentValue

src/Language/TypeScript/Syntax/Import.hs

@@ -58,10 +58,8 @@ instance Evaluatable QualifiedAliasedImport where
     importScope <- newScope (Map.singleton ScopeGraph.Import [ moduleScope ])
     let scopeMap = Map.singleton moduleScope moduleFrame
     aliasFrame <- newFrame importScope (Map.singleton ScopeGraph.Import scopeMap)
-
-    alias <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm)
-    declare (Declaration alias) Default Public span ScopeGraph.QualifiedAliasedImport (Just importScope)
-    aliasSlot <- lookupSlot (Declaration alias)
+    name <- declareMaybeName (declaredName aliasTerm) Default Public span ScopeGraph.QualifiedAliasedImport (Just importScope)
+    aliasSlot <- lookupSlot (Declaration name)
     assign aliasSlot =<< object aliasFrame
 
     unit

src/Language/TypeScript/Syntax/JSX.hs

@@ -76,9 +76,8 @@ instance Declarations1 RequiredParameter where
 
 instance Evaluatable RequiredParameter where
   eval eval ref RequiredParameter{..} = do
-    name <- maybeM (throwNoNameError requiredParameterSubject) (declaredName requiredParameterSubject)
     span <- ask @Span
-    declare (Declaration name) Default Public span ScopeGraph.RequiredParameter Nothing
+    _ <- declareMaybeName (declaredName requiredParameterSubject) Default Public span ScopeGraph.RequiredParameter Nothing
 
     lhs <- ref requiredParameterSubject
     rhs <- eval requiredParameterValue

src/Language/TypeScript/Syntax/TypeScript.hs

@@ -193,7 +193,9 @@ declareModule :: ( AbstractValue term address value m
                 -> [term]
                 -> Evaluator term address value m value
 declareModule eval identifier statements = do
-    name <- maybeM (throwNoNameError identifier) (declaredName identifier)
+    (name, relation) <- case declaredName identifier of
+                          Just name -> pure (name, Default)
+                          _         -> gensym >>= \name -> pure (name, Gensym)
     span <- ask @Span
     currentScope' <- currentScope
 
@@ -212,7 +214,7 @@ declareModule eval identifier statements = do
       Nothing -> do
         let edges = Map.singleton Lexical [ currentScope' ]
         childScope <- newScope edges
-        declare (Declaration name) Default Public span ScopeGraph.Module (Just childScope)
+        declare (Declaration name) relation Public span ScopeGraph.Module (Just childScope)
 
         currentFrame' <- currentFrame
         let frameEdges = Map.singleton Lexical (Map.singleton currentScope' currentFrame')
@@ -257,7 +259,6 @@ instance Declarations a => Declarations (AbstractClass a) where
 
 instance Evaluatable AbstractClass where
   eval eval _ AbstractClass{..} = do
-    name <- maybeM (throwNoNameError abstractClassIdentifier) (declaredName abstractClassIdentifier)
     span <- ask @Span
     currentScope' <- currentScope
 
@@ -274,7 +275,7 @@ instance Evaluatable AbstractClass where
         current = (Lexical, ) <$> pure (pure currentScope')
         edges = Map.fromList (superclassEdges <> current)
     classScope <- newScope edges
-    declare (Declaration name) Default Public span ScopeGraph.AbstractClass (Just classScope)
+    name <- declareMaybeName (declaredName abstractClassIdentifier) Default Public span ScopeGraph.AbstractClass (Just classScope)
 
     let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes))
     childFrame <- newFrame classScope frameEdges

src/Parsing/TreeSitter.hs

@@ -6,7 +6,6 @@ module Parsing.TreeSitter
 
 import Prologue hiding (bracket)
 
-import           Control.Concurrent.Async
 import qualified Control.Exception as Exc (bracket)
 import           Control.Effect
 import           Control.Effect.Resource
@@ -23,7 +22,6 @@ import Data.Location
 import Data.Source
 import Data.Span
 import Data.Term
-import Semantic.Timeout
 
 import qualified TreeSitter.Language as TS
 import qualified TreeSitter.Node as TS
@@ -60,7 +58,6 @@ parseToAST :: ( Bounded grammar
               , Carrier sig m
               , Enum grammar
               , Member Resource sig
-              , Member Timeout sig
               , Member Trace sig
               , MonadIO m
               )
@@ -69,25 +66,15 @@ parseToAST :: ( Bounded grammar
            -> Blob
            -> m (Maybe (AST [] grammar))
 parseToAST parseTimeout language Blob{..} = bracket (liftIO TS.ts_parser_new) (liftIO . TS.ts_parser_delete) $ \ parser -> do
-  liftIO $ do
+  result <- liftIO $ do
+    let timeoutMicros = fromIntegral $ toMicroseconds parseTimeout
+    TS.ts_parser_set_timeout_micros parser timeoutMicros
     TS.ts_parser_halt_on_error parser (CBool 1)
     TS.ts_parser_set_language parser language
-
-  trace $ "tree-sitter: beginning parsing " <> blobPath
-
-  parsing <- liftIO . async $ runParser parser blobSource
-
-  -- Kick the parser off asynchronously and wait according to the provided timeout.
-  res <- timeout parseTimeout $ liftIO (wait parsing)
-
-  case res of
-    Just Failed          -> Nothing  <$ trace ("tree-sitter: parsing failed " <> blobPath)
-    Just (Succeeded ast) -> Just ast <$ trace ("tree-sitter: parsing succeeded " <> blobPath)
-    Nothing -> do
-      trace $ "tree-sitter: parsing timed out " <> blobPath
-      liftIO (TS.ts_parser_set_enabled parser (CBool 0))
-      Nothing <$ liftIO (wait parsing)
-
+    runParser parser blobSource
+  case result of
+    Failed          -> Nothing  <$ trace ("tree-sitter: parsing failed " <> blobPath)
+    (Succeeded ast) -> Just ast <$ trace ("tree-sitter: parsing succeeded " <> blobPath)
 
 toAST :: forall grammar . (Bounded grammar, Enum grammar) => TS.Node -> IO (Base (AST [] grammar) TS.Node)
 toAST node@TS.Node{..} = do

src/Proto3/Google/Timestamp.hs

@@ -1,15 +1,63 @@
-{-# LANGUAGE DeriveAnyClass #-}
-
-module Proto3.Google.Timestamp (Timestamp (..)) where
-
-import Prologue
-
-import Data.Aeson
-import Proto3.Suite
-
+-- Code generated by protoc-gen-haskell 0.1.0, DO NOT EDIT.
+{-# LANGUAGE DerivingVia, DeriveAnyClass, DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Wno-unused-imports -Wno-missing-export-lists #-}
 -- | Predefined timestamp message provided by Google. The schema can be found
 -- <https://github.com/protocolbuffers/protobuf/blob/master/src/google/protobuf/timestamp.proto here>.
+module Proto3.Google.Timestamp (Timestamp (..)) where
+
+import           Control.DeepSeq
+import           Control.Monad (msum)
+import qualified Data.Aeson as A
+import qualified Data.Aeson.Encoding as E
+import           Data.ByteString (ByteString)
+import           Data.Int
+import           Data.Text (Text)
+import qualified Data.Text as T
+import           Data.Vector (Vector)
+import           Data.Word
+import           GHC.Generics
+import           Proto3.Suite (decodeMessageField, encodeMessageField, nestedvec, packedvec)
+import qualified Proto3.Suite as Proto3
+import           Proto3.Suite.JSONPB as JSONPB
+import           Proto3.Wire (at, oneof)
+
 data Timestamp = Timestamp
-  { timestampSeconds :: Int64
-  , timestampNanos   :: Int32
-  } deriving (Eq, Ord, Show, Generic, Message, Named, NFData, FromJSON, ToJSON)
+  { seconds :: Int64
+  , nanos   :: Int32
+  } deriving stock (Eq, Ord, Show, Generic)
+    deriving anyclass (Proto3.Named, NFData)
+
+instance FromJSONPB Timestamp where
+  parseJSONPB = A.withObject "Timestamp" $ \obj -> Timestamp
+    <$> obj .: "seconds"
+    <*> obj .: "nanos"
+
+instance ToJSONPB Timestamp where
+  toJSONPB Timestamp{..} = object
+    [
+      "seconds" .= seconds
+    , "nanos" .= nanos
+    ]
+  toEncodingPB Timestamp{..} = pairs
+    [
+      "seconds" .= seconds
+    , "nanos" .= nanos
+    ]
+
+instance FromJSON Timestamp where
+  parseJSON = parseJSONPB
+
+instance ToJSON Timestamp where
+  toJSON = toAesonValue
+  toEncoding = toAesonEncoding
+
+instance Proto3.Message Timestamp where
+  encodeMessage _ Timestamp{..} = mconcat
+    [
+      encodeMessageField 1 seconds
+    , encodeMessageField 2 nanos
+    ]
+  decodeMessage _ = Timestamp
+    <$> at decodeMessageField 1
+    <*> at decodeMessageField 2
+  dotProto = undefined

src/Proto3/Google/Wrapped.hs

@@ -6,7 +6,10 @@ module Proto3.Google.Wrapped
 
 import Prologue
 
+import qualified Data.Aeson as A
+
 import Proto3.Suite
+import Proto3.Suite.JSONPB as JSONPB
 
 -- | Because protobuf primitive types (string, int32, etc.) are not nullable, Google provides a set of standard
 -- <https://github.com/protocolbuffers/protobuf/blob/master/src/google/protobuf/wrappers.proto wrappers>
@@ -16,6 +19,27 @@ import Proto3.Suite
 newtype Wrapped a = Wrapped { value :: a }
   deriving (Eq, Show, Ord, Generic, NFData)
 
+instance (HasDefault a, FromJSONPB a) => FromJSONPB (Wrapped a) where
+  parseJSONPB = A.withObject "Value" $ \obj -> Wrapped
+    <$> obj .: "value"
+
+instance (HasDefault a, ToJSONPB a) => ToJSONPB (Wrapped a) where
+  toJSONPB Wrapped{..} = object
+    [
+      "value" .= value
+    ]
+  toEncodingPB Wrapped{..} = pairs
+    [
+      "value" .= value
+    ]
+
+instance (HasDefault a, FromJSONPB a) => FromJSON (Wrapped a) where
+  parseJSON = parseJSONPB
+
+instance (HasDefault a, ToJSONPB a) => ToJSON (Wrapped a) where
+  toJSON = toAesonValue
+  toEncoding = toAesonEncoding
+
 instance Named (Wrapped Text) where nameOf _ = "StringValue"
 instance Named (Wrapped ByteString) where nameOf _ = "BytesValue"
 instance Named (Wrapped Double) where nameOf _ = "DoubleValue"

src/Semantic/Api/Bridge.hs

@@ -98,7 +98,7 @@ instance APIBridge T.Text Data.Language where
 instance APIBridge API.Blob Data.Blob where
   bridging = iso apiBlobToBlob blobToApiBlob where
     blobToApiBlob Data.Blob{..} = API.Blob (toText blobSource) (T.pack blobPath) (bridging # blobLanguage)
-    apiBlobToBlob API.Blob{..} = Data.Blob (fromText content) (T.unpack path) (language ^. bridging)
+    apiBlobToBlob API.Blob{..} = Data.Blob (fromText content) (T.unpack path) (language ^. bridging) mempty
 
 
 instance APIConvert API.BlobPair Data.BlobPair where

src/Semantic/Api/Symbols.hs

@@ -37,8 +37,12 @@ legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap
     go blob@Blob{..} = (doParse blob >>= withSomeTerm (renderToSymbols blob)) `catchError` (\(SomeException _) -> pure (pure emptyFile))
       where emptyFile = Legacy.File (pack blobPath) (pack (show blobLanguage)) []
 
+    -- Legacy symbols output doesn't include Function Calls.
+    symbolsToSummarize :: [Text]
+    symbolsToSummarize = ["Function", "Method", "Class", "Module"]
+
     renderToSymbols :: (IsTaggable f, Applicative m) => Blob -> Term f Location -> m [Legacy.File]
-    renderToSymbols blob term = pure $ either mempty (pure . tagsToFile blob) (runTagging blob term)
+    renderToSymbols blob term = pure $ either mempty (pure . tagsToFile blob) (runTagging blob symbolsToSummarize term)
 
     tagsToFile :: Blob -> [Tag] -> Legacy.File
     tagsToFile Blob{..} tags = Legacy.File (pack blobPath) (pack (show blobLanguage)) (fmap tagToSymbol tags)
@@ -63,8 +67,11 @@ parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distribut
       where
         errorFile e = File (pack blobPath) (bridging # blobLanguage) mempty (V.fromList [ParseError (T.pack e)])
 
+        symbolsToSummarize :: [Text]
+        symbolsToSummarize = ["Function", "Method", "Class", "Module", "Call", "Send"]
+
         renderToSymbols :: (IsTaggable f, Applicative m) => Blob -> Term f Location -> m File
-        renderToSymbols blob@Blob{..} term = pure $ either (errorFile . show) (tagsToFile blob) (runTagging blob term)
+        renderToSymbols blob@Blob{..} term = pure $ either (errorFile . show) (tagsToFile blob) (runTagging blob symbolsToSummarize term)
 
         tagsToFile :: Blob -> [Tag] -> File
         tagsToFile Blob{..} tags = File (pack blobPath) (bridging # blobLanguage) (V.fromList (fmap tagToSymbol tags)) mempty

src/Semantic/CLI.hs

@@ -9,6 +9,7 @@ import           Data.List (intercalate, uncons)
 import           Data.List.Split (splitWhen)
 import           Data.Project
 import qualified Data.Text as T
+import qualified Data.Flag as Flag
 import           Options.Applicative hiding (style)
 import           Prologue
 import           Semantic.Api hiding (File)
@@ -48,7 +49,7 @@ optionsParser = do
                       (long "log-level" <> value (Just Log.Warning) <> help "Log messages at or above this level, or disable logging entirely.")
   failOnWarning <- switch (long "fail-on-warning" <> help "Fail on assignment warnings.")
   failOnParseError <- switch (long "fail-on-parse-error" <> help "Fail on tree-sitter parse errors.")
-  pure $ Options logLevel failOnWarning failOnParseError
+  pure $ Options logLevel (Flag.flag FailOnWarning failOnWarning) (Flag.flag FailOnParseError failOnParseError)
 
 argumentsParser :: Parser (Task.TaskEff ())
 argumentsParser = do

src/Semantic/Config.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
-
 module Semantic.Config
   ( Config (..)
   , defaultConfig
@@ -13,9 +11,17 @@ module Semantic.Config
   , withLoggerFromConfig
   , withStatterFromConfig
   , withTelemetry
+  -- * Flags
+  , IsTerminal      (..)
+  , LogPrintSource  (..)
+  , FailTestParsing (..)
+  , FailOnWarning   (..)
+  , FailOnParseError (..)
   ) where
 
 import           Data.Duration
+import           Data.Error (LogPrintSource(..))
+import           Data.Flag
 import           Network.HostName
 import           Network.HTTP.Client.TLS
 import           Network.URI
@@ -29,43 +35,46 @@ import           System.IO (hIsTerminalDevice, stdout)
 import           System.Posix.Process
 import           System.Posix.Types
 
+data IsTerminal       = IsTerminal
+data FailTestParsing  = FailTestParsing
+data FailOnWarning    = FailOnWarning
+data FailOnParseError = FailOnParseError
+
 data Config
   = Config
-  { configAppName                :: String       -- ^ Application name ("semantic")
-  , configHostName               :: String       -- ^ HostName from getHostName
-  , configProcessID              :: ProcessID    -- ^ ProcessID from getProcessID
-  , configHaystackURL            :: Maybe String -- ^ URL of Haystack (with creds) from environment
-  , configStatsHost              :: Stat.Host    -- ^ Host of statsd/datadog (default: "127.0.0.1")
-  , configStatsPort              :: Stat.Port    -- ^ Port of statsd/datadog (default: "28125")
-
-  , configTreeSitterParseTimeout :: Duration     -- ^ Timeout in milliseconds before canceling tree-sitter parsing (default: 6000).
-  , configAssignmentTimeout      :: Duration     -- ^ Millisecond timeout for assignment (default: 4000)
-  , configMaxTelemetyQueueSize   :: Int          -- ^ Max size of telemetry queues before messages are dropped (default: 1000).
-  , configIsTerminal             :: Bool         -- ^ Whether a terminal is attached (set automaticaly at runtime).
-  , configLogPrintSource         :: Bool         -- ^ Whether to print the source reference when logging errors (set automatically at runtime).
-  , configLogFormatter           :: LogFormatter -- ^ Log formatter to use (set automaticaly at runtime).
-  , configSHA                    :: Maybe String -- ^ Optional SHA to include in log messages.
-  , configFailParsingForTesting  :: Bool         -- ^ Simulate internal parse failure for testing (default: False).
-
-  , configOptions                :: Options      -- ^ Options configurable via command line arguments.
+  { configAppName                :: String               -- ^ Application name ("semantic")
+  , configHostName               :: String               -- ^ HostName from getHostName
+  , configProcessID              :: ProcessID            -- ^ ProcessID from getProcessID
+  , configHaystackURL            :: Maybe String         -- ^ URL of Haystack (with creds) from environment
+  , configStatsHost              :: Stat.Host            -- ^ Host of statsd/datadog (default: "127.0.0.1")
+  , configStatsPort              :: Stat.Port            -- ^ Port of statsd/datadog (default: "28125")
+  , configTreeSitterParseTimeout :: Duration             -- ^ Timeout in milliseconds before canceling tree-sitter parsing (default: 6000).
+  , configAssignmentTimeout      :: Duration             -- ^ Millisecond timeout for assignment (default: 4000)
+  , configMaxTelemetyQueueSize   :: Int                  -- ^ Max size of telemetry queues before messages are dropped (default: 1000).
+  , configIsTerminal             :: Flag IsTerminal      -- ^ Whether a terminal is attached (set automaticaly at runtime).
+  , configLogPrintSource         :: Flag LogPrintSource  -- ^ Whether to print the source reference when logging errors (set automatically at runtime).
+  , configLogFormatter           :: LogFormatter         -- ^ Log formatter to use (set automatically at runtime).
+  , configSHA                    :: Maybe String         -- ^ Optional SHA to include in log messages.
+  , configFailParsingForTesting  :: Flag FailTestParsing -- ^ Simulate internal parse failure for testing (default: False).
+  , configOptions                :: Options              -- ^ Options configurable via command line arguments.
   }
 
 -- Options configurable via command line arguments.
 data Options
   = Options
-  { optionsLogLevel         :: Maybe Level   -- ^ What level of messages to log. 'Nothing' disables logging.
-  , optionsFailOnWarning    :: Bool          -- ^ Should semantic fail fast on assignment warnings (for testing)
-  , optionsFailOnParseError :: Bool          -- ^ Should semantic fail fast on tree-sitter parser errors (for testing)
+  { optionsLogLevel         :: Maybe Level           -- ^ What level of messages to log. 'Nothing' disables logging.
+  , optionsFailOnWarning    :: Flag FailOnWarning    -- ^ Should semantic fail fast on assignment warnings (for testing)
+  , optionsFailOnParseError :: Flag FailOnParseError -- ^ Should semantic fail fast on tree-sitter parser errors (for testing)
   }
 
 defaultOptions :: Options
-defaultOptions = Options (Just Warning) False False
+defaultOptions = Options (Just Warning) (flag FailOnWarning False) (flag FailOnParseError False)
 
 debugOptions :: Options
-debugOptions = Options (Just Debug) False False
+debugOptions = defaultOptions { optionsLogLevel = Just Debug }
 
 infoOptions :: Options
-infoOptions = Options (Just Info) False False
+infoOptions = defaultOptions { optionsLogLevel = Just Info }
 
 defaultConfig :: Options -> IO Config
 defaultConfig options@Options{..} = do
@@ -88,11 +97,11 @@ defaultConfig options@Options{..} = do
     , configTreeSitterParseTimeout = fromMilliseconds parseTimeout
     , configAssignmentTimeout = fromMilliseconds assignTimeout
     , configMaxTelemetyQueueSize = size
-    , configIsTerminal = isTerminal
-    , configLogPrintSource = isTerminal
+    , configIsTerminal = flag IsTerminal isTerminal
+    , configLogPrintSource = flag LogPrintSource isTerminal
     , configLogFormatter = if isTerminal then terminalFormatter else logfmtFormatter
     , configSHA = Nothing
-    , configFailParsingForTesting = False
+    , configFailParsingForTesting = flag FailTestParsing False
 
     , configOptions = options
     }
@@ -108,15 +117,15 @@ logOptionsFromConfig :: Config -> LogOptions
 logOptionsFromConfig Config{..} = LogOptions
   { logOptionsLevel     = optionsLogLevel configOptions
   , logOptionsFormatter = configLogFormatter
-  , logOptionsContext   = logOptionsContext' configIsTerminal
+  , logOptionsContext   = logOptionsContext'
   }
-  where logOptionsContext' = \case
-          False -> [ ("app", configAppName)
-                   , ("pid", show configProcessID)
-                   , ("hostname", configHostName)
-                   , ("sha", fromMaybe "development" configSHA)
-                   ]
-          _     -> []
+  where logOptionsContext'
+          | toBool IsTerminal configIsTerminal = []
+          | otherwise = [ ("app", configAppName)
+                        , ("pid", show configProcessID)
+                        , ("hostname", configHostName)
+                        , ("sha", fromMaybe "development" configSHA)
+                        ]
 
 
 withLoggerFromConfig :: Config -> (LogQueue -> IO c) -> IO c

src/Semantic/REPL.hs

@@ -18,8 +18,9 @@ import Data.Abstract.ModuleTable as ModuleTable
 import Data.Abstract.Package
 import Data.Abstract.Value.Concrete as Concrete
 import Data.Blob (Blob(..))
-import Data.Error (showExcerpt)
+import Data.Error (Colourize (..), showExcerpt)
 import Data.File (File (..), readBlobFromFile)
+import Data.Flag (flag)
 import Data.Graph (topologicalSort)
 import Data.Language as Language
 import Data.List (uncons)
@@ -138,7 +139,7 @@ step blobs recur term = do
   where list = do
           path <- asks modulePath
           span <- ask
-          maybe (pure ()) (\ blob -> output (T.pack (showExcerpt True span blob ""))) (Prelude.lookup path blobs)
+          maybe (pure ()) (\ blob -> output (T.pack (showExcerpt (flag Colourize True) span blob ""))) (Prelude.lookup path blobs)
         help = do
           output "Commands available from the prompt:"
           output ""

src/Semantic/Task.hs

@@ -68,11 +68,11 @@ import           Control.Effect.Trace
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Data.Blob
-import           Data.Bool
 import           Data.ByteString.Builder
 import           Data.Coerce
 import           Data.Diff
 import qualified Data.Error as Error
+import qualified Data.Flag as Flag
 import           Data.Location
 import           Data.Source (Source)
 import           Data.Sum
@@ -240,7 +240,7 @@ instance (Member (Error SomeException) sig, Member (Lift IO) sig, Member (Reader
     Semantic.Task.Diff terms k -> k (diffTermPair terms)
     Render renderer input k -> k (renderer input)
     Serialize format input k -> do
-      formatStyle <- asks (bool Plain Colourful . configIsTerminal . config)
+      formatStyle <- asks (Flag.choose IsTerminal Plain Colourful . configIsTerminal . config)
       k (runSerialize formatStyle format input)
 
 
@@ -253,9 +253,9 @@ logError :: (Member Telemetry sig, Carrier sig m)
          -> [(String, String)]
          -> m ()
 logError TaskSession{..} level blob err =
-  let configLogPrintSource' = configLogPrintSource config
-      configIsTerminal' = configIsTerminal config
-  in writeLog level (Error.formatError configLogPrintSource' configIsTerminal' blob err)
+  let shouldLogSource = configLogPrintSource config
+      shouldColorize = Flag.switch IsTerminal Error.Colourize $ configIsTerminal config
+  in writeLog level (Error.formatError shouldLogSource shouldColorize blob err)
 
 data ParserCancelled = ParserTimedOut | AssignmentTimedOut
   deriving (Show, Typeable)
@@ -308,8 +308,13 @@ runParser blob@Blob{..} parser = case parser of
           taskSession <- ask
           let requestID' = ("github_request_id", requestID taskSession)
           let isPublic'  = ("github_is_public", show (isPublic taskSession))
-          let blobFields = ("path", if isPublic taskSession || configLogPrintSource (config taskSession) then blobPath else "<filtered>")
+          let logPrintFlag = configLogPrintSource . config $ taskSession
+          let blobFields = ("path", if isPublic taskSession || Flag.toBool LogPrintSource logPrintFlag then blobPath else "<filtered>")
           let logFields = requestID' : isPublic' : blobFields : languageTag
+          let shouldFailForTesting = configFailParsingForTesting $ config taskSession
+          let shouldFailOnParsing = optionsFailOnParseError . configOptions $ config taskSession
+          let shouldFailOnWarning = optionsFailOnWarning . configOptions $ config taskSession
+
           ast <- runParser blob parser `catchError` \ (SomeException err) -> do
             writeStat (increment "parse.parse_failures" languageTag)
             writeLog Error "failed parsing" (("task", "parse") : logFields)
@@ -326,15 +331,14 @@ runParser blob@Blob{..} parser = case parser of
                   Just "ParseError" -> do
                     when (i == 0) $ writeStat (increment "parse.parse_errors" languageTag)
                     logError taskSession Warning blob err (("task", "parse") : logFields)
-                    when (optionsFailOnParseError (configOptions (config taskSession))) $ throwError (toException err)
+                    when (Flag.toBool FailOnParseError shouldFailOnParsing) (throwError (toException err))
                   _ -> do
                     when (i == 0) $ writeStat (increment "parse.assign_warnings" languageTag)
                     logError taskSession Warning blob err (("task", "assign") : logFields)
-                    when (optionsFailOnWarning (configOptions (config taskSession))) $ throwError (toException err)
+                    when (Flag.toBool FailOnWarning shouldFailOnWarning) (throwError (toException err))
                 term <$ writeStat (count "parse.nodes" (length term) languageTag)
           case res of
-            Just r | not (configFailParsingForTesting (config taskSession))
-              -> pure r
+            Just r | not (Flag.toBool FailTestParsing shouldFailForTesting) -> pure r
             _ -> do
               writeStat (increment "assign.assign_timeouts" languageTag)
               writeLog Error "assignment timeout" (("task", "assign") : logFields)

src/Semantic/Telemetry/Log.hs

@@ -8,7 +8,8 @@ module Semantic.Telemetry.Log
   , writeLogMessage
   ) where
 
-import           Data.Error (withSGRCode)
+import           Data.Error (Colourize (..), withSGRCode)
+import           Data.Flag as Flag
 import           Data.List (intersperse)
 import qualified Data.Time.Format as Time
 import qualified Data.Time.LocalTime as LocalTime
@@ -75,7 +76,7 @@ terminalFormatter LogOptions{..} (Message level message pairs time) =
   . showPairs (pairs <> logOptionsContext)
   . showChar '\n' $ ""
   where
-    colourize = True
+    colourize = flag Colourize True
     showLevel Error = withSGRCode colourize [SetColor Foreground Vivid Red, SetConsoleIntensity BoldIntensity] (showString "ERROR")
     showLevel Warning = withSGRCode colourize [SetColor Foreground Vivid Yellow, SetConsoleIntensity BoldIntensity] (showString " WARN")
     showLevel Info = withSGRCode colourize [SetColor Foreground Vivid Cyan, SetConsoleIntensity BoldIntensity] (showString " INFO")

src/Tags/Taggable.hs

@@ -200,6 +200,15 @@ instance Taggable TypeScript.Module where
   snippet ann (TypeScript.Module _ _                   ) = Just $ locationByteRange ann
   symbolName = declaredName . TypeScript.moduleIdentifier
 
+instance Taggable Expression.Call where
+  snippet ann (Expression.Call _ _ _ (Term (In body _))) = Just $ subtractLocation ann body
+  symbolName = declaredName . Expression.callFunction
+
+instance Taggable Ruby.Send where
+  snippet ann (Ruby.Send _ _ _ (Just (Term (In body _)))) = Just $ subtractLocation ann body
+  snippet ann _                                           = Just $ locationByteRange ann
+  symbolName Ruby.Send{..} = maybe Nothing declaredName sendSelector
+
 instance Taggable []
 instance Taggable Comment.Comment
 instance Taggable Comment.HashBang
@@ -209,7 +218,6 @@ instance Taggable Expression.Await
 instance Taggable Expression.BAnd
 instance Taggable Expression.BOr
 instance Taggable Expression.BXOr
-instance Taggable Expression.Call
 instance Taggable Expression.Cast
 instance Taggable Expression.Comparison
 instance Taggable Expression.Complement
@@ -606,7 +614,6 @@ instance Taggable PHP.PropertyModifier
 instance Taggable PHP.InterfaceDeclaration
 instance Taggable PHP.Declare
 
-instance Taggable Ruby.Send
 instance Taggable Ruby.Require
 instance Taggable Ruby.Load
 instance Taggable Ruby.LowPrecedenceAnd

src/Tags/Tagging.hs

@@ -21,19 +21,17 @@ import           Data.Term
 import           Data.Text hiding (empty)
 import           Tags.Taggable
 
-symbolsToSummarize :: [Text]
-symbolsToSummarize = ["Function", "Method", "Class", "Module"]
-
 runTagging :: (IsTaggable syntax)
   => Blob
+  -> [Text]
   -> Term syntax Location
   -> Either TranslationError [Tag]
-runTagging blob tree
+runTagging blob symbolsToSummarize tree
   = Eff.run
   . Error.runError
   . State.evalState mempty
   . runT $ source (tagging blob tree)
-      ~> contextualizing blob
+      ~> contextualizing blob symbolsToSummarize
 
 type ContextToken = (Text, Maybe Range)
 
@@ -41,8 +39,8 @@ type Contextualizer
   = StateC [ContextToken]
   ( ErrorC TranslationError PureC)
 
-contextualizing :: Blob -> Machine.ProcessT Contextualizer Token Tag
-contextualizing Blob{..} = repeatedly $ await >>= \case
+contextualizing :: Blob -> [Text] -> Machine.ProcessT Contextualizer Token Tag
+contextualizing Blob{..} symbolsToSummarize = repeatedly $ await >>= \case
   Enter x r -> enterScope (x, r)
   Exit  x r -> exitScope (x, r)
   Iden iden span docsLiteralRange -> lift State.get >>= \case

test/Data/Functor/Listable.hs

@@ -568,7 +568,7 @@ instance Listable Span where
   tiers = cons2 Span
 
 instance Listable Blob where
-  tiers = cons3 Blob
+  tiers = cons4 Blob
 
 instance Listable BlobPair where
   tiers = liftTiers tiers

test/Examples.hs

@@ -10,6 +10,7 @@ import           Data.ByteString.Builder
 import qualified Data.ByteString.Char8 as BC
 import           Data.Either
 import           Data.File (file)
+import           Data.Flag
 import           Data.Foldable
 import           Data.List
 import           Data.Maybe
@@ -18,7 +19,7 @@ import           Data.Typeable (cast)
 import           Data.Void
 import           Parsing.Parser
 import           Semantic.Api (TermOutputFormat (..), parseTermBuilder)
-import           Semantic.Config (Config (..), Options (..), defaultOptions)
+import           Semantic.Config (Config (..), Options (..), FailOnWarning (..), defaultOptions)
 import qualified Semantic.IO as IO
 import           Semantic.Task
 import           Semantic.Task.Files
@@ -58,7 +59,7 @@ main = withOptions opts $ \ config logger statter -> hspec . parallel $ do
                   else res `shouldSatisfy` isRight
 
     setupExampleRepos = readProcess "script/clone-example-repos" mempty mempty >>= print
-    opts = defaultOptions { optionsFailOnWarning = True, optionsLogLevel = Nothing }
+    opts = defaultOptions { optionsFailOnWarning = flag FailOnWarning True, optionsLogLevel = Nothing }
 
     knownFailuresForPath :: FilePath -> Maybe FilePath -> IO [FilePath]
     knownFailuresForPath _     Nothing     = pure []

test/Parsing/Spec.hs

@@ -0,0 +1,37 @@
+module Parsing.Spec (spec) where
+
+import Control.Effect
+import Data.AST
+import Data.Blob
+import Data.ByteString.Char8 (pack)
+import Data.Duration
+import Data.Language
+import Data.Maybe
+import Data.Source
+import Language.JSON.Grammar (Grammar)
+import Parsing.TreeSitter
+import Semantic.Config
+import SpecHelpers
+import System.Timeout
+import TreeSitter.JSON
+
+spec :: Spec
+spec = parallel $ do
+  describe "parseToAST" $ do
+    let source = toJSONSource $ take 10000 [1..]
+    let largeBlob = sourceBlob "large.json" JSON source
+
+    it "returns a result when the timeout does not expire" $ do
+      let timeout = fromMicroseconds 0 -- Zero microseconds indicates no timeout
+      let parseTask = parseToAST timeout tree_sitter_json largeBlob :: TaskEff (Maybe (AST [] Grammar))
+      result <- runTaskOrDie parseTask
+      (isJust result) `shouldBe` True
+
+    it "returns nothing when the timeout expires" $ do
+      let timeout = fromMicroseconds 1000
+      let parseTask = parseToAST timeout tree_sitter_json largeBlob :: TaskEff (Maybe (AST [] Grammar))
+      result <- runTaskOrDie parseTask
+      (isNothing result) `shouldBe` True
+
+toJSONSource :: Show a => a -> Source
+toJSONSource = fromUTF8 . pack . show

test/Reprinting/Spec.hs

@@ -67,5 +67,5 @@ spec = describe "reprinting" $ do
       it "should be able to parse the output of a refactor" $ do
         let (Just tagged) = rewrite (mark Unmodified tree) (topDownAny increaseNumbers)
         let (Right printed) = runReprinter src defaultJSONPipeline tagged
-        tree' <- runTaskOrDie (parse jsonParser (Blob printed path Language.JSON))
+        tree' <- runTaskOrDie (parse jsonParser (Blob printed path Language.JSON mempty))
         length tree' `shouldSatisfy` (/= 0)

test/Semantic/IO/Spec.hs

@@ -11,11 +11,6 @@ import System.IO (IOMode (..))
 import Parsing.TreeSitter
 import System.Timeout
 
-import qualified TreeSitter.Language as TS
-import qualified TreeSitter.Node as TS
-import qualified TreeSitter.Parser as TS
-import qualified TreeSitter.Tree as TS
-
 import Data.Blob
 import Data.Handle
 import SpecHelpers hiding (readFile)
@@ -79,24 +74,6 @@ spec = parallel $ do
       h <- openFileForReading "test/fixtures/cli/diff-null-both-sides.json"
       readBlobPairsFromHandle h `shouldThrow` (== ExitFailure 1)
 
-  describe "cancelable parsing" $
-    it "should be cancelable asynchronously" $ do
-      p <- TS.ts_parser_new
-
-      churn <- async $ do
-        TS.ts_parser_loop_until_cancelled p nullPtr nullPtr 0
-        pure True
-
-      res <- timeout 2500 (wait churn)
-      res `shouldBe` Nothing
-
-      TS.ts_parser_set_enabled p (CBool 0)
-      done <- timeout 2500 (wait churn)
-
-      done `shouldBe` (Just True)
-
-      TS.ts_parser_delete p
-
   describe "readBlobsFromHandle" $ do
     it "returns blobs for valid JSON encoded parse input" $ do
       h <- openFileForReading "test/fixtures/cli/parse.json"

test/Semantic/Spec.hs

@@ -22,4 +22,4 @@ spec = parallel $ do
       output <- fmap runBuilder . runTaskOrDie $ parseTermBuilder TermSExpression [methodsBlob]
       output `shouldBe` "(Statements\n  (Method\n    (Empty)\n    (Identifier)\n    (Statements)))\n"
   where
-    methodsBlob = Blob "def foo\nend\n" "methods.rb" Ruby
+    methodsBlob = Blob "def foo\nend\n" "methods.rb" Ruby mempty

test/Spec.hs

@@ -23,6 +23,7 @@ import qualified Diffing.Interpreter.Spec
 import qualified Graphing.Calls.Spec
 import qualified Integration.Spec
 import qualified Numeric.Spec
+import qualified Parsing.Spec
 import qualified Rendering.TOC.Spec
 import qualified Reprinting.Spec
 import qualified Rewriting.Go.Spec
@@ -75,3 +76,4 @@ main = do
       describe "Semantic.CLI" Semantic.CLI.Spec.spec
       describe "Semantic.IO" Semantic.IO.Spec.spec
       describe "Integration" (Integration.Spec.spec args)
+      describe "Parsing" Parsing.Spec.spec

test/Tags/Spec.hs

@@ -1,7 +1,8 @@
 module Tags.Spec (spec) where
 
-import Tags.Tagging
+import Data.Text (Text)
 import SpecHelpers
+import Tags.Tagging
 
 
 spec :: Spec
@@ -9,35 +10,40 @@ spec = parallel $ do
   describe "go" $ do
     it "produces tags for functions with docs" $ do
       (blob, tree) <- parseTestFile goParser "test/fixtures/go/tags/simple_functions.go"
-      runTagging blob tree `shouldBe` Right
-        [ Tag "TestFromBits" "Function" (Span (Pos 6 1) (Pos 7 2)) ["Statements"] (Just "func TestFromBits(t *testing.T)") (Just "// TestFromBits ...")
-        , Tag "Hi" "Function" (Span (Pos 9 1) (Pos 10 2)) ["Statements"] (Just "func Hi()") Nothing ]
+      runTagging blob symbolsToSummarize tree `shouldBe` Right
+        [ Tag "TestFromBits" "Function" (Span (Pos 6 1) (Pos 8 2)) ["Statements"] (Just "func TestFromBits(t *testing.T) {") (Just "// TestFromBits ...")
+        , Tag "Hi" "Function" (Span (Pos 10 1) (Pos 11 2)) ["Statements"] (Just "func Hi()") Nothing ]
 
     it "produces tags for methods" $ do
       (blob, tree) <- parseTestFile goParser "test/fixtures/go/tags/method.go"
-      runTagging blob tree `shouldBe` Right
+      runTagging blob symbolsToSummarize tree `shouldBe` Right
         [ Tag "CheckAuth" "Method" (Span (Pos 3 1) (Pos 3 100)) ["Statements"] (Just "func (c *apiClient) CheckAuth(req *http.Request, user, repo string) (*authenticatedActor, error)") Nothing]
 
+    it "produces tags for calls" $ do
+      (blob, tree) <- parseTestFile goParser "test/fixtures/go/tags/simple_functions.go"
+      runTagging blob ["Call"] tree `shouldBe` Right
+        [ Tag "Hi" "Call" (Span (Pos 7 2) (Pos 7 6)) ["Function", "Context", "Statements"] (Just "Hi()") Nothing]
+
   describe "javascript and typescript" $ do
     it "produces tags for functions with docs" $ do
       (blob, tree) <- parseTestFile typescriptParser "test/fixtures/javascript/tags/simple_function_with_docs.js"
-      runTagging blob tree `shouldBe` Right
+      runTagging blob symbolsToSummarize tree `shouldBe` Right
         [ Tag "myFunction" "Function" (Span (Pos 2 1) (Pos 4 2)) ["Statements"] (Just "function myFunction()") (Just "// This is myFunction") ]
 
     it "produces tags for classes" $ do
       (blob, tree) <- parseTestFile typescriptParser "test/fixtures/typescript/tags/class.ts"
-      runTagging blob tree `shouldBe` Right
+      runTagging blob symbolsToSummarize tree `shouldBe` Right
         [ Tag "FooBar" "Class" (Span (Pos 1 1) (Pos 1 16)) ["Statements"] (Just "class FooBar") Nothing ]
 
     it "produces tags for modules" $ do
       (blob, tree) <- parseTestFile typescriptParser "test/fixtures/typescript/tags/module.ts"
-      runTagging blob tree `shouldBe` Right
+      runTagging blob symbolsToSummarize tree `shouldBe` Right
         [ Tag "APromise" "Module" (Span (Pos 1 1) (Pos 1 20)) ["Statements"] (Just "module APromise { }") Nothing ]
 
   describe "python" $ do
     it "produces tags for functions" $ do
       (blob, tree) <- parseTestFile pythonParser "test/fixtures/python/tags/simple_functions.py"
-      runTagging blob tree `shouldBe` Right
+      runTagging blob symbolsToSummarize tree `shouldBe` Right
         [ Tag "Foo" "Function" (Span (Pos 1 1) (Pos 5 17)) ["Statements"] (Just "def Foo(x)") Nothing
         , Tag "Bar" "Function" (Span (Pos 7 1) (Pos 11 13)) ["Statements"] (Just "def Bar()") Nothing
         , Tag "local" "Function" (Span (Pos 8 5) (Pos 9 17)) ["Statements", "Function", "Statements"] (Just "def local()") Nothing
@@ -45,35 +51,43 @@ spec = parallel $ do
 
     it "produces tags for functions with docs" $ do
       (blob, tree) <- parseTestFile pythonParser "test/fixtures/python/tags/simple_function_with_docs.py"
-      runTagging blob tree `shouldBe` Right
+      runTagging blob symbolsToSummarize tree `shouldBe` Right
         [ Tag "Foo" "Function" (Span (Pos 1 1) (Pos 3 13)) ["Statements"] (Just "def Foo(x)") (Just "\"\"\"This is the foo function\"\"\"") ]
 
     it "produces tags for classes" $ do
       (blob, tree) <- parseTestFile pythonParser "test/fixtures/python/tags/class.py"
-      runTagging blob tree `shouldBe` Right
+      runTagging blob symbolsToSummarize tree `shouldBe` Right
         [ Tag "Foo" "Class" (Span (Pos 1 1) (Pos 5 17)) ["Statements"] (Just "class Foo") (Just "\"\"\"The Foo class\"\"\"")
         , Tag "f" "Function" (Span (Pos 3 5) (Pos 5 17)) ["Statements", "Class", "Statements"] (Just "def f(self)") (Just "\"\"\"The f method\"\"\"")
         ]
 
     it "produces tags for multi-line functions" $ do
       (blob, tree) <- parseTestFile pythonParser "test/fixtures/python/tags/multiline.py"
-      runTagging blob tree `shouldBe` Right
+      runTagging blob symbolsToSummarize tree `shouldBe` Right
         [ Tag "Foo" "Function" (Span (Pos 1 1) (Pos 3 13)) ["Statements"] (Just "def Foo(x,") Nothing ]
 
   describe "ruby" $ do
     it "produces tags for methods" $ do
       (blob, tree) <- parseTestFile rubyParser "test/fixtures/ruby/tags/simple_method.rb"
-      runTagging blob tree `shouldBe` Right
-        [ Tag "foo" "Method" (Span (Pos 1 1) (Pos 2 4)) ["Statements"] (Just "def foo") Nothing ]
+      runTagging blob symbolsToSummarize tree `shouldBe` Right
+        [ Tag "foo" "Method" (Span (Pos 1 1) (Pos 4 4)) ["Statements"] (Just "def foo") Nothing ]
+
+    it "produces tags for sends" $ do
+      (blob, tree) <- parseTestFile rubyParser "test/fixtures/ruby/tags/simple_method.rb"
+      runTagging blob ["Send"] tree `shouldBe` Right
+        [ Tag "puts" "Send" (Span (Pos 2 3) (Pos 2 12)) ["Statements", "Method", "Statements"] (Just "puts \"hi\"") Nothing
+        , Tag "bar" "Send" (Span (Pos 3 3) (Pos 3 8)) ["Statements", "Method", "Statements"] (Just "a.bar") Nothing
+        , Tag "a" "Send" (Span (Pos 3 3) (Pos 3 4)) ["Send", "Statements", "Method", "Statements"] (Just "a") Nothing
+        ]
 
     it "produces tags for methods with docs" $ do
       (blob, tree) <- parseTestFile rubyParser "test/fixtures/ruby/tags/simple_method_with_docs.rb"
-      runTagging blob tree `shouldBe` Right
+      runTagging blob symbolsToSummarize tree `shouldBe` Right
         [ Tag "foo" "Method" (Span (Pos 2 1) (Pos 3 4)) ["Statements"] (Just "def foo") (Just "# Public: foo") ]
 
     it "produces tags for methods and classes with docs" $ do
       (blob, tree) <- parseTestFile rubyParser "test/fixtures/ruby/tags/class_module.rb"
-      runTagging blob tree `shouldBe` Right
+      runTagging blob symbolsToSummarize tree `shouldBe` Right
         [ Tag "Foo" "Module" (Span (Pos 2 1 ) (Pos 12 4)) ["Statements"] (Just "module Foo") (Just "# Public: Foo")
         , Tag "Bar" "Class"  (Span (Pos 5 3 ) (Pos 11 6)) ["Module", "Context", "Statements"] (Just "class Bar") (Just "# Public: Bar")
         , Tag "baz" "Method" (Span (Pos 8 5 ) (Pos 10 8)) ["Class", "Context", "Module", "Context", "Statements"] (Just "def baz(a)") (Just "# Public: baz")
@@ -81,3 +95,6 @@ spec = parallel $ do
         , Tag "foo" "Method" (Span (Pos 15 3) (Pos 17 6)) ["Statements", "Class", "Statements"] (Just "def foo") Nothing
         , Tag "foo" "Method" (Span (Pos 18 3) (Pos 19 6)) ["Statements", "Class", "Statements"] (Just "def self.foo") Nothing
         ]
+
+symbolsToSummarize :: [Text]
+symbolsToSummarize = ["Function", "Method", "Class", "Module"]

test/fixtures/go/tags/simple_functions.go

@@ -4,6 +4,7 @@ import "testing"
 
 // TestFromBits ...
 func TestFromBits(t *testing.T) {
+	Hi()
 }
 
 func Hi() {

test/fixtures/ruby/tags/simple_method.rb

@@ -1,2 +1,4 @@
 def foo
+  puts "hi"
+  a.bar
 end

vendor/haskell-tree-sitter

@@ -1 +1 @@
-Subproject commit 53dbe815fd85726484294833dfaece544d5f423d
+Subproject commit fd22b2cfa318a989759d8a9334d178eb3748813a