Safe Haskell | None |
---|---|
Language | Haskell2010 |
- deriveList :: Name -> Name -> DecsQ
- deriveMonoid :: Name -> Name -> DecsQ
- deriveSemigroup :: Name -> Name -> DecsQ
- deriveIsList :: Name -> Name -> DecsQ
- data DeriveListConfig = DeriveListConfig {
- _getEmptyName :: String -> String
- _getAppendName :: String -> String
- _getToListName :: String -> String
- deriveListWith :: DeriveListConfig -> Name -> Name -> DecsQ
- deriveMonoidWith :: DeriveListConfig -> Name -> Name -> DecsQ
- deriveSemigroupWith :: DeriveListConfig -> Name -> Name -> DecsQ
- deriveIsListWith :: DeriveListConfig -> Name -> Name -> DecsQ
Documentation
when your type can hold a list of itself, deriveList
can generate instances for:
Semigroup
Monoid
IsList
which are lawful (trivially, being based on the list instances).
usage:
data T = ... | C [T] | ... deriveList ''T 'C
Examples
this declaration:
{-# LANGUAGE TemplateHaskell, TypeFamilies #-} -- minimal extensions necessary
{-# OPTIONS_GHC -ddump-splices #-} -- prints out the generated code
import GHC.Exts (IsList (..)) -- minimal imports necessary
import Data.Semigroup -- from the semigroups package
-- a sum type
data Elisp
= ElispAtom (Either String Integer)
| ElispSexp [Elisp]
deriveList
''Elisp 'ElispSexp
generates these instances:
instanceSemigroup
Elisp where (<>
) x y = ElispSexp (toElispList x<>
toElispList y) instanceMonoid
Elisp wheremempty
= emptyElispmappend
= (<>
) instanceIsList
Elisp where typeItem
Elisp = ElispfromList
= ElispSexptoList
= toElispList emptyElisp :: ElispSexp emptyElisp = ElispSexp [] toElispList :: Elisp -> [Elisp] toElispList (ElispSexp ts) = ts toElispList t = [t]
Documentation
you can document functions/variables (though not instances), by placing their signatures after the macro:
data Elisp
= ElispAtom (Either String Integer)
| ElispSexp [Elisp]
deriveList
''Elisp 'ElispSexp
-- | ...
emptyElisp :: Elisp
-- | ...
appendElisp :: Elisp -> Elisp -> Elisp
-- | ...
toElispList :: Elisp -> [Elisp]
Kind
works on type constructors of any kind. that is, a polymorphic Elisp
would work too:
data Elisp a
= ElispAtom a
| ElispSexp [Elisp a]
deriveList
''Elisp 'ElispSexp
Selecting Instances
if you don't want all three instances, you can use one of:
but only one, as they would generate duplicate declarations.
data DeriveListConfig Source
DeriveListConfig | |
|
deriveListWith :: DeriveListConfig -> Name -> Name -> DecsQ Source
deriveMonoidWith :: DeriveListConfig -> Name -> Name -> DecsQ Source
deriveSemigroupWith :: DeriveListConfig -> Name -> Name -> DecsQ Source
derives Semigroup
only.
deriveIsListWith :: DeriveListConfig -> Name -> Name -> DecsQ Source
derives IsList
only.
Alternatives to derive-monoid
- manual instances.
GeneralizeNewtypeDeriving
: works withnewtype
, but not withdata
.- the semigroups package: derives a different semigroup (i.e. pairwise appending, when your type is a product type), which isn't valid for sum types.
- the derive package: derives a different monoid (i.e. pairwise appending, when your type is a product type), which isn't valid for sum types. it also doesn't work with Semigroup.