Interactive code snippets not yet available for SoH 2.0, see our Status of of School of Haskell 2.0 blog post

Making class instances topdown

The problem

When I was reading SPJ's series of papers on SYB, I feel this is really an abstract and very good way to manipulate complex data. However, I quickly run into an annoying state when make instances for Data, Typeable, Show and many other class instances. There might be a quick solution with CPP language extension like the following:


#define DERIVINGS deriving (Typeable, Data ,Show, Eq,Generic)
data Company = C [Dept]  DERIVINGS
data Dept = D Name Manager [SubUnit] DERIVINGS
data SubUnit = PU Employee | DU Dept DERIVINGS
data Employee = E Person Salary DERIVINGS
data Person = P Name Address DERIVINGS
data Salary = S Float DERIVINGS
type Manager = Employee
type Name = String 
type Address = String

#undef DERIVINGS

You might think this is a joke and yes it is. And this kind of joke comes up over and over agagin. Back in days of GHC 7.8, the data types in Language.Haskell.TH are not instances of Generic. If you want to make them instances of it then do it like the follwoing:

deriving instance Generic FixityDirection
deriving instance Generic Inline
deriving instance Generic RuleBndr
deriving instance Generic Match
deriving instance Generic Name
deriving instance Generic RuleMatch
deriving instance Generic Pred
deriving instance Generic Phases
deriving instance Generic Con
deriving instance Generic Module
deriving instance Generic AnnTarget
deriving instance Generic Type
deriving instance Generic TyVarBndr
deriving instance Generic TyLit
deriving instance Generic Exp
deriving instance Generic Lit
deriving instance Generic Pat
deriving instance Generic Dec
deriving instance Generic Clause
deriving instance Generic FunDep
deriving instance Generic Foreign
deriving instance Generic Fixity
deriving instance Generic Pragma
deriving instance Generic FamFlavour
...

You will not go crazy until you find you have Binary or other many empty instances to write.

When I was working with jvm-codec to generate some bytecode with JVM, I want to pretty print the AST in it and the code is like the following:

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving , CPP#-}
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
module Codec.JVM.Pretty 
    (module Text.PrettyPrint.GenericPretty)
    where

import Codec.JVM
import Codec.JVM.ASM.Code.Instr
import Codec.JVM.ConstPool
import Codec.JVM.Const
import Codec.JVM.Method
import Codec.JVM.Field
import Codec.JVM.Attr
import Codec.JVM.ASM.Code.CtrlFlow

import GHC.Generics
import Text.PrettyPrint.GenericPretty
import Text.PrettyPrint
import Codec.JVM.Pretty.GenericOut

#define DERIVE_INSTANCE(T) deriving instance Generic (T); deriving instance Out (T)
DERIVE_INSTANCE(ClassFile)
DERIVE_INSTANCE(Version)
DERIVE_INSTANCE(IClassName)
DERIVE_INSTANCE(Const)
DERIVE_INSTANCE(MethodInfo)
DERIVE_INSTANCE(FieldInfo)
DERIVE_INSTANCE(AccessFlag)
DERIVE_INSTANCE(Attr)
DERIVE_INSTANCE(NameAndDesc)
DERIVE_INSTANCE(MethodRef)
DERIVE_INSTANCE(FieldRef)
DERIVE_INSTANCE(ConstVal)
DERIVE_INSTANCE(UName)
DERIVE_INSTANCE(Desc)
DERIVE_INSTANCE(Code)
DERIVE_INSTANCE(Offset)
DERIVE_INSTANCE(FieldType)
DERIVE_INSTANCE(PrimType)
DERIVE_INSTANCE(StackMapFrame)
DERIVE_INSTANCE(InnerClassMap)
DERIVE_INSTANCE(InnerClass)
DERIVE_INSTANCE(VerifType)
DERIVE_INSTANCE(MethodDef)
DERIVE_INSTANCE(MethodDesc)
#undef DERIVE_INSTANCE

