From ce04fa8f12f11b05f05338d0d02fb79bbb0adab0 Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Fri, 1 Feb 2019 15:04:23 -0800
Subject: [PATCH 1/2] Refactor runTask

---
 src/Semantic/CLI.hs              | 10 ++++---
 src/Semantic/Config.hs           |  8 ++---
 src/Semantic/Task.hs             | 51 ++++++++++++++------------------
 src/Semantic/Util.hs             | 51 +++++++++++++++++---------------
 test/Analysis/Go/Spec.hs         |  6 ++--
 test/Analysis/PHP/Spec.hs        |  6 ++--
 test/Analysis/Python/Spec.hs     |  6 ++--
 test/Analysis/Ruby/Spec.hs       |  6 ++--
 test/Analysis/TypeScript/Spec.hs |  6 ++--
 test/Examples.hs                 |  7 ++---
 test/Graphing/Calls/Spec.hs      |  2 +-
 test/Integration/Spec.hs         | 10 +++----
 test/Rendering/TOC/Spec.hs       | 24 +++++++--------
 test/Reprinting/Spec.hs          |  4 +--
 test/Semantic/CLI/Spec.hs        |  4 +--
 test/Semantic/Spec.hs            |  6 ++--
 test/Spec.hs                     |  9 +++---
 test/SpecHelpers.hs              | 18 +++++++----
 18 files changed, 118 insertions(+), 116 deletions(-)

diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index 4b2b584b5..10a3ee843 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -15,8 +15,9 @@ import qualified Semantic.AST as AST
 import           Semantic.Config
 import qualified Semantic.Graph as Graph
 import qualified Semantic.Task as Task
-import           Semantic.Task.Files
 import qualified Semantic.Telemetry.Log as Log
+import           Semantic.Task.Files
+import           Semantic.Telemetry
 import           Semantic.Version
 import           System.Exit (die)
 import           System.FilePath
@@ -26,8 +27,9 @@ import           Text.Read
 main :: IO ()
 main = do
   (options, task) <- customExecParser (prefs showHelpOnEmpty) arguments
-  res <- Task.withOptions options $ \ config logger statter ->
-    Task.runTaskWithConfig config { configSHA = Just buildSHA } logger statter task
+  config <- defaultConfig options
+  res <- withTelemetry config $ \ (TelemetryQueues logger statter _) ->
+    Task.runTask (Task.TaskSession config "-" logger statter) task
   either (die . displayException) pure res
 
 -- | A parser for the application's command-line arguments.
@@ -46,7 +48,7 @@ optionsParser = do
                       (long "log-level" <> value (Just Log.Warning) <> help "Log messages at or above this level, or disable logging entirely.")
   failOnWarning <- switch (long "fail-on-warning" <> help "Fail on assignment warnings.")
   failOnParseError <- switch (long "fail-on-parse-error" <> help "Fail on tree-sitter parse errors.")
-  pure $ Options logLevel Nothing failOnWarning failOnParseError
+  pure $ Options logLevel failOnWarning failOnParseError
 
 argumentsParser :: Parser (Task.TaskEff ())
 argumentsParser = do
diff --git a/src/Semantic/Config.hs b/src/Semantic/Config.hs
index cdaf8a238..b375ab39d 100644
--- a/src/Semantic/Config.hs
+++ b/src/Semantic/Config.hs
@@ -52,16 +52,15 @@ data Config
 data Options
   = Options
   { optionsLogLevel         :: Maybe Level   -- ^ What level of messages to log. 'Nothing' disables logging.
-  , optionsRequestID        :: Maybe String  -- ^ Optional request id for tracing across systems.
   , optionsFailOnWarning    :: Bool          -- ^ Should semantic fail fast on assignment warnings (for testing)
   , optionsFailOnParseError :: Bool          -- ^ Should semantic fail fast on tree-sitter parser errors (for testing)
   }
 
 defaultOptions :: Options
-defaultOptions = Options (Just Warning) Nothing False False
+defaultOptions = Options (Just Warning) False False
 
 debugOptions :: Options
-debugOptions = Options (Just Debug) Nothing False False
+debugOptions = Options (Just Debug) False False
 
 defaultConfig :: Options -> IO Config
 defaultConfig options@Options{..} = do
@@ -111,8 +110,7 @@ logOptionsFromConfig Config{..} = LogOptions
                    , ("hostname", configHostName)
                    , ("sha", fromMaybe "development" configSHA)
                    ]
-                   <> [("request_id", x) | x <- toList (optionsRequestID configOptions) ]
-          _ -> []
+          _     -> []
 
 
 withLoggerFromConfig :: Config -> (LogQueue -> IO c) -> IO c
diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs
index eae9d00cf..033a1e37e 100644
--- a/src/Semantic/Task.hs
+++ b/src/Semantic/Task.hs
@@ -32,6 +32,7 @@ module Semantic.Task
 , distributeFoldMap
 -- * Configuration
 , debugOptions
+, defaultOptions
 , defaultConfig
 , terminalFormatter
 , logfmtFormatter
@@ -39,7 +40,7 @@ module Semantic.Task
 , runTask
 , runTaskWithOptions
 , withOptions
