[Haskell-cafe] Re: Type hackery help needed!

Niklas Broberg niklas.broberg at gmail.com
Wed Aug 9 18:56:08 EDT 2006


|> It seems you might benefit from local functional dependencies, which
|> are asserted per instance rather than for the whole class. They are
|> explained in
|>
|>         http://pobox.com/~oleg/ftp/Haskell/typecast.html

Unfortunately I come crawling back with a failure. Either my fu was
not strong enough to fully tame the power of the TypeCast, or there's
something here that's trickier than I realize.

This message is a literate haskell source file, and I'll set the scene
more carefully this time. Note that many of my definitions here are
not really definitions but part of the literate comments.

> {-# OPTIONS_GHC -fglasgow-exts #-}
> {-# OPTIONS_GHC -fallow-overlapping-instances #-}
> {-# OPTIONS_GHC -fallow-undecidable-instances #-}
> module GenXML where

We start out with a (very simplified) datatype for XML:

> data XML = Element String [XML] | CDATA String

We want to be able to generate XML values of this type using a
function (not that this is still a comment)

  build :: String -> [XML] -> XML
  build = Element

The intended use of build is as the unsugared counterpart of HSP-style
XML-like syntax, for instance

  p c = <p><% c %></p>  =desugar=> p c = build "p" [embed c]

However, we also want to use this syntax to generate values of other
possible representations of XML, so we put the function definition in
a type class:

> class Build xml child | xml -> child where
>   build :: String -> [child] -> xml
>   asChild :: xml -> child

Read out, we can build values of type xml holding children of type
child. The use of asChild will be evident below. Clearly XML should
fit for this, so we define the instance

> instance Build XML XML where
>  build = Element
>  asChild = id

The next step is to allow values of different types to be embedded
inside XML elements using the embed function:

> class Build xml child => Embed a xml child where
>   embed :: xml -> a -> child

In English, we can embed values of type a into a tree of type xml, by
turning it into something of type child. (The first argument to
'embed' is only there to guide type inference, instantiations of the
class are not allowed to look at it.)

As an example, now we can embed String values into a tree of type XML:

> instance Embed String XML XML where
>  embed _ = CDATA

Clearly we also want to be able to embed XML values as children of
some element, so we could define (comment)

  instance Embed XML XML XML where
   embed _ = id

Now we can define p as

> p c = let x = build "p" [embed x c] in x

and define a test function (comment)

  test :: XML
  test1 = p (p "foo")

and if we do we get the following error from GHCi:
----------------------------------------------------------------
GenXML.hs:25:8:
    No instance for (Embed a xml XML)
      arising from use of `p' at GenXML.hs:25:8
    Probable fix: add an instance declaration for (Embed a xml XML)
    In the definition of `test1': test1 = p (p "foo")

GenXML.hs:25:11:
    No instance for (Embed [Char] xml child)
      arising from use of `p' at GenXML.hs:25:11
    Probable fix: add an instance declaration for (Embed [Char] xml child)
    In the first argument of `p', namely `(p "foo")'
    In the definition of `test1': test1 = p (p "foo")
----------------------------------------------------------------

The problem is that the type of the intermediate value (p "foo")
cannot be determined. Looking at the type of p we see

  p :: (Build a1 child, Embed a xml child) => a -> a1

This is pretty obvious, we have no way of knowing what the result of p
should be just by its use, it is polymorphic in its result type, and
we get no help with inference from the usage site either since it then
occurs in a polymorphic position too.

But my intention here, which is really the core of my problem, is that
I want to disambiguate this problem, by stating (somehow) that if the
result of a build is embedded inside another build, the result types
of the two should be identical. That is, if we want to generate
subtrees of some tree, we should generate them as having the correct
type immediately.

My first attempt was to define the instance

  instance (Build xml child) => Embed xml xml child where
   embed _ x = asChild x

but it didn't quite work out, the instance selection still couldn't
know what the result of the generation should be, so I still get the
same error as above.

When I saw TypeCast I thought I had the answer to my problems, and
tried to define

> class TypeCast   a b   | a -> b, b->a   where typeCast   :: a -> b
> class TypeCast'  t a b | t a -> b, t b -> a where typeCast'  :: t->a->b
> class TypeCast'' t a b | t a -> b, t b -> a where typeCast'' :: t->a->b
> instance TypeCast'  () a b => TypeCast a b where typeCast x = typeCast' () x
> instance TypeCast'' t a b => TypeCast' t a b where typeCast' = typeCast''
> instance TypeCast'' () a a where typeCast'' _ x  = x

> instance (Build xml child, TypeCast x xml) => Embed x xml child where
>    embed _ x = asChild (typeCast x :: xml)

(Btw, why is the type signature needed for typeCast? Shouldn't it be
given by the FD from the TypeCast class?)

The point here is the very general instance head, containing only type
variables, so it will match the result of any call to build. TypeCast
is then used to ensure that what I really get is the same type as that
which I'm trying to embed in.

This works, and I can write for instance

> test2 :: XML
> test2 = p (p (CDATA "foo"))

>From my use of CDATA here I'm sure you can see where I'm headed, if
you didn't already. The above test2 definition type checks and works
as expected, but I still run into a problem if I try to define test1
from above:

  test1 :: XML
  test1 = p (p "foo")

When I try to define this I get the following error from GHCi:
----------------------------------------------------------------
GenXML.hs:29:8:
    Overlapping instances for Embed a XML XML
      arising from use of `p' at GenXML.hs:29:8
    Matching instances:
      GenXML.hs:31:0: instance (Build xml child, TypeCast x xml) =>
Embed x xml child
      GenXML.hs:20:0: instance Embed String XML XML
    (The choice depends on the instantiation of `a'
     Use -fallow-incoherent-instances to use the first choice above)
    In the definition of `test1': test1 = p (p "foo")

GenXML.hs:29:11:
    Overlapping instances for Embed [Char] a child
      arising from use of `p' at GenXML.hs:29:11
    Matching instances:
      GenXML.hs:31:0: instance (Build xml child, TypeCast x xml) =>
Embed x xml child
      GenXML.hs:20:0: instance Embed String XML XML
    (The choice depends on the instantiation of `a, child'
     Use -fallow-incoherent-instances to use the first choice above)
    In the first argument of `p', namely `(p "foo")'
    In the definition of `test1': test1 = p (p "foo")
----------------------------------------------------------------

For the first one, if we turn on incoherent instances we get what we
want. But we would then get the wrong instance for the second one.

Looking at the type signature of the expression p (p "foo") we see that

  p (p "foo") :: (Embed a a1 child, Embed [Char] a child1) => a1

>From the type signature for test1 we know a1 to be XML, and thus by
the FD that child should be XML, so we can simplify this to

 p (p "foo") :: (Embed a XML XML, Embed [Char] a child) => XML

If we look at the first constraint, we would get two possible
instances matching as per the error message above, and similarly for
the second.

So, the error message seems right on the spot, but that doesn't make
me any happier, since I have no idea how to get around this problem.
It seems that the TypeCast trick only works when you have no more
instances than that most general one, but that won't work in my case.
So I come crawling back, hoping to pick up some more wisdom to help me
solve this problematic case.

If you read this long, then thanks a lot for your interest! :-)

/Niklas


More information about the Haskell-Cafe mailing list