[Haskell-cafe] interesting type families problem
Gábor Lehel
illissius at gmail.com
Wed Sep 8 13:20:42 EDT 2010
2010/9/8 Anthony Cowley <acowley at seas.upenn.edu>:
> 2010/9/8 Gábor Lehel <illissius at gmail.com>:
>> Oh. Hmm. That makes sense. So I gather there's absolutely no way to
>> specify which instance you mean, and hence to use `value` as any
>> concrete type?
>
> Here's one way to indicate which value you are referring to.
>
> Anthony
>
> {-# LANGUAGE EmptyDataDecls, TypeFamilies #-}
> data True
> data False
>
> class TypeValue a where
> type ValueTypeOf a
> value :: a -> ValueTypeOf a
>
> instance TypeValue True where
> type ValueTypeOf True = Bool
> value _ = True
>
> instance TypeValue False where
> type ValueTypeOf False = Bool
> value _ = False
>
> main = print (value (undefined::True))
>
Right. You can also use Tagged :) but I meant specifically with the
formulation I presented originally.
{-# LANGUAGE EmptyDataDecls, TypeFamilies #-}
import Data.Tagged
import Control.Applicative
data True :: *
data False :: *
class TypeValue a where
type ValueTypeOf a :: *
value :: Tagged a (ValueTypeOf a)
instance TypeValue True where
type ValueTypeOf True = Bool
value = Tagged True
instance TypeValue False where
type ValueTypeOf False = Bool
value = Tagged False
main = untag $ print <$> (value :: Tagged True (ValueTypeOf True))
--
Work is punishment for failing to procrastinate effectively.
More information about the Haskell-Cafe
mailing list