-, runTaskWithConfig
+, TaskSession(..)
 , runTraceInTelemetry
 , runTaskF
 -- * Exceptions
@@ -91,7 +92,6 @@ import           Semantic.Timeout
 import           Semantic.Resolution
 import           Semantic.Telemetry
 import           Serializing.Format hiding (Options)
-import           System.Exit (die)
 
 -- | A high-level task producing some result, e.g. parsing, diffing, rendering. 'Task's can also specify explicit concurrency via 'distribute', 'distributeFor', and 'distributeFoldMap'
 type TaskEff
@@ -150,33 +150,17 @@ serialize :: (Member Task sig, Carrier sig m)
           -> m Builder
 serialize format input = send (Serialize format input ret)
 
--- | Execute a 'Task' with the 'defaultOptions', yielding its result value in 'IO'.
---
--- > runTask = runTaskWithOptions defaultOptions
-runTask :: TaskEff a
-        -> IO a
-runTask = runTaskWithOptions defaultOptions
-
--- | Execute a 'TaskEff' with the passed 'Options', yielding its result value in 'IO'.
-runTaskWithOptions :: Options
-                   -> TaskEff a
-                   -> IO a
-runTaskWithOptions opts task = withOptions opts (\ config logger statter -> runTaskWithConfig config logger statter task) >>= either (die . displayException) pure
-
-withOptions :: Options
-            -> (Config -> LogQueue -> StatQueue -> IO a)
-            -> IO a
-withOptions options with = do
-  config <- defaultConfig options
-  withTelemetry config (\ (TelemetryQueues logger statter _) -> with config logger statter)
+data TaskSession
+  = TaskSession
+  { config :: Config
+  , requestID :: String
+  , logger :: LogQueue
+  , statter :: StatQueue
+  }
 
 -- | Execute a 'TaskEff' yielding its result value in 'IO'.
-runTaskWithConfig :: Config
-                  -> LogQueue
-                  -> StatQueue
-                  -> TaskEff a
-                  -> IO (Either SomeException a)
-runTaskWithConfig options logger statter task = do
+runTask :: TaskSession -> TaskEff a -> IO (Either SomeException a)
+runTask TaskSession{..} task = do
   (result, stat) <- withTiming "run" [] $ do
     let run :: TaskEff a -> IO (Either SomeException a)
         run
@@ -187,7 +171,7 @@ runTaskWithConfig options logger statter task = do
           . runError
           . runTelemetry logger statter
           . runTraceInTelemetry
-          . runReader options
+          . runReader config
           . Files.runFiles
           . runResolution
           . runTaskF
@@ -195,6 +179,17 @@ runTaskWithConfig options logger statter task = do
   queueStat statter stat
   pure result
 
+-- | Execute a 'TaskEff' yielding its result value in 'IO' using all default options and configuration.
+runTaskWithOptions :: Options -> TaskEff a -> IO (Either SomeException a)
+runTaskWithOptions options task = withOptions options $ \ config logger statter ->
+  runTask (TaskSession config "-" logger statter) task
+
+-- | Yield config and telemetry queues for options.
+withOptions :: Options -> (Config -> LogQueue -> StatQueue -> IO a) -> IO a
+withOptions options with = do
+  config <- defaultConfig options
+  withTelemetry config (\ (TelemetryQueues logger statter _) -> with config logger statter)
+
 runTraceInTelemetry :: (Member Telemetry sig, Carrier sig m, Monad m)
                     => Eff (TraceInTelemetryC m) a
                     -> m a
diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs
index 7901777df..e482749a7 100644
--- a/src/Semantic/Util.hs
+++ b/src/Semantic/Util.hs
@@ -33,7 +33,6 @@ import           Semantic.Analysis
 import           Semantic.Config
 import           Semantic.Graph
 import           Semantic.Task
-import           Semantic.Telemetry (LogQueue, StatQueue)
 import           System.Exit (die)
 import           System.FilePath.Posix (takeDirectory)
 
