[Haskell-cafe] Re: Unwrapping newtypes

Kevin Jardine kevinjardine at gmail.com
Thu Sep 9 03:49:29 EDT 2010


Hi Ertugrul,

My goal was to find a way to define all that was needed using
Haskell's automatic instance deriving mechanism. Haskell can
automatically derive Foldable, which is why I was looking at that.

However, that requires writing two lines for each wrapper newtype to
get around the kind problem.

I wanted one line.

Fortunately,

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

gives me what I want now that I know how it works!

I agree that the Foldable solution was a bit of a kludge.

Kevin

On Sep 9, 3:57 am, Ertugrul Soeylemez <e... at ertes.de> wrote:
> Kevin Jardine <kevinjard... at gmail.com> wrote:
> > I have a generic object that I want to wrap in various newtypes to
> > better facilitate type checking.
>
> > For example,
>
> > newtype Blog = Blog Obj
> > newtype Comment = Comment Obj
> > newtype User = User Obj
>
> > Unlike Obj itself, whose internal structure is hidden in a library
> > module, the newtype wrappings are purely to facilitate type checking.
> > It is no secret that each is just a wrapper around Obj.
>
> > It is obvious how to construct the various wrapper objects. It is not
> > so obvious how to extract the Obj they contain in a reasonably generic
> > way however. What I want is a getObj function that works on all of
> > them.
>
> > Of course this could work if someone using the library wrote an
> > instance for each wrapper object:
>
> > instance GetObject Blog where
> >     getObj (Blog obj) = obj
>
> > but this is a pain in the neck to write for each newtype.
>
> Simple solution:
>
>   data ObjContent = Blah
>
>   data Obj
>     = Blog    { getObj :: !ObjContent }
>     | Comment { getObj :: !ObjContent }
>     | User    { getObj :: !ObjContent }
>
> With your GetObject class this even becomes extensible:
>
>   instance GetObject Obj where
>     getObject = getObj
>
>   data OtherType = OtherType ObjContent
>
>   instance GetObject OtherType where
>     getObject (OtherType obj) = obj
>
> > I discovered that Foldable defines a handy toList function that
> > extracts content from generic Foldable structures.
>
> > So that I could write:
>
> > toObj :: Foldable thing => thing Obj -> Obj
> > toObj w = head $ toList w
>
> > Slightly kludgy but it works.
>
> But it's not what you are looking for.  You are confusing constructor
> types with type kinds.  Foldable expects a type of kind * -> *, which
> isn't quite what you want.  Also I would consider this to be abuse.
> Also from a complexity standpoint it's nothing different from your
> GetObject class anyway.  You still need to write the instances.
>
> Greets,
> Ertugrul
>
> --
> nightmare = unsafePerformIO (getWrongWife >>= sex)http://ertes.de/
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-C... at haskell.orghttp://www.haskell.org/mailman/listinfo/haskell-cafe


More information about the Haskell-Cafe mailing list