Capturing typeclass dictionaries from constructors

Hi All I've asked the following question on StackOverflow, but I thought here might be a good place for it also. Sorry for the crosspost but I'm never sure what the best place to ask Haskell questions is: https://stackoverflow.com/questions/73244177/capturing-typeclass-dictionarie... I've copied the StackOverflow post below: --- Below is code that will happily compile (once adding the constraints package). Foo1 and Foo2 are two alternate definitions of Foo, which I can write f1 and f2 sensibly for. However, I *think* Foo3 is reasonable as well. Yet I don't know how to write f3. It seems to me that Haskell should store a pointer to the typeclass dictionary inside the Foo3 constructor, for whatever a is passed when Foo3 is created, so then I should be able to just call silly. Since silly just returns String, it doesn't matter if a has been erased by now, I should be able to happily call the silly pointed to by the dictionary stored in the constructor Foo3. Is my reasoning right? And if so, how can I write f3. Alternative, have I missed something and is there a good reason why I need either Dict or Proxy here because without them I haven't got enough information? {-# LANGUAGE ScopedTypeVariables #-} import Data.Constraint (Dict(Dict), withDict)import Data.Proxy (Proxy) data Aliceclass C a where silly :: Stringinstance C Alice where silly = "Silly Alice" data Foo1 where Foo1 :: Dict (C a) -> Foo1 f1 :: Foo1 -> Stringf1 (Foo1 (dict :: Dict (C a))) = withDict dict $ silly @a data Foo2 where Foo2 :: C a => Proxy a -> Foo2 f2 :: Foo2 -> Stringf2 (Foo2 (_ :: Proxy a)) = silly @a data Foo3 where Foo3 :: C a => Foo3 mkFoo3 :: forall a. C a => Foo3mkFoo3 = Foo3 @a f3 :: Foo3 -> Stringf3 = undefined

On Fri, Aug 05, 2022 at 01:58:20PM +1000, Clinton Mead wrote:
I've asked the following question on StackOverflow, but I thought here might be a good place for it also. Sorry for the crosspost but I'm never sure what the best place to ask Haskell questions is:
https://stackoverflow.com/questions/73244177/capturing-typeclass-dictionarie...
With minor changes it works: λ> :set -package constraints λ> :load foo.hs λ> :set -XTypeApplications λ> f3 (mkFoo3 @Alice) "Silly Alice" Code below. Which is not to say that this is a best-practice design. For many use-cases of runtime typing, the "Dynamic" API: https://www.microsoft.com/en-us/research/wp-content/uploads/2016/08/dynamic.... https://hackage.haskell.org/package/base-4.16.3.0/docs/Data-Dynamic.html is likely a better fit. Of course since TypeReps can't capture class instancess (Haskell is not C++) dynamic class instances need additional machinery. See related: https://stackoverflow.com/questions/38521481/haskell-dynamic-typerep-extract... -- Viktor. {-# LANGUAGE AllowAmbiguousTypes, GADTs, ScopedTypeVariables, TypeApplications #-} import Data.Constraint (Dict(Dict), withDict) import Data.Proxy (Proxy) class C a where silly :: String data Alice instance C Alice where silly = "Silly Alice" data Foo1 where Foo1 :: Dict (C a) -> Foo1 f1 :: Foo1 -> String f1 (Foo1 (dict :: Dict (C a))) = withDict dict $ silly @a data Foo2 where Foo2 :: C a => Proxy a -> Foo2 f2 :: Foo2 -> String f2 (Foo2 (_ :: Proxy a)) = silly @a data Foo3 where Foo3 :: forall a. C a => Foo3 mkFoo3 :: forall a. C a => Foo3 mkFoo3 = Foo3 @a f3 :: Foo3 -> String f3 (Foo3 @a) = silly @a
participants (2)
-
Clinton Mead
-
Viktor Dukhovni