@@ -83,7 +82,7 @@ evalTypeScriptProject = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Lang
 typecheckGoFile = checking <=< evaluateProjectWithCaching (Proxy :: Proxy 'Language.Go) goParser
 typecheckRubyFile = checking <=< evaluateProjectWithCaching (Proxy :: Proxy 'Language.Ruby) rubyParser
 
-callGraphProject parser proxy opts paths = runTaskWithOptions opts $ do
+callGraphProject parser proxy paths = runTask' $ do
   blobs <- catMaybes <$> traverse readBlobFromFile (flip File (Language.reflect proxy) <$> paths)
   package <- fmap snd <$> parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs (Language.reflect proxy) [])
   modules <- topologicalSort <$> runImportGraphToModules proxy package
@@ -92,28 +91,29 @@ callGraphProject parser proxy opts paths = runTaskWithOptions opts $ do
 
 evaluatePythonProject = justEvaluating <=< evaluatePythonProjects (Proxy @'Language.Python) pythonParser Language.Python
 
-callGraphRubyProject = callGraphProject rubyParser (Proxy @'Language.Ruby) debugOptions
+callGraphRubyProject = callGraphProject rubyParser (Proxy @'Language.Ruby)
+
+evaluateProject proxy parser paths = withOptions debugOptions $ \ config logger statter ->
+  evaluateProject' (TaskSession config "-" logger statter) proxy parser paths
 
 -- Evaluate a project consisting of the listed paths.
-evaluateProject proxy parser paths = withOptions debugOptions $ \ config logger statter ->
-  evaluateProject' (TaskConfig config logger statter) proxy parser paths
+-- TODO: This is used by our specs and should be moved into SpecHelpers.hs
+evaluateProject' session proxy parser paths = do
+  res <- runTask session $ do
+    blobs <- catMaybes <$> traverse readBlobFromFile (flip File (Language.reflect proxy) <$> paths)
+    package <- fmap (quieterm . snd) <$> parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs (Language.reflect proxy) [])
+    modules <- topologicalSort <$> runImportGraphToModules proxy package
+    trace $ "evaluating with load order: " <> show (map (modulePath . moduleInfo) modules)
+    pure (id @(Evaluator _ Precise (Value _ Precise) _ _)
+         (runModuleTable
+         (runModules (ModuleTable.modulePaths (packageModules package))
+         (raiseHandler (runReader (packageInfo package))
+         (raiseHandler (evalState (lowerBound @Span))
+         (raiseHandler (runReader (lowerBound @Span))
+         (evaluate proxy (runDomainEffects (evalTerm withTermSpans)) modules)))))))
+  either (die . displayException) pure res
 
-data TaskConfig = TaskConfig Config LogQueue StatQueue
-
-evaluateProject' (TaskConfig config logger statter) proxy parser paths = either (die . displayException) pure <=< runTaskWithConfig config logger statter $ do
-  blobs <- catMaybes <$> traverse readBlobFromFile (flip File (Language.reflect proxy) <$> paths)
-  package <- fmap (quieterm . snd) <$> parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs (Language.reflect proxy) [])
-  modules <- topologicalSort <$> runImportGraphToModules proxy package
-  trace $ "evaluating with load order: " <> show (map (modulePath . moduleInfo) modules)
-  pure (id @(Evaluator _ Precise (Value _ Precise) _ _)
-       (runModuleTable
-       (runModules (ModuleTable.modulePaths (packageModules package))
-       (raiseHandler (runReader (packageInfo package))
-       (raiseHandler (evalState (lowerBound @Span))
-       (raiseHandler (runReader (lowerBound @Span))
-       (evaluate proxy (runDomainEffects (evalTerm withTermSpans)) modules)))))))
-
-evaluatePythonProjects proxy parser lang path = runTaskWithOptions debugOptions $ do
+evaluatePythonProjects proxy parser lang path = runTask' $ do
   project <- readProject Nothing path lang []
   package <- fmap quieterm <$> parsePythonPackage parser project
   modules <- topologicalSort <$> runImportGraphToModules proxy package
@@ -127,7 +127,7 @@ evaluatePythonProjects proxy parser lang path = runTaskWithOptions debugOptions
        (evaluate proxy (runDomainEffects (evalTerm withTermSpans)) modules)))))))
 
 
-evaluateProjectWithCaching proxy parser path = runTaskWithOptions debugOptions $ do
+evaluateProjectWithCaching proxy parser path = runTask' $ do
   project <- readProject Nothing path (Language.reflect proxy) []
   package <- fmap (quieterm . snd) <$> parsePackage parser project
   modules <- topologicalSort <$> runImportGraphToModules proxy package
@@ -141,10 +141,13 @@ evaluateProjectWithCaching proxy parser path = runTaskWithOptions debugOptions $
 
 
 parseFile :: Parser term -> FilePath -> IO term
-parseFile parser = runTask . (parse parser <=< readBlob . file)
+parseFile parser = runTask' . (parse parser <=< readBlob . file)
 
 blob :: FilePath -> IO Blob
-blob = runTask . readBlob . file
+blob = runTask' . readBlob . file
+
+runTask' :: TaskEff a -> IO a
+runTask' task = runTaskWithOptions debugOptions 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)
diff --git a/test/Analysis/Go/Spec.hs b/test/Analysis/Go/Spec.hs
index 7c3b8fe80..9bdb9f7a0 100644
--- a/test/Analysis/Go/Spec.hs
+++ b/test/Analysis/Go/Spec.hs
@@ -7,8 +7,8 @@ import qualified Language.Go.Assignment as Go
 import SpecHelpers
 
 
-spec :: TaskConfig -> Spec
-spec config = parallel $ do
+spec :: TaskSession -> Spec
+spec session = parallel $ 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"]
@@ -33,4 +33,4 @@ spec config = parallel $ do
   where
     fixtures = "test/fixtures/go/analysis/"
     evaluate = evalGoProject . map (fixtures <>)
