[Haskell-cafe] ANNOUCE: one-liner-0, SYB-like generics with constraint kinds
Sjoerd Visscher
sjoerd at w3future.com
Wed Sep 19 23:19:25 CEST 2012
Hi all,
I am pleased to announce the first release of One-Liner, a package for writing short and concise generic instances of type classes. It works a bit like Scrap-Your-Boilerplate, but it uses the new constraint kinds instead of the Typeable class.
On hackage: http://hackage.haskell.org/package/one-liner-0
On github: https://github.com/sjoerdvisscher/one-liner
For example, this is how to write generic equality (using the All monoid):
eqADT :: (ADT t, Constraints t Eq) => t -> t -> Bool
eqADT s t = ctorIndex s == ctorIndex t &&
getAll (mbuilds (For :: For Eq) (\fld -> All $ s ! fld == t ! fld) `at` s)
The code works like this: "Constraints t Eq" means it requires that all subcomponents of type t have an Eq instance, and then values s and t are equal if they are built by the same constructor and each subcomponent is equal.
The package is called One-Liner because the generic functions often end up as short as eqADT, especially if there's already an appropriate Monoid or Applicative functor available.
Here are two more examples, generic put and get for the Binary package (after adding the missing Monoid instance for Put)
putADT :: (ADT t, Constraints t Binary) => t -> Put
putADT t = putWord8 (toEnum (ctorIndex t)) >> gfoldMap (For :: For Binary) put
getADT :: (ADT t, Constraints t Binary) => Get t
getADT = do
ix <- fromEnum <$> getWord8
buildsA (For :: For Binary) (const get) !! ix
Finally, to give a complete sense of what's involved, here's an example data type and its ADT implementation:
data T a = A Int a | B a (T a)
instance ADT (T a) where
ctorIndex A{} = 0
ctorIndex B{} = 1
type Constraints (T a) c = (c Int, c a, c (T a))
buildsRecA For sub rec =
[ (ctor "A", A <$> sub (FieldInfo (\(A i _) -> i)) <*> sub (FieldInfo (\(A _ a) -> a)))
, (ctor "B", B <$> sub (FieldInfo (\(B a _) -> a)) <*> rec (FieldInfo (\(B _ t) -> t)))
]
If you want to learn more, you can find an introductory blog post here:
https://github.com/sjoerdvisscher/blog/blob/master/2012/2012-09-06%20constraint-based%20generics.md
Some complete examples are here:
https://github.com/sjoerdvisscher/one-liner/tree/master/examples
Some more generic functions, including generic Show and Read:
https://github.com/sjoerdvisscher/one-liner/blob/master/src/Generics/OneLiner/Functions.hs
--
Sjoerd Visscher
https://github.com/sjoerdvisscher/blog
More information about the Haskell-Cafe
mailing list