Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Generic programming in Haskell with SYB and ad-hoc polymorphism

I have a class identical to Show and I would like to make an instance of this class for each tuple type. Usually this is done by writing separately instances for each tuple type

instance  (Show a, Show b) => Show (a,b)  where
  showsPrec _ (a,b) s = show_tuple [shows a, shows b] s

instance (Show a, Show b, Show c) => Show (a, b, c) where
  showsPrec _ (a,b,c) s = show_tuple [shows a, shows b, shows c] s

instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
  showsPrec _ (a,b,c,d) s = show_tuple [shows a, shows b, shows c, shows d] s
...

Writing one instance per tuple type results in a lot of boilerplate and it's easy to see the common pattern shared among all the showPrec implementations. To avoid this kind of boilerplate I thought I could use Data.Generics from Scrap your boilerplate and implement a folding over tuples, like

showTuple = intercalate " " . gmapQ ("" `mkQ` show)

But showTuple doesn't work for some reason

> showTuple (1,2)
" "

I think the problem is the fact that show is polymorphic because if I specialize showTuple then it works

showTupleInt = intercalate " " . gmapQ ("" `mkQ` (show :: Int -> String))
> showTupleInt (1::Int,2::Int)
"1 2"

I have checked the code of gshow that does something similar to what I need, but I can't figure out how it works. If I try to import its code into GHCI I get an error:

> let gshows = (\t -> showChar '('
                      . (showString . showConstr . toConstr $ t)
                      . (foldr (.) id . gmapQ ((showChar ' ' .) . gshows) $ t)
                      . showChar ')'
                      ) `extQ` (shows :: String -> ShowS)
<interactive>:262:59:
Could not deduce (a ~ d)
from the context (Data a)
  bound by the inferred type of
           gshows :: Data a => a -> String -> String
  at <interactive>:(259,5)-(264,44)
or from (Data d)
  bound by a type expected by the context:
             Data d => d -> String -> String
  at <interactive>:262:33-65
  `a' is a rigid type variable bound by
      the inferred type of gshows :: Data a => a -> String -> String
      at <interactive>:259:5
  `d' is a rigid type variable bound by
      a type expected by the context: Data d => d -> String -> String
      at <interactive>:262:33
Expected type: d -> String -> String
  Actual type: a -> String -> String
In the second argument of `(.)', namely `gshows'
In the first argument of `gmapQ', namely
  `((showChar ' ' .) . gshows)'
In the second argument of `(.)', namely
  `gmapQ ((showChar ' ' .) . gshows)'

So I have two questions:

  1. what's wrong with showTuple and how can I fix it such that it will work with tuples of any size
  2. how gshow works and why if I import its code on GHCI I get that error?

EDIT: I'm studying Data.Generics and in general SYM, so I would like to use that module. I will accept an answer only if it uses just that module. Thanks.

like image 281
mariop Avatar asked Dec 27 '13 18:12

mariop


2 Answers

I'm more familiar with GHC Generics, rather than with SYB, so I'm offering a solution based on Generics. While it doesn't directly answer your question, I hope it could be also useful.

{-# LANGUAGE TypeOperators, FlexibleContexts, DefaultSignatures #-}
import Data.Sequence
import GHC.Generics

class Strs' f where
    strings' :: f a -> Seq String

instance Strs' U1 where
    strings' U1 = empty

instance Show c => Strs' (K1 i c) where
    strings' (K1 a) = singleton $ show a

instance (Strs' a) => Strs' (M1 i c a) where
    strings' (M1 a) = strings' a

instance (Strs' f, Strs' g) => Strs' (f :*: g) where
    strings' (a :*: b) = strings' a >< strings' b

class Strs a where
    strings :: a -> Seq String
    default strings :: (Generic a, Strs' (Rep a)) => a -> Seq String
    strings = strings' . from

-- Since tuples have Generic instances, they're automatically derived using
-- the above default.
instance Strs () where
instance (Show a, Show b) => Strs (a, b) where
instance (Show a, Show b, Show c) => Strs (a, b, c) where
like image 96
Petr Avatar answered Sep 28 '22 02:09

Petr


You could use syb-with-class. It predates -XConstraintKinds, so you need to write an instance of a Sat class and derive the Data class that this library derives. Here is an example, that's pretty close to the showTuple example, except I add some {}:

{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TemplateHaskell, UndecidableInstances #-}
import Data.Generics.SYB.WithClass.Basics
import Data.Generics.SYB.WithClass.Instances
import Data.Generics.SYB.WithClass.Derive

data A a b c = A a b c deriving Show
data B a = B a deriving Show
data C a = C a deriving Show

derive [''A,''B,''C]

data ShowD a = ShowD { showD :: a -> String -> String }
instance (Show a) => Sat (ShowD a) where
    dict = ShowD shows

gshow x = case gfoldl ctx 
                (\ (s, f) x -> (s . ("{"++) . showD dict x . ("}"++) , f x))
                (\y -> (id ,y))
                x
        of (str,_) -> str ""
    where
        ctx :: Proxy ShowD
        ctx = undefined

x1 = A (B 'b') (C "abc") (B ())

{-
>>> gshow x1
"{B 'b'}{C \"abc\"}{B ()}"

>>> show x1
"A (B 'b') (C \"abc\") (B ())"
-}

The second argument to gfoldl gets to call shows (B 'b'), shows (C "abc") and shows (B ()) thanks to the showD dict which gets the shows function with the correct type.

like image 45
aavogt Avatar answered Sep 28 '22 01:09

aavogt