mirror of
https://github.com/github/semantic.git
synced 2024-11-28 01:47:01 +03:00
Rename TaskEff to TaskC.
This commit is contained in:
parent
f1b4fa870b
commit
9e183cd46b
@ -63,7 +63,7 @@ main = do
|
||||
-- | A parser for the application's command-line arguments.
|
||||
--
|
||||
-- Returns a 'Task' to read the input, run the requested operation, and write the output to the specified output path or stdout.
|
||||
arguments :: ParserInfo (Options, Task.TaskEff ())
|
||||
arguments :: ParserInfo (Options, Task.TaskC ())
|
||||
arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsParser)) description
|
||||
where
|
||||
version = infoOption versionString (long "version" <> short 'v' <> help "Output the version of the program")
|
||||
@ -79,13 +79,13 @@ optionsParser = do
|
||||
logPathsOnError <- switch (long "log-paths" <> help "Log source paths on parse and assignment error.")
|
||||
pure $ Options logLevel logPathsOnError (Flag.flag FailOnWarning failOnWarning) (Flag.flag FailOnParseError failOnParseError)
|
||||
|
||||
argumentsParser :: Parser (Task.TaskEff ())
|
||||
argumentsParser :: Parser (Task.TaskC ())
|
||||
argumentsParser = do
|
||||
subparser <- hsubparser (diffCommand <> parseCommand <> tsParseCommand <> graphCommand)
|
||||
output <- ToPath <$> strOption (long "output" <> short 'o' <> help "Output path, defaults to stdout") <|> pure (ToHandle stdout)
|
||||
pure $ subparser >>= Task.write output
|
||||
|
||||
diffCommand :: Mod CommandFields (Task.TaskEff Builder)
|
||||
diffCommand :: Mod CommandFields (Task.TaskC Builder)
|
||||
diffCommand = command "diff" (info diffArgumentsParser (progDesc "Compute changes between paths"))
|
||||
where
|
||||
diffArgumentsParser = do
|
||||
@ -98,7 +98,7 @@ diffCommand = command "diff" (info diffArgumentsParser (progDesc "Compute change
|
||||
filesOrStdin <- Right <$> some (Both <$> argument filePathReader (metavar "FILE_A") <*> argument filePathReader (metavar "FILE_B")) <|> pure (Left stdin)
|
||||
pure $ Task.readBlobPairs filesOrStdin >>= renderer
|
||||
|
||||
parseCommand :: Mod CommandFields (Task.TaskEff Builder)
|
||||
parseCommand :: Mod CommandFields (Task.TaskC Builder)
|
||||
parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate parse trees for path(s)"))
|
||||
where
|
||||
parseArgumentsParser = do
|
||||
@ -146,7 +146,7 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa
|
||||
<|> pure (FilesFromHandle stdin)
|
||||
pure $ Task.readBlobs filesOrStdin >>= runReader languageModes . renderer
|
||||
|
||||
tsParseCommand :: Mod CommandFields (Task.TaskEff Builder)
|
||||
tsParseCommand :: Mod CommandFields (Task.TaskC Builder)
|
||||
tsParseCommand = command "ts-parse" (info tsParseArgumentsParser (progDesc "Generate raw tree-sitter parse trees for path(s)"))
|
||||
where
|
||||
tsParseArgumentsParser = do
|
||||
@ -165,7 +165,7 @@ tsParseCommand = command "ts-parse" (info tsParseArgumentsParser (progDesc "Gene
|
||||
<|> pure (FilesFromHandle stdin)
|
||||
pure $ Task.readBlobs filesOrStdin >>= AST.runASTParse format
|
||||
|
||||
graphCommand :: Mod CommandFields (Task.TaskEff Builder)
|
||||
graphCommand :: Mod CommandFields (Task.TaskC Builder)
|
||||
graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute a graph for a directory or from a top-level entry point module"))
|
||||
where
|
||||
graphArgumentsParser = makeGraphTask
|
||||
|
@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE ConstraintKinds, ExistentialQuantification, GADTs, GeneralizedNewtypeDeriving, KindSignatures,
|
||||
ScopedTypeVariables, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
|
||||
module Semantic.Task
|
||||
( TaskEff
|
||||
( TaskC
|
||||
, Level(..)
|
||||
-- * Parse effect
|
||||
, Parse
|
||||
@ -86,7 +86,7 @@ import Serializing.Format hiding (Options)
|
||||
import Source.Source (Source)
|
||||
|
||||
-- | 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
|
||||
type TaskC
|
||||
= ParseC
|
||||
( ResolutionC
|
||||
( Files.FilesC
|
||||
@ -124,11 +124,11 @@ data TaskSession
|
||||
, statter :: StatQueue
|
||||
}
|
||||
|
||||
-- | Execute a 'TaskEff' yielding its result value in 'IO'.
|
||||
runTask :: TaskSession -> TaskEff a -> IO (Either SomeException a)
|
||||
-- | Execute a 'TaskC' yielding its result value in 'IO'.
|
||||
runTask :: TaskSession -> TaskC a -> IO (Either SomeException a)
|
||||
runTask taskSession@TaskSession{..} task = do
|
||||
(result, stat) <- withTiming "run" [] $ do
|
||||
let run :: TaskEff a -> IO (Either SomeException a)
|
||||
let run :: TaskC a -> IO (Either SomeException a)
|
||||
run
|
||||
= runM
|
||||
. withDistribute
|
||||
@ -146,8 +146,8 @@ runTask taskSession@TaskSession{..} 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)
|
||||
-- | Execute a 'TaskC' yielding its result value in 'IO' using all default options and configuration.
|
||||
runTaskWithOptions :: Options -> TaskC a -> IO (Either SomeException a)
|
||||
runTaskWithOptions options task = withOptions options $ \ config logger statter ->
|
||||
runTask (TaskSession config "-" False logger statter) task
|
||||
|
||||
|
@ -120,7 +120,7 @@ parseFile, parseFileQuiet :: Parser term -> FilePath -> IO term
|
||||
parseFile parser = runTask' . (parse parser <=< readBlob . fileForPath)
|
||||
parseFileQuiet parser = runTaskQuiet . (parse parser <=< readBlob . fileForPath)
|
||||
|
||||
runTask', runTaskQuiet :: TaskEff a -> IO a
|
||||
runTask', runTaskQuiet :: TaskC a -> IO a
|
||||
runTask' task = runTaskWithOptions debugOptions task >>= either (die . displayException) pure
|
||||
runTaskQuiet task = runTaskWithOptions defaultOptions task >>= either (die . displayException) pure
|
||||
|
||||
|
@ -19,13 +19,13 @@ spec = do
|
||||
|
||||
it "returns a result when the timeout does not expire" $ do
|
||||
let timeout = fromMicroseconds 0 -- Zero microseconds indicates no timeout
|
||||
let parseTask = parseToAST timeout tree_sitter_json largeBlob :: TaskEff (Maybe (AST [] Grammar))
|
||||
let parseTask = parseToAST timeout tree_sitter_json largeBlob :: TaskC (Maybe (AST [] Grammar))
|
||||
result <- runTaskOrDie parseTask
|
||||
(isJust result) `shouldBe` True
|
||||
|
||||
it "returns nothing when the timeout expires" $ do
|
||||
let timeout = fromMicroseconds 1000
|
||||
let parseTask = parseToAST timeout tree_sitter_json largeBlob :: TaskEff (Maybe (AST [] Grammar))
|
||||
let parseTask = parseToAST timeout tree_sitter_json largeBlob :: TaskC (Maybe (AST [] Grammar))
|
||||
result <- runTaskOrDie parseTask
|
||||
(isNothing result) `shouldBe` True
|
||||
|
||||
|
@ -33,7 +33,7 @@ renderDiff ref new = unsafePerformIO $ do
|
||||
else ["git", "diff", ref, new]
|
||||
{-# NOINLINE renderDiff #-}
|
||||
|
||||
testForDiffFixture :: (String, [BlobPair] -> TaskEff Builder, [Both File], Path.RelFile) -> TestTree
|
||||
testForDiffFixture :: (String, [BlobPair] -> TaskC Builder, [Both File], Path.RelFile) -> TestTree
|
||||
testForDiffFixture (diffRenderer, runDiff, files, expected) =
|
||||
goldenVsStringDiff
|
||||
("diff fixture renders to " <> diffRenderer <> " " <> show files)
|
||||
@ -41,7 +41,7 @@ testForDiffFixture (diffRenderer, runDiff, files, expected) =
|
||||
(Path.toString expected)
|
||||
(fmap toLazyByteString . runTaskOrDie $ readBlobPairs (Right files) >>= runDiff)
|
||||
|
||||
testForParseFixture :: (String, [Blob] -> TaskEff Builder, [File], Path.RelFile) -> TestTree
|
||||
testForParseFixture :: (String, [Blob] -> TaskC Builder, [File], Path.RelFile) -> TestTree
|
||||
testForParseFixture (format, runParse, files, expected) =
|
||||
goldenVsStringDiff
|
||||
("diff fixture renders to " <> format)
|
||||
@ -49,7 +49,7 @@ testForParseFixture (format, runParse, files, expected) =
|
||||
(Path.toString expected)
|
||||
(fmap toLazyByteString . runTaskOrDie $ readBlobs (FilesFromPaths files) >>= runParse)
|
||||
|
||||
parseFixtures :: [(String, [Blob] -> TaskEff Builder, [File], Path.RelFile)]
|
||||
parseFixtures :: [(String, [Blob] -> TaskC Builder, [File], Path.RelFile)]
|
||||
parseFixtures =
|
||||
[ ("s-expression", run . parseTermBuilder TermSExpression, path, Path.relFile "test/fixtures/ruby/corpus/and-or.parseA.txt")
|
||||
, ("json", run . parseTermBuilder TermJSONTree, path, prefix </> Path.file "parse-tree.json")
|
||||
@ -64,7 +64,7 @@ parseFixtures =
|
||||
prefix = Path.relDir "test/fixtures/cli"
|
||||
run = runReader (PerLanguageModes ALaCarte)
|
||||
|
||||
diffFixtures :: [(String, [BlobPair] -> TaskEff Builder, [Both File], Path.RelFile)]
|
||||
diffFixtures :: [(String, [BlobPair] -> TaskC Builder, [Both File], Path.RelFile)]
|
||||
diffFixtures =
|
||||
[ ("json diff", parseDiffBuilder DiffJSONTree, pathMode, prefix </> Path.file "diff-tree.json")
|
||||
, ("s-expression diff", parseDiffBuilder DiffSExpression, pathMode, Path.relFile "test/fixtures/ruby/corpus/method-declaration.diffA-B.txt")
|
||||
|
@ -110,7 +110,7 @@ parseTestFile parser path = runTaskOrDie $ do
|
||||
pure (blob, term)
|
||||
|
||||
-- Run a Task and call `die` if it returns an Exception.
|
||||
runTaskOrDie :: TaskEff a -> IO a
|
||||
runTaskOrDie :: TaskC a -> IO a
|
||||
runTaskOrDie task = runTaskWithOptions defaultOptions { optionsLogLevel = Nothing } task >>= either (die . displayException) pure
|
||||
|
||||
type TestEvaluatingC term
|
||||
|
Loading…
Reference in New Issue
Block a user