Tuple predicates in Template Haskell

Hi, I try to make my way through #7021 [1]. Unfortunately, there is nothing in the ticket about what should be expected from the code given as example. I came with an implementation and I would like feedback from you guys. So, considering this snippet: -- {-# LANGUAGE ConstraintKinds #-} type IOable a = (Show a, Read a) foo :: IOable a => a foo = undefined -- This is what I got now when pretty-printing TH.Info after reify "foo" call: VarI Tuple.foo (ForallT [PlainTV a_1627398594] [TupleP 2 [AppT (ConT GHC.Show.Show) (VarT a_1627398594),AppT (ConT GHC.Read.Read) (VarT a_1627398594)]] (VarT a_1627398594)) Nothing (Fixity 9 InfixL) Does that sound right to you ? Thanks for your time -- Yorick [1] https://ghc.haskell.org/trac/ghc/ticket/7021

Hello Yorick, Thanks for taking this one on! First off, this kind of question/post is appropriate for putting right into the ticket itself. Posting a comment to the ticket makes it more likely that you'll get a response and saves your thoughts for posterity. Now, on to your question: That seems somewhat reasonable, but I think your work could go a little further. It looks like you've introduced TupleP as a new constructor for Pred. This, I believe, would work. But, I think it would be better to have a way of using *any* type as a predicate in TH, as allowed by ConstraintKinds. Perhaps one way to achieve this is to make Pred a synonym of Type, or there could be a TypeP constructor for Pred. In any case, I would recommend writing a wiki page up with a proposed new TH syntax for predicates and then posting a link to the proposal on the #7021 ticket. Then, it will be easier to debate the merits of any particular approach. Once again, thanks! Richard On Jan 3, 2014, at 6:13 PM, Yorick Laupa wrote:
Hi,
I try to make my way through #7021 [1]. Unfortunately, there is nothing in the ticket about what should be expected from the code given as example.
I came with an implementation and I would like feedback from you guys. So, considering this snippet:
-- {-# LANGUAGE ConstraintKinds #-}
type IOable a = (Show a, Read a)
foo :: IOable a => a foo = undefined --
This is what I got now when pretty-printing TH.Info after reify "foo" call:
VarI Tuple.foo (ForallT [PlainTV a_1627398594] [TupleP 2 [AppT (ConT GHC.Show.Show) (VarT a_1627398594),AppT (ConT GHC.Read.Read) (VarT a_1627398594)]] (VarT a_1627398594)) Nothing (Fixity 9 InfixL)
Does that sound right to you ?
Thanks for your time
-- Yorick
[1] https://ghc.haskell.org/trac/ghc/ticket/7021 _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://www.haskell.org/mailman/listinfo/ghc-devs

Thanks Richard !
I followed your advice and posted a new comment to the ticket
Yorick
2014/1/6 Richard Eisenberg
Hello Yorick,
Thanks for taking this one on!
First off, this kind of question/post is appropriate for putting right into the ticket itself. Posting a comment to the ticket makes it more likely that you'll get a response and saves your thoughts for posterity.
Now, on to your question:
That seems somewhat reasonable, but I think your work could go a little further. It looks like you've introduced TupleP as a new constructor for Pred. This, I believe, would work. But, I think it would be better to have a way of using *any* type as a predicate in TH, as allowed by ConstraintKinds. Perhaps one way to achieve this is to make Pred a synonym of Type, or there could be a TypeP constructor for Pred.
In any case, I would recommend writing a wiki page up with a proposed new TH syntax for predicates and then posting a link to the proposal on the #7021 ticket. Then, it will be easier to debate the merits of any particular approach.
Once again, thanks! Richard
On Jan 3, 2014, at 6:13 PM, Yorick Laupa wrote:
Hi,
I try to make my way through #7021 [1]. Unfortunately, there is nothing in the ticket about what should be expected from the code given as example.
I came with an implementation and I would like feedback from you guys. So, considering this snippet:
--
{-# LANGUAGE ConstraintKinds #-}
type IOable a = (Show a, Read a)
foo :: IOable a => a foo = undefined
--
This is what I got now when pretty-printing TH.Info after reify "foo" call:
VarI Tuple.foo (ForallT [PlainTV a_1627398594] [TupleP 2 [AppT (ConT GHC.Show.Show) (VarT a_1627398594),AppT (ConT GHC.Read.Read) (VarT a_1627398594)]] (VarT a_1627398594)) Nothing (Fixity 9 InfixL)
Does that sound right to you ?
Thanks for your time
-- Yorick
[1] https://ghc.haskell.org/trac/ghc/ticket/7021 _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://www.haskell.org/mailman/listinfo/ghc-devs
participants (2)
-
Richard Eisenberg
-
Yorick Laupa