github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 06:11:49 +03:00
Code Issues Projects Releases Wiki Activity

Make the options available via a Reader.

Browse Source
This commit is contained in:
Rob Rix 2018-04-03 18:30:26 -04:00
parent 5d6c75188d
commit 4d27b1d72f
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Semantic/Task.hs
View File

@ -76,7 +76,7 @@ type Logger = AsyncQueue Message Options
type Statter = AsyncQueue Stat StatsClient
-- | 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 Task = Eff '[TaskF, Reader Logger, Reader Statter, Exc SomeException, IO]
type Task = Eff '[TaskF, Reader Options, Reader Logger, Reader Statter, Exc SomeException, IO]
-- | A function to compute the 'Diff' for a pair of 'Term's with arbitrary syntax functor & annotation types.
type Differ syntax ann1 ann2 = Term syntax ann1 -> Term syntax ann2 -> Diff syntax ann1 ann2
@ -184,8 +184,8 @@ runTaskWithOptions options task = do
run options logger statter = run'
where
run' :: Task a -> IO (Either SomeException a)
run' = runM . runError . flip runReader statter . flip runReader logger . go
go :: Task a -> Eff '[Reader Logger, Reader Statter, Exc SomeException, IO] a
run' = runM . runError . flip runReader statter . flip runReader logger . flip runReader options . go
go :: Task a -> Eff '[Reader Options, Reader Logger, Reader Statter, Exc SomeException, IO] a
go = interpret (\ task -> case task of
ReadBlobs (Left handle) -> rethrowing (IO.readBlobsFromHandle handle)
ReadBlobs (Right paths@[(path, Nothing)]) -> rethrowing (IO.isDirectory path >>= bool (IO.readBlobsFromPaths paths) (IO.readBlobsFromDir path))
@ -194,7 +194,7 @@ runTaskWithOptions options task = do
WriteToOutput destination contents -> liftIO (either B.hPutStr B.writeFile destination contents)
WriteLog level message pairs -> ask >>= \ logger -> queueLogMessage logger level message pairs
WriteStat stat -> ask >>= \ statter -> liftIO (queue (statter :: Statter) stat)
Parse parser blob -> go (runParser options blob parser)
Parse parser blob -> ask >>= \ options -> go (runParser options blob parser)
Decorate algebra term -> pure (decoratorWithAlgebra algebra term)
Semantic.Task.Diff differ term1 term2 -> pure (differ term1 term2)
Render renderer input -> pure (renderer input)