<div dir="ltr">yeah... I dont think close type families can match on the first one, thought its interesting to ask if they should be able to....</div><div class="gmail_extra"><br><br><div class="gmail_quote">On Sat, Mar 15, 2014 at 10:21 AM, Silvio Frischknecht <span dir="ltr"><<a href="mailto:silvio.frischi@gmail.com" target="_blank">silvio.frischi@gmail.com</a>></span> wrote:<br>

<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Hi<br>
<br>
I have been playing around a bit with closed type families. However, I somehow<br>
always bump my head at the fact that things usually doesn't work for Num<br>
without specifying the type.<br>
<br>
Here is an example.<br>
<br>
    {-# LANGUAGE FlexibleInstances         #-}<br>
    {-# LANGUAGE FlexibleContexts          #-}<br>
    {-# LANGUAGE TypeFamilies              #-}<br>
    {-# LANGUAGE DataKinds                 #-}<br>
    {-# LANGUAGE UndecidableInstances      #-}<br>
    {-# LANGUAGE OverlappingInstances      #-}<br>
    {-# LANGUAGE IncoherentInstances       #-}<br>
    module Main where<br>
<br>
    import Data.Typeable<br>
<br>
    type family UnMaybed a where<br>
        UnMaybed (Maybe a) = a<br>
        UnMaybed a = a<br>
<br>
    class UnMaybe x where<br>
        unMaybe :: x -> UnMaybed x<br>
<br>
    instance UnMaybe (Maybe a) where<br>
        unMaybe (Just a) = a<br>
<br>
    instance (UnMaybed a ~ a) => UnMaybe a where<br>
        unMaybe a = a<br>
<br>
    main = do<br>
        print $ unMaybe 'c'<br>
        print $ unMaybe (1::Int)<br>
        print $ unMaybe (Just 1)<br>
        print $ unMaybe 1 -- this line does not compile<br>
<br>
everything except the last line will compile.<br>
<br>
    ../Example.hs:23:17:<br>
        Occurs check: cannot construct the infinite type: s0 ~ UnMaybed s0<br>
        The type variable ‘s0’ is ambiguous<br>
        In the second argument of ‘($)’, namely ‘unMaybe 1’<br>
        In a stmt of a 'do' block: print $ unMaybe 1<br>
<br>
Now I know this is because numbers are polymorphic and (Maybe a) could be an<br>
instance of Num. I think for normal overlapping typeclasses this dilemma can<br>
be solved by using the IncoherentInstances PRAGMA. Anyway, I wanted to ask if<br>
there is a way to make this work in type families?<br>
<br>
I also thought about specifying Num explicitly in UnMaybed<br>
<br>
    type family UnMaybed a where<br>
        unMaybed (Num a => a) = a<br>
        UnMaybed (Maybe a) = a<br>
        UnMaybed a = a<br>
<br>
This compiles but i think the first case will never be matched this is probably<br>
a bug.<br>
<br>
Silvio<br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
</blockquote></div><br></div>