github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-02 20:41:38 +03:00
Code Issues Projects Releases Wiki Activity

Move rendering out of run.

Browse Source
This commit is contained in:
Rob Rix 2018-05-14 13:35:11 -04:00
parent cf756afc4a
commit 76fa3371ac
1 changed files with 8 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/Semantic/Diff.hs
View File

@ -27,20 +27,18 @@ diffBlobPair :: Members '[Distribute WrappedTask, Task, Telemetry, Exc SomeExcep
diffBlobPair renderer blobs
| Just (SomeParser parser) <- someParser @'[ConstructorName, Diffable, Eq1, GAlign, HasDeclaration, IdentifierName, Show1, ToJSONFields1, Traversable] <$> effectiveLanguage
= case renderer of
ToCDiffRenderer -> run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob)) renderToCDiff
JSONDiffRenderer -> run ( parse parser >=> decorate constructorLabel >=> decorate identifierLabel) renderJSONDiff
SExpressionDiffRenderer -> run ( parse parser) (const id) >>= serialize (SExpression ByConstructorName)
DOTDiffRenderer -> run ( parse parser) (const renderTreeGraph) >>= serialize (DOT (diffStyle (pathKeyForBlobPair blobs)))
ToCDiffRenderer -> run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob)) >>= render (renderToCDiff blobs)
JSONDiffRenderer -> run ( parse parser >=> decorate constructorLabel >=> decorate identifierLabel) >>= render (renderJSONDiff blobs)
SExpressionDiffRenderer -> run ( parse parser) >>= serialize (SExpression ByConstructorName)
DOTDiffRenderer -> run ( parse parser) >>= render renderTreeGraph >>= serialize (DOT (diffStyle (pathKeyForBlobPair blobs)))
| otherwise = noLanguageForBlob effectivePath
where effectivePath = pathForBlobPair blobs
effectiveLanguage = languageForBlobPair blobs
languageTag = languageTagForBlobPair blobs
run :: (Diffable syntax, Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax) => Members [Distribute WrappedTask, Task, Telemetry, IO] effs => (Blob -> TaskEff (Term syntax (Record fields))) -> (BlobPair -> Diff syntax (Record fields) (Record fields) -> output) -> Eff effs output
run parse renderer = do
run :: (Diffable syntax, Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax) => Members [Distribute WrappedTask, Task, Telemetry, IO] effs => (Blob -> TaskEff (Term syntax (Record fields))) -> Eff effs (Diff syntax (Record fields) (Record fields))
run parse = do
terms <- distributeFor blobs (WrapTask . parse)
time "diff" languageTag $ do
diff <- diff (runJoin terms)
writeStat (Stat.count "diff.nodes" (bilength diff) languageTag)
render (renderer blobs) diff
where
languageTag = languageTagForBlobPair blobs
diff <$ writeStat (Stat.count "diff.nodes" (bilength diff) languageTag)