Merge branch 'master' into semantic-python

2024-12-26 00:12:29 +03:00 · 2019-06-25 10:08:47 -07:00 · 2019-06-25 10:08:47 -07:00 · 9ea288a36d
commit 9ea288a36d
parent cf8b344efc 9d1c0249c0
51 changed files with 520 additions and 471 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -2,3 +2,4 @@
 test/fixtures linguist-vendored
 test/repos linguist-vendored
 vendor linguist-vendored
+*.protobuf.bin binary
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@ -7,6 +7,8 @@

 Hi there! We're thrilled that you'd like to contribute to this project. Your help is essential for keeping it great.

+We're happy to accept code and documentation contributions, as well as issues suggesting new features, asking questions about how things work, or generally about what we're trying to accomplish! However, we are not opening up the code review process to the public. PRs should _only_ be reviewed by one of the project maintainers. Therefore, we ask that you refrain from leaving approvals or change requests on in-progress pull requests, as spurious reviews make it difficult to discern which patches are truly ready for integration.
+
 Contributions to this project are [released](https://help.github.com/articles/github-terms-of-service/#6-contributions-under-repository-license) to the public under the [project's open source license](LICENSE.md).

 Please note that this project is released with a [Contributor Code of Conduct][code-of-conduct]. By participating in this project you agree to abide by its terms.
@ -28,6 +30,8 @@ Here are a few things you can do that will increase the likelihood of your pull
 - Keep your change as focused as possible. If there are multiple changes you would like to make that are not dependent upon each other, consider submitting them as separate pull requests.
 - Write a [good commit message](http://tbaggery.com/2008/04/19/a-note-about-git-commit-messages.html).

+Unless you are a member of the Semantic team or a code owner, we ask that you refrain from leaving approvals or change requests on in-progress pull requests, as spurious reviews make it difficult to discern which patches are truly ready for integration.
+
 Please be aware that contributions to Semantic may multiple cycles of code review—we are grateful for all community involvement, but because Semantic powers real systems, we must maintain a high standard of code quality. For reasons of compatibility with production uses of Semantic within GitHub, we may also reject or require modifications to changes that would affect these systems. We may also reject patches that don't fit with our vision of the project; should this be the case, we will be clear about our rationale.

 ## Resources
--- a/README.md
+++ b/README.md
@ -96,19 +96,20 @@ Available options:

 ## Development

+`semantic` requires at least GHC 8.6.4 and Cabal 2.4. We strongly recommend using [`ghcup`][ghcup] to sandbox GHC versions, as GHC packages installed through your OS's package manager may not install statically-linked versions of the GHC boot libraries.
+
 We use `cabal's` [Nix-style local builds][nix] for development. To get started quickly:

 ```bash
 git clone git@github.com:github/semantic.git
 cd semantic
-git submodule sync --recursive && git submodule update --init --recursive --force
-cabal new-update
+script/bootstrap
 cabal new-build
 cabal new-test
 cabal new-run semantic -- --help
 ```

-`semantic` requires at least GHC 8.6.4 and Cabal 2.4. We recommend using [`ghcup`][ghcup] to sandbox GHC versions. `stack` as a build tool is not officially supported; there is an unofficial [`stack.yaml`](https://gist.github.com/jkachmar/f200caee83280f1f25e9cfa2dd2b16bb) available, though we cannot make guarantees as to its stability.
+ `stack` as a build tool is not officially supported; there is an unofficial [`stack.yaml`](https://gist.github.com/jkachmar/f200caee83280f1f25e9cfa2dd2b16bb) available, though we cannot make guarantees as to its stability.

 [nix]: https://www.haskell.org/cabal/users-guide/nix-local-build-overview.html
 [stackage]: https://stackage.org
--- a/script/bootstrap
+++ b/script/bootstrap
@ -0,0 +1,4 @@
+#!/bin/bash
+
+git submodule sync --recursive && git submodule update --init --recursive --force
+cabal new-update
--- a/semantic.cabal
+++ b/semantic.cabal
@ -59,7 +59,6 @@ common dependencies
                     , fused-effects-exceptions ^>= 0.1.1.0
                     , hashable ^>= 1.2.7.0
                     , tree-sitter ^>= 0.1.0.0
-                     , machines ^>= 0.6.4
                     , mtl ^>= 2.2.2
                     , network ^>= 2.8.0.0
                     , process ^>= 1.6.3.0
@ -67,6 +66,8 @@ common dependencies
                     , scientific ^>= 0.3.6.2
                     , safe-exceptions ^>= 0.1.7.0
                     , semilattices ^>= 0.0.0.3
+                     , shelly >= 1.5 && <2
+                     , streaming ^>= 0.2.2.0
                     , text ^>= 1.2.3.1
                     , these >= 0.7 && <1
                     , unix ^>= 2.7.2.2
@ -273,6 +274,7 @@ library
                     -- Serialization
                     , Serializing.Format
                     , Serializing.SExpression
+                     , Serializing.SExpression.Precise
                     , Tags.Taggable
                     , Tags.Tagging
                     -- Custom Prelude
@ -309,8 +311,6 @@ library
                     , profunctors ^>= 5.3
                     , reducers ^>= 3.12.3
                     , semigroupoids ^>= 5.3.2
-                     , servant ^>= 0.15
-                     , shelly >= 1.5 && <2
                     , split ^>= 0.2.3.3
                     , stm-chans ^>= 3.0.0.4
                     , template-haskell ^>= 2.14
@ -396,6 +396,7 @@ test-suite test
                     , tasty-golden ^>= 2.3.2
                     , tasty-hedgehog ^>= 1.0.0.1
                     , tasty-hspec ^>= 1.1.5.1
+                     , tasty-hunit ^>= 0.10.0.2
                     , HUnit ^>= 1.6.0.0
                     , leancheck >= 0.8 && <1
                     , temporary ^>= 1.3
--- a/src/Data/Blob.hs
+++ b/src/Data/Blob.hs
@ -5,6 +5,7 @@ module Data.Blob
 , Blob(..)
 , Blobs(..)
 , blobLanguage
+, NoLanguageForBlob (..)
 , blobPath
 , makeBlob
 , decodeBlobs
--- a/src/Data/Handle.hs
+++ b/src/Data/Handle.hs
@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DeriveAnyClass, GADTs #-}

 module Data.Handle
  ( Handle (..)
@ -11,14 +11,15 @@ module Data.Handle
  , readBlobPairsFromHandle
  , readFromHandle
  , openFileForReading
+  , InvalidJSONException (..)
  ) where

 import Prologue

+import           Control.Exception (throw)
 import           Data.Aeson
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Lazy.Char8 as BLC
-import           System.Exit
 import qualified System.IO as IO

 import Data.Blob
@ -58,9 +59,14 @@ readPathsFromHandle (ReadHandle h) = liftIO $ fmap BLC.unpack . BLC.lines <$> BL
 readBlobPairsFromHandle :: MonadIO m => Handle 'IO.ReadMode -> m [BlobPair]
 readBlobPairsFromHandle = fmap blobs <$> readFromHandle

+newtype InvalidJSONException = InvalidJSONException String
+  deriving (Eq, Show, Exception)
+
+-- | Read JSON-encoded data from a 'Handle'. Throws
+-- 'InvalidJSONException' on parse failure.
 readFromHandle :: (FromJSON a, MonadIO m) => Handle 'IO.ReadMode -> m a
 readFromHandle (ReadHandle h) = do
  input <- liftIO $ BL.hGetContents h
  case eitherDecode input of
-    Left e  -> liftIO (die (e <> ". Invalid input on " <> show h <> ", expecting JSON"))
+    Left e  -> throw (InvalidJSONException e)
    Right d -> pure d
--- a/src/Data/Language.hs
+++ b/src/Data/Language.hs
@ -108,6 +108,7 @@ languageForType mediaType = case mediaType of
    ".rb"   -> Ruby
    ".go"   -> Go
    ".js"   -> JavaScript
+    ".mjs"  -> JavaScript
    ".ts"   -> TypeScript
    ".tsx"  -> TSX
    ".jsx"  -> JSX
@ -120,7 +121,7 @@ extensionsForLanguage :: Language -> [String]
 extensionsForLanguage language = case language of
  Go         -> [".go"]
  Haskell    -> [".hs"]
-  JavaScript -> [".js"]
+  JavaScript -> [".js", ".mjs"]
  PHP        -> [".php"]
  Python     -> [".py"]
  Ruby       -> [".rb"]
@ -134,10 +135,10 @@ languageForFilePath :: FilePath -> Language
 languageForFilePath = languageForType . takeExtension

 supportedExts :: [String]
-supportedExts = [".go", ".py", ".rb", ".js", ".ts"]
+supportedExts = [".go", ".py", ".rb", ".js", ".mjs", ".ts", ".php", ".phpt"]

 codeNavLanguages :: [Language]
-codeNavLanguages = [Go, Ruby, Python, JavaScript, TypeScript]
+codeNavLanguages = [Go, Ruby, Python, JavaScript, PHP, TypeScript]

 pathIsMinified :: FilePath -> Bool
 pathIsMinified = isExtensionOf ".min.js"
--- a/src/Data/Reprinting/Fragment.hs
+++ b/src/Data/Reprinting/Fragment.hs
@ -7,8 +7,9 @@ module Data.Reprinting.Fragment
  , defer
  ) where

-import Data.Machine
 import Data.Text (Text)
+import Streaming
+import Streaming.Prelude (yield)

 import Data.Reprinting.Scope
 import Data.Reprinting.Token
@ -25,13 +26,13 @@ data Fragment
  deriving (Eq, Show)

 -- | Copy along some original, un-refactored 'Text'.
-copy :: Text -> Plan k Fragment ()
+copy :: Monad m => Text -> Stream (Of Fragment) m ()
 copy = yield . Verbatim

 -- | Insert some new 'Text'.
-insert :: Element -> [Scope] -> Text -> Plan k Fragment ()
+insert :: Monad m => Element -> [Scope] -> Text -> Stream (Of Fragment) m ()
 insert el c = yield . New el c

 -- | Defer processing an element to a later stage.
-defer :: Element -> [Scope] -> Plan k Fragment ()
+defer :: Monad m => Element -> [Scope] -> Stream (Of Fragment) m ()
 defer el = yield . Defer el
--- a/src/Data/Reprinting/Splice.hs
+++ b/src/Data/Reprinting/Splice.hs
@ -18,7 +18,8 @@ module Data.Reprinting.Splice

 import Prologue hiding (Element)

-import Data.Machine
+import Streaming
+import Streaming.Prelude (yield)

 import Data.Reprinting.Fragment

@ -29,29 +30,29 @@ data Splice
  deriving (Eq, Show)

 -- | Emit some 'Text' as a 'Splice'.
-emit :: Text -> Plan k Splice ()
+emit :: Monad m => Text -> Stream (Of Splice) m ()
 emit = yield . Emit

 -- | Emit the provided 'Text' if the given predicate is true.
-emitIf :: Bool -> Text -> Plan k Splice ()
+emitIf :: Monad m => Bool -> Text -> Stream (Of Splice) m ()
 emitIf p = when p . emit

 -- | Construct a layout 'Splice'.
-layout :: Whitespace -> Plan k Splice ()
+layout :: Monad m => Whitespace -> Stream (Of Splice) m ()
 layout = yield . Layout

 -- | @indent w n@ emits @w@ 'Spaces' @n@ times.
-indent :: Int -> Int -> Plan k Splice ()
+indent :: Monad m => Int -> Int -> Stream (Of Splice) m ()
 indent width times
  | times > 0 = replicateM_ times (layout (Indent width Spaces))
  | otherwise = pure ()

 -- | Construct multiple layouts.
-layouts :: [Whitespace] -> Plan k Splice ()
+layouts :: Monad m => [Whitespace] -> Stream (Of Splice) m ()
 layouts = traverse_ (yield . Layout)

 -- | Single space.
-space :: Plan k Splice ()
+space :: Monad m => Stream (Of Splice) m ()
 space = yield (Layout Space)

 -- | Indentation, spacing, and other whitespace.
--- a/src/Language/JSON/PrettyPrint.hs
+++ b/src/Language/JSON/PrettyPrint.hs
@ -8,32 +8,35 @@ module Language.JSON.PrettyPrint

 import Prologue

-import Control.Effect
-import Control.Effect.Error
-import Control.Monad.Trans (lift)
-import Data.Machine
+import           Control.Effect
+import           Control.Effect.Error
+import           Streaming
+import qualified Streaming.Prelude as Streaming

 import Data.Reprinting.Errors
+import Data.Reprinting.Scope
 import Data.Reprinting.Splice
 import Data.Reprinting.Token
-import Data.Reprinting.Scope

 -- | Default printing pipeline for JSON.
 defaultJSONPipeline :: (Member (Error TranslationError) sig, Carrier sig m)
-  => ProcessT m Fragment Splice
+                    => Stream (Of Fragment) m a
+                    -> Stream (Of Splice) m a
 defaultJSONPipeline
-  = printingJSON
-  ~> beautifyingJSON defaultBeautyOpts
+  = beautifyingJSON defaultBeautyOpts
+  . printingJSON

 -- | Print JSON syntax.
-printingJSON :: Monad m => ProcessT m Fragment Fragment
-printingJSON = repeatedly (await >>= step) where
+printingJSON :: Monad m
+             => Stream (Of Fragment) m a
+             -> Stream (Of Fragment) m a
+printingJSON = Streaming.map step where
  step s@(Defer el cs) =
-    let ins = yield . New el cs
+    let ins = New el cs
    in case (el, listToMaybe cs) of
-      (Truth True, _)      -> ins "true"
-      (Truth False, _)     -> ins "false"
-      (Nullity, _)         -> ins "null"
+      (Truth True, _)    -> ins "true"
+      (Truth False, _)   -> ins "false"
+      (Nullity, _)       -> ins "null"

      (Open,  Just List) -> ins "["
      (Close, Just List) -> ins "]"
@ -44,8 +47,8 @@ printingJSON = repeatedly (await >>= step) where
      (Sep, Just Pair)   -> ins ":"
      (Sep, Just Hash)   -> ins ","

-      _                    -> yield s
-  step x = yield x
+      _                  -> s
+  step x = x

 -- TODO: Fill out and implement configurable options like indentation count,
 -- tabs vs. spaces, etc.
@ -57,9 +60,11 @@ defaultBeautyOpts = JSONBeautyOpts 2 False

 -- | Produce JSON with configurable whitespace and layout.
 beautifyingJSON :: (Member (Error TranslationError) sig, Carrier sig m)
-  => JSONBeautyOpts -> ProcessT m Fragment Splice
-beautifyingJSON _ = repeatedly (await >>= step) where
-  step (Defer el cs)   = lift (throwError (NoTranslation el cs))
+                => JSONBeautyOpts
+                -> Stream (Of Fragment) m a
+                -> Stream (Of Splice) m a
+beautifyingJSON _ s = Streaming.for s step where
+  step (Defer el cs)   = effect (throwError (NoTranslation el cs))
  step (Verbatim txt)  = emit txt
  step (New el cs txt) = case (el, cs) of
    (Open,  Hash:_)    -> emit txt *> layout HardWrap *> indent 2 (hashDepth cs)
@ -67,13 +72,14 @@ beautifyingJSON _ = repeatedly (await >>= step) where
    (Sep,   List:_)    -> emit txt *> space
    (Sep,   Pair:_)    -> emit txt *> space
    (Sep,   Hash:_)    -> emit txt *> layout HardWrap *> indent 2 (hashDepth cs)
-    _                    -> emit txt
+    _                  -> emit txt

 -- | Produce whitespace minimal JSON.
 minimizingJSON :: (Member (Error TranslationError) sig, Carrier sig m)
-  => ProcessT m Fragment Splice
-minimizingJSON = repeatedly (await >>= step) where
-  step (Defer el cs)  = lift (throwError (NoTranslation el cs))
+               => Stream (Of Fragment) m a
+               -> Stream (Of Splice) m a
+minimizingJSON s = Streaming.for s step where
+  step (Defer el cs)  = effect (throwError (NoTranslation el cs))
  step (Verbatim txt) = emit txt
  step (New _ _ txt)  = emit txt

--- a/src/Language/PHP/Assignment.hs
+++ b/src/Language/PHP/Assignment.hs
@ -388,7 +388,7 @@ anonymousFunctionCreationExpression = makeTerm <$> symbol AnonymousFunctionCreat
    makeFunction identifier parameters functionUseClause returnType statement = Declaration.Function [functionUseClause, returnType] identifier parameters statement

 parameters :: Assignment [Term]
-parameters = manyTerm (simpleParameter <|> variadicParameter)
+parameters = symbol FormalParameters *> children (manyTerm (simpleParameter <|> variadicParameter))

 simpleParameter :: Assignment Term
 simpleParameter = makeTerm <$> symbol SimpleParameter <*> children (makeAnnotation <$> (term typeDeclaration <|> emptyTerm) <*> (makeAssignment <$> location <*> term variableName <*> (term defaultArgumentSpecifier <|> emptyTerm)))
--- a/src/Language/Python/PrettyPrint.hs
+++ b/src/Language/Python/PrettyPrint.hs
@ -4,8 +4,8 @@ module Language.Python.PrettyPrint ( printingPython ) where

 import Control.Effect
 import Control.Effect.Error
-import Control.Monad.Trans (lift)
-import Data.Machine
+import Streaming
+import qualified Streaming.Prelude as Streaming

 import Data.Reprinting.Errors
 import Data.Reprinting.Splice
@ -14,10 +14,12 @@ import Data.Reprinting.Scope
 import Data.Reprinting.Operator

 -- | Print Python syntax.
-printingPython :: (Member (Error TranslationError) sig, Carrier sig m) => ProcessT m Fragment Splice
-printingPython = repeatedly (await >>= step)
+printingPython :: (Member (Error TranslationError) sig, Carrier sig m)
+               => Stream (Of Fragment) m a
+               -> Stream (Of Splice) m a
+printingPython s = Streaming.for s step

-step :: (Member (Error TranslationError) sig, Carrier sig m) => Fragment -> PlanT k Splice m ()
+step :: (Member (Error TranslationError) sig, Carrier sig m) => Fragment -> Stream (Of Splice) m ()
 step (Verbatim txt) = emit txt
 step (New _ _ txt)  = emit txt
 step (Defer el cs)  = case (el, cs) of
@ -63,7 +65,7 @@ step (Defer el cs)  = case (el, cs) of
  (Sep,   Imperative:xs)        -> layout HardWrap *> indent 4 (imperativeDepth xs)
  (Close, Imperative:_)         -> pure ()

-  _                              -> lift (throwError (NoTranslation el cs))
+  _                             -> effect (throwError (NoTranslation el cs))

  where
    endContext times = layout HardWrap *> indent 4 (pred times)
--- a/src/Language/Ruby/PrettyPrint.hs
+++ b/src/Language/Ruby/PrettyPrint.hs
@ -5,7 +5,8 @@ module Language.Ruby.PrettyPrint ( printingRuby ) where
 import Control.Effect
 import Control.Effect.Error
 import Control.Monad.Trans (lift)
-import Data.Machine
+import Streaming
+import qualified Streaming.Prelude as Streaming

 import Data.Reprinting.Scope
 import Data.Reprinting.Errors
@ -14,10 +15,14 @@ import Data.Reprinting.Splice
 import Data.Reprinting.Token as Token

 -- | Print Ruby syntax.
-printingRuby :: (Member (Error TranslationError) sig, Carrier sig m) => ProcessT m Fragment Splice
-printingRuby = repeatedly (await >>= step)
+printingRuby :: (Member (Error TranslationError) sig, Carrier sig m)
+             => Stream (Of Fragment) m a
+             -> Stream (Of Splice) m a
+printingRuby s = Streaming.for s step

-step :: (Member (Error TranslationError) sig, Carrier sig m) => Fragment -> PlanT k Splice m ()
+step :: (Member (Error TranslationError) sig, Carrier sig m)
+     => Fragment
+     -> Stream (Of Splice) m ()
 step (Verbatim txt) = emit txt
 step (New _ _ txt)  = emit txt
 step (Defer el cs)  = case (el, cs) of
@ -47,9 +52,9 @@ step (Defer el cs)  = case (el, cs) of
  (Close, [Imperative])         -> layout HardWrap
  (Close, Imperative:xs)        -> indent 2 (pred (imperativeDepth xs))

-  (Sep, Call:_)                -> emit "."
+  (Sep, Call:_)                 -> emit "."

-  _                              -> lift (throwError (NoTranslation el cs))
+  _                             -> effect (throwError (NoTranslation el cs))

  where
    endContext times = layout HardWrap *> indent 2 (pred times)
--- a/src/Reprinting/Pipeline.hs
+++ b/src/Reprinting/Pipeline.hs
@ -95,7 +95,7 @@ stages of the pipeline follows:

 -}

-{-# LANGUAGE AllowAmbiguousTypes, ScopedTypeVariables, RankNTypes #-}
+{-# LANGUAGE AllowAmbiguousTypes, RankNTypes, ScopedTypeVariables #-}
 module Reprinting.Pipeline
  ( runReprinter
  , runTokenizing
@ -106,10 +106,10 @@ module Reprinting.Pipeline
 import           Control.Effect as Effect
 import           Control.Effect.Error as Effect
 import           Control.Effect.State as Effect
-import           Data.Machine hiding (Source)
-import           Data.Machine.Runner
 import           Data.Text.Prettyprint.Doc
 import           Data.Text.Prettyprint.Doc.Render.Text
+import           Streaming
+import qualified Streaming.Prelude as Streaming

 import           Data.Reprinting.Errors
 import           Data.Reprinting.Scope
@ -121,57 +121,58 @@ import           Reprinting.Tokenize
 import           Reprinting.Translate
 import           Reprinting.Typeset

-
-- | Run the reprinting pipeline given the original 'Source', a language
-- specific machine (`ProcessT`) and the provided 'Term'.
+-- | Run the reprinting pipeline given the original 'Source', a language specific
+-- translation function (as a function over 'Stream's) and the provided 'Term'.
 runReprinter :: Tokenize a
-  => Source.Source
-  -> ProcessT Translator Fragment Splice
-  -> Term a History
-  -> Either TranslationError Source.Source
-runReprinter src translating tree
+             => Source.Source
+             -> (Stream (Of Fragment) TranslatorC () -> Stream (Of Splice) TranslatorC ())
+             -> Term a History
+             -> Either TranslationError Source.Source
+runReprinter src translating
  = fmap go
  . Effect.run
  . Effect.runError
-  . fmap snd
-  . runState (mempty :: [Scope])
-  . foldT $ source (tokenizing src tree)
-      ~> contextualizing
-      ~> translating
-      ~> typesetting
+  . evalState @[Scope] mempty
+  . Streaming.mconcat_
+  . typesetting
+  . translating
+  . contextualizing
+  . tokenizing src
  where go = Source.fromText . renderStrict . layoutPretty defaultLayoutOptions

 -- | Run the reprinting pipeline up to tokenizing.
 runTokenizing :: Tokenize a
-  => Source.Source
-  -> Term a History
-  -> [Token]
-runTokenizing src tree
-  = Data.Machine.run $ source (tokenizing src tree)
+              => Source.Source
+              -> Term a History
+              -> [Token]
+runTokenizing src
+  = runIdentity
+  . Streaming.toList_
+  . tokenizing src

 -- | Run the reprinting pipeline up to contextualizing.
 runContextualizing :: Tokenize a
-  => Source.Source
-  -> Term a History
-  -> Either TranslationError [Fragment]
-runContextualizing src tree
+                   => Source.Source
+                   -> Term a History
+                   -> Either TranslationError [Fragment]
+runContextualizing src
  = Effect.run
  . Effect.runError
-  . fmap snd
-  . runState (mempty :: [Scope])
-  . runT $ source (tokenizing src tree)
-      ~> contextualizing
+  . evalState @[Scope] mempty
+  . Streaming.toList_
+  . contextualizing
+  . tokenizing src

 runTranslating :: Tokenize a
-  => Source.Source
-  -> ProcessT Translator Fragment Splice
-  -> Term a History
-  -> Either TranslationError [Splice]
-runTranslating src translating tree
+               => Source.Source
+               -> (Stream (Of Fragment) TranslatorC () -> Stream (Of Splice) TranslatorC ())
+               -> Term a History
+               -> Either TranslationError [Splice]
+runTranslating src translating
  = Effect.run
  . Effect.runError
-  . fmap snd
-  . runState (mempty :: [Scope])
-  . runT $ source (tokenizing src tree)
-      ~> contextualizing
-      ~> translating
+  . evalState @[Scope] mempty
+  . Streaming.toList_
+  . translating
+  . contextualizing
+  . tokenizing src
--- a/src/Reprinting/Tokenize.hs
+++ b/src/Reprinting/Tokenize.hs
@ -29,10 +29,11 @@ module Reprinting.Tokenize

 import Prelude hiding (fail, log, filter)
 import Prologue hiding (Element, hash)
+import Streaming hiding (Sum)
+import qualified Streaming.Prelude as Streaming

 import           Data.History
 import           Data.List (intersperse)
-import qualified Data.Machine as Machine
 import           Data.Range
 import           Data.Reprinting.Scope (Scope)
 import qualified Data.Reprinting.Scope as Scope
@ -55,15 +56,14 @@ data Tokenizer a where
  Get :: Tokenizer State
  Put :: State -> Tokenizer ()

-- Tokenizers are compiled into a Plan capable of being converted
-- to a Source. Note that the state parameter is internal to the
-- tokenizer being run: the invoker of 'tokenizing' doesn't need
-- to keep track of it at all.
-compile :: State -> Tokenizer a -> Machine.Plan k Token (State, a)
+-- Tokenizers are compiled directly into Stream values. Note that the
+-- state parameter is internal to the tokenizer being run: the invoker
+-- of 'tokenizing' doesn't need to keep track of it at all.
+compile :: Monad m => State -> Tokenizer a -> Stream (Of Token) m (State, a)
 compile p = \case
  Pure a   -> pure (p, a)
  Bind a f -> compile p a >>= (\(new, v) -> compile new (f v))
-  Tell t   -> Machine.yield t $> (p, ())
+  Tell t   -> Streaming.yield t $> (p, ())
  Get      -> pure (p, p)
  Put p'   -> pure (p', ())

@ -229,12 +229,12 @@ class (Show1 constr, Traversable constr) => Tokenize constr where
  -- | Should emit control and data tokens.
  tokenize :: FAlgebra constr (Tokenizer ())

-tokenizing :: Tokenize a
+tokenizing :: (Monad m, Tokenize a)
           => Source
           -> Term a History
-           -> Machine.Source Token
+           -> Stream (Of Token) m ()
 tokenizing src term = pipe
-  where pipe  = Machine.construct . fmap snd $ compile state go
+  where pipe  = fmap snd $ compile state go
        state = State src (termAnnotation term) Reprinting 0 ForbidData
        go    = forbidData *> foldSubterms descend term <* finish

--- a/src/Reprinting/Translate.hs
+++ b/src/Reprinting/Translate.hs
@ -1,42 +1,50 @@
 {-# LANGUAGE LambdaCase #-}

 module Reprinting.Translate
-  ( Translator
-  , contextualizing
+  ( contextualizing
+  , TranslatorC
  ) where

-import           Control.Monad
 import           Control.Effect
 import           Control.Effect.Error
 import           Control.Effect.State
-import           Control.Monad.Trans
-import           Data.Machine
+import           Control.Monad
+import           Streaming
+import qualified Streaming.Prelude as Streaming

 import           Data.Reprinting.Errors
+import           Data.Reprinting.Scope
 import           Data.Reprinting.Splice
 import           Data.Reprinting.Token
-import           Data.Reprinting.Scope
 import qualified Data.Source as Source

-type Translator
+type TranslatorC
  = StateC [Scope]
  ( ErrorC TranslationError PureC)

-contextualizing :: ProcessT Translator Token Fragment
-contextualizing = repeatedly $ await >>= \case
-  Chunk source -> yield . Verbatim . Source.toText $ source
-  Element t -> case t of
-    Run f -> lift get >>= \c -> yield (New t c f)
-    _     -> lift get >>= yield . Defer t
-  Control ctl -> case ctl of
+contextualizing :: Stream (Of Token) TranslatorC a
+                -> Stream (Of Fragment) TranslatorC a
+contextualizing = Streaming.mapMaybeM $ \case
+  Chunk source -> pure . Just . Verbatim . Source.toText $ source
+  Element t -> Just <$> case t of
+    Run f -> get >>= \c -> pure (New t c f)
+    _     -> get >>= pure . Defer t
+  Control ctl -> Nothing <$ case ctl of
    Enter c -> enterScope c
    Exit c  -> exitScope c
    _       -> pure ()

-enterScope, exitScope :: Scope -> PlanT k Fragment Translator ()
+enterScope :: (Member (State [Scope]) sig, Carrier sig m)
+           => Scope
+           -> m ()
+enterScope c = modify (c :)

-enterScope c = lift (modify (c :))
-
-exitScope c = lift get >>= \case
-  (x:xs) -> when (x == c) (lift (modify (const xs)))
-  cs     -> lift (throwError (UnbalancedPair c cs))
+exitScope :: ( Member (State [Scope]) sig
+             , Member (Error TranslationError) sig
+             , Carrier sig m
+             )
+          => Scope
+          -> m ()
+exitScope c = get >>= \case
+  (x:xs) -> when (x == c) (put xs)
+  cs     -> throwError (UnbalancedPair c cs)
--- a/src/Reprinting/Typeset.hs
+++ b/src/Reprinting/Typeset.hs
@ -5,12 +5,14 @@ module Reprinting.Typeset

 import Prologue

-import Data.Machine
+import Streaming
+import qualified Streaming.Prelude as Streaming
 import Data.Reprinting.Splice hiding (space)
 import Data.Text.Prettyprint.Doc

-typesetting :: Monad m => ProcessT m Splice (Doc a)
-typesetting = auto step
+typesetting :: Monad m => Stream (Of Splice) m x
+                       -> Stream (Of (Doc a)) m x
+typesetting = Streaming.map step

 step :: Splice -> Doc a
 step (Emit t)                   = pretty t
@ -23,8 +25,10 @@ step (Layout (Indent 0 Tabs))   = mempty
 step (Layout (Indent n Tabs))   = stimes n "\t"

 -- | Typeset, but show whitespace with printable characters for debugging purposes.
-typesettingWithVisualWhitespace :: Monad m => ProcessT m Splice (Doc a)
-typesettingWithVisualWhitespace = auto step where
+typesettingWithVisualWhitespace :: Monad m
+                                => Stream (Of Splice) m x
+                                -> Stream (Of (Doc a)) m x
+typesettingWithVisualWhitespace = Streaming.map step where
  step :: Splice -> Doc a
  step (Emit t)                   = pretty t
  step (Layout SoftWrap)          = softline
--- a/src/Semantic/Util.hs
+++ b/src/Semantic/Util.hs
@ -1,5 +1,6 @@
-{-# LANGUAGE CPP, ConstraintKinds, Rank2Types, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
-{-# OPTIONS_GHC -Wno-missing-signatures -O0 #-}
+{-# LANGUAGE CPP, ConstraintKinds, PartialTypeSignatures, Rank2Types, ScopedTypeVariables, TypeFamilies,
+             TypeOperators #-}
+{-# OPTIONS_GHC -Wno-missing-signatures -Wno-partial-type-signatures -O0 #-}
 module Semantic.Util
  ( evalGoProject
  , evalPHPProject
@ -10,6 +11,7 @@ module Semantic.Util
  , mergeErrors
  , reassociate
  , parseFile
+  , parseFileQuiet
  ) where

 import Prelude hiding (readFile)
@ -30,6 +32,7 @@ import           Data.Blob.IO
 import           Data.Graph (topologicalSort)
 import qualified Data.Language as Language
 import           Data.List (uncons)
+import           Data.Location
 import           Data.Project hiding (readFile)
 import           Data.Quieterm (Quieterm, quieterm)
 import           Data.Sum (weaken)
@ -47,70 +50,11 @@ import           Semantic.Task
 import           System.Exit (die)
 import           System.FilePath.Posix (takeDirectory)

-import Data.Location
-
-- The type signatures in these functions are pretty gnarly, but these functions
-- are hit sufficiently often in the CLI and test suite so as to merit avoiding
-- the overhead of repeated type inference. If you have to hack on these functions,
-- it's recommended to remove all the type signatures and add them back when you
-- are done (type holes in GHCi will help here).
-
-justEvaluating :: Evaluator
-                        term
-                        Precise
-                        (Value term Precise)
-                        (ResumableC
-                           (BaseError (ValueError term Precise))
-                              (ResumableC
-                                 (BaseError (AddressError Precise (Value term Precise)))
-                                    (ResumableC
-                                       (BaseError ResolutionError)
-                                          (ResumableC
-                                             (BaseError
-                                                (EvalError term Precise (Value term Precise)))
-                                                (ResumableC
-                                                   (BaseError (HeapError Precise))
-                                                      (ResumableC
-                                                         (BaseError (ScopeError Precise))
-                                                            (ResumableC
-                                                               (BaseError
-                                                                  (UnspecializedError
-                                                                     Precise (Value term Precise)))
-                                                                  (ResumableC
-                                                                     (BaseError
-                                                                        (LoadError
-                                                                           Precise
-                                                                           (Value term Precise)))
-                                                                        (FreshC
-                                                                              (StateC
-                                                                                 (ScopeGraph
-                                                                                    Precise)
-                                                                                    (StateC
-                                                                                       (Heap
-                                                                                          Precise
-                                                                                          Precise
-                                                                                          (Value
-                                                                                             term
-                                                                                             Precise))
-                                                                                          (TraceByPrintingC
-                                                                                                (LiftC
-                                                                                                   IO)))))))))))))
-                        result
-                      -> IO
-                           (Heap Precise Precise (Value term Precise),
-                            (ScopeGraph Precise,
-                             Either
-                               (SomeError
-                                  (Sum
-                                     '[BaseError (ValueError term Precise),
-                                       BaseError (AddressError Precise (Value term Precise)),
-                                       BaseError ResolutionError,
-                                       BaseError (EvalError term Precise (Value term Precise)),
-                                       BaseError (HeapError Precise),
-                                       BaseError (ScopeError Precise),
-                                       BaseError (UnspecializedError Precise (Value term Precise)),
-                                       BaseError (LoadError Precise (Value term Precise))]))
-                               result))
+justEvaluating :: Evaluator term Precise (Value term Precise) _ result
+               -> IO ( Heap Precise Precise (Value term Precise),
+                     ( ScopeGraph Precise
+                     , Either (SomeError (Sum _)) result)
+                     )
 justEvaluating
  = runM
  . runEvaluator
@ -128,75 +72,27 @@ justEvaluating
  . runAddressError
  . runValueError

-type FileEvaluator syntax =
+type FileEvaluator err syntax =
  [FilePath]
  -> IO
-       (Heap
-          Precise
-          Precise
-          (Value
-             (Quieterm (Sum syntax) Location) Precise),
-        (ScopeGraph Precise,
-         Either
-           (SomeError
-              (Sum
-                 '[BaseError
-                     (ValueError
-                        (Quieterm (Sum syntax) Location)
-                        Precise),
-                   BaseError
-                     (AddressError
-                        Precise
-                        (Value
-                           (Quieterm
-                              (Sum syntax) Location)
-                           Precise)),
-                   BaseError ResolutionError,
-                   BaseError
-                     (EvalError
-                        (Quieterm (Sum syntax) Location)
-                        Precise
-                        (Value
-                           (Quieterm
-                              (Sum syntax) Location)
-                           Precise)),
-                   BaseError (HeapError Precise),
-                   BaseError (ScopeError Precise),
-                   BaseError
-                     (UnspecializedError
-                        Precise
-                        (Value
-                           (Quieterm
-                              (Sum syntax) Location)
-                           Precise)),
-                   BaseError
-                     (LoadError
-                        Precise
-                        (Value
-                           (Quieterm
-                              (Sum syntax) Location)
-                           Precise))]))
-           (ModuleTable
-              (Module
-                 (ModuleResult
-                    Precise
-                    (Value
-                       (Quieterm (Sum syntax) Location)
-                       Precise))))))
+       ( Heap Precise Precise (Value (Quieterm (Sum syntax) Location) Precise),
+       ( ScopeGraph Precise
+       , Either (SomeError (Sum err))
+                (ModuleTable (Module (ModuleResult Precise (Value (Quieterm (Sum syntax) Location) Precise))))))

-evalGoProject :: FileEvaluator Language.Go.Assignment.Syntax
+evalGoProject :: FileEvaluator _ Language.Go.Assignment.Syntax
 evalGoProject = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.Go) goParser

-evalRubyProject :: FileEvaluator Language.Ruby.Assignment.Syntax
+evalRubyProject :: FileEvaluator _ Language.Ruby.Assignment.Syntax
 evalRubyProject = justEvaluating <=< evaluateProject (Proxy @'Language.Ruby)               rubyParser

-evalPHPProject :: FileEvaluator Language.PHP.Assignment.Syntax
+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
+evalPythonProject :: FileEvaluator _ Language.Python.Assignment.Syntax
+evalPythonProject = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.Python)     pythonParser

-evalTypeScriptProject :: FileEvaluator Language.TypeScript.Assignment.Syntax
+evalTypeScriptProject :: FileEvaluator _ Language.TypeScript.Assignment.Syntax
 evalTypeScriptProject = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.TypeScript) typescriptParser

 evaluateProject proxy parser paths = withOptions debugOptions $ \ config logger statter ->
@ -218,11 +114,13 @@ evaluateProject' session proxy parser paths = do
         (evaluate proxy (runDomainEffects (evalTerm withTermSpans)) modules)))))))
  either (die . displayException) pure res

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

