derive-monoid-0.0.0: derive Semigroup/Monoid/IsList

Safe HaskellNone
LanguageHaskell2010

Derive.List

Synopsis

Documentation

when your type can hold a list of itself, deriveList can generate instances for:

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:

instance Semigroup Elisp where
 (<>) x y = ElispSexp (toElispList x <> toElispList y)

instance Monoid Elisp where
 mempty = emptyElisp
 mappend = (<>)

instance IsList Elisp where
 type Item Elisp = Elisp
 fromList = ElispSexp
 toList = 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.

deriveIsList :: Name -> Name -> DecsQ Source

derives IsList only.

Alternatives to derive-monoid

  • manual instances.
  • GeneralizeNewtypeDeriving: works with newtype, but not with data.
  • 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.