Quiet debug spew in specs.

This console barf makes reading though backscrolls unpleasant. Using
Shelly rather than an abomination of a `system` call and adding a
helper function to parse files quietly improved the situation greatly.

This also contains changes to Util that make the file significantly
easier to navigate, thanks to the power of `PartialTyepSignatures`.

Fixes #140.

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
@@ -307,7 +308,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

src/Data/Blob.hs

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

src/Semantic/Util.hs

@@ -1,5 +1,6 @@
-{-# LANGUAGE CPP, ConstraintKinds, Rank2Types, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
+{-# LANGUAGE CPP, ConstraintKinds, PartialTypeSignatures, Rank2Types, ScopedTypeVariables, TypeFamilies,
-{-# OPTIONS_GHC -Wno-missing-signatures -O0 #-}
+             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
+justEvaluating :: Evaluator term Precise (Value term Precise) _ result
-
+               -> IO ( Heap Precise Precise (Value term Precise),
--- The type signatures in these functions are pretty gnarly, but these functions
+                     ( ScopeGraph Precise
--- are hit sufficiently often in the CLI and test suite so as to merit avoiding
+                     , Either (SomeError (Sum _)) result)
--- 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
   = runM
   . runEvaluator
@@ -128,75 +72,27 @@ justEvaluating
   . runAddressError
   . runValueError
 
-type FileEvaluator syntax =
+type FileEvaluator err syntax =
   [FilePath]
   -> IO
-       (Heap
+       ( Heap Precise Precise (Value (Quieterm (Sum syntax) Location) Precise),
-          Precise
+       ( ScopeGraph Precise
-          Precise
+       , Either (SomeError (Sum err))
-          (Value
+                (ModuleTable (Module (ModuleResult Precise (Value (Quieterm (Sum syntax) Location) Precise))))))
-             (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))))))
 
-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 :: FileEvaluator _ Language.Python.Assignment.Syntax
-evalPythonProject     = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.Python)     pythonParser
+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)

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

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/IO/Spec.hs

@@ -7,13 +7,13 @@ 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
@@ -22,16 +22,16 @@ spec = parallel $ do
     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
+        shelly $ silently $ do
-                       , "git init"
+          cd (fromString dir)
-                       , "touch foo.py bar.rb"
+          let git = run_ "git"
-                       , "git add foo.py bar.rb"
+          git ["init"]
-                       , "git config user.name 'Test'"
+          run_ "touch" ["foo.py", "bar.rb"]
-                       , "git config user.email 'test@test.test'"
+          git ["add", "foo.py", "bar.rb"]
-                       , "git commit -am 'test commit'"
+          git ["config", "user.name", "'Test'"]
-                       ]
+          git ["config", "user.email", "'test@test.test'"]
-        exit <- system (intercalate " && " commands)
+          git ["commit", "-am", "'test commit'"]
-        when (exit /= ExitSuccess) (fail ("Couldn't run git properly in dir " <> dir))
+
         readBlobsFromGitRepo (dir </> ".git") (Git.OID "HEAD") []
       let files = sortOn fileLanguage (blobFile <$> blobs)
       files `shouldBe` [ File "foo.py" Python

test/Semantic/Spec.hs

@@ -1,10 +1,11 @@
 module Semantic.Spec (spec) where
 
+import Data.Either
+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
@@ -18,7 +19,8 @@ spec = parallel $ do
       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])
+      void res `shouldBe` Left (NoLanguageForBlob "methods.rb")
 
     it "renders with the specified renderer" $ do
       output <- fmap runBuilder . runTaskOrDie $ parseTermBuilder TermSExpression [methodsBlob]