1
1
mirror of https://github.com/github/semantic.git synced 2024-12-01 00:33:59 +03:00

Implement runTypeScriptDiff and runJSONDiff

This commit is contained in:
joshvera 2018-07-16 14:06:03 -04:00
parent 6ef7fe4945
commit ab1c1c2569

View File

@ -40,15 +40,27 @@ runRubyDiff = flip distributeFor (\ (blobs :: BlobPair) -> do
diff <$ writeStat (Stat.count "diff.nodes" (bilength diff) languageTag)
where languageTag = languageTagForBlobPair blobs
-- runTypeScriptDiff :: (Member Distribute effs, Member Task effs) => [BlobPair] -> Eff effs [Term (Sum TypeScript.Syntax) ()]
-- runTypeScriptDiff = flip distributeFor (\ blob -> do
-- term <- parse typescriptParser blob
-- pure diffs)
--
-- runJSONDiff :: (Member Distribute effs, Member Task effs) => [BlobPair] -> Eff effs [Term (Sum JSON.Syntax) ()]
-- runJSONDiff = flip distributeFor (\ blob -> do
-- term <- parse jsonParser blob
-- pure (() <$ term))
runTypeScriptDiff :: (Member Telemetry effs, Member (Lift IO) effs, Member Distribute effs, Member Task effs) => [BlobPair] -> Eff effs [Diff (Sum TypeScript.Syntax) () ()]
runTypeScriptDiff = flip distributeFor (\ (blobs :: BlobPair) -> do
terms <- distributeFor blobs (\blob -> parse typescriptParser blob)
diffs <- (diffTerms blobs) terms
pure (bimap (const ()) (const ()) diffs))
where
diffTerms blobs terms = time "diff" languageTag $ do
diff <- diff (runJoin terms)
diff <$ writeStat (Stat.count "diff.nodes" (bilength diff) languageTag)
where languageTag = languageTagForBlobPair blobs
runJSONDiff :: (Member Telemetry effs, Member (Lift IO) effs, Member Distribute effs, Member Task effs) => [BlobPair] -> Eff effs [Diff (Sum JSON.Syntax) () ()]
runJSONDiff = flip distributeFor (\ (blobs :: BlobPair) -> do
terms <- distributeFor blobs (\blob -> parse jsonParser blob)
diffs <- (diffTerms blobs) terms
pure (bimap (const ()) (const ()) diffs))
where
diffTerms blobs terms = time "diff" languageTag $ do
diff <- diff (runJoin terms)
diff <$ writeStat (Stat.count "diff.nodes" (bilength diff) languageTag)
where languageTag = languageTagForBlobPair blobs
data SomeTermPair typeclasses ann where
SomeTermPair :: ApplyAll typeclasses syntax => Join These (Term syntax ann) -> SomeTermPair typeclasses ann