-runTask' :: TaskEff a -> IO a
+runTask', runTaskQuiet :: TaskEff a -> IO a
 runTask' task = runTaskWithOptions debugOptions task >>= either (die . displayException) pure
+runTaskQuiet task = runTaskWithOptions defaultOptions task >>= either (die . displayException) pure

 mergeErrors :: Either (SomeError (Sum errs)) (Either (SomeError err) result) -> Either (SomeError (Sum (err ': errs))) result
 mergeErrors = either (\ (SomeError sum) -> Left (SomeError (weaken sum))) (either (\ (SomeError err) -> Left (SomeError (inject err))) Right)
--- a/src/Serializing/SExpression/Precise.hs
+++ b/src/Serializing/SExpression/Precise.hs
@ -0,0 +1,70 @@
+{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
+module Serializing.SExpression.Precise
+( serializeSExpression
+) where
+
+import Data.ByteString.Builder
+import Data.Foldable (fold)
+import Data.List (intersperse)
+import Data.Text (Text)
+import GHC.Generics
+
+serializeSExpression :: ToSExpression t => t -> Builder
+serializeSExpression t = toSExpression t 0 <> "\n"
+
+
+nl :: Int -> Builder
+nl n | n <= 0    = ""
+     | otherwise = "\n"
+
+pad :: Int -> Builder
+pad n = stringUtf8 (replicate (2 * n) ' ')
+
+
+class ToSExpression t where
+  toSExpression :: t -> Int -> Builder
+
+instance (ToSExpressionWithStrategy strategy t, strategy ~ ToSExpressionStrategy t) => ToSExpression t where
+  toSExpression = toSExpressionWithStrategy @strategy undefined
+
+
+data Strategy = Generic | Show
+
+type family ToSExpressionStrategy t :: Strategy where
+  ToSExpressionStrategy Text = 'Show
+  ToSExpressionStrategy _    = 'Generic
+
+class ToSExpressionWithStrategy (strategy :: Strategy) t where
+  toSExpressionWithStrategy :: proxy strategy -> t -> Int -> Builder
+
+instance Show t => ToSExpressionWithStrategy 'Show t where
+  toSExpressionWithStrategy _ t _ = stringUtf8 (show t)
+
+instance (Generic t, GToSExpression (Rep t)) => ToSExpressionWithStrategy 'Generic t where
+  toSExpressionWithStrategy _ t n = nl n <> pad n <> "(" <> fold (intersperse " " (gtoSExpression (from t) n)) <> ")"
+
+
+class GToSExpression f where
+  gtoSExpression :: f (Int -> Builder) -> (Int -> [Builder])
+
+instance GToSExpression f => GToSExpression (M1 D d f) where
+  gtoSExpression = gtoSExpression . unM1
+
+instance (GToSExpression f, GToSExpression g) => GToSExpression (f :+: g) where
+  gtoSExpression (L1 l) = gtoSExpression l
+  gtoSExpression (R1 r) = gtoSExpression r
+
+instance (Constructor c, GToSExpression f) => GToSExpression (M1 C c f) where
+  gtoSExpression m n = stringUtf8 (conName m) : gtoSExpression (unM1 m) (n + 1)
+
+instance (GToSExpression f, GToSExpression g) => GToSExpression (f :*: g) where
+  gtoSExpression (l :*: r) = gtoSExpression l <> gtoSExpression r
+
+instance GToSExpression U1 where
+  gtoSExpression _ _ = []
+
+instance GToSExpression f => GToSExpression (M1 S s f) where
+  gtoSExpression = gtoSExpression . unM1 -- FIXME: show the selector name, if any
+
+instance ToSExpression k => GToSExpression (K1 R k) where
+  gtoSExpression k = pure . toSExpression (unK1 k)
--- a/src/Tags/Taggable.hs
+++ b/src/Tags/Taggable.hs
@ -28,14 +28,15 @@ import Analysis.HasTextElement
 import Data.Abstract.Declarations
 import Data.Abstract.Name
 import Data.Blob
-import Data.Functor.Identity
 import Data.Language
 import Data.Location
-import Data.Machine as Machine
 import Data.Range
 import Data.Term
 import Data.Text hiding (empty)

+import Streaming hiding (Sum)
+import Streaming.Prelude (yield)
+
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Comment as Comment
 import qualified Data.Syntax.Declaration as Declaration
@ -63,13 +64,13 @@ data Token
  | Iden  { identifierName :: Text, tokenSpan :: Span, docsLiteralRange :: Maybe Range }
  deriving (Eq, Show)

-type Tagger k a = PlanT k Token Identity a
+type Tagger = Stream (Of Token)

-enter, exit :: String -> Maybe Range -> Tagger k ()
+enter, exit :: Monad m => String -> Maybe Range -> Tagger m ()
 enter c = yield . Enter (pack c)
 exit c = yield . Exit (pack c)

-emitIden :: Span -> Maybe Range -> Name -> Tagger k ()
+emitIden :: Monad m => Span -> Maybe Range -> Name -> Tagger m ()
 emitIden span docsLiteralRange name = yield (Iden (formatName name) span docsLiteralRange)

 class (Show1 constr, Traversable constr) => Taggable constr where
@ -98,11 +99,11 @@ type IsTaggable syntax =
  , HasTextElement syntax
  )

-tagging :: (IsTaggable syntax)
+tagging :: (Monad m, IsTaggable syntax)
        => Blob
        -> Term syntax Location
-        -> Machine.MachineT Identity k Token
-tagging b = Machine.construct . foldSubterms (descend (blobLanguage b))
+        -> Stream (Of Token) m ()
+tagging b = foldSubterms (descend (blobLanguage b))

 descend ::
  ( Taggable (TermF syntax Location)
@ -111,8 +112,9 @@ descend ::
  , Foldable syntax
  , HasTextElement syntax
  , Declarations1 syntax
+  , Monad m
  )
-  => Language -> SubtermAlgebra (TermF syntax Location) (Term syntax Location) (Tagger k ())
+  => Language -> SubtermAlgebra (TermF syntax Location) (Term syntax Location) (Tagger m ())
 descend lang t@(In loc _) = do
  let term = fmap subterm t
  let snippetRange = snippet loc term
--- a/src/Tags/Tagging.hs
+++ b/src/Tags/Tagging.hs
@ -10,26 +10,28 @@ import Prologue hiding (Element, hash)

 import           Control.Effect as Eff
 import           Control.Effect.State
-import           Control.Monad.Trans
+import           Data.Text as T hiding (empty)
+import           Streaming
+import qualified Streaming.Prelude as Streaming
+
 import           Data.Blob
 import           Data.Location
-import           Data.Machine as Machine
 import qualified Data.Source as Source
 import           Data.Tag
 import           Data.Term
-import           Data.Text as T hiding (empty)
 import           Tags.Taggable

 runTagging :: (IsTaggable syntax)
-  => Blob
-  -> [Text]
-  -> Term syntax Location
-  -> [Tag]
-runTagging blob symbolsToSummarize tree
+           => Blob
+           -> [Text]
+           -> Term syntax Location
+           -> [Tag]
+runTagging blob symbolsToSummarize
  = Eff.run
  . evalState @[ContextToken] []
-  . runT $ source (tagging blob tree)
-      ~> contextualizing blob symbolsToSummarize
+  . Streaming.toList_
+  . contextualizing blob symbolsToSummarize
+  . tagging blob

 type ContextToken = (Text, Maybe Range)

@ -38,16 +40,17 @@ contextualizing :: ( Member (State [ContextToken]) sig
                   )
                => Blob
                -> [Text]
-                -> Machine.ProcessT m Token Tag
-contextualizing Blob{..} symbolsToSummarize = repeatedly $ await >>= \case
-  Enter x r -> lift (enterScope (x, r))
-  Exit  x r -> lift (exitScope (x, r))
-  Iden iden span docsLiteralRange -> lift (get @[ContextToken]) >>= \case
+                -> Stream (Of Token) m a
+                -> Stream (Of Tag) m a
+contextualizing Blob{..} symbolsToSummarize = Streaming.mapMaybeM $ \case
+  Enter x r -> Nothing <$ enterScope (x, r)
+  Exit  x r -> Nothing <$ exitScope (x, r)
+  Iden iden span docsLiteralRange -> get @[ContextToken] >>= pure . \case
    ((x, r):("Context", cr):xs) | x `elem` symbolsToSummarize
-      -> yield $ Tag iden x span (fmap fst xs) (firstLine (slice r)) (slice cr)
+      -> Just $ Tag iden x span (fmap fst xs) (firstLine (slice r)) (slice cr)
    ((x, r):xs) | x `elem` symbolsToSummarize
-      -> yield $ Tag iden x span (fmap fst xs) (firstLine (slice r)) (slice docsLiteralRange)
-    _ -> pure ()
+      -> Just $ Tag iden x span (fmap fst xs) (firstLine (slice r)) (slice docsLiteralRange)
+    _ -> Nothing
  where
    slice = fmap (stripEnd . Source.toText . flip Source.slice blobSource)
    firstLine = fmap (T.take 180 . fst . breakOn "\n")
--- a/test/Analysis/Go/Spec.hs
+++ b/test/Analysis/Go/Spec.hs
@ -8,7 +8,7 @@ import           SpecHelpers


 spec :: (?session :: TaskSession) => Spec
-spec = parallel $ do
+spec = do
  describe "Go" $ do
    it "imports and wildcard imports" $ do
      (scopeGraph, (heap, res)) <- evaluate ["main.go", "foo/foo.go", "bar/bar.go", "bar/rab.go"]
--- a/test/Analysis/PHP/Spec.hs
+++ b/test/Analysis/PHP/Spec.hs
@ -9,7 +9,7 @@ import           SpecHelpers


 spec :: (?session :: TaskSession) => Spec
-spec = parallel $ do
+spec = do
  describe "PHP" $ do
    xit "evaluates include and require" $ do
      (scopeGraph, (heap, res)) <- evaluate ["main.php", "foo.php", "bar.php"]
--- a/test/Analysis/Python/Spec.hs
+++ b/test/Analysis/Python/Spec.hs
@ -10,7 +10,7 @@ import SpecHelpers


 spec :: (?session :: TaskSession) => Spec
-spec = parallel $ do
+spec = do
  describe "Python" $ do
    it "imports" $ do
      (scopeGraph, (heap, res)) <- evaluate ["main.py", "a.py", "b/__init__.py", "b/c.py"]
--- a/test/Analysis/Ruby/Spec.hs
+++ b/test/Analysis/Ruby/Spec.hs
@ -15,7 +15,7 @@ import SpecHelpers


 spec :: (?session :: TaskSession) =>  Spec
-spec = parallel $ do
+spec = do
  describe "Ruby" $ do
    it "evaluates require_relative" $ do
      (scopeGraph, (heap, res)) <- evaluate ["main.rb", "foo.rb"]
--- a/test/Analysis/TypeScript/Spec.hs
+++ b/test/Analysis/TypeScript/Spec.hs
@ -23,7 +23,7 @@ import qualified Language.TypeScript.Assignment as TypeScript
 import           SpecHelpers

 spec :: (?session :: TaskSession) => Spec
-spec = parallel $ do
+spec = do
  describe "TypeScript" $ do
    it "qualified export from" $ do
      (scopeGraph, (heap, res)) <- evaluate ["main6.ts", "baz.ts", "foo.ts"]
--- a/test/Assigning/Assignment/Spec.hs
+++ b/test/Assigning/Assignment/Spec.hs
@ -44,35 +44,37 @@ spec = do
      `shouldBe`
        Right [Out "hello"]

-    it "distributes through overlapping committed choices, matching the left alternative" $
-      fst <$> runAssignment "(red (green))" (symbol Red *> children green <|> symbol Red *> children blue) (makeState [node Red 0 13 [node Green 5 12 []]])
-      `shouldBe`
-      Right (Out "(green)")
+    describe "distributing through overlapping committed choices" $ do

-    it "distributes through overlapping committed choices, matching the right alternative" $
-      fst <$> runAssignment "(red (blue))" (symbol Red *> children green <|> symbol Red *> children blue) (makeState [node Red 0 12 [node Blue 5 11 []]])
-      `shouldBe`
-      Right (Out "(blue)")
+      it "matches the left alternative" $
+        fst <$> runAssignment "(red (green))" (symbol Red *> children green <|> symbol Red *> children blue) (makeState [node Red 0 13 [node Green 5 12 []]])
+        `shouldBe`
+        Right (Out "(green)")

-    it "distributes through overlapping committed choices, matching the left alternatives" $
-      fst <$> runAssignment "magenta green green" (symbol Magenta *> many green <|> symbol Magenta *> many blue) (makeState [node Magenta 0 7 [], node Green 8 13 [], node Green 14 19 []])
-      `shouldBe`
-      Right [Out "green", Out "green"]
+      it "matches the right alternative" $
+        fst <$> runAssignment "(red (blue))" (symbol Red *> children green <|> symbol Red *> children blue) (makeState [node Red 0 12 [node Blue 5 11 []]])
+        `shouldBe`
+        Right (Out "(blue)")

-    it "distributes through overlapping committed choices, matching the empty list" $
-      fst <$> runAssignment "magenta" (symbol Magenta *> (Left <$> many green) <|> symbol Magenta *> (Right <$> many blue)) (makeState [node Magenta 0 7 []])
-      `shouldBe`
-      Right (Left [])
+      it "matches the left alternatives" $
+        fst <$> runAssignment "magenta green green" (symbol Magenta *> many green <|> symbol Magenta *> many blue) (makeState [node Magenta 0 7 [], node Green 8 13 [], node Green 14 19 []])
+        `shouldBe`
+        Right [Out "green", Out "green"]

-    it "distributes through overlapping committed choices, dropping anonymous nodes & matching the left alternative" $
-      fst <$> runAssignment "magenta green" (symbol Magenta *> green <|> symbol Magenta *> blue) (makeState [node Magenta 0 7 [], node Green 8 13 []])
-      `shouldBe`
-      Right (Out "green")
+      it "matches the empty list" $
+        fst <$> runAssignment "magenta" (symbol Magenta *> (Left <$> many green) <|> symbol Magenta *> (Right <$> many blue)) (makeState [node Magenta 0 7 []])
+        `shouldBe`
+        Right (Left [])

-    it "distributes through overlapping committed choices, dropping anonymous nodes & matching the right alternative" $
-      fst <$> runAssignment "magenta blue" (symbol Magenta *> green <|> symbol Magenta *> blue) (makeState [node Magenta 0 7 [], node Blue 8 12 []])
-      `shouldBe`
-      Right (Out "blue")
+      it "drops anonymous nodes & matches the left alternative" $
+        fst <$> runAssignment "magenta green" (symbol Magenta *> green <|> symbol Magenta *> blue) (makeState [node Magenta 0 7 [], node Green 8 13 []])
+        `shouldBe`
+        Right (Out "green")
+
+      it "drops anonymous nodes & matches the right alternative" $
+        fst <$> runAssignment "magenta blue" (symbol Magenta *> green <|> symbol Magenta *> blue) (makeState [node Magenta 0 7 [], node Blue 8 12 []])
+        `shouldBe`
+        Right (Out "blue")

    it "alternates repetitions, matching the left alternative" $
      fst <$> runAssignment "green green" (many green <|> many blue) (makeState [node Green 0 5 [], node Green 6 11 []])
--- a/test/Control/Abstract/Evaluator/Spec.hs
+++ b/test/Control/Abstract/Evaluator/Spec.hs
@ -1,4 +1,5 @@
 {-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 module Control.Abstract.Evaluator.Spec
 ( spec
 ) where
@ -20,7 +21,7 @@ import           SpecHelpers hiding (reassociate)
 import           System.IO.Unsafe (unsafePerformIO)

 spec :: Spec
-spec = parallel $ do
+spec = do
  it "constructs integers" $ do
    (_, (_, (_, expected))) <- evaluate (integer 123)
    expected `shouldBe` Right (Value.Integer (Number.Integer 123))
--- a/test/Data/Diff/Spec.hs
+++ b/test/Data/Diff/Spec.hs
@ -7,6 +7,6 @@ import Test.Hspec
 import Test.Hspec.LeanCheck

 spec :: Spec
-spec = parallel $ do
+spec = do
  prop "equality is reflexive" $
    \ diff -> diff `shouldBe` (diff :: Diff ListableSyntax () ())
--- a/test/Data/Functor/Classes/Generic/Spec.hs
+++ b/test/Data/Functor/Classes/Generic/Spec.hs
@ -7,7 +7,7 @@ import Test.Hspec
 import Test.Hspec.LeanCheck

 spec :: Spec
-spec = parallel $ do
+spec = do
  describe "Eq1" $ do
    describe "genericLiftEq" $ do
      prop "equivalent to derived (==) for product types" $
--- a/test/Data/Functor/Listable.hs
+++ b/test/Data/Functor/Listable.hs
@ -104,13 +104,6 @@ liftCons4 :: [Tier a] -> [Tier b] -> [Tier c] -> [Tier d] -> (a -> b -> c -> d -
 liftCons4 tiers1 tiers2 tiers3 tiers4 f = mapT (uncurry4 f) (tiers1 >< tiers2 >< tiers3 >< tiers4) `addWeight` 1
  where uncurry4 f (a, (b, (c, d))) = f a b c d

-- | Lifts a quinary constructor to a list of tiers, given lists of tiers for its arguments.
--
--   Commonly used in the definition of 'Listable1' and 'Listable2' instances.
-liftCons5 :: [Tier a] -> [Tier b] -> [Tier c] -> [Tier d] -> [Tier e] -> (a -> b -> c -> d -> e -> f) -> [Tier f]
-liftCons5 tiers1 tiers2 tiers3 tiers4 tiers5 f = mapT (uncurry5 f) (tiers1 >< tiers2 >< tiers3 >< tiers4 >< tiers5) `addWeight` 1
-  where uncurry5 f (a, (b, (c, (d, e)))) = f a b c d e
-
 -- | Lifts a senary constructor to a list of tiers, given lists of tiers for its arguments.
 --
 --   Commonly used in the definition of 'Listable1' and 'Listable2' instances.
--- a/test/Data/Source/Spec.hs
+++ b/test/Data/Source/Spec.hs
@ -70,7 +70,7 @@ testTree = Tasty.testGroup "Data.Source"
  ]

 spec :: Spec
-spec = parallel $ do
+spec = do
  describe "newlineIndices" $ do
    it "finds \\n" $
      let source = "a\nb" in
--- a/test/Data/Term/Spec.hs
+++ b/test/Data/Term/Spec.hs
@ -3,12 +3,12 @@ module Data.Term.Spec (spec) where

 import Data.Functor.Listable
 import Data.Term
-import Test.Hspec (Spec, describe, parallel)
+import Test.Hspec (Spec, describe)
 import Test.Hspec.Expectations
 import Test.Hspec.LeanCheck

 spec :: Spec
-spec = parallel $ do
+spec = do
  describe "Term" $ do
    prop "equality is reflexive" $
      \ a -> a `shouldBe` (a :: Term ListableSyntax ())
--- a/test/Diffing/Algorithm/RWS/Spec.hs
+++ b/test/Diffing/Algorithm/RWS/Spec.hs
@ -16,7 +16,7 @@ import Test.Hspec.LeanCheck
 import SpecHelpers

 spec :: Spec
-spec = parallel $ do
+spec = do
  let positively = succ . abs
  describe "pqGramDecorator" $ do
    prop "produces grams with stems of the specified length" $
--- a/test/Diffing/Interpreter/Spec.hs
+++ b/test/Diffing/Interpreter/Spec.hs
@ -14,14 +14,14 @@ import Data.Term
 import Data.These
 import Diffing.Interpreter
 import qualified Data.Syntax as Syntax
-import Test.Hspec (Spec, describe, it, parallel)
+import Test.Hspec (Spec, describe, it)
 import Test.Hspec.Expectations
 import Test.Hspec.LeanCheck
 import Test.LeanCheck.Core
 import SpecHelpers ()

 spec :: Spec
-spec = parallel $ do
+spec = do
  describe "diffTerms" $ do
    it "returns a replacement when comparing two unicode equivalent terms" $
      let termA = termIn emptyAnnotation (inject (Syntax.Identifier "t\776"))
--- a/test/Integration/Spec.hs
+++ b/test/Integration/Spec.hs
@ -1,5 +1,5 @@
 {-# LANGUAGE ImplicitParams, LambdaCase, NamedFieldPuns #-}
-module Integration.Spec (spec) where
+module Integration.Spec (testTree) where

 import Control.Exception (throw)
 import Data.Foldable (find)
@ -17,8 +17,8 @@ import Test.Tasty.Golden
 languages :: [FilePath]
 languages = ["go", "javascript", "json", "python", "ruby", "typescript", "tsx"]

-spec :: (?session :: TaskSession) => TestTree
-spec = testGroup "Integration (golden tests)" $ fmap testsForLanguage languages
+testTree :: (?session :: TaskSession) => TestTree
+testTree = testGroup "Integration (golden tests)" $ fmap testsForLanguage languages

 testsForLanguage :: (?session :: TaskSession) => FilePath -> TestTree
 testsForLanguage language = do
--- a/test/Parsing/Spec.hs
+++ b/test/Parsing/Spec.hs
@ -12,7 +12,7 @@ import SpecHelpers
 import TreeSitter.JSON (tree_sitter_json, Grammar)

 spec :: Spec
-spec = parallel $ do
+spec = do
  describe "parseToAST" $ do
    let source = toJSONSource [1 :: Int .. 10000]
    let largeBlob = sourceBlob "large.json" JSON source
--- a/test/Rendering/TOC/Spec.hs
+++ b/test/Rendering/TOC/Spec.hs
@ -28,7 +28,7 @@ import SpecHelpers


 spec :: Spec
-spec = parallel $ do
+spec = do
  describe "tableOfContentsBy" $ do
    prop "drops all nodes with the constant Nothing function" $
      \ diff -> tableOfContentsBy (const Nothing :: a -> Maybe ()) (diff :: Diff ListableSyntax () ()) `shouldBe` []
--- a/test/Reprinting/Spec.hs
+++ b/test/Reprinting/Spec.hs
@ -5,7 +5,8 @@ module Reprinting.Spec (spec) where
 import SpecHelpers

 import           Data.Foldable
-import qualified Data.Machine as Machine
+import           Streaming hiding (Sum)
+import qualified Streaming.Prelude as Streaming

 import           Control.Rewriting
 import qualified Data.Language as Language
@ -28,20 +29,20 @@ spec = describe "reprinting" $ do
    let path = "test/fixtures/javascript/reprinting/map.json"
    (src, tree) <- runIO $ do
      src  <- blobSource <$> readBlobFromFile' (File path Language.JSON)
-      tree <- parseFile jsonParser path
+      tree <- parseFileQuiet jsonParser path
      pure (src, tree)

    describe "tokenization" $ do

      it "should pass over a pristine tree" $ do
        let tagged = mark Unmodified tree
-        let toks = Machine.run $ tokenizing src tagged
+        let toks = runIdentity . Streaming.toList_ $ tokenizing src tagged
        toks `shouldSatisfy` not . null
        head toks `shouldSatisfy` isControl
        last toks `shouldSatisfy` isChunk

      it "should emit control tokens but only 1 chunk for a wholly-modified tree" $ do
-        let toks = Machine.run $ tokenizing src (mark Refactored tree)
+        let toks = runIdentity . Streaming.toList_ $ tokenizing src (mark Refactored tree)
        for_ @[] [List, Hash] $ \t -> do
          toks `shouldSatisfy` elem (Control (Enter t))
          toks `shouldSatisfy` elem (Control (Exit t))
--- a/test/Rewriting/Go/Spec.hs
+++ b/test/Rewriting/Go/Spec.hs
@ -30,11 +30,11 @@ loopMatcher = target <* go where
 spec :: Spec
 spec = describe "recursively" $ do
  it "extracts integers" $ do
-    parsed <- parseFile goParser "test/fixtures/go/matching/integers.go"
+    parsed <- parseFileQuiet goParser "test/fixtures/go/matching/integers.go"
    let matched = recursively integerMatcher parsed
    sort matched `shouldBe` ["1", "2", "3"]

  it "counts for loops" $ do
-    parsed <- parseFile goParser "test/fixtures/go/matching/for.go"
+    parsed <- parseFileQuiet goParser "test/fixtures/go/matching/for.go"
    let matched = recursively @[] @(Term _ _) loopMatcher parsed
    length matched `shouldBe` 2
--- a/test/Rewriting/JSON/Spec.hs
+++ b/test/Rewriting/JSON/Spec.hs
@ -44,7 +44,7 @@ spec = describe "rewriting" $ do
  bytes <- runIO $ Source.fromUTF8 <$> B.readFile path

  refactored <- runIO $ do
-    json <- parseFile jsonParser path
+    json <- parseFileQuiet jsonParser path
    let result = rewrite @Maybe (History.mark Unmodified json) (topDownAny onTrees)
    maybe (fail "rewrite failed") pure result

--- a/test/Rewriting/Python/Spec.hs
+++ b/test/Rewriting/Python/Spec.hs
@ -25,11 +25,11 @@ docstringMatcher =
 spec :: Spec
 spec = describe "matching/python" $ do
  it "matches top-level docstrings" $ do
-    parsed <- parseFile pythonParser "test/fixtures/python/matching/docstrings.py"
+    parsed <- parseFileQuiet pythonParser "test/fixtures/python/matching/docstrings.py"
    let matched = recursively @[] docstringMatcher parsed
    length matched `shouldBe` 2

  it "matches docstrings recursively" $ do
-    parsed <- parseFile pythonParser "test/fixtures/python/matching/docstrings_nested.py"
+    parsed <- parseFileQuiet pythonParser "test/fixtures/python/matching/docstrings_nested.py"
    let matched = recursively @[] docstringMatcher parsed
    length matched `shouldBe` 3
--- a/test/Semantic/CLI/Spec.hs
+++ b/test/Semantic/CLI/Spec.hs
@ -1,4 +1,4 @@
-module Semantic.CLI.Spec (spec) where
+module Semantic.CLI.Spec (testTree) where

 import           Data.ByteString.Builder
 import           Semantic.Api hiding (Blob, BlobPair, File)
@ -11,8 +11,8 @@ import SpecHelpers
 import Test.Tasty
 import Test.Tasty.Golden

-spec :: TestTree
-spec = testGroup "Semantic.CLI"
+testTree :: TestTree
+testTree = testGroup "Semantic.CLI"
  [ testGroup "parseDiffBuilder" $ fmap testForDiffFixture diffFixtures
  , testGroup "parseTermBuilder" $ fmap testForParseFixture parseFixtures
  ]
@ -41,7 +41,7 @@ testForDiffFixture (diffRenderer, runDiff, files, expected) =
 testForParseFixture :: (String, [Blob] -> TaskEff Builder, [File], FilePath) -> TestTree
 testForParseFixture (format, runParse, files, expected) =
  goldenVsStringDiff
-    ("diff fixture renders to " <> format <> " " <> show files)
+    ("diff fixture renders to " <> format)
    renderDiff
    expected
    (fmap toLazyByteString . runTaskOrDie $ readBlobs (FilesFromPaths files) >>= runParse)
@ -53,6 +53,7 @@ parseFixtures =
  , ("json", parseTermBuilder TermJSONTree, path', prefix </> "parse-trees.json")
  , ("json", parseTermBuilder TermJSONTree, [], prefix </> "parse-tree-empty.json")
  , ("symbols", parseSymbolsBuilder Serializing.Format.JSON, path'', prefix </> "parse-tree.symbols.json")
+  , ("protobuf symbols", parseSymbolsBuilder Serializing.Format.Proto, path'', prefix </> "parse-tree.symbols.protobuf.bin")
  ]
  where path = [File "test/fixtures/ruby/corpus/and-or.A.rb" Ruby]
        path' = [File "test/fixtures/ruby/corpus/and-or.A.rb" Ruby, File "test/fixtures/ruby/corpus/and-or.B.rb" Ruby]
@ -64,6 +65,7 @@ diffFixtures =
  [ ("json diff", parseDiffBuilder DiffJSONTree, pathMode, prefix </> "diff-tree.json")
  , ("s-expression diff", parseDiffBuilder DiffSExpression, pathMode, "test/fixtures/ruby/corpus/method-declaration.diffA-B.txt")
  , ("toc summaries diff", diffSummaryBuilder Serializing.Format.JSON, pathMode, prefix </> "diff-tree.toc.json")
+  , ("protobuf diff", diffSummaryBuilder Serializing.Format.Proto, pathMode, prefix </> "diff-tree.toc.protobuf.bin")
  ]
  where pathMode = [Both (File "test/fixtures/ruby/corpus/method-declaration.A.rb" Ruby) (File "test/fixtures/ruby/corpus/method-declaration.B.rb"  Ruby)]
        prefix = "test/fixtures/cli"
--- a/test/Semantic/IO/Spec.hs
+++ b/test/Semantic/IO/Spec.hs
@ -5,33 +5,32 @@ import Prelude hiding (readFile)
 import Control.Monad.IO.Class
 import Data.List
 import System.Directory
-import System.Exit (ExitCode (..))
 import System.IO.Temp
-import System.Process
+import Data.String

 import Data.Blob
 import Data.Handle
 import SpecHelpers hiding (readFile)
 import qualified Semantic.Git as Git
-
+import Shelly (shelly, silently, cd, run_)

 spec :: Spec
-spec = parallel $ do
+spec = do
  describe "readBlobsFromGitRepo" $ do
    hasGit <- runIO $ isJust <$> findExecutable "git"
    when hasGit . it "should read from a git directory" $ do
      -- This temporary directory will be cleaned after use.
      blobs <- liftIO . withSystemTempDirectory "semantic-temp-git-repo" $ \dir -> do
-        let commands = [ "cd " <> dir
-                       , "git init"
-                       , "touch foo.py bar.rb"
-                       , "git add foo.py bar.rb"
-                       , "git config user.name 'Test'"
-                       , "git config user.email 'test@test.test'"
-                       , "git commit -am 'test commit'"
-                       ]
-        exit <- system (intercalate " && " commands)
-        when (exit /= ExitSuccess) (fail ("Couldn't run git properly in dir " <> dir))
+        shelly $ silently $ do
+          cd (fromString dir)
+          let git = run_ "git"
+          git ["init"]
+          run_ "touch" ["foo.py", "bar.rb"]
+          git ["add", "foo.py", "bar.rb"]
+          git ["config", "user.name", "'Test'"]
+          git ["config", "user.email", "'test@test.test'"]
+          git ["commit", "-am", "'test commit'"]
+
        readBlobsFromGitRepo (dir </> ".git") (Git.OID "HEAD") []
      let files = sortOn fileLanguage (blobFile <$> blobs)
      files `shouldBe` [ File "foo.py" Python
@ -50,9 +49,7 @@ spec = parallel $ do
    let a = sourceBlob "method.rb" Ruby "def foo; end"
    let b = sourceBlob "method.rb" Ruby "def bar(x); end"
    it "returns blobs for valid JSON encoded diff input" $ do
-      putStrLn "step 1"
      blobs <- blobsFromFilePath "test/fixtures/cli/diff.json"
-      putStrLn "done"
      blobs `shouldBe` [Diffing a b]

    it "returns blobs when there's no before" $ do
@ -84,15 +81,15 @@ spec = parallel $ do

    it "throws on blank input" $ do
      h <- openFileForReading "test/fixtures/cli/blank.json"
-      readBlobPairsFromHandle h `shouldThrow` (== ExitFailure 1)
+      readBlobPairsFromHandle h `shouldThrow` jsonException

    it "throws if language field not given" $ do
      h <- openFileForReading "test/fixtures/cli/diff-no-language.json"
-      readBlobsFromHandle h `shouldThrow` (== ExitFailure 1)
+      readBlobsFromHandle h `shouldThrow` jsonException

    it "throws if null on before and after" $ do
      h <- openFileForReading "test/fixtures/cli/diff-null-both-sides.json"
-      readBlobPairsFromHandle h `shouldThrow` (== ExitFailure 1)
+      readBlobPairsFromHandle h `shouldThrow` jsonException

  describe "readBlobsFromHandle" $ do
    it "returns blobs for valid JSON encoded parse input" $ do
@ -103,9 +100,13 @@ spec = parallel $ do

    it "throws on blank input" $ do
      h <- openFileForReading "test/fixtures/cli/blank.json"
-      readBlobsFromHandle h `shouldThrow` (== ExitFailure 1)
+      readBlobsFromHandle h `shouldThrow` jsonException

  where blobsFromFilePath path = do
          h <- openFileForReading path
          blobs <- readBlobPairsFromHandle h
          pure blobs
+
+jsonException :: Selector InvalidJSONException
+jsonException = const True
+
--- a/test/Semantic/Spec.hs
+++ b/test/Semantic/Spec.hs
@ -1,24 +1,28 @@
 module Semantic.Spec (spec) where

+import Control.Exception (fromException)
+import SpecHelpers
+
+import Data.Blob (NoLanguageForBlob (..))
 import Semantic.Api hiding (Blob)
 import Semantic.Git
-import System.Exit
-
-import SpecHelpers

 -- we need some lenses here, oof
 setBlobLanguage :: Language -> Blob -> Blob
 setBlobLanguage lang b = b { blobFile = (blobFile b) { fileLanguage = lang }}

 spec :: Spec
-spec = parallel $ do
+spec = do
  describe "parseBlob" $ do
    it "returns error if given an unknown language (json)" $ do
      output <- fmap runBuilder . runTaskOrDie $ parseTermBuilder TermJSONTree [ setBlobLanguage Unknown methodsBlob ]
      output `shouldBe` "{\"trees\":[{\"path\":\"methods.rb\",\"error\":\"NoLanguageForBlob \\\"methods.rb\\\"\",\"language\":\"Unknown\"}]}\n"

    it "throws if given an unknown language for sexpression output" $ do
-      runTaskOrDie (parseTermBuilder TermSExpression [setBlobLanguage Unknown methodsBlob]) `shouldThrow` (== ExitFailure 1)
+      res <- runTaskWithOptions defaultOptions (parseTermBuilder TermSExpression [setBlobLanguage Unknown methodsBlob])
+      case res of
+        Left exc    -> fromException exc `shouldBe` Just (NoLanguageForBlob "methods.rb")
+        Right _bad  -> fail "Expected parseTermBuilder to fail for an unknown language"

    it "renders with the specified renderer" $ do
      output <- fmap runBuilder . runTaskOrDie $ parseTermBuilder TermSExpression [methodsBlob]
--- a/test/Semantic/Stat/Spec.hs
+++ b/test/Semantic/Stat/Spec.hs
@ -1,4 +1,6 @@
-module Semantic.Stat.Spec (spec) where
+{-# LANGUAGE TemplateHaskell #-}
+
+module Semantic.Stat.Spec (testTree) where

 import Control.Exception
 import Network.Socket hiding (recv)
@ -7,80 +9,94 @@ import Semantic.Telemetry.Stat
 import Semantic.Config
 import System.Environment

-import SpecHelpers
+import Test.Tasty
+import Test.Tasty.HUnit

 withSocketPair :: ((Socket, Socket) -> IO c) -> IO c
 withSocketPair = bracket create release
  where create = socketPair AF_UNIX Datagram defaultProtocol
        release (client, server) = close client >> close server

-withEnvironment :: String -> String -> (() -> IO ()) -> IO ()
-withEnvironment key value = bracket (setEnv key value) (const (unsetEnv key))
+withEnvironment :: String -> String -> IO () -> IO ()
+withEnvironment key value = bracket (setEnv key value) (const (unsetEnv key)) . const

 -- NOTE: These cannot easily run in parallel because we test things like
 -- setting/unsetting the environment.
-spec :: Spec
-spec = do
-  describe "defaultStatsClient" $ do
-    it "sets appropriate defaults" $ do
-      StatsClient{..} <- defaultStatsClient
-      statsClientNamespace `shouldBe` "semantic"
-      statsClientUDPHost `shouldBe` "127.0.0.1"
-      statsClientUDPPort `shouldBe` "28125"
+testTree :: TestTree
+testTree = testCaseSteps "Semantic.Stat.Spec" $ \step -> do
+  step "Sets appropriate defaults"
+  case_sets_appropriate_defaults
+  step "Takes stats addr from environment"
+  case_takes_stats_addr_from_environment
+  step "Handles stats addr with just hostname"
+  case_handles_stats_addr_with_just_hostname
+  step "takes dogstats host from environment"
+  case_takes_dogstats_host_from_environment
+  step "rendering"
+  case_render_counters *> case_render_tags
+  step "stats deliver datagram"
+  case_sendstat_delivers_datagram

-    around (withEnvironment "STATS_ADDR" "localhost:8125") $
-      it "takes STATS_ADDR from environment" $ do
-        StatsClient{..} <- defaultStatsClient
-        statsClientUDPHost `shouldBe` "localhost"
-        statsClientUDPPort `shouldBe` "8125"

-    around (withEnvironment "STATS_ADDR" "localhost") $
-      it "handles STATS_ADDR with just hostname" $ do
-        StatsClient{..} <- defaultStatsClient
-        statsClientUDPHost `shouldBe` "localhost"
-        statsClientUDPPort `shouldBe` "28125"
+case_sets_appropriate_defaults :: Assertion
+case_sets_appropriate_defaults = do
+  StatsClient{..} <- defaultStatsClient
+  statsClientNamespace @?= "semantic"
+  statsClientUDPHost   @?= "127.0.0.1"
+  statsClientUDPPort   @?= "28125"

-    around (withEnvironment "DOGSTATSD_HOST" "0.0.0.0") $
-      it "takes DOGSTATSD_HOST from environment" $ do
-        StatsClient{..} <- defaultStatsClient
-        statsClientUDPHost `shouldBe` "0.0.0.0"
-        statsClientUDPPort `shouldBe` "28125"
+case_takes_stats_addr_from_environment :: Assertion
+case_takes_stats_addr_from_environment =
+  withEnvironment "STATS_ADDR" "localhost:8125" $ do
+    StatsClient{..} <- defaultStatsClient
+    statsClientUDPHost @?= "localhost"
+    statsClientUDPPort @?= "8125"

-  describe "renderDatagram" $ do
-    let key = "app.metric"
+case_handles_stats_addr_with_just_hostname :: Assertion
+case_handles_stats_addr_with_just_hostname =
+  withEnvironment "STATS_ADDR" "localhost" $ do
+    StatsClient{..} <- defaultStatsClient
+    statsClientUDPHost @?= "localhost"
+    statsClientUDPPort @?= "28125"

-    describe "counters" $ do
-      it "renders increment" $
-        renderDatagram "" (increment key []) `shouldBe` "app.metric:1|c"
-      it "renders decrement" $
-        renderDatagram "" (decrement key []) `shouldBe` "app.metric:-1|c"
-      it "renders count" $
-        renderDatagram "" (count key 8 []) `shouldBe` "app.metric:8|c"
+case_takes_dogstats_host_from_environment :: Assertion
+case_takes_dogstats_host_from_environment =
+  withEnvironment "DOGSTATSD_HOST" "0.0.0.0" $ do
+    StatsClient{..} <- defaultStatsClient
+    statsClientUDPHost @?= "0.0.0.0"
+    statsClientUDPPort @?= "28125"

-    it "renders statsClientNamespace" $
-      renderDatagram "pre" (increment key []) `shouldBe` "pre.app.metric:1|c"
+key :: String
+key = "app.metric"

-    describe "tags" $ do
-      it "renders a tag" $ do
-        let inc = increment key [("key", "value")]
-        renderDatagram "" inc `shouldBe` "app.metric:1|c|#key:value"
-      it "renders a tag without value" $ do
-        let inc = increment key [("a", "")]
-        renderDatagram "" inc `shouldBe` "app.metric:1|c|#a"
-      it "renders tags" $ do
-        let inc = increment key [("key", "value"), ("a", "true")]
-        renderDatagram "" inc `shouldBe` "app.metric:1|c|#key:value,a:true"
-      it "renders tags without value" $ do
-        let inc = increment key [("key", "value"), ("a", "")]
-        renderDatagram "" inc `shouldBe` "app.metric:1|c|#key:value,a"
+case_render_counters :: Assertion
+case_render_counters = do
+  renderDatagram "" (increment key []) @?= "app.metric:1|c"
+  renderDatagram "" (decrement key []) @?= "app.metric:-1|c"
+  renderDatagram "" (count key 8 []) @?= "app.metric:8|c"
+  renderDatagram "pre" (increment key []) @?= "pre.app.metric:1|c"

-  describe "sendStat" $
-    it "delivers datagram" $ do
-      client@StatsClient{..} <- defaultStatsClient
-      withSocketPair $ \(clientSoc, serverSoc) -> do
-        sendStat client { statsClientUDPSocket = clientSoc } (increment "app.metric" [])
-        info <- recv serverSoc 1024
-        info `shouldBe` "semantic.app.metric:1|c"
+case_render_tags :: Assertion
+case_render_tags = do
+  let incTag = increment key [("key", "value")]
+  renderDatagram "" incTag @?= "app.metric:1|c|#key:value"
+
+  let tagWithoutValue = increment key [("a", "")]
+  renderDatagram "" tagWithoutValue @?= "app.metric:1|c|#a"
+
+  let tags = increment key [("key", "value"), ("a", "true")]
+  renderDatagram "" tags @?= "app.metric:1|c|#key:value,a:true"
+
+  let tagsWithoutValue = increment key [("key", "value"), ("a", "")]
+  renderDatagram "" tagsWithoutValue @?= "app.metric:1|c|#key:value,a"
+
+case_sendstat_delivers_datagram :: Assertion
+case_sendstat_delivers_datagram = do
+  client@StatsClient{..} <- defaultStatsClient
+  withSocketPair $ \(clientSoc, serverSoc) -> do
+    sendStat client { statsClientUDPSocket = clientSoc } (increment "app.metric" [])
+    info <- recv serverSoc 1024
+    info @?= "semantic.app.metric:1|c"

 -- Defaults are all driven by defaultConfig.
 defaultStatsClient :: IO StatsClient
--- a/test/Spec.hs
+++ b/test/Spec.hs
@ -44,9 +44,10 @@ import Test.Tasty.Hspec as Tasty

 tests :: (?session :: TaskSession) => [TestTree]
 tests =
-  [ Integration.Spec.spec
-  , Semantic.CLI.Spec.spec
+  [ Integration.Spec.testTree
+  , Semantic.CLI.Spec.testTree
  , Data.Source.Spec.testTree
+  , Semantic.Stat.Spec.testTree
  ]

 -- We can't bring this out of the IO monad until we divest
@ -64,40 +65,38 @@ allTests = do
 -- using one or the other.") Instead, create a new TestTree value
 -- in your spec module and add it to the above 'tests' list.
 legacySpecs :: (?session :: TaskSession) => Spec
-legacySpecs = do
-  describe "Semantic.Stat" Semantic.Stat.Spec.spec
-  parallel $ do
-    describe "Analysis.Go" Analysis.Go.Spec.spec
-    describe "Analysis.PHP" Analysis.PHP.Spec.spec
-    describe "Analysis.Python" Analysis.Python.Spec.spec
-    describe "Analysis.Ruby" Analysis.Ruby.Spec.spec
-    describe "Analysis.TypeScript" Analysis.TypeScript.Spec.spec
-    describe "Assigning.Assignment" Assigning.Assignment.Spec.spec
-    describe "Control.Abstract.Evaluator" Control.Abstract.Evaluator.Spec.spec
-    describe "Data.Diff" Data.Diff.Spec.spec
-    describe "Data.Graph" Data.Graph.Spec.spec
-    describe "Data.Abstract.Path" Data.Abstract.Path.Spec.spec
-    describe "Data.Abstract.Name" Data.Abstract.Name.Spec.spec
-    describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec
-    describe "Data.Range" Data.Range.Spec.spec
-    describe "Data.Scientific" Data.Scientific.Spec.spec
-    describe "Data.Semigroup.App" Data.Semigroup.App.Spec.spec
-    describe "Data.Source" Data.Source.Spec.spec
-    describe "Data.Term" Data.Term.Spec.spec
-    describe "Diffing.Algorithm.RWS" Diffing.Algorithm.RWS.Spec.spec
-    describe "Diffing.Algorithm.SES" Diffing.Algorithm.SES.Spec.spec
-    describe "Diffing.Interpreter" Diffing.Interpreter.Spec.spec
-    describe "Graphing.Calls" Graphing.Calls.Spec.spec
-    describe "Numeric" Numeric.Spec.spec
-    describe "Rendering.TOC" Rendering.TOC.Spec.spec
-    describe "Reprinting.Spec" Reprinting.Spec.spec
-    describe "Rewriting.Go" Rewriting.Go.Spec.spec
-    describe "Rewriting.JSON" Rewriting.JSON.Spec.spec
-    describe "Rewriting.Python" Rewriting.Python.Spec.spec
-    describe "Tags.Spec" Tags.Spec.spec
-    describe "Semantic" Semantic.Spec.spec
-    describe "Semantic.IO" Semantic.IO.Spec.spec
-    describe "Parsing" Parsing.Spec.spec
+legacySpecs = parallel $ do
+  describe "Analysis.Go" Analysis.Go.Spec.spec
+  describe "Analysis.PHP" Analysis.PHP.Spec.spec
+  describe "Analysis.Python" Analysis.Python.Spec.spec
+  describe "Analysis.Ruby" Analysis.Ruby.Spec.spec
+  describe "Analysis.TypeScript" Analysis.TypeScript.Spec.spec
+  describe "Assigning.Assignment" Assigning.Assignment.Spec.spec
+  describe "Control.Abstract.Evaluator" Control.Abstract.Evaluator.Spec.spec
+  describe "Data.Diff" Data.Diff.Spec.spec
+  describe "Data.Graph" Data.Graph.Spec.spec
+  describe "Data.Abstract.Path" Data.Abstract.Path.Spec.spec
+  describe "Data.Abstract.Name" Data.Abstract.Name.Spec.spec
+  describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec
+  describe "Data.Range" Data.Range.Spec.spec
+  describe "Data.Scientific" Data.Scientific.Spec.spec
+  describe "Data.Semigroup.App" Data.Semigroup.App.Spec.spec
+  describe "Data.Source" Data.Source.Spec.spec
+  describe "Data.Term" Data.Term.Spec.spec
+  describe "Diffing.Algorithm.RWS" Diffing.Algorithm.RWS.Spec.spec
+  describe "Diffing.Algorithm.SES" Diffing.Algorithm.SES.Spec.spec
+  describe "Diffing.Interpreter" Diffing.Interpreter.Spec.spec
+  describe "Graphing.Calls" Graphing.Calls.Spec.spec
+  describe "Numeric" Numeric.Spec.spec
+  describe "Rendering.TOC" Rendering.TOC.Spec.spec
+  describe "Reprinting.Spec" Reprinting.Spec.spec
+  describe "Rewriting.Go" Rewriting.Go.Spec.spec
+  describe "Rewriting.JSON" Rewriting.JSON.Spec.spec
+  describe "Rewriting.Python" Rewriting.Python.Spec.spec
+  describe "Tags.Spec" Tags.Spec.spec
+  describe "Semantic" Semantic.Spec.spec
+  describe "Semantic.IO" Semantic.IO.Spec.spec
+  describe "Parsing" Parsing.Spec.spec


 main :: IO ()
--- a/test/Tags/Spec.hs
+++ b/test/Tags/Spec.hs
@ -6,7 +6,7 @@ import Tags.Tagging


 spec :: Spec
-spec = parallel $ do
+spec = do
  describe "go" $ do
    it "produces tags for functions with docs" $ do
      (blob, tree) <- parseTestFile goParser "test/fixtures/go/tags/simple_functions.go"
--- a/test/fixtures/cli/diff-tree.toc.protobuf.bin
+++ b/test/fixtures/cli/diff-tree.toc.protobuf.bin
@ -0,0 +1,5 @@
+
+<EFBFBD>
+ftest/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rbRuby
+Methodbar
+ 
--- a/test/fixtures/cli/parse-tree.symbols.protobuf.bin
+++ b/test/fixtures/cli/parse-tree.symbols.protobuf.bin
@ -0,0 +1,5 @@
+
+_
+1test/fixtures/ruby/corpus/method-declaration.A.rbRuby$
+fooMethoddef foo"
+