github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-23 06:41:45 +03:00
Code Issues Projects Releases Wiki Activity

Spike out a function aligning Terms in Patches.

Browse Source
This commit is contained in:
Rob Rix 2016-03-18 12:01:59 -04:00
parent 23ba7c0ae6
commit 00c3a2ef9f
1 changed files with 8 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Alignment.hs
View File

@ -14,6 +14,7 @@ import Control.Monad
import Control.Monad.Free
import Data.Adjoined
import Data.Align
import Data.Aligned
import Data.Bifunctor.These
import Data.Coalescent
import Data.Copointed
@ -108,6 +109,13 @@ type Row a = Both (Line a)
-- | A fixpoint over a functor.
newtype Fix f = Fix { unFix :: f (Fix f) }
alignPatch :: Patch (Term leaf Info) -> Fix (Aligned (Syntax leaf))
alignPatch (Insert term) = hylo (Fix . AlignThis . pure) unwrap term
alignPatch (Delete term) = hylo (Fix . AlignThat . pure) unwrap term
alignPatch (Replace term1 term2) = let Fix (AlignThis a) = alignPatch $ Delete term1
Fix (AlignThat b) = alignPatch $ Insert term2 in
Fix (AlignThese a b)
hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
hylo phi psi = Alignment.cata phi . ana psi