[Haskell-cafe] Re: [Haskell] boilerplate boilerplate

Jacques Carette carette at mcmaster.ca
Tue May 22 19:51:41 EDT 2007


Personally I would like
{-# OPTIONS -fglasgow-exts -fgenerics -}
module Blog.Types where

family Usual = (Eq, Ord, Read, Show, Typeable)

data BlogEntry = Entry EpochSeconds Name Email Title Body  deriving Usual
newtype Name = Name String   deriving Usual
newtype Title = Title String deriving Usual
newtype Body = Body String deriving Usual

Of course, if you're doing that, you might as well change those last 3 
lines with
newtype-schema NamedString = NamedString String deriving Usual
instantiate NamedString with Name, Title, Body

To me, that is very clear.  Syntax-wise, I am sure things can be 
improved (but I rather like 'family', 'foo-schema' and 'instantiate', 
but not really the 'with').

Jacques

Alex Jacobson wrote:
> Consider this module for a blog entry that I will want to put in 
> various generic collections that require Ord
>
>   {-# OPTIONS -fglasgow-exts #-}
>   module Blog.Types where
>   import Data.Typeable
>   import Data.Generics
>
>   data BlogEntry = Entry EpochSeconds Name Email Title Body 
>                    deriving (Eq,Ord,Read,Show,Typeable)
>
>   newtype Name = Name String deriving (Eq,Ord,Read,Show,Typeable)
>   newtype Title = Title String deriving (Eq,Ord,Read,Show,Typeable)
>   newtype Body = Body String deriving (Eq,Ord,Read,Show,Typeable)
>
>
> It seems really unnecessarily verbose.  Having to add the OPTION 
> header AND import Data.Typeable and Data.Generics just to derive 
> Typeable is a beat-down.  It is even more of a beat-down to have to 
> add a deriving clause for every newtype to make this all work nicely.  
> Is there a way to make all types automatically derive everything 
> unless there is an explicit instance declaration otherwise?
>
>   {-# OPTIONS -fglasgow-exts -fgenerics -fderiving#-}
>   module Blog.Types where
>
>   data BlogEntry = Entry EpochSeconds Name Email Title Body 
>   newtype Name = Name String   newtype Title = Title String   newtype 
> Body = Body String
> Isn't that much nicer?
>
> -Alex-
>
>
> _______________________________________________
> Haskell mailing list
> Haskell at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell


More information about the Haskell-Cafe mailing list