-    evalGoProject = testEvaluating <=< evaluateProject' config (Proxy :: Proxy 'Language.Go) goParser
+    evalGoProject = testEvaluating <=< evaluateProject' session (Proxy :: Proxy 'Language.Go) goParser
diff --git a/test/Analysis/PHP/Spec.hs b/test/Analysis/PHP/Spec.hs
index 0ec2a272d..2069e50dd 100644
--- a/test/Analysis/PHP/Spec.hs
+++ b/test/Analysis/PHP/Spec.hs
@@ -9,8 +9,8 @@ import qualified Language.PHP.Assignment as PHP
 import           SpecHelpers
 
 
-spec :: TaskConfig -> Spec
-spec config = parallel $ do
+spec :: TaskSession -> Spec
+spec session = parallel $ do
   describe "PHP" $ do
     xit "evaluates include and require" $ do
       (scopeGraph, (heap, res)) <- evaluate ["main.php", "foo.php", "bar.php"]
@@ -46,4 +46,4 @@ spec config = parallel $ do
   where
     fixtures = "test/fixtures/php/analysis/"
     evaluate = evalPHPProject . map (fixtures <>)
-    evalPHPProject = testEvaluating <=< evaluateProject' config (Proxy :: Proxy 'Language.PHP) phpParser
+    evalPHPProject = testEvaluating <=< evaluateProject' session (Proxy :: Proxy 'Language.PHP) phpParser
diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs
index af47b0482..a87e9e8bf 100644
--- a/test/Analysis/Python/Spec.hs
+++ b/test/Analysis/Python/Spec.hs
@@ -9,8 +9,8 @@ import qualified Data.Language as Language
 import SpecHelpers
 
 
-spec :: TaskConfig -> Spec
-spec config = parallel $ do
+spec :: TaskSession -> Spec
+spec session = parallel $ do
   describe "Python" $ do
     it "imports" $ do
       (scopeGraph, (heap, res)) <- evaluate ["main.py", "a.py", "b/__init__.py", "b/c.py"]
@@ -72,4 +72,4 @@ spec config = parallel $ do
   where
     fixtures = "test/fixtures/python/analysis/"
     evaluate = evalPythonProject . map (fixtures <>)
-    evalPythonProject = testEvaluating <=< evaluateProject' config (Proxy :: Proxy 'Language.Python) pythonParser
+    evalPythonProject = testEvaluating <=< evaluateProject' session (Proxy :: Proxy 'Language.Python) pythonParser
diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs
index f742db17e..bda040a91 100644
--- a/test/Analysis/Ruby/Spec.hs
+++ b/test/Analysis/Ruby/Spec.hs
@@ -14,8 +14,8 @@ import           Data.Sum
 import SpecHelpers
 
 
-spec :: TaskConfig -> Spec
-spec config = parallel $ do
+spec :: TaskSession -> Spec
+spec session = parallel $ do
   describe "Ruby" $ do
     it "evaluates require_relative" $ do
       (scopeGraph, (heap, res)) <- evaluate ["main.rb", "foo.rb"]
@@ -101,4 +101,4 @@ spec config = parallel $ do
   where
     fixtures = "test/fixtures/ruby/analysis/"
     evaluate = evalRubyProject . map (fixtures <>)
-    evalRubyProject = testEvaluating <=< evaluateProject' config (Proxy :: Proxy 'Language.Ruby) rubyParser
+    evalRubyProject = testEvaluating <=< evaluateProject' session (Proxy :: Proxy 'Language.Ruby) rubyParser
diff --git a/test/Analysis/TypeScript/Spec.hs b/test/Analysis/TypeScript/Spec.hs
index 745654fe8..5e80943d8 100644
--- a/test/Analysis/TypeScript/Spec.hs
+++ b/test/Analysis/TypeScript/Spec.hs
@@ -24,8 +24,8 @@ import           Data.Text (pack)
 import qualified Language.TypeScript.Assignment as TypeScript
 import           SpecHelpers
 
-spec :: TaskConfig -> Spec
-spec config = parallel $ do
+spec :: TaskSession -> Spec
+spec session = parallel $ do
   describe "TypeScript" $ do
     it "qualified export from" $ do
       (scopeGraph, (heap, res)) <- evaluate ["main6.ts", "baz.ts", "foo.ts"]
@@ -184,7 +184,7 @@ spec config = parallel $ do
   where
     fixtures = "test/fixtures/typescript/analysis/"
     evaluate = evalTypeScriptProject . map (fixtures <>)
-    evalTypeScriptProject = testEvaluating <=< (evaluateProject' config (Proxy :: Proxy 'Language.TypeScript) typescriptParser)
+    evalTypeScriptProject = testEvaluating <=< (evaluateProject' session (Proxy :: Proxy 'Language.TypeScript) typescriptParser)
 
 type TypeScriptTerm = Quieterm (Sum TypeScript.Syntax) Location
 type TypeScriptEvalError = BaseError (EvalError TypeScriptTerm Precise (Concrete.Value TypeScriptTerm Precise))
diff --git a/test/Examples.hs b/test/Examples.hs
index 8dc8ed765..0fc07c6db 100644
--- a/test/Examples.hs
+++ b/test/Examples.hs
@@ -22,7 +22,6 @@ import           Semantic.Config (Config (..), Options (..), defaultOptions)
 import qualified Semantic.IO as IO
 import           Semantic.Task
 import           Semantic.Task.Files
