
I have a user input (string) and need to select one of two types. depending what the input is. is this possible? data A data B data X n = X String op :: String -> X n op "a" = X "a" :: X A op "b" = X "b" :: X B this does obviously not compile. is there a way to achieve that the type X A is produced when the input is "a" and X B when the input is "b"? thank you for help! andrew

What is stopping you from using an enumeration type? data Tag = A | B data X = X String Tag op "a" = X "a" A op "b" = X "b" B On 9/2/10 1:31 PM, Andrew U. Frank wrote:
I have a user input (string) and need to select one of two types. depending what the input is. is this possible?
data A data B
data X n = X String
op :: String -> X n op "a" = X "a" :: X A op "b" = X "b" :: X B
this does obviously not compile. is there a way to achieve that the type X A is produced when the input is "a" and X B when the input is "b"?
thank you for help! andrew
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

What you're asking for is essentially a dependent type (something where a type depends on a value). Haskell doesn't support these, but can approximate them with GADTs: {-# LANGUAGE GADTs, EmptyDataDecls, KindSignatures, Rank2Types #-} data A data B -- The data constructors refine the type index data X :: * -> * where A :: X A B :: X B -- We can't return a different type based on the input string (unless you represent the string as some complex GADT that itself refines the output type), so instead we have a pseudo-existential type represented as a polymorphic function parameter. -- This basically says, "if you give me a string and a function that can work on X n for all values of n, I'll give you something of the same type as the return value of that function" op :: String -> (forall n. X n -> r) -> r op "a" f = f A op "b" f = f B If you give a more detailed example of what you need, we might be able to tell you better approaches, though. This rank-2/existential approach is mostly useful for preserving internal (hidden from the end-user) type-level constraints on GADT indices. On Thu, Sep 2, 2010 at 10:31 PM, Andrew U. Frank < frank22@geoinfo.tuwien.ac.at> wrote:
I have a user input (string) and need to select one of two types. depending what the input is. is this possible?
data A data B
data X n = X String
op :: String -> X n op "a" = X "a" :: X A op "b" = X "b" :: X B
this does obviously not compile. is there a way to achieve that the type X A is produced when the input is "a" and X B when the input is "b"?
thank you for help! andrew
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On Thu, Sep 2, 2010 at 9:31 PM, Andrew U. Frank
I have a user input (string) and need to select one of two types. depending what the input is. is this possible?
data A data B
data X n = X String
op :: String -> X n op "a" = X "a" :: X A op "b" = X "b" :: X B
this does obviously not compile. is there a way to achieve that the type X A is produced when the input is "a" and X B when the input is "b"?
thank you for help! andrew
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Here's another way of not quite doing what you want: op :: String -> Either (X A) (X B) op "a" = Left (X "a") op "b" = Right (X "b") which is roughly how I translate the recent discussion about type-level validity certification: http://www.haskell.org/pipermail/haskell-cafe/2010-August/082899.html

You may also look at Data.Dynamic / Data.Typeable. It may not work really well, depending on how you defined A and B. In GHC, it should work with any type produced with the haskell 98 use of the keyword "data", though. This is the "canonical" solution to cope with the GHC API returning values of arbitrary type. Good luck, Pierre El 02/09/2010, a las 16:31, Andrew U. Frank escribió:
I have a user input (string) and need to select one of two types. depending what the input is. is this possible?
data A data B
data X n = X String
op :: String -> X n op "a" = X "a" :: X A op "b" = X "b" :: X B
this does obviously not compile. is there a way to achieve that the type X A is produced when the input is "a" and X B when the input is "b"?
thank you for help! andrew
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
participants (5)
-
Andrew U. Frank
-
Ben Millwood
-
Daniel Peebles
-
Gregory Crosswhite
-
Pierre-Etienne Meunier