Merge branch 'master' into update-php-assignment

.gitattributes

@@ -2,3 +2,4 @@
 test/fixtures linguist-vendored
 test/repos linguist-vendored
 vendor linguist-vendored
+*.protobuf.bin binary

semantic.cabal

@@ -64,6 +64,7 @@ common dependencies
                      , scientific ^>= 0.3.6.2
                      , safe-exceptions ^>= 0.1.7.0
                      , semilattices ^>= 0.0.0.3
+                     , shelly >= 1.5 && <2
                      , text ^>= 1.2.3.1
                      , these >= 0.7 && <1
                      , unix ^>= 2.7.2.2
@@ -270,6 +271,7 @@ library
                      -- Serialization
                      , Serializing.Format
                      , Serializing.SExpression
+                     , Serializing.SExpression.Precise
                      , Tags.Taggable
                      , Tags.Tagging
                      -- Custom Prelude
@@ -307,7 +309,6 @@ library
                      , 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
@@ -393,6 +394,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

src/Data/Blob.hs

@@ -5,6 +5,7 @@ module Data.Blob
 , Blob(..)
 , Blobs(..)
 , blobLanguage
+, NoLanguageForBlob (..)
 , blobPath
 , makeBlob
 , decodeBlobs

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

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)

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)

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"]

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"]

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"]

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"]

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"]

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 []])

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))

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 () ())

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" $

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.

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

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 ())

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" $

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"))

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

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

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` []

test/Reprinting/Spec.hs

@@ -28,7 +28,7 @@ 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

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

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
 

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

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"

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
+

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]

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

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 ()

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"

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
+

 

test/fixtures/cli/parse-tree.symbols.protobuf.bin

@@ -0,0 +1,5 @@
+
+_
+1test/fixtures/ruby/corpus/method-declaration.A.rbRuby$
+fooMethoddef foo"
+