github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-19 21:01:35 +03:00
Code Issues Projects Releases Wiki Activity

Add zipUnwrap cases for Comment and Commented

Browse Source
This commit is contained in:
joshvera 2016-07-08 13:27:41 -04:00
parent 3ee4c062d6
commit 772575dffd
1 changed files with 2 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Term.hs
View File

@ -25,6 +25,7 @@ zipTerms t1 t2 = annotate (zipUnwrap a b)
(annotation1 :< a, annotation2 :< b) = (runCofree t1, runCofree t2)
annotate = fmap (cofree . (both annotation1 annotation2 :<))
zipUnwrap (Leaf _) (Leaf b') = Just $ Leaf b'
zipUnwrap (Comment _) (Comment b) = Just $ Comment b
zipUnwrap (Indexed a') (Indexed b') = Just . Indexed . catMaybes $ zipWith zipTerms a' b'
zipUnwrap (FunctionCall idA' a') (FunctionCall idB' b') = case (zipTerms idA' idB') of
(Just id') -> Just $ FunctionCall id' (catMaybes $ zipWith zipTerms a' b')
@ -40,6 +41,7 @@ zipTerms t1 t2 = annotate (zipUnwrap a b)
_ -> Nothing
zipUnwrap (Object as') (Object bs') | as' == bs' = Just . Object . catMaybes $ zipWith zipTerms as' bs'
zipUnwrap (Pair a1' a2') (Pair b1' b2') = Pair <$> zipTerms a1' b1' <*> zipTerms a2' b2'
zipUnwrap (Commented cs1 a) (Commented cs2 b) = Commented (catMaybes $ zipWith zipTerms cs1 cs2) <$> (zipTerms <$> a <*> b)
zipUnwrap (Fixed a') (Fixed b') = Just . Fixed . catMaybes $ zipWith zipTerms a' b'
zipUnwrap (Keyed a') (Keyed b') | keys a' == keys b' = Just . Keyed . fromList . catMaybes $ zipUnwrapMaps a' b' <$> keys a'
zipUnwrap _ _ = Nothing