Merge pull request #359 from github/you-already-know-too-much

🔥 concrete parsers
2024-11-24 17:04:47 +03:00 · 2019-10-23 17:14:43 -04:00 · 2019-10-23 17:14:43 -04:00 · d17ca69065
commit d17ca69065
parent 7e9701e436 d78adfc09d
16 changed files with 240 additions and 322 deletions
--- a/bench/Evaluation.hs
+++ b/bench/Evaluation.hs
@ -24,7 +24,7 @@ import           Parsing.Parser
 import           Semantic.Config (defaultOptions)
 import           Semantic.Graph
 import           Semantic.Task (SomeException, TaskSession (..), runTask, withOptions)
-import           Semantic.Util hiding (evalPythonProject, evalRubyProject, evaluateProject)
+import           Semantic.Util
 import           Source.Loc
 import           Source.Span (HasSpan)
 import qualified System.Path as Path
@ -34,47 +34,38 @@ import           System.Path ((</>))

 callGraphProject' :: ( Language.SLanguage lang
                     , HasPrelude lang
-                     , 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 Loc)
                  -> Path.RelFile
                  -> IO (Either String (Data.Graph.Graph ControlFlowVertex))
-callGraphProject' session proxy parser path = fmap (first show) . runTask session $ do
+callGraphProject' session proxy path
+  | let lang = Language.reflect proxy
+  , Just (SomeParser parser) <- parserForLanguage analysisParsers lang = fmap (first show) . runTask session $ do
  blob <- readBlobFromFile' (fileForTypedPath path)
-  package <- fmap snd <$> runParse (Duration.fromSeconds 10) (parsePackage parser (Project (Path.toString (Path.takeDirectory path)) [blob] (Language.reflect proxy) []))
+  package <- fmap snd <$> runParse (Duration.fromSeconds 10) (parsePackage parser (Project (Path.toString (Path.takeDirectory path)) [blob] lang []))
  modules <- topologicalSort <$> runImportGraphToModules proxy package
  runCallGraph proxy False modules package

-callGraphProject proxy parser paths = withOptions defaultOptions $ \ config logger statter ->
-  callGraphProject' (TaskSession config "" False logger statter) proxy parser paths
+callGraphProject proxy paths = withOptions defaultOptions $ \ config logger statter ->
+  callGraphProject' (TaskSession config "" False logger statter) proxy paths

-evalRubyProject       = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.Ruby)       rubyParser
-evalPythonProject     = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.Python)     pythonParser
-
-evaluateProject proxy parser path = withOptions defaultOptions $ \ config logger statter ->
-  evaluateProject' (TaskSession config "" False logger statter) proxy parser [Path.toString path]
+evaluateProject proxy path
+  | let lang = Language.reflect proxy
+  , Just (SomeParser parser) <- parserForLanguage analysisParsers lang = withOptions defaultOptions $ \ config logger statter ->
+  fmap (const ()) . justEvaluating =<< evaluateProject' (TaskSession config "" False logger statter) proxy parser [Path.toString path]

 pyEval :: Path.RelFile -> Benchmarkable
