generic-xml-0.1: Xml/DeriveAll.hs

{-# LANGUAGE TemplateHaskell #-}

module Xml.DeriveAll (deriveAll) where

import Data.Generics as Old
import Data.Generics.SYB.WithClass.Derive
import Language.Haskell.TH

deriveAll :: Q [Dec] -> Q [Dec]
deriveAll qdecs = do decs <- qdecs
                     derivedDecs <- deriveDec (filter isDataOrNewtype decs)
                     let decs' = map deriveOldData decs
                     return (decs' ++ derivedDecs)

deriveOldData :: Dec -> Dec
deriveOldData (DataD ctxt nm tvs cons derivs)
    = DataD ctxt nm tvs cons (''Old.Data : derivs)
deriveOldData (NewtypeD ctxt nm tvs con derivs)
    = NewtypeD ctxt nm tvs con (''Old.Data : derivs)
deriveOldData d = d

isDataOrNewtype :: Dec -> Bool
isDataOrNewtype (DataD {}) = True
isDataOrNewtype (NewtypeD {}) = True
isDataOrNewtype _ = False