
Hello Cafe, I was playing around with TypeLits in combination with Typeable (using GHC 7.7.7.20130812 FWIW), but was surprised to find Symbols aren't Typeable, and as such the following doesn't work. Is this intentional, or am I missing something? Thanks, Nicolas {-# LANGUAGE DataKinds, KindSignatures, DeriveFunctor, DeriveDataTypeable #-} module Main where import Data.Typeable import GHC.TypeLits data NoSymbol n a b = NoSymbol a b deriving (Typeable) data WithSymbol (n :: Symbol) a b = WithSymbol a b deriving (Typeable) data Sym deriving (Typeable) main :: IO () main = do print $ typeOf (undefined :: NoSymbol Sym Int Int) let d = undefined :: WithSymbol "sym" Int Int {- print $ typeOf d No instance for (Typeable Symbol "sym") arising from a use of ‛typeOf’ -} return ()

Hi Nicolas,
It's not intentional, but Iavor is aware of this, and we want to change it.
I'm CC-ing him as he might know more about what the current plan is.
Cheers,
Pedro
On Sat, Aug 24, 2013 at 3:20 PM, Nicolas Trangez
Hello Cafe,
I was playing around with TypeLits in combination with Typeable (using GHC 7.7.7.20130812 FWIW), but was surprised to find Symbols aren't Typeable, and as such the following doesn't work. Is this intentional, or am I missing something?
Thanks,
Nicolas
{-# LANGUAGE DataKinds, KindSignatures, DeriveFunctor, DeriveDataTypeable #-} module Main where
import Data.Typeable import GHC.TypeLits
data NoSymbol n a b = NoSymbol a b deriving (Typeable)
data WithSymbol (n :: Symbol) a b = WithSymbol a b deriving (Typeable)
data Sym deriving (Typeable)
main :: IO () main = do print $ typeOf (undefined :: NoSymbol Sym Int Int)
let d = undefined :: WithSymbol "sym" Int Int {- print $ typeOf d
No instance for (Typeable Symbol "sym") arising from a use of 'typeOf' -}
return ()
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Hi guys,
Yep, we know about this and, I believe, the plan is to add custom rules to
the constraint solver to solve `Typable n` constraints (where n is a
number or symbol). Just for the record, the other design choice was to
add instance `Typeable (n :: Symbol)`, but that conflicted with some of the
polymorphic instances already present in the library, so we decided to go
for the custom constraint solver rules.
This should not be hard to do, I just need to sit down and do it---my
current priority has been to catch up the type-nats solver with HEAD and
clean up things for merging.
-Iavor
On Mon, Aug 26, 2013 at 1:19 AM, José Pedro Magalhães
Hi Nicolas,
It's not intentional, but Iavor is aware of this, and we want to change it. I'm CC-ing him as he might know more about what the current plan is.
Cheers, Pedro
On Sat, Aug 24, 2013 at 3:20 PM, Nicolas Trangez
wrote: Hello Cafe,
I was playing around with TypeLits in combination with Typeable (using GHC 7.7.7.20130812 FWIW), but was surprised to find Symbols aren't Typeable, and as such the following doesn't work. Is this intentional, or am I missing something?
Thanks,
Nicolas
{-# LANGUAGE DataKinds, KindSignatures, DeriveFunctor, DeriveDataTypeable #-} module Main where
import Data.Typeable import GHC.TypeLits
data NoSymbol n a b = NoSymbol a b deriving (Typeable)
data WithSymbol (n :: Symbol) a b = WithSymbol a b deriving (Typeable)
data Sym deriving (Typeable)
main :: IO () main = do print $ typeOf (undefined :: NoSymbol Sym Int Int)
let d = undefined :: WithSymbol "sym" Int Int {- print $ typeOf d
No instance for (Typeable Symbol "sym") arising from a use of ‛typeOf’ -}
return ()
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
participants (3)
-
Iavor Diatchki
-
José Pedro Magalhães
-
Nicolas Trangez