deriving instance Generic (Signature a)
deriving instance Out a => Out (Signature a)

deriving instance Generic (MethodSignature a)
deriving instance Out a => Out (MethodSignature a)

deriving instance Generic (FieldSignature a)
deriving instance Out a => Out (FieldSignature a)

deriving instance Generic (ClassSignature a)
deriving instance Out a => Out (ClassSignature a)

deriving instance Generic (TypeVariableDeclaration a)
deriving instance Out a => Out (TypeVariableDeclaration a)

deriving instance Generic (ReferenceParameter a)
deriving instance Out a => Out (ReferenceParameter a)

deriving instance Generic (Parameter a)
deriving instance Out a => Out (Parameter a)

deriving instance Generic (TypeParameter a)
deriving instance Out a => Out (TypeParameter a)

deriving instance Generic (Bound a)
deriving instance Out a => Out (Bound a)

instance Out Instr where
  docPrec n x = parens $ text (show x)
  doc = docPrec 0  

The solution

So I post https://ghc.haskell.org/trac/ghc/ticket/10607. And in ICFP 2016 Nara, I demostrated another solution for this class instance deriving problem. Use a package called derive-topdown

Here, I introduce only standalone deriving and template Haskell

1. Standalone deriving

There are functions named deriving_, derivings, derivingss. Please see the API for their types.

{-# LANGUAGE StandaloneDeriving,
    ConstraintKinds,
    UndecidableInstances,
    GADTs,
    TemplateHaskell,
    DeriveGeneric #-}
{-# OPTIONS_GHC -ddump-splices #-}

import Data.Derive.TopDown
import GHC.Generics
import Data.Binary
imoprt Data.Aeson
import Data.Aeson.TH

data Gender = Male | Female
type Age = Int
data Person a = P {name :: String , age :: Int, gender :: Gender}
data Department a = D {dname :: String , 
                       head :: Person a, 
                       staff :: [Person a]}
data Company a = C {cname :: String, 
                    departments :: [Department a]}

derivings [''Eq, ''Ord, ''Generic] ''Company

You will get:

    derivings [''Eq, ''Ord, ''Generic] ''Company
  ======>
    deriving instance Eq Gender
    deriving instance Eq (Person a_acKV)
    deriving instance Eq a_acKU => Eq (Department a_acKU)
    deriving instance Eq a_acKT => Eq (Company a_acKT)
    deriving instance Ord Gender
    deriving instance Ord (Person a_acKV)
    deriving instance Ord a_acKU => Ord (Department a_acKU)
    deriving instance Ord a_acKT => Ord (Company a_acKT)
    deriving instance Generic Gender
    deriving instance Generic (Person a_acKV)
    deriving instance Generic (Department a_acKU)
    deriving instance Generic (Company a_acKT)

2. Usage with Template Haskell

For generating instances with a template Haskell function, derivingTH, derivingTHs and derivingTHss can be used:

   derivingTHs
      [(''ToJSON, deriveToJSON defaultOptions),
       (''FromJSON, deriveFromJSON defaultOptions)]
      ''Company
  ======>
    instance ToJSON Gender where
      toJSON
        = \ value_amQG
            -> case value_amQG of {
                 Male -> String (text-1.2.2.2:Data.Text.pack "Male")
                 Female -> String (text-1.2.2.2:Data.Text.pack "Female") }
      toEncoding
        = \ value_amQH
            -> case value_amQH of {
                 Male
                   -> Data.Aeson.Encoding.Internal.text
                        (text-1.2.2.2:Data.Text.pack "Male")
                 Female
                   -> Data.Aeson.Encoding.Internal.text
                        (text-1.2.2.2:Data.Text.pack "Female") }
    instance ToJSON a_amqg => ToJSON (Person a_amqg) where
      toJSON
        = \ value_amQy
        ...
        ...
comments powered by Disqus