So, I have an AST data type with a large number of cases, which is parameterized by an "annotation" type
data Expr a = Plus a Int Int
| ...
| Times a Int Int
I have annotation types S
and T
, and some function f :: S -> T
. I want to take an Expr S
and convert it to an Expr T
using my conversion f
on each S
which occurs within an Expr value.
Is there a way to do this using SYB or generics and avoid having to pattern match on every case? It seems like the type of thing that this is suited for. I just am not familiar enough with SYB to know the specific way to do it.
It sounds like you want a Functor
instance. This can be automatically derived by GHC using the DeriveFunctor
extension.
Based on your follow-up question, it seems that a generics library is more appropriate to your situation than Functor. I'd recommend just using the function given on SYB's wiki page:
{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, FlexibleContexts #-}
import Data.Generics
import Unsafe.Coerce
newtype C a = C a deriving (Data,Typeable)
fmapData :: forall t a b. (Typeable a, Data (t (C a)), Data (t a)) =>
(a -> b) -> t a -> t b
fmapData f input = uc . everywhere (mkT $ \(x::C a) -> uc (f (uc x)))
$ (uc input :: t (C a))
where uc = unsafeCoerce
The reason for the extra C
type is to avoid a problematic corner case where there are occurrences of fields at the same type as a
(more details on the wiki). The caller of fmapData
doesn't need to ever see it.
This function does have a few extra requirements compared to the real fmap
: there must be instances of Typeable
for a
, and Data
for t a
. In your case t a
is Expr a
, which means that you'll need to add a deriving Data
to the definition of Expr
, as well as have a Data
instance in scope for whatever a
you're using.