[Haskell-cafe] Ambiguous type variable with subclass instance
(also: is there a better way to do this?)
José Pedro Magalhães
jpm at cs.uu.nl
Thu Sep 17 09:56:03 EDT 2009
Hey Andy,
On Thu, Sep 17, 2009 at 15:40, Andy Gimblett <haskell at gimbo.org.uk> wrote:
>
> Now, some of those algebraic data type types happen to be
> enumerations; in this case, my idea is to list the constructors, with
> the rule that each constructor's position in the list is the Int which
> gets converted into that constructor.
>
> > class Enumerated a where
> > constructors :: [a]
>
> E.g. here's a type Bar with three constructors:
>
> > data Bar = X | Y | Z deriving (Show)
> > instance Enumerated Bar where
> > constructors = [X, Y, Z]
>
> (This is certainly ugly. Any suggestions?)
>
|constructors| is expressible in SYB:
{-# LANGUAGE ScopedTypeVariables #-}
> {-# LANGUAGE FlexibleContexts #-}
>
> module Test where
>
> import Data.Data
> import Data.Generics.Aliases (extB)
>
> -- | Construct the empty value for a datatype. For algebraic datatypes, the
> -- leftmost constructor is chosen.
> empty :: forall a. Data a => a
> empty = general
> `extB` char
> `extB` int
> `extB` integer
> `extB` float
> `extB` double where
> -- Generic case
> general :: Data a => a
> general = fromConstrB empty (indexConstr (dataTypeOf general) 1)
>
> -- Base cases
> char = '\NUL'
> int = 0 :: Int
> integer = 0 :: Integer
> float = 0.0 :: Float
> double = 0.0 :: Double
>
> -- | Return a list of values of a datatype. Each value is one of the
> possible
> -- constructors of the datatype, populated with 'empty' values.
> constrs :: forall a. Data a => [a]
> constrs = general
> `extB` char
> `extB` int
> `extB` integer
> `extB` float
> `extB` double where
> -- Generic case
> general :: Data a => [a]
> general = map (fromConstrB empty)
> (dataTypeConstrs (dataTypeOf (unList general))) where
> unList :: Data a => [a] -> a
> unList = undefined
>
> -- Base cases
> char = "\NUL"
> int = [0 :: Int]
> integer = [0 :: Integer]
> float = [0.0 :: Float]
> double = [0.0 :: Double]
>
|constrs| is similar to your |constructors|, but in this way you get it for
free for any datatype with a |Data| instance. Then I guess your |convert|
is:
convert :: forall a. Data a => Int -> Maybe a
> convert n = let cs :: [a]
> cs = constrs
> in if (length cs > n) then (Just (cs !! n)) else Nothing
>
Note that ScopedTypeVariables are essential to typecheck this code.
Cheers,
Pedro
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20090917/4c9e2053/attachment.html
More information about the Haskell-Cafe
mailing list