-import           Semantic.Util (TaskConfig (..))
 import           System.Directory
 import           System.Exit (die)
 import           System.FilePath.Glob
@@ -33,7 +32,7 @@ import           Test.Hspec
 
 main :: IO ()
 main = withOptions opts $ \ config logger statter -> hspec . parallel $ do
-  let args = TaskConfig config logger statter
+  let args = TaskSession config "-" logger statter
 
   runIO setupExampleRepos
 
@@ -42,11 +41,11 @@ main = withOptions opts $ \ config logger statter -> hspec . parallel $ do
     parallel . describe languageName $ parseExamples args lang tsDir
 
   where
-    parseExamples (TaskConfig config logger statter) LanguageExample{..} tsDir = do
+    parseExamples session LanguageExample{..} tsDir = do
       knownFailures <- runIO $ knownFailuresForPath tsDir languageKnownFailuresTxt
       files <- runIO $ globDir1 (compile ("**/*" <> languageExtension)) (tsDir </> languageExampleDir)
       for_ files $ \file -> it file $ do
-        res <- runTaskWithConfig config logger statter (parseFilePath file)
+        res <- runTask session (parseFilePath file)
         case res of
           Left (SomeException e) -> case cast e of
             -- We have a number of known assignment timeouts, consider these pending specs instead of failing the build.
diff --git a/test/Graphing/Calls/Spec.hs b/test/Graphing/Calls/Spec.hs
index 36b7bfa62..4fee9ed62 100644
--- a/test/Graphing/Calls/Spec.hs
+++ b/test/Graphing/Calls/Spec.hs
@@ -18,7 +18,7 @@ import           Semantic.Config (defaultOptions)
 import           Semantic.Graph
 import           Semantic.IO
 
-callGraphPythonProject paths = runTask $ do
+callGraphPythonProject paths = runTaskOrDie $ do
   let proxy = Proxy @'Language.Python
   let lang = Language.Python
   blobs <- catMaybes <$> traverse readBlobFromFile (flip File lang <$> paths)
diff --git a/test/Integration/Spec.hs b/test/Integration/Spec.hs
index 12a349c9d..55e2255c1 100644
--- a/test/Integration/Spec.hs
+++ b/test/Integration/Spec.hs
@@ -11,7 +11,7 @@ import SpecHelpers
 languages :: [FilePath]
 languages = ["go", "javascript", "json", "python", "ruby", "typescript"]
 
-spec :: TaskConfig -> Spec
+spec :: TaskSession -> Spec
 spec config = parallel $ do
   for_ languages $ \language -> do
     let dir = "test/fixtures" </> language </> "corpus"
@@ -81,13 +81,13 @@ examples directory = do
 normalizeName :: FilePath -> FilePath
 normalizeName path = dropExtension $ dropExtension path
 
-testParse :: TaskConfig -> FilePath -> FilePath -> Expectation
-testParse config path expectedOutput = do
-  actual <- verbatim <$> parseFilePath config path
+testParse :: TaskSession -> FilePath -> FilePath -> Expectation
+testParse session path expectedOutput = do
+  actual <- verbatim <$> parseFilePath session path
   expected <- verbatim <$> B.readFile expectedOutput
   actual `shouldBe` expected
 
-testDiff :: TaskConfig -> Both FilePath -> FilePath -> Expectation
+testDiff :: TaskSession -> Both FilePath -> FilePath -> Expectation
 testDiff config paths expectedOutput = do
   actual <- verbatim <$> diffFilePaths config paths
   expected <- verbatim <$> B.readFile expectedOutput
diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs
index 40a7200c3..3b3b29a4d 100644
--- a/test/Rendering/TOC/Spec.hs
+++ b/test/Rendering/TOC/Spec.hs
@@ -57,7 +57,7 @@ spec = parallel $ do
 
     it "summarizes changed methods" $ do
       sourceBlobs <- blobsForPaths (Both "ruby/toc/methods.A.rb" "ruby/toc/methods.B.rb")
