1
1
mirror of https://github.com/github/semantic.git synced 2024-12-29 18:06:14 +03:00

Define decomposeWith internally to diffTermsWith.

This commit is contained in:
Rob Rix 2017-06-01 12:02:15 -04:00
parent 9c1c8e8f85
commit 995c87a359

View File

@ -39,12 +39,22 @@ decoratingWith :: (Hashable label, Traversable f)
decoratingWith getLabel differ = stripDiff . differ . fmap (defaultFeatureVectorDecorator getLabel)
-- | Diff a pair of terms recurisvely, using the supplied continuation and 'ComparabilityRelation'.
diffTermsWith :: (Traversable f, GAlign f, Eq1 f, HasField fields (Maybe FeatureVector))
diffTermsWith :: forall f fields . (Traversable f, GAlign f, Eq1 f, HasField fields (Maybe FeatureVector))
=> (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f (Record fields)) (Diff f (Record fields)) (Diff f (Record fields))) -- ^ A function producing syntax-directed continuations of the algorithm.
-> ComparabilityRelation f fields -- ^ A relation on terms used to determine comparability and equality.
-> Both (Term f (Record fields)) -- ^ A pair of terms.
-> Diff f (Record fields) -- ^ The resulting diff.
diffTermsWith refine comparable (Join (a, b)) = runAlgorithm (decomposeWith refine comparable) (diff a b)
diffTermsWith refine comparable (Join (a, b)) = runAlgorithm decompose (diff a b)
where decompose :: AlgorithmF (Term f (Record fields)) (Diff f (Record fields)) result -> Algorithm (Term f (Record fields)) (Diff f (Record fields)) result
decompose step = case step of
Diff t1 t2 -> refine t1 t2
Linear t1 t2 -> case galignWith diffThese (unwrap t1) (unwrap t2) of
Just result -> wrap . (both (extract t1) (extract t2) :<) <$> sequenceA result
_ -> byReplacing t1 t2
RWS as bs -> traverse diffThese (rws (editDistanceUpTo defaultM) comparable as bs)
Delete a -> pure (deleting a)
Insert b -> pure (inserting b)
Replace a b -> pure (replacing a b)
-- | Compute the label for a given term, suitable for inclusion in a _p_,_q_-gram.
getLabel :: HasField fields Category => TermF (Syntax leaf) (Record fields) a -> (Category, Maybe leaf)
@ -76,22 +86,6 @@ runAlgorithmSteps decompose = go
Return a -> [Return a]
step `Then` yield -> algorithm : go (decompose step >>= yield)
-- | Decompose a step of an algorithm into the next steps to perform using a helper function.
decomposeWith :: (Traversable f, GAlign f, Eq1 f, HasField fields (Maybe FeatureVector))
=> (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f (Record fields)) (Diff f (Record fields)) (Diff f (Record fields)))
-> ComparabilityRelation f fields
-> AlgorithmF (Term f (Record fields)) (Diff f (Record fields)) result
-> Algorithm (Term f (Record fields)) (Diff f (Record fields)) result
decomposeWith algorithmWithTerms comparable step = case step of
Diff t1 t2 -> algorithmWithTerms t1 t2
Linear t1 t2 -> case galignWith diffThese (unwrap t1) (unwrap t2) of
Just result -> wrap . (both (extract t1) (extract t2) :<) <$> sequenceA result
_ -> byReplacing t1 t2
RWS as bs -> traverse diffThese (rws (editDistanceUpTo defaultM) comparable as bs)
Delete a -> pure (deleting a)
Insert b -> pure (inserting b)
Replace a b -> pure (replacing a b)
-- | Construct an algorithm to diff a pair of terms.
algorithmWithTerms :: SyntaxTerm leaf fields