{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
import Data.Typeable
import GHC.Generics
rewrite_
:: (Generic a, Generic b, Rewriter (Rep a), Rewrite (Rep a) ~ Rep b)
=> a -> b
rewrite_ = to . rewrite False . from
class Rewriter f where
type Rewrite f :: * -> *
rewrite :: Bool -> f a -> (Rewrite f) a
instance Rewriter f => Rewriter (M1 i c f) where
type Rewrite (M1 i c f) = M1 i c (Rewrite f)
rewrite x = M1 . rewrite x . unM1
instance Typeable c => Rewriter (K1 i c) where
type Rewrite (K1 i c) = K1 i String
rewrite False (K1 x) | Just val <- cast x = K1 val
rewrite _ _ = K1 "NIL"
instance (Rewriter a, Rewriter b) => Rewriter (a :*: b) where
type Rewrite (a :*: b) = Rewrite a :*: Rewrite b
rewrite x (a :*: b) = rewrite x a :*: rewrite True b
y0 :: (String, Int, Double)
y0 = ("something", 3, 4.788)
y1 :: (String, String, String, (Int, Int))
y1 = ("something else", "Hello", "NIL", (4,6))
main :: IO ()
main = do
print (rewrite_ y0 :: (String, String, String))
print (rewrite_ y1 :: (String, String, String, String))