-      diff <- runTask $ diffWithParser rubyParser sourceBlobs
+      diff <- runTaskOrDie $ diffWithParser rubyParser sourceBlobs
       diffTOC diff `shouldBe`
         [ TOCSummary "Method" "self.foo" (Span (Pos 1 1) (Pos 2 4)) "added"
         , TOCSummary "Method" "bar" (Span (Pos 4 1) (Pos 6 4)) "modified"
@@ -66,7 +66,7 @@ spec = parallel $ do
 
     xit "summarizes changed classes" $ do
       sourceBlobs <- blobsForPaths (Both "ruby/toc/classes.A.rb" "ruby/toc/classes.B.rb")
-      diff <- runTask $ diffWithParser rubyParser sourceBlobs
+      diff <- runTaskOrDie $ diffWithParser rubyParser sourceBlobs
       diffTOC diff `shouldBe`
         [ TOCSummary "Class" "Baz" (Span (Pos 1 1) (Pos 2 4)) "removed"
         , TOCSummary "Class" "Foo" (Span (Pos 1 1) (Pos 3 4)) "modified"
@@ -75,37 +75,37 @@ spec = parallel $ do
 
     it "dedupes changes in same parent method" $ do
       sourceBlobs <- blobsForPaths (Both "javascript/toc/duplicate-parent.A.js" "javascript/toc/duplicate-parent.B.js")
-      diff <- runTask $ diffWithParser typescriptParser sourceBlobs
+      diff <- runTaskOrDie $ diffWithParser typescriptParser sourceBlobs
       diffTOC diff `shouldBe`
         [ TOCSummary "Function" "myFunction" (Span (Pos 1 1) (Pos 6 2)) "modified" ]
 
     it "dedupes similar methods" $ do
       sourceBlobs <- blobsForPaths (Both "javascript/toc/erroneous-duplicate-method.A.js" "javascript/toc/erroneous-duplicate-method.B.js")
-      diff <- runTask $ diffWithParser typescriptParser sourceBlobs
+      diff <- runTaskOrDie $ diffWithParser typescriptParser sourceBlobs
       diffTOC diff `shouldBe`
         [ TOCSummary "Function" "performHealthCheck" (Span (Pos 8 1) (Pos 29 2)) "modified" ]
 
     it "summarizes Go methods with receivers with special formatting" $ do
       sourceBlobs <- blobsForPaths (Both "go/toc/method-with-receiver.A.go" "go/toc/method-with-receiver.B.go")
-      diff <- runTask $ diffWithParser goParser sourceBlobs
+      diff <- runTaskOrDie $ diffWithParser goParser sourceBlobs
       diffTOC diff `shouldBe`
         [ TOCSummary "Method" "(*apiClient) CheckAuth" (Span (Pos 3 1) (Pos 3 101)) "added" ]
 
     it "summarizes Ruby methods that start with two identifiers" $ do
       sourceBlobs <- blobsForPaths (Both "ruby/toc/method-starts-with-two-identifiers.A.rb" "ruby/toc/method-starts-with-two-identifiers.B.rb")
-      diff <- runTask $ diffWithParser rubyParser sourceBlobs
+      diff <- runTaskOrDie $ diffWithParser rubyParser sourceBlobs
       diffTOC diff `shouldBe`
         [ TOCSummary "Method" "foo" (Span (Pos 1 1) (Pos 4 4)) "modified" ]
 
     it "handles unicode characters in file" $ do
       sourceBlobs <- blobsForPaths (Both "ruby/toc/unicode.A.rb" "ruby/toc/unicode.B.rb")
-      diff <- runTask $ diffWithParser rubyParser sourceBlobs
+      diff <- runTaskOrDie $ diffWithParser rubyParser sourceBlobs
       diffTOC diff `shouldBe`
         [ TOCSummary "Method" "foo" (Span (Pos 6 1) (Pos 7 4)) "added" ]
 
     it "properly slices source blob that starts with a newline and has multi-byte chars" $ do
       sourceBlobs <- blobsForPaths (Both "javascript/toc/starts-with-newline.js" "javascript/toc/starts-with-newline.js")
-      diff <- runTaskWithOptions (defaultOptions { optionsLogLevel = Nothing }) $ diffWithParser typescriptParser sourceBlobs
+      diff <- runTaskOrDie $ diffWithParser typescriptParser sourceBlobs
       diffTOC diff `shouldBe` []
 
     prop "inserts of methods and functions are summarized" . forAll ((not . isMethodOrFunction . Prelude.snd) `filterT` tiers) $
@@ -148,22 +148,22 @@ spec = parallel $ do
   describe "diff with ToCDiffRenderer'" $ do
     it "produces JSON output" $ do
       blobs <- blobsForPaths (Both "ruby/toc/methods.A.rb" "ruby/toc/methods.B.rb")
-      output <- runTask (diffSummaryBuilder Format.JSON [blobs])
+      output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs])
       runBuilder output `shouldBe` ("{\"changes\":{\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"self.foo\",\"changeType\":\"added\"},{\"span\":{\"start\":[4,1],\"end\":[6,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"modified\"},{\"span\":{\"start\":[4,1],\"end\":[5,4]},\"category\":\"Method\",\"term\":\"baz\",\"changeType\":\"removed\"}]},\"errors\":{}}\n" :: ByteString)
 
     it "produces JSON output if there are parse errors" $ do
       blobs <- blobsForPaths (Both "ruby/toc/methods.A.rb" "ruby/toc/methods.X.rb")
-      output <- runTaskWithOptions (defaultOptions { optionsLogLevel = Nothing }) (diffSummaryBuilder Format.JSON [blobs])
+      output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs])
       runBuilder output `shouldBe` ("{\"changes\":{\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"removed\"},{\"span\":{\"start\":[4,1],\"end\":[5,4]},\"category\":\"Method\",\"term\":\"baz\",\"changeType\":\"removed\"}]},\"errors\":{\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,3]},\"error\":\"expected end of input nodes, but got ParseError\",\"language\":\"Ruby\"}]}}\n" :: ByteString)
 
     it "ignores anonymous functions" $ do
       blobs <- blobsForPaths (Both "ruby/toc/lambda.A.rb" "ruby/toc/lambda.B.rb")
