derive-topdown-0.0.2.0: Help Haskellers derive class instances for composited data types.

Copyright(c) songzh
LicenseBSD3
MaintainerHaskell.Zhang.Song@hotmail.com
Stabilityexperimental
Safe HaskellNone
LanguageHaskell2010

Data.Derive.TopDown

Description

derive-topdown will make it easier to derive class instance for complex composited data types by using Template Haskell. For using this module, you may need to enable the following langauge extensions: TemplateHaskell, StandaloneDeriving, DeriveGeneric, DeriveDataTypeable, GeneralizedNewtypeDeriving, DeriveAnyClass.

You may also need to enable GHC options -ddump-splices.

For example:

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_adHv)
    deriving instance (Eq a_adHu, Eq a_adHu) => Eq (Department a_adHu)
    deriving instance Eq a_adHt => Eq (Company a_adHt)
    deriving instance Ord Gender
    deriving instance Ord (Person a_adHv)
    deriving instance (Ord a_adHu, Ord a_adHu) =>
                      Ord (Department a_adHu)
    deriving instance Ord a_adHt => Ord (Company a_adHt)
    deriving instance Generic Gender
    deriving instance Generic (Person a_adHv)
    deriving instance Generic (Department a_adHu)
    deriving instance Generic (Company a_adHt)

This will make sense if you have a deep composited data types, nomally an AST of a language.

instance_ and instances functions will generate empty instances. It is not quite useful with GHC newer than 7.10 with DeriveAnyClass extension. However, with older GHC, it may help. The useage is the same with 'deriving' and derivings.

  • NOTE! This is not tested with GHC 7.8.

For other classes whose instance can only be generated by using a function with type Name -> Q [Dec] like Arbitrary in QuickCheck, the derive package provides derive makeArbitrary function. For doing the top-down derive in these cases, deriving_th and deriving_ths are defined. Other example can the deriveXXXX functions in Data.Aeson.TH.

deriving_th (''FromJSON, deriveFromJSON defaultOptions) ''Company
deriving_th (''ToJSON, deriveToJSON defaultOptions)     ''Company

However, the poblem could be that the instance context is generated by the template haskell derive function instead mine, so it could be wrong in some circumtances. For example, a type with high order type constructor:

data T1 k a b = T11 (k a) b | T12 (k (k b)) a b Int

It cannot be derived FromJSON and ToJSON with deriveFromJSON and deriveToJSON since it does not generate (k a) and (k (k b)) for in the instance context.

Also, there are some data types which are impossible to be derived as instances of a certain type class. For example, Word cannot be derived as Functor or Generic. Using derive-topdown is the same with hand-written code, so it is your responsiblity to make that right.

  • NOTE! derive-topdown works with Typeable type class, but there might be problems. Use AutoDeriveTypeable extension if you want derive Typeable class. See README and here.
  • NOTE! When derive Generic type class, derive-topdown will stop generation on primitive and Integer types. You need to specify the types that deriving Generic class can break with. See the document below.
Synopsis

Documentation

deriving_ Source #

Arguments

:: Name

class name

-> Name

type name

-> Q [Dec] 

derivings Source #

Arguments

:: [Name]

class names

-> Name

type name

-> Q [Dec] 

derivingss Source #

Arguments

:: [Name]

class names

-> [Name]

type names

-> Q [Dec] 

deriving_with_breaks Source #

Arguments

:: Name

class name

-> Name

type name

-> [Name]

type names that stop the deriving process

-> Q [Dec] 

This is particularly useful with Generic class.

For the types like Int, Char,Ratio or other types which are not Generic, there must be a way to stop the generation process on those types.

However, the deriving topdown function will only stop generating Generic instances on primitive types and Integer by default, so you do not need to break on them manually.

Another circumtances might be deriving for Typeable class. Since there is a bug in GHC, isInstance function in TH library is not working on Typeable, you can manually give the types which are already instances of Typeable to stop the generation process.

For others cases, there no need to use this function, bacause for a data type A which is composited by another type, when you manually write an instance declaration for A, the process will stop on A automatically since it is already an instance of the type class.

instance_ Source #

Arguments

:: Name

class name

-> Name

type name

-> Q [Dec] 

instances Source #

Arguments

:: [Name]

class names

-> Name

type name

-> Q [Dec] 

instancess Source #

Arguments

:: [Name]

class names

-> [Name]

type names

-> Q [Dec] 

deriving_th Source #

Arguments

:: (Name, Name -> Q [Dec])

class name and corresponding isntance generation function

-> Name

type name

-> Q [Dec] 

deriving_ths Source #

Arguments

:: [(Name, Name -> Q [Dec])]

class names and corresponding instance generation functions

-> Name

type name

-> Q [Dec] 

deriving_thss Source #

Arguments

:: [(Name, Name -> Q [Dec])]

class names and corresponding instance generation functions

-> [Name]

type names

-> Q [Dec] 

stock :: DerivStrategy Source #

The name sock and anyclass are still allowed to be used as functions or arguments. See https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DerivingStrategies

data DerivStrategy #

What the user explicitly requests when deriving an instance.

Constructors

StockStrategy

A "standard" derived instance

AnyclassStrategy
-XDeriveAnyClass
NewtypeStrategy
-XGeneralizedNewtypeDeriving
Instances
Eq DerivStrategy 
Instance details

Defined in Language.Haskell.TH.Syntax

Data DerivStrategy 
Instance details

Defined in Language.Haskell.TH.Syntax

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> DerivStrategy -> c DerivStrategy #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c DerivStrategy #

toConstr :: DerivStrategy -> Constr #

dataTypeOf :: DerivStrategy -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c DerivStrategy) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DerivStrategy) #

gmapT :: (forall b. Data b => b -> b) -> DerivStrategy -> DerivStrategy #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DerivStrategy -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DerivStrategy -> r #

gmapQ :: (forall d. Data d => d -> u) -> DerivStrategy -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> DerivStrategy -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> DerivStrategy -> m DerivStrategy #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> DerivStrategy -> m DerivStrategy #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> DerivStrategy -> m DerivStrategy #

Ord DerivStrategy 
Instance details

Defined in Language.Haskell.TH.Syntax

Show DerivStrategy 
Instance details

Defined in Language.Haskell.TH.Syntax

Generic DerivStrategy 
Instance details

Defined in Language.Haskell.TH.Syntax

Associated Types

type Rep DerivStrategy :: * -> * #

type Rep DerivStrategy 
Instance details

Defined in Language.Haskell.TH.Syntax

type Rep DerivStrategy = D1 (MetaData "DerivStrategy" "Language.Haskell.TH.Syntax" "template-haskell" False) (C1 (MetaCons "StockStrategy" PrefixI False) (U1 :: * -> *) :+: (C1 (MetaCons "AnyclassStrategy" PrefixI False) (U1 :: * -> *) :+: C1 (MetaCons "NewtypeStrategy" PrefixI False) (U1 :: * -> *)))