
Hi Cafe! Disclaimer: I know what I'm going to ask is now available as a language feature normally. And sorry for the subject of this message, I couldn't compe up with a good&descriptive subject. Is there any way to limit a functions type, not by a data type but by a group of constructors of a data type? If not, what would be the *right* thing to do to achieve this level of type safety? data DT1 = X | Y | Z data DT2 = A | B | C | D func1 :: DT1 -> DT2 -- instead of this func1' :: (X|Y) -> (B|C) -- i want sth. like this. (| means or) Only think I can think of is having the constructors, as seperate data types, introducing new type classes to group every possible subset of [X,Y,Z] and [A,B,C,D] and use those type classes when defining the functions. But as you can imagine, this is not the only place I want to use this thing, and the code will start to look cryptic if I do so. I must add, I want to use this *disjunction of constructors* thingy in data type declerations as well. A little bit brainstorming maybe? Thanks in advance, -- Ozgur Akgun

Hi Ozgur, Perhaps you can have a look at what discussion there was about non-empty lists. Seems (slightly) related to me. Matthias.

On Fri, Mar 19, 2010 at 8:15 AM, Ozgur Akgun
Hi Cafe!
Disclaimer: I know what I'm going to ask is now available as a language feature normally.
Did you mean "not available"? I don't know of a Haskell language feature for this, so if you really did mean "now" then I'd love to learn about the feature you're thinking of. Only think I can think of is having the constructors, as seperate data
types, introducing new type classes to group every possible subset of [X,Y,Z] and [A,B,C,D] and use those type classes when defining the functions. But as you can imagine, this is not the only place I want to use this thing, and the code will start to look cryptic if I do so. I must add, I want to use this *disjunction of constructors* thingy in data type declerations as well.
It looks to me like you want dependent types. You might look at Agda. It's similar to Haskell but features dependent types and other interesting things. Jason

Jason,
Oh sorry. I definitely meant not available. I hope it was available though
:)
I'll look into dependent types, sure. But as I said, I can come up with a
way (even though it is ugly) via promoting every constructor to a data type
and using type classes to group different types. This makes me think there
can be a more elegant way of handling it.
Matthias,
I searched in the list, but couldn't find the discussion you've reffered. Do
you have a link to it by any chance?
Thanks for the comments. Anyone else?
On 19 March 2010 19:39, Jason Dagit
On Fri, Mar 19, 2010 at 8:15 AM, Ozgur Akgun
wrote: Hi Cafe!
Disclaimer: I know what I'm going to ask is now available as a language feature normally.
Did you mean "not available"? I don't know of a Haskell language feature for this, so if you really did mean "now" then I'd love to learn about the feature you're thinking of.
Only think I can think of is having the constructors, as seperate data
types, introducing new type classes to group every possible subset of [X,Y,Z] and [A,B,C,D] and use those type classes when defining the functions. But as you can imagine, this is not the only place I want to use this thing, and the code will start to look cryptic if I do so. I must add, I want to use this *disjunction of constructors* thingy in data type declerations as well.
It looks to me like you want dependent types. You might look at Agda. It's similar to Haskell but features dependent types and other interesting things.
Jason
-- Ozgur Akgun

On Fri, Mar 19, 2010 at 03:15:02PM +0000, Ozgur Akgun wrote:
Hi Cafe!
Disclaimer: I know what I'm going to ask is now available as a language feature normally. And sorry for the subject of this message, I couldn't compe up with a good&descriptive subject.
Is there any way to limit a functions type, not by a data type but by a group of constructors of a data type? If not, what would be the *right* thing to do to achieve this level of type safety?
data DT1 = X | Y | Z data DT2 = A | B | C | D
func1 :: DT1 -> DT2 -- instead of this func1' :: (X|Y) -> (B|C) -- i want sth. like this. (| means or)
The standard way to do this is with GADTs and phantom type parameters. Something like this:
data XY data NotXY data BC data NotBC
data DT1 a where X :: DT1 XY Y :: DT1 XY Z :: DT1 NotXY
data DT2 a where A :: DT1 NotBC ... etc.
func1 :: DT1 XY -> DT2 BC ...
Every value of DT1 is tagged with an extra piece of information at the type level saying whether it is X or Y, or not. These extra types are known as "phantom type parameters" since nothing of those types actually show up in the values of the data type (indeed, XY, NotXY, and so on have no values) but they are only there to provide some extra information at the type level. Of course, the only problem with this approach is that if you want another function that only takes Y or Z, you are out of luck without some fancier type hackery. However, if you wish to know about a nice approach to said fancier type hackery, see Wouter Swierstra's paper "Data Types a la Carte" [1]. -Brent [1] http://www.cs.nott.ac.uk/~wss/Publications/DataTypesALaCarte.pdf

Hi,
Only think I can think of is having the constructors, as seperate data types, introducing new type classes to group every possible subset of [X,Y,Z] and [A,B,C,D] and use those type classes when defining the functions.
Wouldn't it be possible to use Either? You make the constructors seperate data types and then have something like
func1 :: Either X Y -> Either B C
When you need more then two alternatives you could define similar datatypes like
OneOfThree x y z = OOTFirst x | OOTSecond y | OOTThird z
or something like
{-# LANGUAGE TypeOperators #-} data Or x y = First x | Second y deriving (Show) infixl 5 `Or`
func :: Int `Or` String `Or` Integer -> String `Or` Integer
but then pattern matching becomes ugly. Christoph

Ozgur Akgun wrote:
Is there any way to limit a functions type, not by a data type but by a group of constructors of a data type? If not, what would be the *right* thing to do to achieve this level of type safety?
data DT1 = X | Y | Z data DT2 = A | B | C | D
func1 :: DT1 -> DT2 -- instead of this func1' :: (X|Y) -> (B|C) -- i want sth. like this. (| means or)
OCaml has a feature called 'polymorphic variants' that allows exactly this. You may want to google 'polymorphic variants in haskell'.

Thank you all very much for the pointers.
Best,
On 22 March 2010 09:32, Gleb Alexeyev
Ozgur Akgun wrote:
Is there any way to limit a functions type, not by a data type but by a group of constructors of a data type? If not, what would be the *right* thing to do to achieve this level of type safety?
data DT1 = X | Y | Z data DT2 = A | B | C | D
func1 :: DT1 -> DT2 -- instead of this func1' :: (X|Y) -> (B|C) -- i want sth. like this. (| means or)
OCaml has a feature called 'polymorphic variants' that allows exactly this. You may want to google 'polymorphic variants in haskell'.
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- Ozgur Akgun
participants (6)
-
Brent Yorgey
-
Christoph Bier
-
Gleb Alexeyev
-
Jason Dagit
-
Matthias Görgens
-
Ozgur Akgun