-      output <- runTask (diffSummaryBuilder Format.JSON [blobs])
+      output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs])
       runBuilder output `shouldBe` ("{\"changes\":{},\"errors\":{}}\n" :: ByteString)
 
     it "summarizes Markdown headings" $ do
       blobs <- blobsForPaths (Both "markdown/toc/headings.A.md" "markdown/toc/headings.B.md")
-      output <- runTask (diffSummaryBuilder Format.JSON [blobs])
+      output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs])
       runBuilder output `shouldBe` ("{\"changes\":{\"test/fixtures/markdown/toc/headings.A.md -> test/fixtures/markdown/toc/headings.B.md\":[{\"span\":{\"start\":[1,1],\"end\":[3,16]},\"category\":\"Heading 1\",\"term\":\"Introduction\",\"changeType\":\"removed\"},{\"span\":{\"start\":[5,1],\"end\":[7,4]},\"category\":\"Heading 2\",\"term\":\"Two\",\"changeType\":\"modified\"},{\"span\":{\"start\":[9,1],\"end\":[11,10]},\"category\":\"Heading 3\",\"term\":\"This heading is new\",\"changeType\":\"added\"},{\"span\":{\"start\":[13,1],\"end\":[14,4]},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString)
 
 
diff --git a/test/Reprinting/Spec.hs b/test/Reprinting/Spec.hs
index e4ec3cfa3..650181065 100644
--- a/test/Reprinting/Spec.hs
+++ b/test/Reprinting/Spec.hs
@@ -65,7 +65,7 @@ spec = describe "reprinting" $ do
         printed `shouldBe` Right src
 
       it "should be able to parse the output of a refactor" $ do
-        let (Just tagged) = rewrite (mark Unmodified tree) (topDownAny increaseNumbers) 
+        let (Just tagged) = rewrite (mark Unmodified tree) (topDownAny increaseNumbers)
         let (Right printed) = runReprinter src defaultJSONPipeline tagged
-        tree' <- runTask (parse jsonParser (Blob printed path Language.JSON))
+        tree' <- runTaskOrDie (parse jsonParser (Blob printed path Language.JSON))
         length tree' `shouldSatisfy` (/= 0)
diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs
index b7168d376..1217896d9 100644
--- a/test/Semantic/CLI/Spec.hs
+++ b/test/Semantic/CLI/Spec.hs
@@ -18,13 +18,13 @@ spec = parallel $ do
   describe "parseDiffBuilder" $
     for_ diffFixtures $ \ (diffRenderer, runDiff, files, expected) ->
       it ("renders to " <> diffRenderer <> " with files " <> show files) $ do
-        output <- runTask $ readBlobPairs (Right files) >>= runDiff
+        output <- runTaskOrDie $ readBlobPairs (Right files) >>= runDiff
         runBuilder output `shouldBe'` expected
 
   describe "parseTermBuilder" $
     for_ parseFixtures $ \ (format, runParse, files, expected) ->
       it ("renders to " <> format <> " with files " <> show files) $ do
-        output <- runTask $ readBlobs (Right files) >>= runParse
+        output <- runTaskOrDie $ readBlobs (Right files) >>= runParse
         runBuilder output `shouldBe'` expected
   where
     shouldBe' actual' expectedFile = do
diff --git a/test/Semantic/Spec.hs b/test/Semantic/Spec.hs
index 6c3a3a48b..65e4f4130 100644
--- a/test/Semantic/Spec.hs
+++ b/test/Semantic/Spec.hs
@@ -12,14 +12,14 @@ spec :: Spec
 spec = parallel $ do
   describe "parseBlob" $ do
     it "returns error if given an unknown language (json)" $ do
-      output <- fmap runBuilder . runTask $ parseTermBuilder TermJSONTree [ methodsBlob { blobLanguage = Unknown } ]
+      output <- fmap runBuilder . runTaskOrDie $ parseTermBuilder TermJSONTree [ methodsBlob { blobLanguage = Unknown } ]
       output `shouldBe` "{\"trees\":[{\"path\":\"methods.rb\",\"error\":\"NoLanguageForBlob \\\"methods.rb\\\"\",\"language\":\"Unknown\"}]}\n"
 
     it "throws if given an unknown language for sexpression output" $ do
-      runTask (parseTermBuilder TermSExpression [methodsBlob { blobLanguage = Unknown }]) `shouldThrow` (== ExitFailure 1)
+      runTaskOrDie (parseTermBuilder TermSExpression [methodsBlob { blobLanguage = Unknown }]) `shouldThrow` (== ExitFailure 1)
 
     it "renders with the specified renderer" $ do
-      output <- fmap runBuilder . runTask $ parseTermBuilder TermSExpression [methodsBlob]
+      output <- fmap runBuilder . runTaskOrDie $ parseTermBuilder TermSExpression [methodsBlob]
       output `shouldBe` "(Statements\n  (Method\n    (Empty)\n    (Identifier)\n    (Statements)))\n"
   where
     methodsBlob = Blob "def foo\nend\n" "methods.rb" Ruby
diff --git a/test/Spec.hs b/test/Spec.hs
index a0215ffc8..693c957b6 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -33,16 +33,15 @@ import qualified Semantic.Spec
 import qualified Semantic.CLI.Spec
 import qualified Semantic.IO.Spec
 import qualified Semantic.Stat.Spec
-import Semantic.Config (defaultOptions)
-import Semantic.Task (withOptions)
-import Semantic.Util (TaskConfig(..))
+import Semantic.Config (defaultOptions, optionsLogLevel)
+import Semantic.Task (withOptions, TaskSession(..))
 import qualified Proto3.Roundtrip
 import Test.Hspec
 
 main :: IO ()
 main = do
-  withOptions defaultOptions $ \ config logger statter -> hspec $ do
-    let args = TaskConfig config logger statter
+  withOptions defaultOptions { optionsLogLevel = Nothing } $ \ config logger statter -> hspec $ do
+    let args = TaskSession config "-" logger statter
     describe "Semantic.Stat" Semantic.Stat.Spec.spec
     parallel $ do
       describe "Analysis.Go" (Analysis.Go.Spec.spec args)
diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs
index 396e8112d..f2df8479b 100644
--- a/test/SpecHelpers.hs
+++ b/test/SpecHelpers.hs
@@ -7,6 +7,8 @@ module SpecHelpers
 , parseFilePath
 , parseTestFile
 , readFilePair
+, runTaskOrDie
+, TaskSession(..)
 , testEvaluating
 , verbatim
 , Verbatim(..)
@@ -78,7 +80,7 @@ import qualified Data.ByteString as B
 import qualified Data.Set as Set
 import Data.Set (Set)
 import qualified Semantic.IO as IO
-import Semantic.Config (Config)
+import Semantic.Config (Config(..), optionsLogLevel)
 import Semantic.Telemetry (LogQueue, StatQueue)
 import Semantic.API hiding (File, Blob, BlobPair)
 import System.Exit (die)
@@ -92,12 +94,12 @@ instance IsString Name where
   fromString = X.name . fromString
 
 -- | Returns an s-expression formatted diff for the specified FilePath pair.
-diffFilePaths :: TaskConfig -> Both FilePath -> IO ByteString
-diffFilePaths (TaskConfig config logger statter) paths = readFilePair paths >>= runTaskWithConfig config logger statter . parseDiffBuilder @[] DiffSExpression . pure >>= either (die . displayException) (pure . runBuilder)
+diffFilePaths :: TaskSession -> Both FilePath -> IO ByteString
+diffFilePaths session paths = readFilePair paths >>= runTask session . parseDiffBuilder @[] DiffSExpression . pure >>= either (die . displayException) (pure . runBuilder)
 
 -- | Returns an s-expression parse tree for the specified FilePath.
-parseFilePath :: TaskConfig -> FilePath -> IO ByteString
-parseFilePath (TaskConfig config logger statter) path = (fromJust <$> readBlobFromFile (file path)) >>= runTaskWithConfig config logger statter . parseTermBuilder @[] TermSExpression . pure >>= either (die . displayException) (pure . runBuilder)
+parseFilePath :: TaskSession -> FilePath -> IO ByteString
+parseFilePath session path = (fromJust <$> readBlobFromFile (file path)) >>= runTask session . parseTermBuilder @[] TermSExpression . pure >>= either (die . displayException) (pure . runBuilder)
 
 -- | Read two files to a BlobPair.
 readFilePair :: Both FilePath -> IO BlobPair
@@ -105,11 +107,15 @@ readFilePair paths = let paths' = fmap file paths in
                      runBothWith F.readFilePair paths'
 
 parseTestFile :: Parser term -> FilePath -> IO (Blob, term)
-parseTestFile parser path = runTask $ do
+parseTestFile parser path = runTaskOrDie $ do
   blob <- readBlob (file path)
   term <- parse parser blob
   pure (blob, term)
 
+-- Run a Task and call `die` if it returns an Exception.  
+runTaskOrDie :: TaskEff a -> IO a
+runTaskOrDie task = runTaskWithOptions defaultOptions { optionsLogLevel = Nothing } task >>= either (die . displayException) pure
+
 type TestEvaluatingC term
   = ResumableC (BaseError (AddressError Precise (Val term))) (Eff
   ( ResumableC (BaseError (ValueError term Precise)) (Eff

From 33f03c42a5ea68411223a719ec032b0f2d070e9f Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Mon, 4 Feb 2019 13:31:31 -0800
Subject: [PATCH 2/2] Align the ::

---
 src/Semantic/Task.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs
index 033a1e37e..621768970 100644
--- a/src/Semantic/Task.hs
+++ b/src/Semantic/Task.hs
@@ -152,10 +152,10 @@ serialize format input = send (Serialize format input ret)
 
 data TaskSession
   = TaskSession
-  { config :: Config
+  { config    :: Config
   , requestID :: String
-  , logger :: LogQueue
-  , statter :: StatQueue
+  , logger    :: LogQueue
+  , statter   :: StatQueue
   }
 
 -- | Execute a 'TaskEff' yielding its result value in 'IO'.