github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 01:47:01 +03:00
Code Issues Projects Releases Wiki Activity

Define a function to parse and diff a pair of blobs.

Browse Source
This commit is contained in:
Rob Rix 2017-09-29 15:33:02 -04:00
parent c3a6912a14
commit 5621830b41
1 changed files with 10 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Semantic.hs
View File

@ -4,22 +4,29 @@ module Semantic
, parseBlob , parseBlob
, diffBlobPairs , diffBlobPairs
, diffBlobPair , diffBlobPair
, parseAndDiffBlobPair
, diffTermPair , diffTermPair
) where ) where
import Algorithm (Diffable)
import Control.Exception import Control.Exception
import Control.Monad ((<=<)) import Control.Monad ((<=<))
import Control.Monad.Error.Class import Control.Monad.Error.Class
import Data.Align.Generic (GAlign)
import Data.Bifunctor import Data.Bifunctor
import Data.Blob import Data.Blob
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.Diff import Data.Diff
import Data.Functor.Both as Both import Data.Functor.Both as Both
import Data.Functor.Classes
import Data.Output import Data.Output
import Data.Record import Data.Record
import Data.Syntax.Algebra import Data.Syntax.Algebra
import qualified Data.Syntax as Syntax
import qualified Data.Syntax.Declaration as Declaration
import Data.Term import Data.Term
import Data.Typeable import Data.Typeable
import Data.Union
import Info import Info
import Interpreter import Interpreter
import qualified Language import qualified Language
@ -110,6 +117,9 @@ diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
run :: Functor syntax => (Blob -> Task (Term syntax ann)) -> (Term syntax ann -> Term syntax ann -> Diff syntax ann ann) -> (Diff syntax ann ann -> output) -> Task output run :: Functor syntax => (Blob -> Task (Term syntax ann)) -> (Term syntax ann -> Term syntax ann -> Diff syntax ann ann) -> (Diff syntax ann ann -> output) -> Task output
run parse diff renderer = distributeFor blobs parse >>= runBothWith (diffTermPair blobs diff) >>= render renderer run parse diff renderer = distributeFor blobs parse >>= runBothWith (diffTermPair blobs diff) >>= render renderer
parseAndDiffBlobPair :: (Apply Diffable syntax, Apply Foldable syntax, Apply Functor syntax, Apply GAlign syntax, Apply Show1 syntax, Apply Traversable syntax, Declaration.Function :< syntax, Declaration.Method :< syntax, Syntax.Context :< syntax) => Both Blob -> Parser (Term (Union syntax) (Record fields)) -> Task (Diff (Union syntax) (Record fields) (Record fields))
parseAndDiffBlobPair blobs parser = distributeFor blobs (parse parser) >>= runBothWith (diffTermPair blobs diffTerms)
-- | A task to diff a pair of 'Term's, producing insertion/deletion 'Patch'es for non-existent 'Blob's. -- | A task to diff a pair of 'Term's, producing insertion/deletion 'Patch'es for non-existent 'Blob's.
diffTermPair :: Functor syntax => Both Blob -> Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> Task (Diff syntax ann1 ann2) diffTermPair :: Functor syntax => Both Blob -> Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> Task (Diff syntax ann1 ann2)
diffTermPair blobs differ t1 t2 = case runJoin (blobExists <$> blobs) of diffTermPair blobs differ t1 t2 = case runJoin (blobExists <$> blobs) of