Move diffTermPair into Diffing.Interpreter.

src/Diffing/Interpreter.hs

@@ -1,17 +1,18 @@
 {-# LANGUAGE DataKinds, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators #-}
 module Diffing.Interpreter
 ( diffTerms
+, diffTermPair
 ) where
 
-import Prologue
-import Data.Align.Generic (galignWith)
 import Analysis.Decorator
 import Control.Monad.Free.Freer
+import Data.Align.Generic (galignWith)
 import Data.Diff
 import Data.Record
 import Data.Term
 import Diffing.Algorithm
 import Diffing.Algorithm.RWS
+import Prologue
 
 -- | Diff two à la carte terms recursively.
 diffTerms :: (Diffable syntax, Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax)
@@ -22,6 +23,12 @@ diffTerms t1 t2 = stripDiff (fromMaybe (replacing t1' t2') (runAlgorithm (diff t
   where (t1', t2') = ( defaultFeatureVectorDecorator constructorNameAndConstantFields t1
                      , defaultFeatureVectorDecorator constructorNameAndConstantFields t2)
 
+-- | Diff a 'These' of terms.
+diffTermPair :: (Diffable syntax, Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Diff syntax (Record fields1) (Record fields2)
+diffTermPair (This  t1   ) = deleting t1
+diffTermPair (That     t2) = inserting t2
+diffTermPair (These t1 t2) = diffTerms t1 t2
+
 -- | Run an 'Algorithm' to completion in an 'Alternative' context using the supplied comparability & equivalence relations.
 runAlgorithm :: forall syntax fields1 fields2 m result
              .  (Diffable syntax, Eq1 syntax, GAlign syntax, Traversable syntax, Alternative m, Monad m)

src/Semantic/Diff.hs

@@ -10,7 +10,6 @@ import Data.JSON.Fields
 import Data.Record
 import Data.Term
 import Diffing.Algorithm (Diffable)
-import Diffing.Interpreter
 import Parsing.Parser
 import Prologue hiding (MonadError(..))
 import Rendering.Graph
@@ -40,14 +39,8 @@ diffBlobPair renderer blobs
         run parse renderer = do
           terms <- distributeFor blobs (WrapTask . parse)
           time "diff" languageTag $ do
-            diff <- diffTermPair (runJoin terms)
+            diff <- diff (runJoin terms)
             writeStat (Stat.count "diff.nodes" (bilength diff) languageTag)
             render (renderer blobs) diff
           where
             languageTag = languageTagForBlobPair blobs
-
--- | A task to diff 'Term's, producing insertion/deletion 'Patch'es for non-existent 'Blob's.
-diffTermPair :: (Diffable syntax, Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax, Member Task effs) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Eff effs (Diff syntax (Record fields1) (Record fields2))
-diffTermPair (This  t1   ) = pure (deleting t1)
-diffTermPair (That     t2) = pure (inserting t2)
-diffTermPair (These t1 t2) = diff diffTerms t1 t2

src/Semantic/Task.hs

@@ -5,7 +5,6 @@ module Semantic.Task
 , WrappedTask(..)
 , Level(..)
 , RAlgebra
-, Differ
 -- * I/O
 , IO.readBlob
 , IO.readBlobs
@@ -59,6 +58,8 @@ import qualified Data.Error as Error
 import           Data.Record
 import qualified Data.Syntax as Syntax
 import           Data.Term
+import           Diffing.Algorithm (Diffable)
+import           Diffing.Interpreter
 import           Parsing.CMark
 import           Parsing.Parser
 import           Parsing.TreeSitter
@@ -87,9 +88,6 @@ type TaskEff = Eff '[Distribute WrappedTask
 newtype WrappedTask a = WrapTask { unwrapTask :: TaskEff a }
   deriving (Applicative, Functor, Monad)
 
--- | 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
-
 -- | A function to render terms or diffs.
 type Renderer i o = i -> o
 
@@ -106,8 +104,8 @@ decorate :: (Functor f, Member Task effs) => RAlgebra (TermF f (Record fields))
 decorate algebra = send . Decorate algebra
 
 -- | A task which diffs a pair of terms using the supplied 'Differ' function.
-diff :: Member Task effs => Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> Eff effs (Diff syntax ann1 ann2)
-diff differ term1 term2 = send (Semantic.Task.Diff differ term1 term2)
+diff :: (Diffable syntax, Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax, Member Task effs) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Eff effs (Diff syntax (Record fields1) (Record fields2))
+diff terms = send (Semantic.Task.Diff terms)
 
 -- | A task which renders some input using the supplied 'Renderer' function.
 render :: Member Task effs => Renderer input output -> input -> Eff effs output
@@ -149,7 +147,7 @@ data Task output where
   Parse     :: Parser term -> Blob -> Task term
   Analyze   :: (Analysis.Evaluator location value effects a -> result) -> Analysis.Evaluator location value effects a -> Task result
   Decorate  :: Functor f => RAlgebra (TermF f (Record fields)) (Term f (Record fields)) field -> Term f (Record fields) -> Task (Term f (Record (field ': fields)))
-  Diff      :: Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> Task (Diff syntax ann1 ann2)
+  Diff      :: (Diffable syntax, Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Task (Diff syntax (Record fields1) (Record fields2))
   Render    :: Renderer input output -> input -> Task output
   Serialize :: Format input -> input -> Task Builder
 
@@ -159,7 +157,7 @@ runTaskF = interpret $ \ task -> case task of
   Parse parser blob -> runParser blob parser
   Analyze interpret analysis -> pure (interpret analysis)
   Decorate algebra term -> pure (decoratorWithAlgebra algebra term)
-  Semantic.Task.Diff differ term1 term2 -> pure (differ term1 term2)
+  Semantic.Task.Diff terms -> pure (diffTermPair terms)
   Render renderer input -> pure (renderer input)
   Serialize format input -> pure (runSerialize format input)