-pyEval p = nfIO $ evalPythonProject (Path.relDir "bench/bench-fixtures/python" </> p)
+pyEval p = nfIO $ evaluateProject  (Proxy @'Language.Python) (Path.relDir "bench/bench-fixtures/python" </> p)

 rbEval :: Path.RelFile -> Benchmarkable
-rbEval p = nfIO $ evalRubyProject (Path.relDir "bench/bench-fixtures/python" </> p)
+rbEval p = nfIO $ evaluateProject  (Proxy @'Language.Ruby)   (Path.relDir "bench/bench-fixtures/ruby" </> p)

 pyCall :: Path.RelFile -> Benchmarkable
-pyCall p = nfIO $ callGraphProject (Proxy @'Language.Python) pythonParser (Path.relDir "bench/bench-fixtures/python/" </> p)
+pyCall p = nfIO $ callGraphProject (Proxy @'Language.Python) (Path.relDir "bench/bench-fixtures/python/" </> p)

 rbCall :: Path.RelFile -> Benchmarkable
-rbCall p = nfIO $ callGraphProject (Proxy @'Language.Ruby) rubyParser $ (Path.relDir "bench/bench-fixtures/ruby" </> p)
+rbCall p = nfIO $ callGraphProject (Proxy @'Language.Ruby)   (Path.relDir "bench/bench-fixtures/ruby" </> p)

 benchmarks :: Benchmark
 benchmarks = bgroup "evaluation"
--- a/src/Control/Abstract/Modules.hs
+++ b/src/Control/Abstract/Modules.hs
@ -30,8 +30,10 @@ import Prologue
 import Source.Span
 import System.FilePath.Posix (takeDirectory)

-- A scope address, frame address, and value ref.
-type ModuleResult address value = ((address, address), value)
+-- | A scope address, frame address, and value ref.
+--
+-- Partially applied, omitting the value type for type applications at * -> *.
+type ModuleResult address = (,) (address, address)

 -- | Retrieve an evaluated module, if any. @Nothing@ means we’ve never tried to load it, and @Just (env, value)@ indicates the result of a completed load.
 lookupModule :: (Member (Modules address value) sig, Carrier sig m) => ModulePath -> Evaluator term address value m (Maybe (ModuleResult address value))
--- a/src/Control/Effect/Parse.hs
+++ b/src/Control/Effect/Parse.hs
@ -3,6 +3,8 @@ module Control.Effect.Parse
 ( -- * Parse effect
  Parse(..)
 , parse
+, parserForLanguage
+, parserForBlob
 , parseWith
 , parsePairWith
 ) where
@ -37,6 +39,15 @@ parse :: (Member Parse sig, Carrier sig m)
 parse parser blob = send (Parse parser blob pure)


+-- | Select a parser for the given 'Language'.
+parserForLanguage :: Map.Map Language (SomeParser c ann) -> Language -> Maybe (SomeParser c ann)
+parserForLanguage = flip Map.lookup
+
+-- | Select a parser for the given 'Blob'.
+parserForBlob :: Map.Map Language (SomeParser c ann) -> Blob -> Maybe (SomeParser c ann)
+parserForBlob parsers = parserForLanguage parsers . blobLanguage
+
+
 -- | Parse a 'Blob' with one of the provided parsers, and run an action on the abstracted term.
 parseWith
  :: (Carrier sig m, Member (Error SomeException) sig, Member Parse sig)
@ -44,7 +55,7 @@ parseWith
  -> (forall term . c term => term ann -> m a) -- ^ A function to run on the parsed term. Note that the term is abstract, but constrained by @c@, allowing you to do anything @c@ allows, and requiring that all the input parsers produce terms supporting @c@.
  -> Blob                                      -- ^ The blob to parse.
  -> m a
-parseWith parsers with blob = case Map.lookup (blobLanguage blob) parsers of
+parseWith parsers with blob = case parserForBlob parsers blob of
  Just (SomeParser parser) -> parse parser blob >>= with
  _                        -> noLanguageForBlob (blobPath blob)

@ -55,7 +66,7 @@ parsePairWith
  -> (forall term . c term => Edit (Blob, term ann) (Blob, term ann) -> m a) -- ^ A function to run on the parsed terms. Note that the terms are abstract, but 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 a
-parsePairWith parsers with blobPair = case Map.lookup (languageForBlobPair blobPair) parsers of
+parsePairWith parsers with blobPair = case parserForLanguage parsers (languageForBlobPair blobPair) of
  Just (SomeParser parser) -> bitraverse (p parser) (p parser) blobPair >>= with
  _                        -> noLanguageForBlob (pathForBlobPair blobPair)
  where p parser blob = (,) blob <$> parse parser blob
--- a/src/Data/Abstract/Value/Concrete.hs
+++ b/src/Data/Abstract/Value/Concrete.hs
@ -289,11 +289,11 @@ instance Carrier sig m => Carrier (Abstract.Object address (Value term address)
    Abstract.Klass n frame k -> k (Class n mempty frame)

 instance ( Member (Reader ModuleInfo) sig
-       , Member (Reader Span) sig
-       , Member (Resumable (BaseError (ValueError term address))) sig
-       , Carrier sig m
-       , Monad m
-       )
+         , Member (Reader Span) sig
+         , Member (Resumable (BaseError (ValueError term address))) sig
+         , Carrier sig m
+         , Monad m
+         )
      => Carrier (Abstract.Array (Value term address) :+: sig) (ArrayC (Value term address) m) where
  eff (R other) = ArrayC . eff . handleCoercible $ other
  eff (L op) = case op of
--- a/src/Parsing/Parser.hs
+++ b/src/Parsing/Parser.hs
@ -1,31 +1,22 @@
 {-# LANGUAGE ConstraintKinds, DataKinds, GADTs, TypeFamilies #-}
 module Parsing.Parser
 ( Parser(..)
-- * À la carte parsers
+  -- * Parsers
+  -- $abstract
+, SomeParser(..)
 , goParser
+, javaParser
+, javascriptParser
+, jsonParser
+, jsxParser
 , markdownParser
+, phpParser
+, pythonParserALaCarte
+, pythonParserPrecise
 , pythonParser
 , rubyParser
 , tsxParser
 , typescriptParser
-, phpParser
-  -- * Abstract parsers
-
-  -- $abstract
-, SomeParser(..)
-, goParser'
-, javaParser'
-, javascriptParser'
-, jsonParserPrecise'
-, jsxParser'
-, markdownParser'
-, phpParser'
-, pythonParserALaCarte'
-, pythonParserPrecise'
-, pythonParser'
-, rubyParser'
-, tsxParser'
-, typescriptParser'
  -- * Modes by term type
 , TermMode
  -- * Canonical sets of parsers
@ -78,38 +69,6 @@ data Parser term where
  MarkdownParser :: Parser (AST (TermF [] CMarkGFM.NodeType) Markdown.Grammar)


-goParser :: Parser (Go.Term Loc)
-goParser = AssignmentParser (ASTParser tree_sitter_go) Go.assignment
-
-rubyParser :: Parser (Ruby.Term Loc)
-rubyParser = AssignmentParser (ASTParser tree_sitter_ruby) Ruby.assignment
-
-phpParser :: Parser (PHP.Term Loc)
-phpParser = AssignmentParser (ASTParser tree_sitter_php) PHP.assignment
-
-pythonParser :: Parser (PythonALaCarte.Term Loc)
-pythonParser = AssignmentParser (ASTParser tree_sitter_python) PythonALaCarte.assignment
-
-typescriptParser :: Parser (TypeScript.Term Loc)
-typescriptParser = AssignmentParser (ASTParser tree_sitter_typescript) TypeScript.assignment
-
-tsxParser :: Parser (TSX.Term Loc)
-tsxParser = AssignmentParser (ASTParser tree_sitter_tsx) TSX.assignment
-
-markdownParser :: Parser (Markdown.Term Loc)
-markdownParser = AssignmentParser MarkdownParser Markdown.assignment
-
-
-javaParserPrecise :: Parser (Java.Term Loc)
-javaParserPrecise = UnmarshalParser Java.tree_sitter_java
-
-jsonParserPrecise :: Parser (JSON.Term Loc)
-jsonParserPrecise = UnmarshalParser JSON.tree_sitter_json
-
-pythonParserPrecise :: Parser (PythonPrecise.Term Loc)
-pythonParserPrecise = UnmarshalParser PythonPrecise.tree_sitter_python
-
-
 -- $abstract
 -- Most of our features are intended to operate over multiple languages, each represented by disjoint term types. Thus, we typically implement them using typeclasses, allowing us to share a single interface to invoke the feature, while specializing the implementation(s) as appropriate for each distinct term type.
 --
@ -141,46 +100,46 @@ pythonParserPrecise = UnmarshalParser PythonPrecise.tree_sitter_python
 data SomeParser c a where
  SomeParser :: c t => Parser (t a) -> SomeParser c a

-goParser' :: c Go.Term => (Language, SomeParser c Loc)
-goParser' = (Go, SomeParser goParser)
+goParser :: c Go.Term => (Language, SomeParser c Loc)
+goParser = (Go, SomeParser (AssignmentParser (ASTParser tree_sitter_go) Go.assignment))

-javaParser' :: c Java.Term => (Language, SomeParser c Loc)
-javaParser' = (Java, SomeParser javaParserPrecise)
+javaParser :: c Java.Term => (Language, SomeParser c Loc)
+javaParser = (Java, SomeParser (UnmarshalParser @Java.Term Java.tree_sitter_java))

-javascriptParser' :: c TSX.Term => (Language, SomeParser c Loc)
-javascriptParser' = (JavaScript, SomeParser tsxParser)
+javascriptParser :: c TSX.Term => (Language, SomeParser c Loc)
+javascriptParser = (JavaScript, SomeParser (AssignmentParser (ASTParser tree_sitter_tsx) TSX.assignment))

-jsonParserPrecise' :: c JSON.Term => (Language, SomeParser c Loc)
-jsonParserPrecise' = (JSON, SomeParser jsonParserPrecise)
+jsonParser :: c JSON.Term => (Language, SomeParser c Loc)
+jsonParser = (JSON, SomeParser (UnmarshalParser @JSON.Term JSON.tree_sitter_json))

-jsxParser' :: c TSX.Term => (Language, SomeParser c Loc)
-jsxParser' = (JSX, SomeParser tsxParser)
+jsxParser :: c TSX.Term => (Language, SomeParser c Loc)
+jsxParser = (JSX, SomeParser (AssignmentParser (ASTParser tree_sitter_tsx) TSX.assignment))

-markdownParser' :: c Markdown.Term => (Language, SomeParser c Loc)
-markdownParser' = (Markdown, SomeParser markdownParser)
+markdownParser :: c Markdown.Term => (Language, SomeParser c Loc)
+markdownParser = (Markdown, SomeParser (AssignmentParser MarkdownParser Markdown.assignment))

-phpParser' :: c PHP.Term => (Language, SomeParser c Loc)
-phpParser' = (PHP, SomeParser phpParser)
+phpParser :: c PHP.Term => (Language, SomeParser c Loc)
+phpParser = (PHP, SomeParser (AssignmentParser (ASTParser tree_sitter_php) PHP.assignment))

-pythonParserALaCarte' :: c PythonALaCarte.Term => (Language, SomeParser c Loc)
-pythonParserALaCarte' = (Python, SomeParser pythonParser)
+pythonParserALaCarte :: c PythonALaCarte.Term => (Language, SomeParser c Loc)
+pythonParserALaCarte = (Python, SomeParser (AssignmentParser (ASTParser tree_sitter_python) PythonALaCarte.assignment))

-pythonParserPrecise' :: c PythonPrecise.Term => (Language, SomeParser c Loc)
-pythonParserPrecise' = (Python, SomeParser pythonParserPrecise)
+pythonParserPrecise :: c PythonPrecise.Term => (Language, SomeParser c Loc)
+pythonParserPrecise = (Python, SomeParser (UnmarshalParser @PythonPrecise.Term PythonPrecise.tree_sitter_python))

-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)
+pythonParser :: (c PythonALaCarte.Term, c PythonPrecise.Term) => PerLanguageModes -> (Language, SomeParser c Loc)
+pythonParser modes = case pythonMode modes of
+  ALaCarte -> pythonParserALaCarte
+  Precise  -> pythonParserPrecise

-rubyParser' :: c Ruby.Term => (Language, SomeParser c Loc)
-rubyParser' = (Ruby, SomeParser rubyParser)
+rubyParser :: c Ruby.Term => (Language, SomeParser c Loc)
+rubyParser = (Ruby, SomeParser (AssignmentParser (ASTParser tree_sitter_ruby) Ruby.assignment))

-tsxParser' :: c TSX.Term => (Language, SomeParser c Loc)
-tsxParser' = (TSX, SomeParser tsxParser)
+tsxParser :: c TSX.Term => (Language, SomeParser c Loc)
+tsxParser = (TSX, SomeParser (AssignmentParser (ASTParser tree_sitter_tsx) TSX.assignment))

-typescriptParser' :: c TypeScript.Term => (Language, SomeParser c Loc)
-typescriptParser' = (TypeScript, SomeParser typescriptParser)
+typescriptParser :: c TypeScript.Term => (Language, SomeParser c Loc)
+typescriptParser = (TypeScript, SomeParser (AssignmentParser (ASTParser tree_sitter_typescript) TypeScript.assignment))


 -- | A type family selecting the language mode for a given term type.
@ -203,15 +162,15 @@ aLaCarteParsers
     )
  => Map Language (SomeParser c Loc)
 aLaCarteParsers = Map.fromList
-  [ goParser'
-  , javascriptParser'
-  , jsxParser'
-  , markdownParser'
-  , phpParser'
-  , pythonParserALaCarte'
-  , rubyParser'
-  , typescriptParser'
-  , tsxParser'
+  [ goParser
+  , javascriptParser
+  , jsxParser
+  , markdownParser
+  , phpParser
+  , pythonParserALaCarte
+  , rubyParser
+  , typescriptParser
+  , tsxParser
  ]

 -- | The canonical set of parsers producing precise terms.
@ -222,9 +181,9 @@ preciseParsers
     )
  => Map Language (SomeParser c Loc)
 preciseParsers = Map.fromList
-  [ javaParser'
-  , jsonParserPrecise'
-  , pythonParserPrecise'
+  [ javaParser
+  , jsonParser
+  , pythonParserPrecise
  ]

 -- | The canonical set of all parsers for the passed per-language modes.
@ -243,15 +202,15 @@ allParsers
  => PerLanguageModes
  -> Map Language (SomeParser c Loc)
 allParsers modes = Map.fromList
-  [ goParser'
-  , javaParser'
-  , javascriptParser'
-  , jsonParserPrecise'
-  , jsxParser'
-  , markdownParser'
-  , phpParser'
-  , pythonParser' modes
-  , rubyParser'
-  , typescriptParser'
-  , tsxParser'
+  [ goParser
+  , javaParser
+  , javascriptParser
+  , jsonParser
+  , jsxParser
+  , markdownParser
+  , phpParser
+  , pythonParser modes
+  , rubyParser
+  , typescriptParser
+  , tsxParser
  ]
--- a/src/Semantic/Api/Symbols.hs
+++ b/src/Semantic/Api/Symbols.hs
@ -3,6 +3,7 @@ module Semantic.Api.Symbols
  ( legacyParseSymbols
  , parseSymbols
  , parseSymbolsBuilder
+  , tagsForBlob
  ) where

 import           Control.Effect.Error
@ -28,7 +29,6 @@ import           Semantic.Config
 import           Semantic.Task
 import           Serializing.Format (Format)
 import           Source.Loc as Loc
-import           Source.Source
 import           Tags.Tagging
 import qualified Tags.Tagging.Precise as Precise

@ -45,7 +45,7 @@ legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap
        symbolsToSummarize = ["Function", "Method", "Class", "Module"]

        renderToSymbols :: ToTags t => t Loc -> [Legacy.File]
-        renderToSymbols = pure . tagsToFile . tags (blobLanguage blob) symbolsToSummarize blobSource
+        renderToSymbols = pure . tagsToFile . tags symbolsToSummarize blob

        tagsToFile :: [Tag] -> Legacy.File
        tagsToFile tags = Legacy.File (pack (blobPath blob)) (pack (show (blobLanguage blob))) (fmap tagToSymbol tags)
@ -68,7 +68,7 @@ parseSymbols blobs = do
  pure $ defMessage & P.files .~ toList terms
  where
    go :: (Member (Error SomeException) sig, Member (Reader PerLanguageModes) sig, Member Parse sig, Carrier sig m) => Blob -> m File
-    go blob@Blob{..} = catching $ asks toTagsParsers >>= \ p -> parseWith p (pure . renderToSymbols) blob
+    go blob@Blob{..} = catching $ tagsToFile <$> tagsForBlob blob
      where
        catching m = m `catchError` (\(SomeException e) -> pure $ errorFile (show e))
        blobLanguage' = blobLanguage blob
@ -80,9 +80,6 @@ parseSymbols blobs = do
          & P.errors .~ [defMessage & P.error .~ pack e]
          & P.blobOid .~ blobOid

-        renderToSymbols :: ToTags t => t Loc -> File
-        renderToSymbols term = tagsToFile (tags (blobLanguage blob) symbolsToSummarize blobSource term)
-
        tagsToFile :: [Tag] -> File
        tagsToFile tags = defMessage
          & P.path .~ blobPath'
@ -99,23 +96,26 @@ parseSymbols blobs = do
          & P.maybe'span ?~ converting # Loc.span loc
          & P.maybe'docs .~ fmap (flip (set P.docstring) defMessage) docs

+tagsForBlob :: (Carrier sig m, Member (Error SomeException) sig, Member Parse sig, Member (Reader PerLanguageModes) sig) => Blob -> m [Tag]
+tagsForBlob blob = asks toTagsParsers >>= \p -> parseWith p (pure . tags symbolsToSummarize blob) blob
+
 symbolsToSummarize :: [Text]
 symbolsToSummarize = ["Function", "Method", "Class", "Module", "Call", "Send"]

 class ToTags t where
-  tags :: Language -> [Text] -> Source -> t Loc -> [Tag]
+  tags :: [Text] -> Blob -> t Loc -> [Tag]

 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]
+  tagsBy :: [Text] -> Blob -> term Loc -> [Tag]

 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
+  tagsBy symbols blob = runTagging (blobLanguage blob) symbols (blobSource blob)

 instance Precise.ToTags term => ToTagsBy 'Precise term where
-  tagsBy _ _ = Precise.tags
+  tagsBy _ = Precise.tags . blobSource


 toTagsParsers :: PerLanguageModes -> Map Language (Parser.SomeParser ToTags Loc)
--- a/src/Semantic/Graph.hs
+++ b/src/Semantic/Graph.hs
@ -101,13 +101,13 @@ instance

 analysisParsers :: Map Language (SomeParser AnalyzeTerm Loc)
 analysisParsers = Map.fromList
-  [ goParser'
-  , javascriptParser'
-  , phpParser'
-  , pythonParserALaCarte'
-  , rubyParser'
-  , typescriptParser'
-  , tsxParser'
+  [ goParser
+  , javascriptParser
+  , phpParser
+  , pythonParserALaCarte
+  , rubyParser
+  , typescriptParser
+  , tsxParser
  ]

 runGraph :: ( Member Distribute sig
@ -122,7 +122,7 @@ runGraph :: ( Member Distribute sig
         -> Project
         -> m (Graph ControlFlowVertex)
 runGraph type' includePackages project
-  | Just (SomeParser parser) <- Map.lookup (projectLanguage project) analysisParsers
+  | Just (SomeParser parser) <- parserForLanguage analysisParsers (projectLanguage project)
  , SomeLanguage (lang :: Proxy lang) <- reifyLanguage (projectLanguage project) = do
    package <- if projectLanguage project == Language.Python then
        parsePythonPackage parser project
@ -200,7 +200,7 @@ runImportGraphToModuleInfos :: ( AnalyzeTerm term
                            => Proxy lang
                            -> Package (term Loc)
                            -> m (Graph ControlFlowVertex)
-runImportGraphToModuleInfos lang (package :: Package (term Loc)) = runImportGraph lang package allModuleInfos
+runImportGraphToModuleInfos lang package = runImportGraph lang package allModuleInfos
  where allModuleInfos info = vertex (maybe (unknownModuleVertex info) (moduleVertex . moduleInfo) (ModuleTable.lookup (modulePath info) (packageModules package)))

 runImportGraphToModules :: ( AnalyzeTerm term
@ -212,7 +212,7 @@ runImportGraphToModules :: ( AnalyzeTerm term
                        => Proxy lang
                        -> Package (term Loc)
                        -> m (Graph (Module (term Loc)))
-runImportGraphToModules lang (package :: Package (term Loc)) = runImportGraph lang package resolveOrLowerBound
+runImportGraphToModules lang package = runImportGraph lang package resolveOrLowerBound
  where resolveOrLowerBound info = maybe lowerBound vertex (ModuleTable.lookup (modulePath info) (packageModules package))

 runImportGraph :: ( AnalyzeTerm term
@ -225,7 +225,7 @@ runImportGraph :: ( AnalyzeTerm term
               -> Package (term Loc)
               -> (ModuleInfo -> Graph vertex)
               -> m (Graph vertex)
-runImportGraph lang (package :: Package (term Loc)) f
+runImportGraph lang package f
  = fmap (fst >=> f)
  . runEvaluator @_ @_ @(Value _ (Hole (Maybe Name) Precise))
  . raiseHandler (runState lowerBound)
--- a/src/Semantic/Util.hs
+++ b/src/Semantic/Util.hs
@ -1,13 +1,7 @@
-{-# LANGUAGE CPP, ConstraintKinds, PartialTypeSignatures, Rank2Types, ScopedTypeVariables, TypeFamilies,
-             TypeOperators #-}
+{-# LANGUAGE PartialTypeSignatures, TypeOperators #-}
 {-# OPTIONS_GHC -Wno-missing-signatures -Wno-partial-type-signatures -O0 #-}
 module Semantic.Util
-  ( evalGoProject
-  , evalPHPProject
-  , evalPythonProject
-  , evalRubyProject
-  , evalTypeScriptProject
-  , evaluateProject'
+  ( evaluateProject'
  , justEvaluating
  , mergeErrors
  , reassociate
@ -24,6 +18,7 @@ import           Control.Carrier.Parse.Simple
 import           Control.Effect.Lift
 import           Control.Effect.Trace (runTraceByPrinting)
 import           Control.Exception (displayException)
+import           Control.Lens.Getter
 import           Data.Abstract.Address.Precise as Precise
 import           Data.Abstract.Evaluatable
 import           Data.Abstract.Module
@ -36,21 +31,14 @@ import           Data.Graph (topologicalSort)
 import qualified Data.Language as Language
 import           Data.List (uncons)
 import           Data.Project
-import           Data.Quieterm (Quieterm, quieterm)
 import           Data.Sum (weaken)
-import           Data.Term (termFAnnotation)
-import qualified Language.Go.Assignment
-import qualified Language.PHP.Assignment
-import qualified Language.Python.Assignment
-import qualified Language.Ruby.Assignment
-import qualified Language.TypeScript.Assignment
 import           Parsing.Parser
 import           Prologue
 import           Semantic.Analysis
 import           Semantic.Config
 import           Semantic.Graph
 import           Semantic.Task
-import           Source.Loc as Loc
+import           Source.Span (HasSpan(..))
 import           System.Exit (die)
 import           System.FilePath.Posix (takeDirectory)

@ -76,54 +64,29 @@ justEvaluating
  . runAddressError
  . runValueError

-type FileEvaluator err syntax =
-  [FilePath]
-  -> IO
-       ( Heap Precise Precise (Value (Quieterm (Sum syntax) Loc) Precise),
-       ( ScopeGraph Precise
-       , Either (SomeError (Sum err))
-                (ModuleTable (Module (ModuleResult Precise (Value (Quieterm (Sum syntax) Loc) Precise))))))
-
-evalGoProject :: FileEvaluator _ Language.Go.Assignment.Syntax
-evalGoProject = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.Go) goParser
-
-evalRubyProject :: FileEvaluator _ Language.Ruby.Assignment.Syntax
-evalRubyProject = justEvaluating <=< evaluateProject (Proxy @'Language.Ruby)               rubyParser
-
-evalPHPProject :: FileEvaluator _ Language.PHP.Assignment.Syntax
-evalPHPProject  = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.PHP)        phpParser
-
-evalPythonProject :: FileEvaluator _ Language.Python.Assignment.Syntax
-evalPythonProject = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.Python)     pythonParser
-
-evalTypeScriptProject :: FileEvaluator _ Language.TypeScript.Assignment.Syntax
-evalTypeScriptProject = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.TypeScript) typescriptParser
-
-evaluateProject proxy parser paths = withOptions debugOptions $ \ config logger statter ->
-  evaluateProject' (TaskSession config "-" False logger statter) proxy parser paths
-
 -- Evaluate a project consisting of the listed paths.
 evaluateProject' session proxy parser paths = do
+  let lang = Language.reflect proxy
  res <- runTask session $ asks configTreeSitterParseTimeout >>= \ timeout -> runParse timeout $ do
-    blobs <- catMaybes <$> traverse readBlobFromFile (flip File (Language.reflect proxy) <$> paths)
-    package <- fmap (quieterm . snd) <$> parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs (Language.reflect proxy) [])
+    blobs <- catMaybes <$> traverse readBlobFromFile (flip File lang <$> paths)
+    package <- fmap snd <$> parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs lang [])
    modules <- topologicalSort <$> runImportGraphToModules proxy package
    trace $ "evaluating with load order: " <> show (map (modulePath . moduleInfo) modules)
-    pure (id @(Evaluator _ Precise (Value _ Precise) _ _)
-         (runModuleTable
-         (runModules (ModuleTable.modulePaths (packageModules package))
-         (raiseHandler (runReader (packageInfo package))
-         (raiseHandler (evalState (lowerBound @Span))
-         (raiseHandler (runReader (lowerBound @Span))
-         (evaluate proxy (runDomainEffects (evalTerm (withTermSpans (Loc.span . termFAnnotation . project)))) modules)))))))
-  either (die . displayException) pure res
+    pure (package, modules)
+  (package, modules) <- either (die . displayException) pure res
+  pure (runModuleTable
+       (runModules (ModuleTable.modulePaths (packageModules package))
+       (raiseHandler (runReader (packageInfo package))
+       (raiseHandler (evalState (lowerBound @Span))
+       (raiseHandler (runReader (lowerBound @Span))
+       (evaluate proxy (runDomainEffects (evalTerm (withTermSpans (^. span_)))) modules))))))

 parseFile, parseFileQuiet :: Parser term -> FilePath -> IO term
-parseFile parser = runTask' . (parse parser <=< readBlob . fileForPath)
+parseFile      parser = runTask'     . (parse parser <=< readBlob . fileForPath)
 parseFileQuiet parser = runTaskQuiet . (parse parser <=< readBlob . fileForPath)

 runTask', runTaskQuiet :: ParseC TaskC a -> IO a
-runTask' task = runTaskWithOptions debugOptions (asks configTreeSitterParseTimeout >>= \ timeout -> runParse timeout task) >>= either (die . displayException) pure
+runTask'     task = runTaskWithOptions debugOptions   (asks configTreeSitterParseTimeout >>= \ timeout -> runParse timeout task) >>= either (die . displayException) pure
 runTaskQuiet task = runTaskWithOptions defaultOptions (asks configTreeSitterParseTimeout >>= \ timeout -> runParse timeout task) >>= either (die . displayException) pure

 mergeErrors :: Either (SomeError (Sum errs)) (Either (SomeError err) result) -> Either (SomeError (Sum (err ': errs))) result
--- a/test/Analysis/Go/Spec.hs
+++ b/test/Analysis/Go/Spec.hs
@ -4,6 +4,8 @@ module Analysis.Go.Spec (spec) where

 import qualified Data.Abstract.ModuleTable as ModuleTable
 import qualified Data.Language as Language
+import qualified Language.Go.Term as Go
+import           Source.Loc
 import           SpecHelpers


@ -32,5 +34,4 @@ spec = do

  where
    fixtures = "test/fixtures/go/analysis/"
-    evaluate = evalGoProject . map (fixtures <>)
-    evalGoProject = testEvaluating <=< evaluateProject' ?session (Proxy :: Proxy 'Language.Go) goParser
+    evaluate = evaluateProject @'Language.Go @(Go.Term Loc) ?session Proxy . map (fixtures <>)
--- a/test/Analysis/PHP/Spec.hs
+++ b/test/Analysis/PHP/Spec.hs
@ -5,6 +5,8 @@ module Analysis.PHP.Spec (spec) where
 import qualified Data.Abstract.ModuleTable as ModuleTable
 import qualified Data.Abstract.Value.Concrete as Value
 import qualified Data.Language as Language
+import qualified Language.PHP.Term as PHP
+import           Source.Loc
 import           SpecHelpers


@ -44,5 +46,4 @@ spec = do

  where
    fixtures = "test/fixtures/php/analysis/"
-    evaluate = evalPHPProject . map (fixtures <>)
-    evalPHPProject = testEvaluating <=< evaluateProject' ?session (Proxy :: Proxy 'Language.PHP) phpParser
+    evaluate = evaluateProject @'Language.PHP @(PHP.Term Loc) ?session Proxy . map (fixtures <>)
--- a/test/Analysis/Python/Spec.hs
+++ b/test/Analysis/Python/Spec.hs
@ -3,10 +3,11 @@
 module Analysis.Python.Spec (spec) where

 import qualified Data.Abstract.ModuleTable as ModuleTable
-import Data.Abstract.Value.Concrete
+import           Data.Abstract.Value.Concrete
 import qualified Data.Language as Language
-
-import SpecHelpers
+import qualified Language.Python.Term as Python
+import           Source.Loc
+import           SpecHelpers


 spec :: (?session :: TaskSession) => Spec
@ -71,5 +72,4 @@ spec = do

  where
    fixtures = "test/fixtures/python/analysis/"
-    evaluate = evalPythonProject . map (fixtures <>)
-    evalPythonProject = testEvaluating <=< evaluateProject' ?session (Proxy :: Proxy 'Language.Python) pythonParser
+    evaluate = evaluateProject @'Language.Python @(Python.Term Loc) ?session Proxy . map (fixtures <>)
--- a/test/Analysis/Ruby/Spec.hs
+++ b/test/Analysis/Ruby/Spec.hs
@ -10,8 +10,9 @@ import           Data.Abstract.Number as Number
 import           Data.Abstract.Value.Concrete as Value
 import qualified Data.Language as Language
 import           Data.Sum
-
-import SpecHelpers
+import qualified Language.Ruby.Term as Ruby
+import           Source.Loc
+import           SpecHelpers


 spec :: (?session :: TaskSession) =>  Spec
@ -100,5 +101,4 @@ spec = do

  where
    fixtures = "test/fixtures/ruby/analysis/"
-    evaluate = evalRubyProject . map (fixtures <>)
-    evalRubyProject = testEvaluating <=< evaluateProject' ?session (Proxy :: Proxy 'Language.Ruby) rubyParser
+    evaluate = evaluateProject @'Language.Ruby @(Ruby.Term Loc) ?session Proxy . map (fixtures <>)
--- a/test/Analysis/TypeScript/Spec.hs
+++ b/test/Analysis/TypeScript/Spec.hs
@ -14,11 +14,10 @@ import           Data.Abstract.Number as Number
 import           Data.Abstract.Package (PackageInfo (..))
 import           Data.Abstract.Value.Concrete as Concrete
 import qualified Data.Language as Language
-import           Data.Quieterm
 import           Data.Scientific (scientific)
 import           Data.Sum
 import           Data.Text (pack)
-import qualified Language.TypeScript.Assignment as TypeScript
+import qualified Language.TypeScript.Term as TypeScript
 import           Source.Loc
 import           SpecHelpers

@ -176,13 +175,11 @@ spec = do

    it "member access of private methods throws AccessControlError" $ do
      (_, (_, res)) <- evaluate ["access_control/adder.ts", "access_control/private_method.ts"]
-      let expected = Left (SomeError (inject @TypeScriptEvalError (BaseError (ModuleInfo "private_method.ts" Language.TypeScript mempty) (Span (Pos 4 1) (Pos 4 16)) (AccessControlError ("foo", ScopeGraph.Public) ("private_add", ScopeGraph.Private) (Closure (PackageInfo "access_control" mempty) (ModuleInfo "adder.ts" Language.TypeScript mempty) (Just "private_add") Nothing [] (Right (Quieterm (In (Loc (Range 146 148) (Span (Pos 7 27) (Pos 7 29))) (inject (StatementBlock []))))) (Precise 20) (Precise 18))))))
+      let expected = Left (SomeError (inject @TypeScriptEvalError (BaseError (ModuleInfo "private_method.ts" Language.TypeScript mempty) (Span (Pos 4 1) (Pos 4 16)) (AccessControlError ("foo", ScopeGraph.Public) ("private_add", ScopeGraph.Private) (Closure (PackageInfo "access_control" mempty) (ModuleInfo "adder.ts" Language.TypeScript mempty) (Just "private_add") Nothing [] (Right (TypeScript.Term (In (Loc (Range 146 148) (Span (Pos 7 27) (Pos 7 29))) (inject (StatementBlock []))))) (Precise 20) (Precise 18))))))
      res `shouldBe` expected

  where
    fixtures = "test/fixtures/typescript/analysis/"
-    evaluate = evalTypeScriptProject . map (fixtures <>)
-    evalTypeScriptProject = testEvaluating <=< (evaluateProject' ?session (Proxy :: Proxy 'Language.TypeScript) typescriptParser)
+    evaluate = evaluateProject @'Language.TypeScript @(TypeScript.Term Loc) ?session Proxy . map (fixtures <>)

-type TypeScriptTerm = Quieterm (Sum TypeScript.Syntax) Loc
-type TypeScriptEvalError = BaseError (EvalError TypeScriptTerm Precise (Concrete.Value TypeScriptTerm Precise))
+type TypeScriptEvalError = BaseError (EvalError (TypeScript.Term Loc) Precise (Concrete.Value (TypeScript.Term Loc) Precise))
--- a/test/Graphing/Calls/Spec.hs
+++ b/test/Graphing/Calls/Spec.hs
@ -1,4 +1,4 @@
-{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE GADTs, PackageImports #-}

 module Graphing.Calls.Spec ( spec ) where

@ -7,18 +7,21 @@ import SpecHelpers

 import Algebra.Graph

+import           Control.Effect.Parse
 import           "semantic" Data.Graph (Graph (..), topologicalSort)
 import           Data.Graph.ControlFlowVertex
 import qualified Data.Language as Language
+import           Data.Maybe (fromJust)
 import           Semantic.Graph
 import qualified System.Path as Path

 callGraphPythonProject :: Path.RelFile -> IO (Semantic.Graph.Graph ControlFlowVertex)
 callGraphPythonProject path = runTaskOrDie $ do
  let proxy = Proxy @'Language.Python
-  let lang = Language.Python
+      lang = Language.Python
+  SomeParser parser <- pure . fromJust $! parserForLanguage analysisParsers Language.Python
  blob <- readBlobFromFile' (fileForTypedPath path)
-  package <- fmap snd <$> parsePackage pythonParser (Project (Path.toString (Path.takeDirectory path)) [blob] lang [])
+  package <- fmap snd <$> parsePackage parser (Project (Path.toString (Path.takeDirectory path)) [blob] lang [])
  modules <- topologicalSort <$> runImportGraphToModules proxy package
  runCallGraph proxy False modules package

--- a/test/SpecHelpers.hs
+++ b/test/SpecHelpers.hs
@ -5,7 +5,6 @@ module SpecHelpers
 , runBuilder
 , diffFilePaths
 , parseFilePath
-, parseTestFile
 , readFilePathPair
 , runTaskOrDie
 , runParseWithConfig
@ -18,65 +17,66 @@ module SpecHelpers
 , lookupDeclaration
 , lookupMembers
 , EdgeLabel(..)
+, TestEvaluatingResult
+, TestEvaluatingState
+, evaluateProject
 ) where

 import Control.Abstract
 import Control.Carrier.Parse.Simple
-import Data.Abstract.ScopeGraph (EdgeLabel(..))
-import qualified Data.Abstract.ScopeGraph as ScopeGraph
-import qualified Data.Abstract.Heap as Heap
 import Control.Effect.Lift
 import Control.Effect.Trace as X (runTraceByIgnoring, runTraceByReturning)
+import Control.Exception (displayException)
 import Control.Monad ((>=>))
-import Data.Traversable as X (for)
+import Control.Monad as X
 import Data.Abstract.Address.Precise as X
 import Data.Abstract.Evaluatable
 import Data.Abstract.FreeVariables as X
+import qualified Data.Abstract.Heap as Heap
 import Data.Abstract.Module as X
 import Data.Abstract.ModuleTable as X hiding (lookup)
 import Data.Abstract.Name as X
+import Data.Abstract.ScopeGraph (EdgeLabel(..))
+import qualified Data.Abstract.ScopeGraph as ScopeGraph
 import Data.Abstract.Value.Concrete (Value(..), ValueError, runValueError)
 import Data.Blob as X
 import Data.Blob.IO as X
+import Data.ByteString as X (ByteString)
 import Data.ByteString.Builder (Builder, toLazyByteString)
 import Data.ByteString.Lazy (toStrict)
-import Data.Project as X
-import Data.Proxy as X
+import Data.Edit as X
 import Data.Foldable (toList)
 import Data.Functor.Listable as X
 import Data.Language as X hiding (Precise)
 import Data.List.NonEmpty as X (NonEmpty(..))
-import Data.Semilattice.Lower as X
-import Source.Source as X (Source)
-import Data.String
-import Data.Sum
-import Data.Term as X
-import Parsing.Parser as X
-import Semantic.Task as X
-import Semantic.Util as X
-import Semantic.Graph (runHeap, runScopeGraph)
-import Source.Range as X hiding (start, end, point)
-import Source.Span as X hiding (HasSpan(..), start, end, point)
-import Debug.Trace as X (traceShowM, traceM)
-
-import Data.ByteString as X (ByteString)
-import Data.Edit as X
 import Data.Maybe as X
 import Data.Monoid as X (Monoid(..), First(..), Last(..))
+import Data.Project as X
+import Data.Proxy as X
 import Data.Semigroup as X (Semigroup(..))
-import Control.Monad as X
-
+import Data.Semilattice.Lower as X
+import Data.String
+import Data.Sum as Sum
+import Data.Term as X
+import Data.Traversable as X (for)
+import Debug.Trace as X (traceShowM, traceM)
+import Parsing.Parser as X
+import Semantic.Api hiding (File, Blob, BlobPair)
+import Semantic.Config (Config(..), optionsLogLevel)
+import Semantic.Graph (analysisParsers, runHeap, runScopeGraph)
+import Semantic.Task as X
+import Semantic.Telemetry (LogQueue, StatQueue)
+import Semantic.Util as X
+import Source.Range as X hiding (start, end, point)
+import Source.Source as X (Source)
+import Source.Span as X hiding (HasSpan(..), start, end, point)
+import System.Exit (die)
+import qualified System.Path as Path
 import Test.Hspec as X (Spec, SpecWith, context, describe, it, xit, parallel, pendingWith, around, runIO)
 import Test.Hspec.Expectations as X
 import Test.Hspec.LeanCheck as X
 import Test.LeanCheck as X
-
-import Semantic.Config (Config(..), optionsLogLevel)
-import Semantic.Telemetry (LogQueue, StatQueue)
-import Semantic.Api hiding (File, Blob, BlobPair)
-import System.Exit (die)
-import Control.Exception (displayException)
-import qualified System.Path as Path
+import Unsafe.Coerce (unsafeCoerce)

 runBuilder :: Builder -> ByteString
 runBuilder = toStrict . toLazyByteString
@ -107,12 +107,6 @@ runParseWithConfig task = asks configTreeSitterParseTimeout >>= \ timeout -> run
 readFilePathPair :: Path.RelFile -> Path.RelFile -> IO BlobPair
 readFilePathPair p1 p2 = readFilePair (fileForTypedPath p1) (fileForTypedPath p2)

-parseTestFile :: Parser term -> Path.RelFile -> IO (Blob, term)
-parseTestFile parser path = runTaskOrDie $ do
-  blob <- readBlob (fileForPath (Path.toString path))
-  term <- parse parser blob
-  pure (blob, term)
-
 -- Run a Task and call `die` if it returns an Exception.
 runTaskOrDie :: ParseC TaskC a -> IO a
 runTaskOrDie task = runTaskWithOptions defaultOptions { optionsLogLevel = Nothing } (runParseWithConfig task) >>= either (die . displayException) pure
@ -141,11 +135,15 @@ type TestEvaluatingErrors term
     , BaseError (UnspecializedError Precise (Val term))
     , BaseError (LoadError Precise (Val term))
     ]
+type TestEvaluatingState term a
+  = ( ScopeGraph Precise
+    , ( Heap Precise Precise (Val term)
+      , Either (SomeError (Sum.Sum (TestEvaluatingErrors term))) a
+      )
+    )
+type TestEvaluatingResult term = ModuleTable (Module (ModuleResult Precise (Val term)))
 testEvaluating :: Evaluator term Precise (Val term) (TestEvaluatingC term) a
-               -> IO
-                  (ScopeGraph Precise,
-                    (Heap Precise Precise (Value term Precise),
-                     Either (SomeError (Data.Sum.Sum (TestEvaluatingErrors term))) a))
+               -> IO (TestEvaluatingState term a)
 testEvaluating
  = runM
  . runTraceByIgnoring
@ -165,6 +163,12 @@ testEvaluating

 type Val term = Value term Precise

+evaluateProject :: (HasPrelude lang, SLanguage lang) => TaskSession -> Proxy lang -> [FilePath] -> IO (TestEvaluatingState term (TestEvaluatingResult term))
+evaluateProject session proxy = case parserForLanguage analysisParsers lang of
+  Just (SomeParser parser) -> unsafeCoerce . testEvaluating <=< evaluateProject' session proxy parser
+  _                        -> error $ "analysis not supported for " <> show lang
+  where lang = reflect proxy
+

 members :: EdgeLabel
        -> Heap Precise Precise (Value term Precise)
--- a/test/Tags/Spec.hs
+++ b/test/Tags/Spec.hs
@ -1,6 +1,7 @@
 module Tags.Spec (spec) where

-import Data.Text (Text)
+import Control.Effect.Reader
+import Semantic.Api.Symbols
 import Source.Loc
 import SpecHelpers
 import qualified System.Path as Path
@ -9,91 +10,76 @@ import Tags.Tagging as Tags
 spec :: Spec
 spec = do
  describe "go" $ do
-    it "produces tags for functions with docs" $ do
-      (blob, tree) <- parseTestFile goParser (Path.relFile "test/fixtures/go/tags/simple_functions.go")
-      runTagging (blobLanguage blob) symbolsToSummarize (blobSource blob) tree `shouldBe`
+    it "produces tags for functions with docs" $
+      parseTestFile [Function] (Path.relFile "test/fixtures/go/tags/simple_functions.go") `shouldReturn`
        [ Tag "TestFromBits" Function (Loc (Range 51 92) (Span (Pos 6 1) (Pos 8 2))) "func TestFromBits(t *testing.T) {" (Just "// TestFromBits ...")
        , Tag "Hi" Function (Loc (Range 94 107) (Span (Pos 10 1) (Pos 11 2))) "func Hi()" Nothing ]

-    it "produces tags for methods" $ do
-      (blob, tree) <- parseTestFile goParser (Path.relFile "test/fixtures/go/tags/method.go")
-      runTagging (blobLanguage blob) symbolsToSummarize (blobSource blob) tree `shouldBe`
+    it "produces tags for methods" $
+      parseTestFile [Method] (Path.relFile "test/fixtures/go/tags/method.go") `shouldReturn`
        [ Tag "CheckAuth" Method (Loc (Range 19 118) (Span (Pos 3 1) (Pos 3 100))) "func (c *apiClient) CheckAuth(req *http.Request, user, repo string) (*authenticatedActor, error)" Nothing]

-    it "produces tags for calls" $ do
-      (blob, tree) <- parseTestFile goParser (Path.relFile "test/fixtures/go/tags/simple_functions.go")
-      runTagging (blobLanguage blob) ["Call"] (blobSource blob) tree `shouldBe`
+    it "produces tags for calls" $
+      parseTestFile [Call] (Path.relFile "test/fixtures/go/tags/simple_functions.go") `shouldReturn`
        [ Tag "Hi" Call (Loc (Range 86 90) (Span (Pos 7 2) (Pos 7 6))) "Hi()" Nothing]

  describe "javascript and typescript" $ do
-    it "produces tags for functions with docs" $ do
-      (blob, tree) <- parseTestFile typescriptParser (Path.relFile "test/fixtures/javascript/tags/simple_function_with_docs.js")
-      runTagging (blobLanguage blob) symbolsToSummarize (blobSource blob) tree `shouldBe`
+    it "produces tags for functions with docs" $
+      parseTestFile [Function] (Path.relFile "test/fixtures/javascript/tags/simple_function_with_docs.js") `shouldReturn`
        [ Tag "myFunction" Function (Loc (Range 22 59) (Span (Pos 2 1) (Pos 4 2))) "function myFunction()" (Just "// This is myFunction") ]

-    it "produces tags for classes" $ do
-      (blob, tree) <- parseTestFile typescriptParser (Path.relFile "test/fixtures/typescript/tags/class.ts")
-      runTagging (blobLanguage blob) symbolsToSummarize (blobSource blob) tree `shouldBe`
+    it "produces tags for classes" $
+      parseTestFile [Class] (Path.relFile "test/fixtures/typescript/tags/class.ts") `shouldReturn`
        [ Tag "FooBar" Class (Loc (Range 0 15) (Span (Pos 1 1) (Pos 1 16))) "class FooBar" Nothing ]

-    it "produces tags for modules" $ do
-      (blob, tree) <- parseTestFile typescriptParser (Path.relFile "test/fixtures/typescript/tags/module.ts")
-      runTagging (blobLanguage blob) symbolsToSummarize (blobSource blob) tree `shouldBe`
+    it "produces tags for modules" $
+      parseTestFile [Tags.Module] (Path.relFile "test/fixtures/typescript/tags/module.ts") `shouldReturn`
        [ Tag "APromise" Tags.Module (Loc (Range 0 19) (Span (Pos 1 1) (Pos 1 20))) "module APromise { }" Nothing ]

  describe "python" $ do
-    it "produces tags for functions" $ do
-      (blob, tree) <- parseTestFile pythonParser (Path.relFile "test/fixtures/python/tags/simple_functions.py")
-      runTagging (blobLanguage blob) symbolsToSummarize (blobSource blob) tree `shouldBe`
+    it "produces tags for functions" $
+      parseTestFile [Function] (Path.relFile "test/fixtures/python/tags/simple_functions.py") `shouldReturn`
        [ Tag "Foo" Function (Loc (Range 0 68) (Span (Pos 1 1) (Pos 5 17))) "def Foo(x):" Nothing
        , Tag "Bar" Function (Loc (Range 70 136) (Span (Pos 7 1) (Pos 11 13))) "def Bar():" Nothing
        , Tag "local" Function (Loc (Range 85 114) (Span (Pos 8 5) (Pos 9 17))) "def local():" Nothing
        ]

-    it "produces tags for functions with docs" $ do
-      (blob, tree) <- parseTestFile pythonParser (Path.relFile "test/fixtures/python/tags/simple_function_with_docs.py")
-      runTagging (blobLanguage blob) symbolsToSummarize (blobSource blob) tree `shouldBe`
+    it "produces tags for functions with docs" $
+      parseTestFile [Function] (Path.relFile "test/fixtures/python/tags/simple_function_with_docs.py") `shouldReturn`
        [ Tag "Foo" Function (Loc (Range 0 59) (Span (Pos 1 1) (Pos 3 13))) "def Foo(x):" (Just "\"\"\"This is the foo function\"\"\"") ]

-    it "produces tags for classes" $ do
-      (blob, tree) <- parseTestFile pythonParser (Path.relFile "test/fixtures/python/tags/class.py")
-      runTagging (blobLanguage blob) symbolsToSummarize (blobSource blob) tree `shouldBe`
+    it "produces tags for classes" $
+      parseTestFile [Class, Function] (Path.relFile "test/fixtures/python/tags/class.py") `shouldReturn`
        [ Tag "Foo" Class (Loc (Range 0 95) (Span (Pos 1 1) (Pos 5 17))) "class Foo:" (Just "\"\"\"The Foo class\"\"\"")
        , Tag "f" Function (Loc (Range 39 95) (Span (Pos 3 5) (Pos 5 17))) "def f(self):" (Just "\"\"\"The f method\"\"\"")
        ]

-    it "produces tags for multi-line functions" $ do
-      (blob, tree) <- parseTestFile pythonParser (Path.relFile "test/fixtures/python/tags/multiline.py")
-      runTagging (blobLanguage blob) symbolsToSummarize (blobSource blob) tree `shouldBe`
+    it "produces tags for multi-line functions" $
+      parseTestFile [Function] (Path.relFile "test/fixtures/python/tags/multiline.py") `shouldReturn`
        [ Tag "Foo" Function (Loc (Range 0 29) (Span (Pos 1 1) (Pos 3 13))) "def Foo(x," Nothing ]

  describe "ruby" $ do
-    it "produces tags for methods" $ do
-      (blob, tree) <- parseTestFile rubyParser (Path.relFile "test/fixtures/ruby/tags/simple_method.rb")
-      runTagging (blobLanguage blob) symbolsToSummarize (blobSource blob) tree `shouldBe`
+    it "produces tags for methods" $
+      parseTestFile [Method] (Path.relFile "test/fixtures/ruby/tags/simple_method.rb") `shouldReturn`
        [ Tag "foo" Method (Loc (Range 0 31) (Span (Pos 1 1) (Pos 4 4))) "def foo" Nothing ]

-    it "produces tags for sends" $ do
-      (blob, tree) <- parseTestFile rubyParser (Path.relFile "test/fixtures/ruby/tags/simple_method.rb")
-      runTagging (blobLanguage blob) ["Send"] (blobSource blob) tree `shouldBe`
+    it "produces tags for sends" $
+      parseTestFile [Call] (Path.relFile "test/fixtures/ruby/tags/simple_method.rb") `shouldReturn`
        [ Tag "puts" Call (Loc (Range 10 19) (Span (Pos 2 3) (Pos 2 12))) "puts \"hi\"" Nothing
        , Tag "bar" Call (Loc (Range 22 27) (Span (Pos 3 3) (Pos 3 8))) "a.bar" Nothing
        , Tag "a" Call (Loc (Range 22 23) (Span (Pos 3 3) (Pos 3 4))) "a" Nothing
        ]

-    it "produces tags for methods with docs" $ do
-      (blob, tree) <- parseTestFile rubyParser (Path.relFile "test/fixtures/ruby/tags/simple_method_with_docs.rb")
-      runTagging (blobLanguage blob) symbolsToSummarize (blobSource blob) tree `shouldBe`
+    it "produces tags for methods with docs" $
+      parseTestFile [Method] (Path.relFile "test/fixtures/ruby/tags/simple_method_with_docs.rb") `shouldReturn`
        [ Tag "foo" Method (Loc (Range 14 25) (Span (Pos 2 1) (Pos 3 4))) "def foo" (Just "# Public: foo") ]

-    it "correctly tags files containing multibyte UTF-8 characters" $ do
-      (blob, tree) <- parseTestFile rubyParser (Path.relFile "test/fixtures/ruby/tags/unicode_identifiers.rb")
-      runTagging (blobLanguage blob) symbolsToSummarize (blobSource blob) tree `shouldBe`
+    it "correctly tags files containing multibyte UTF-8 characters" $
+      parseTestFile [Method] (Path.relFile "test/fixtures/ruby/tags/unicode_identifiers.rb") `shouldReturn`
        [ Tag "日本語" Method (Loc (Range 16 43) (Span (Pos 2 1) (Pos 4 4))) "def 日本語" (Just "# coding: utf-8")]

-    it "produces tags for methods and classes with docs" $ do
-      (blob, tree) <- parseTestFile rubyParser (Path.relFile "test/fixtures/ruby/tags/class_module.rb")
-      runTagging (blobLanguage blob) symbolsToSummarize (blobSource blob) tree `shouldBe`
+    it "produces tags for methods and classes with docs" $
+      parseTestFile [Class, Method, Tags.Module] (Path.relFile "test/fixtures/ruby/tags/class_module.rb") `shouldReturn`
        [ Tag "Foo" Tags.Module (Loc (Range 14 118) (Span (Pos 2 1 ) (Pos 12 4))) "module Foo" (Just "# Public: Foo")
        , Tag "Bar" Class  (Loc (Range 44 114) (Span (Pos 5 3 ) (Pos 11 6))) "class Bar" (Just "# Public: Bar")
        , Tag "baz" Method (Loc (Range 77 108) (Span (Pos 8 5 ) (Pos 10 8))) "def baz(a)" (Just "# Public: baz")
@ -102,5 +88,5 @@ spec = do
        , Tag "foo" Method (Loc (Range 166 184) (Span (Pos 18 3) (Pos 19 6))) "def self.foo" Nothing
        ]

-symbolsToSummarize :: [Text]
-symbolsToSummarize = ["Function", "Method", "Class", "Module"]
+parseTestFile :: Foldable t => t Tags.Kind -> Path.RelFile -> IO [Tag]
+parseTestFile include path = runTaskOrDie $ readBlob (fileForPath (Path.toString path)) >>= runReader defaultLanguageModes . fmap (filter ((`elem` include) . kind)) . tagsForBlob