github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-03 04:51:57 +03:00
Code Issues Projects Releases Wiki Activity

Avoid redundant concurrency.

Browse Source
This commit is contained in:
Rob Rix 2017-05-26 15:02:18 -04:00
parent 6ed7c37e5b
commit e1d8a98b22
1 changed files with 5 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Semantic.hs
View File

@ -32,14 +32,13 @@ import Term
-- | Diff a list of SourceBlob pairs to produce ByteString output using the specified renderer.
diffBlobPairs :: (Monoid output, StringConv output ByteString, HasField fields Category, NFData (Record fields)) => (Source -> Term (Syntax Text) (Record DefaultFields) -> Term (Syntax Text) (Record fields)) -> Renderer (Both SourceBlob, Diff (Syntax Text) (Record fields)) output -> [Both SourceBlob] -> IO ByteString
diffBlobPairs decorator renderer blobs = do
diffs <- Async.mapConcurrently go blobs
let diffs' = diffs >>= \ (blobs, diff) -> (,) blobs <$> toList diff
renderConcurrently (pure . runRenderer renderer) diffs'
diffBlobPairs decorator renderer blobs = renderConcurrently parseDiffAndRender blobs
where
go blobPair = do
parseDiffAndRender blobPair = do
diff <- diffBlobPair decorator blobPair
pure (blobPair, diff)
pure $! case diff of
Just a -> runRenderer renderer (blobPair, a)
Nothing -> mempty
-- | Diff a pair of SourceBlobs.
diffBlobPair :: (HasField fields Category, NFData (Record fields)) => (Source -> Term (Syntax Text) (Record DefaultFields) -> Term (Syntax Text) (Record fields)) -> Both SourceBlob -> IO (Maybe (Diff (Syntax Text) (Record fields)))