<div dir="ltr"><div><div><div><div>Yes, closed type families *can* be used to achieve the same result even now, but it tends to be fairly verbose. There are a number of minor variations in how it can be done, but here's one example:<br><br></div>{-# LANGUAGE TypeFamilies, DataKinds, MultiParamTypeClasses,<br></div><div>      FlexibleInstances, FlexibleInstances, ScopedTypeVariables,<br></div><div>      UndecidableInstances #-}<br></div><div>import Data.Proxy<br></div><div><br></div>class Closed a b where<br></div><div>  fun :: a -> b -> Int<br></div><div><br></div><div>-- Names for the instances<br></div><div>data InstanceChoice = ChooseFirst | ChooseSecond | IgnoreBoth<br></div><div><br></div><div>-- Determine which instance should be used<br></div>type family Choose a b where<br></div>  Choose Int y = 'ChooseFirst<br><div><div><div>  Choose x Int = 'ChooseSecond<br></div><div>  Choose x y = 'IgnoreBoth<br><br></div><div>-- Auxiliary class with instance-choice parameter<br></div><div>class Closed' (choice :: InstanceChoice) a b where<br>  fun' :: proxy choice -> a -> b -> Int<br><br></div><div>-- The actual instances<br></div><div>instance Closed' 'ChooseFirst Int y where fun' _ x _ = x<br></div><div>instance Closed' 'ChooseSecond x Int where fun' _ _ y = y<br></div><div>instance Closed' 'IgnoreBoth x y where fun' _ _ _ = 0<br></div><div><br></div><div>-- Note that ScopedTypeVariables is necessary to make this typecheck.<br></div><div>instance (choice ~ Choose a b, Closed' choice a b) => Closed a b where<br>  fun = fun' (Proxy :: Proxy choice)<br><br></div><div>Then<br><br>> fun (3 :: Int) 'a'<br>3<br>> fun 'a' (4 :: Int)<br>4<br>> fun 'a' 'b'<br>0<br><br></div><div><br></div></div></div></div><div class="gmail_extra"><br><div class="gmail_quote">On Wed, Feb 17, 2016 at 7:21 PM, Imants Cekusins <span dir="ltr"><<a href="mailto:imantc@gmail.com" target="_blank">imantc@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><p dir="ltr">This would be very useful indeed.</p>
<p dir="ltr">Can closed type families not be used to achieve the same result even now, already?</p>
<p dir="ltr">I tried to use type families recently to explicitly pick an (otherwise overlapping) instance in specified order but could not figure out, how.</p>
<p dir="ltr">If someone could give a complete simple example of primary intended use of closed type families with class instances,  this would help a lot.</p>
<br>_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
<br></blockquote></div><br></div>