syb
syb copied to clipboard
Implement gzipQ
The following corresponds to gzip, but as a twin query. It took me a few hours to work my head around the twins module, so I thought I'd share it for the next unwitting passerby. Definitely worth a merge, IMO
gzipQ :: forall r. GenericQ (GenericQ [r]) -> GenericQ (GenericQ [r])
gzipQ f = go
where
go :: GenericQ (GenericQ [r])
go x y = f x y <>
if toConstr x == toConstr y
then join $ gzipWithQ go x y
else mempty
mkQQ :: (Monoid r, Typeable a, Typeable b) => (a -> b -> r) -> GenericQ (GenericQ r)
mkQQ f a1 a2 =
case (cast a1, cast a2) of
(Just x, Just y) -> f x y
_ -> mempty
Usage:
data Tree = Leaf | Branch Tree Int Tree
deriving (Data, Typeable)
tree1 = Branch Leaf 0 $ Branch Leaf 1 $ Branch Leaf 2 Leaf
tree2 = Branch Leaf 10 $ Branch (Branch Leaf 20 Leaf) 11 Leaf
correspondingLeaves :: [(Int, Int)]
correspondingLeaves = gzipQ (mkQQ $ \x y -> pure (x, y)) tree1 tree2
-- [(0, 10), (1, 11))]