From zoran.bosnjak at via.si Sat Apr 5 22:27:04 2025 From: zoran.bosnjak at via.si (=?UTF-8?Q?Zoran_Bo=C5=A1njak?=) Date: Sun, 06 Apr 2025 00:27:04 +0200 Subject: [Haskell-cafe] type level function with different return kinds Message-ID: Dear haskellers, is it possible to write a type/kind level function that returns types of different kinds for different inputs. Either by using open/closed type families, a typeclass, extensions or any other type level magic. Something like this: {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} import GHC.TypeLits data A = A1 | A2 data B = B1 | B2 type family F (n :: Nat) where F 0 = 'A1 F 1 = 'A2 F 2 = 'B1 F 3 = 'B2 The problem with this approach is that (F 0) and (F 1) are ok, but not in combination with (F 2). The error says: • Expected kind ‘A’, but ‘'B1’ has kind ‘B’ If I instead write: type family F (n :: Nat) :: k where ... I get compile error already on the (F 0) line • Expected kind ‘k’, but ‘'A1’ has kind ‘A’ Any ideas how to remove the "same kind" restriction or how to workaround it? I am using ghc 9.6.6. regards, Zoran From allbery.b at gmail.com Sat Apr 5 22:55:54 2025 From: allbery.b at gmail.com (Brandon Allbery) Date: Sat, 5 Apr 2025 18:55:54 -0400 Subject: [Haskell-cafe] type level function with different return kinds In-Reply-To: References: Message-ID: I wouldn't expect that to work any more than I would expect a normal function to be able to produce Int or String on demand, absent dependent types. On Sat, Apr 5, 2025 at 6:51 PM Zoran Bošnjak wrote: > Dear haskellers, > is it possible to write a type/kind level function that returns types of > different kinds for different inputs. Either by using open/closed type > families, a typeclass, extensions or any other type level magic. > Something like this: > > {-# LANGUAGE DataKinds #-} > {-# LANGUAGE TypeFamilies #-} > > import GHC.TypeLits > > data A = A1 | A2 > data B = B1 | B2 > > type family F (n :: Nat) where > F 0 = 'A1 > F 1 = 'A2 > F 2 = 'B1 > F 3 = 'B2 > > The problem with this approach is that (F 0) and (F 1) are ok, but not > in combination with (F 2). The error says: > • Expected kind ‘A’, but ‘'B1’ has kind ‘B’ > > If I instead write: > type family F (n :: Nat) :: k where > ... I get compile error already on the (F 0) line > • Expected kind ‘k’, but ‘'A1’ has kind ‘A’ > > Any ideas how to remove the "same kind" restriction or how to workaround > it? > > I am using ghc 9.6.6. > > regards, > Zoran > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -- brandon s allbery kf8nh allbery.b at gmail.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From lemming at henning-thielemann.de Sat Apr 5 22:57:23 2025 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Sun, 6 Apr 2025 00:57:23 +0200 (CEST) Subject: [Haskell-cafe] type level function with different return kinds In-Reply-To: References: Message-ID: <2b285ba2-d3cc-8c92-3479-61347587653e@henning-thielemann.de> On Sun, 6 Apr 2025, Zoran Bošnjak wrote: > Dear haskellers, > is it possible to write a type/kind level function that returns types of > different kinds for different inputs. Either by using open/closed type > families, a typeclass, extensions or any other type level magic. > Something like this: > > {-# LANGUAGE DataKinds #-} > {-# LANGUAGE TypeFamilies #-} > > import GHC.TypeLits > > data A = A1 | A2 > data B = B1 | B2 > > type family F (n :: Nat) where > F 0 = 'A1 > F 1 = 'A2 > F 2 = 'B1 > F 3 = 'B2 > > The problem with this approach is that (F 0) and (F 1) are ok, but not > in combination with (F 2). The error says: > • Expected kind ‘A’, but ‘'B1’ has kind ‘B’ > > ... > > Any ideas how to remove the "same kind" restriction or how to workaround > it? That's the behavior I would expect. Why do you want something different? You could define a type C that has two constructors for A and for B. From d34db33f at airmail.cc Sat Apr 5 23:00:30 2025 From: d34db33f at airmail.cc (D34DB33F) Date: Sun, 6 Apr 2025 01:00:30 +0200 Subject: [Haskell-cafe] type level function with different return kinds In-Reply-To: <2b285ba2-d3cc-8c92-3479-61347587653e@henning-thielemann.de> References: <2b285ba2-d3cc-8c92-3479-61347587653e@henning-thielemann.de> Message-ID: <8be6e83e-3749-46a2-928d-ca3c8c1cbd77@airmail.cc> On 2025-04-06 00:57, Henning Thielemann wrote: > That's the behavior I would expect. Why do you want something different? > > You could define a type C that has two constructors for A and for B. I think you're trying to make a function that either returns constructor for A of type C a, or constructor for B of type C a b -- () ASCII ribbon campaign - against html e-mail /\ www.asciiribbon.org - against proprietary attachments From x at tomsmeding.com Sun Apr 6 12:43:28 2025 From: x at tomsmeding.com (Tom Smeding) Date: Sun, 6 Apr 2025 14:43:28 +0200 Subject: [Haskell-cafe] type level function with different return kinds In-Reply-To: References: Message-ID: <5ca63a44-3848-4e09-bd77-62bd9a3e38b4@tomsmeding.com> I played around a little, and it seems that GHC has some support for dependent quantification here: {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} module M where import GHC.TypeLits data A = A1 | A2 data B = B1 | B2 type family K (n :: Nat) where   K 0 = A   K 1 = A   K 2 = B   K 3 = B type F :: forall (n :: Nat) -> K n type family F n where      F 0 = 'A1      F 1 = 'A2      F 2 = 'B1      F 3 = 'B2 I put it online in a playground paste here: https://play.haskell.org/saved/Pcx912j0 It typechecks, but I didn't test if it indeed works in practice. On 06-04-2025 00:27, Zoran Bošnjak wrote: > Dear haskellers, > is it possible to write a type/kind level function that returns types > of different kinds for different inputs. Either by using open/closed > type families, a typeclass, extensions or any other type level magic. > Something like this: > > {-# LANGUAGE DataKinds #-} > {-# LANGUAGE TypeFamilies #-} > > import GHC.TypeLits > > data A = A1 | A2 > data B = B1 | B2 > > type family F (n :: Nat) where >     F 0 = 'A1 >     F 1 = 'A2 >     F 2 = 'B1 >     F 3 = 'B2 > > The problem with this approach is that (F 0) and (F 1) are ok, but not > in combination with (F 2). The error says: >     • Expected kind ‘A’, but ‘'B1’ has kind ‘B’ > > If I instead write: > type family F (n :: Nat) :: k where > ... I get compile error already on the (F 0) line >     • Expected kind ‘k’, but ‘'A1’ has kind ‘A’ > > Any ideas how to remove the "same kind" restriction or how to > workaround it? > > I am using ghc 9.6.6. > > regards, > Zoran > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From tom-lists-haskell-cafe-2023 at jaguarpaw.co.uk Sun Apr 6 16:07:49 2025 From: tom-lists-haskell-cafe-2023 at jaguarpaw.co.uk (Tom Ellis) Date: Sun, 6 Apr 2025 17:07:49 +0100 Subject: [Haskell-cafe] type level function with different return kinds In-Reply-To: References: Message-ID: On Sun, Apr 06, 2025 at 12:27:04AM +0200, Zoran Bošnjak wrote: > is it possible to write a type/kind level function that returns types of > different kinds for different inputs. Either by using open/closed type > families, a typeclass, extensions or any other type level magic. The way you do this at the type level is with Dynamic: https://www.stackage.org/haddock/lts-23.17/base-4.19.2.0/Data-Dynamic.html#t:Dynamic Or equivalently, something like data SomeTypeable where MkSomeTypeable :: Typeable a => a -> SomeTypeable So if you can work out how to promote one of those to the kind level then yes. If not then probably no! Tom From lysxia at gmail.com Sun Apr 6 17:52:11 2025 From: lysxia at gmail.com (Li-yao Xia) Date: Sun, 6 Apr 2025 19:52:11 +0200 Subject: [Haskell-cafe] type level function with different return kinds In-Reply-To: <5ca63a44-3848-4e09-bd77-62bd9a3e38b4@tomsmeding.com> References: <5ca63a44-3848-4e09-bd77-62bd9a3e38b4@tomsmeding.com> Message-ID: Glad you've found your answer :) By the way this is a technique I've used in the package fcf-family: https://hackage.haskell.org/package/fcf-family The idea is that given a Name which uniquely identifies a type family, it should be possible to map it to, well, the type family it names. You will then also need a type family to map to its type, so you get essentially this: type family TypeOf (n :: Name) :: Type type family Eval (n :: Name) :: TypeOf n I've used fcf-family to extend kind-generics to enable Generic instances for data types that involve type families. Cheers, Li-yao On 2025-04-06 2:43 PM, Tom Smeding wrote: > I played around a little, and it seems that GHC has some support for > dependent quantification here: > > {-# LANGUAGE DataKinds #-} > {-# LANGUAGE TypeFamilies #-} > module M where > > import GHC.TypeLits > > data A = A1 | A2 > data B = B1 | B2 > > type family K (n :: Nat) where >   K 0 = A >   K 1 = A >   K 2 = B >   K 3 = B > > type F :: forall (n :: Nat) -> K n > type family F n where >      F 0 = 'A1 >      F 1 = 'A2 >      F 2 = 'B1 >      F 3 = 'B2 > > I put it online in a playground paste here: > https://play.haskell.org/saved/Pcx912j0 > > It typechecks, but I didn't test if it indeed works in practice. > > On 06-04-2025 00:27, Zoran Bošnjak wrote: >> Dear haskellers, >> is it possible to write a type/kind level function that returns types >> of different kinds for different inputs. Either by using open/closed >> type families, a typeclass, extensions or any other type level magic. >> Something like this: >> >> {-# LANGUAGE DataKinds #-} >> {-# LANGUAGE TypeFamilies #-} >> >> import GHC.TypeLits >> >> data A = A1 | A2 >> data B = B1 | B2 >> >> type family F (n :: Nat) where >>     F 0 = 'A1 >>     F 1 = 'A2 >>     F 2 = 'B1 >>     F 3 = 'B2 >> >> The problem with this approach is that (F 0) and (F 1) are ok, but >> not in combination with (F 2). The error says: >>     • Expected kind ‘A’, but ‘'B1’ has kind ‘B’ >> >> If I instead write: >> type family F (n :: Nat) :: k where >> ... I get compile error already on the (F 0) line >>     • Expected kind ‘k’, but ‘'A1’ has kind ‘A’ >> >> Any ideas how to remove the "same kind" restriction or how to >> workaround it? >> >> I am using ghc 9.6.6. >> >> regards, >> Zoran >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From barak at cs.nuim.ie Sun Apr 6 20:37:42 2025 From: barak at cs.nuim.ie (Barak A. Pearlmutter) Date: Sun, 6 Apr 2025 21:37:42 +0100 Subject: [Haskell-cafe] type level function with different return kinds In-Reply-To: References: Message-ID: Can a type level function have different return kinds depending on its arguments? I think this question is best answered by quoting https://aphyr.com/posts/342-typing-the-technical-interview “Haskell is a dynamically-typed, interpreted language.” From andreash87 at gmx.ch Mon Apr 7 12:28:16 2025 From: andreash87 at gmx.ch (Andreas Herrmann) Date: Mon, 7 Apr 2025 14:28:16 +0200 Subject: [Haskell-cafe] Extended deadline - CFP - Haskell Implementors' Workshop 2025 Message-ID: Extended deadline to April 18, 2025 Call for proposals for the Haskell Implementors' Workshop https://haskell.foundation/events/2025-haskell-implementors-workshop.html June 6, 2025 Organized by the Haskell Community Co-located with ZuriHac 2025 and Haskell Ecosystem Workshop 2025 Hosted by the Haskell Foundation at Eastern Switzerland University of Applied Sciences (OST) https://www.ost.ch/en/university-of-applied-sciences/campus/rapperswil-jona-campus ## Overview * Extended Deadline: April 18, 2025 * Notification: May 5, 2025 * Workshop: June 6, 2025 The 17th Haskell Implementors' Workshop is to be held alongside ZuriHac 2025 this year near Zurich. It is a forum for people involved in the design and development of Haskell implementations, tools, libraries, and supporting infrastructure to share their work and to discuss future directions and collaborations with others. Talks and/or demos are proposed by submitting an abstract, and selected by a small program committee. There will be no published proceedings. The workshop will be informal and interactive, with open spaces in the timetable and room for ad-hoc discussion, demos, and lightning talks. In the past the Haskell Implementors’ Workshop was co-located with ICFP (International Conference on Functional Programming). However, in recent years it has become more and more challenging to attract a large enough audience and sufficiently many speakers for an appealing program. ZuriHac and the Haskell Ecosystem Workshop have become an important annual gathering of a large part of the Haskell community. This year the Haskell Implementors’ Workshop will be co-located with these events to be accessible to a broader audience. ## Scope and Target Audience The Haskell Implementors' Workshop is an ideal place to describe a Haskell extension, describe works-in-progress, demo a new Haskell-related tool, or even propose future lines of Haskell development. Members of the wider Haskell community are encouraged to attend the workshop - we need your feedback to keep the Haskell ecosystem thriving. Students working with Haskell are especially encouraged to share their work. The scope covers any of the following topics. There may be some topics that people feel we've missed, so by all means submit a proposal even if it doesn't fit exactly into one of these buckets: * Compilation techniques * Language features and extensions * Type system implementation * Concurrency and parallelism: language design and implementation * Performance, optimization and benchmarking * Virtual machines and run-time systems * Libraries and tools for development or deployment ## Talks We invite proposals from potential speakers for talks and demonstrations. We are aiming for 20-minute talks with 5 minutes for questions and changeovers. We want to hear from people writing compilers, tools, or libraries, people with cool ideas for directions in which we should take the platform, proposals for new features to be implemented, and half-baked crazy ideas. Submissions can be made via the form linked below until April 18, 2025 (anywhere on earth). https://docs.google.com/forms/d/e/1FAIpQLSdczGbxJYGc4eusvPrxwBbZl561PnKeYnoZ2hYsdw_ZpSfupQ/viewform?usp=header We will also have a lightning talks session. Lightning talks should be ~7mins and are scheduled on the day of the workshop. Suggested topics for lightning talks are to present a single idea, a work-in-progress project, a problem to intrigue and perplex Haskell implementors, or simply to ask for feedback and collaborators. ## Program Committee * Luite Stegeman * Jaro Reinders * Emily Pillmore * Rodrigo Mesquita * Ian-Woo Kim * Andreas Herrmann (chair) ## Contact * Andreas Herrmann -------------- next part -------------- An HTML attachment was scrubbed... URL: From frederic-emmanuel.picca at synchrotron-soleil.fr Mon Apr 7 14:15:49 2025 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Mon, 7 Apr 2025 16:15:49 +0200 (CEST) Subject: [Haskell-cafe] Is there a way to make this code compose generic ? Message-ID: <1691274023.93414477.1744035349527.JavaMail.zimbra@synchrotron-soleil.fr> Hello, I have this data DataSourceShape = DataSourceShape ([HSize], [Maybe HSize]) | DataSourceShape'Range !DIM1 !DIM1 a function which combine 2 DataSourceShape and produce an new one (monoid operation ?) combine'Shape ∷ DataSourceShape → DataSourceShape → DataSourceShape I use this in this class with familly types. class DataSource a where data DataSourcePath a ∷ Type data DataSourceAcq a ∷ Type ds'Shape ∷ MonadSafe m ⇒ DataSourceAcq a → m DataSourceShape withDataSourceP ∷ (Location l, MonadSafe m) ⇒ ScanFile l → DataSourcePath a → (DataSourceAcq a → m r) → m r and here an instance for one of my type DataFrameQCustom (I have plenty of them). they are all constructed the same way. data DataSourceAcq DataFrameQCustom = DataSourceAcq'DataFrameQCustom (DataSourceAcq Attenuation) (DataSourceAcq Geometry) (DataSourceAcq Image) (DataSourceAcq Mask) (DataSourceAcq Timestamp) (DataSourceAcq Timescan0) (DataSourceAcq Scannumber) ds'Shape(DataSourceAcq'DataFrameQCustom a g i m idx t0 s) = do sa ← ds'Shape a sg ← ds'Shape g si ← ds'Shape i sm ← ds'Shape m sidx ← ds'Shape idx st0 ← ds'Shape t0 ss ← ds'Shape s pure $ foldl1 combine'Shape [sa, sg, si, sm, sidx, st0, ss] withDataSourceP f (DataSourcePath'DataFrameQCustom a g i m idx t0 s) gg = withDataSourceP f a $ λa' → withDataSourceP f g $ λg' → withDataSourceP f i $ λi' → withDataSourceP f m $ λm' → withDataSourceP f idx $ λidx' → withDataSourceP f s $ λs' → withDataSourceP f t0 $ λt0' → gg (DataSourceAcq'DataFrameQCustom a' g' i' m' idx' t0' s') My question is, how should avoid writting by hand all these ds'Shape / withDatasourceP implementations, which seems quite mechanical. thanks for your help Frederic From lysxia at gmail.com Mon Apr 7 19:19:12 2025 From: lysxia at gmail.com (Li-yao Xia) Date: Mon, 7 Apr 2025 21:19:12 +0200 Subject: [Haskell-cafe] Is there a way to make this code compose generic ? In-Reply-To: <1691274023.93414477.1744035349527.JavaMail.zimbra@synchrotron-soleil.fr> References: <1691274023.93414477.1744035349527.JavaMail.zimbra@synchrotron-soleil.fr> Message-ID: <84083cc5-0e73-450e-b7de-ef5bc691eefa@gmail.com> Hi Frederic, Below is a generic implementation of your class based on your example, that should get you started. Two changes are worth calling out: - I assumed that the binary operation `combine'Shape` is associative. It takes a bit more effort to associate the exact same as `foldl1`. - To avoid duplicating code between `DataSourcePath` and `DataSourceAcq`, I merged them as a single type indexed by a type-level flag. For more information, several tutorials on Haskell generics are findable on search engines. Cheers, Li-yao --- {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module G where import GHC.Generics import Data.Kind (Type) -- * Interface data DataSourceShape   = DummyDSS Int combine'Shape :: DataSourceShape -> DataSourceShape -> DataSourceShape combine'Shape (DummyDSS x) (DummyDSS y) = DummyDSS (x + y) data DSKind = Path | Acq class DataSource a where   data DataSourceT (k :: DSKind) a :: Type   ds'Shape :: Monad m => DataSourceT Acq a -> m DataSourceShape   withDataSourceP :: String -> DataSourceT Path a -> (DataSourceT Acq a -> m r) -> m r -- | Generic 'ds'Shape' generic'ds'Shape :: (Monad m, Generic (DataSourceT Acq a), GDataSourceAcq (Rep (DataSourceT Acq a))) => DataSourceT Acq a -> m DataSourceShape generic'ds'Shape = g'ds'Shape . from -- | Generic 'withDataSourceP' generic'withDataSourceP ::   (Generic (DataSourceT Path a), Generic (DataSourceT Acq a), GDataSourcePath (Rep (DataSourceT Path a)) (Rep (DataSourceT Acq a))) =>   String -> DataSourceT Path a -> (DataSourceT Acq a -> m r) -> m r generic'withDataSourceP file src gg = g'withDataSourceP file (from src) (gg . to) -- ** Base instance type family DataSourceBase (k :: DSKind) :: Type where   DataSourceBase Acq = String   DataSourceBase Path = [String] data BaseData instance DataSource BaseData where   newtype DataSourceT k BaseData = DataSource'BaseData (DataSourceBase k)   ds'Shape _ = pure (DummyDSS 1)   withDataSourceP _ _ k = k (DataSource'BaseData "source") -- * Generic example usage data ExampleData instance DataSource ExampleData where   data DataSourceT k ExampleData = DataSource'ExampleData     (DataSourceT k BaseData)     (DataSourceT k BaseData)     (DataSourceT k BaseData)     (DataSourceT k BaseData)     (DataSourceT k BaseData)     deriving Generic   ds'Shape = generic'ds'Shape   withDataSourceP = generic'withDataSourceP -- * Generic implementation class GDataSourceAcq dataAcq where   g'ds'Shape :: Monad m => dataAcq x -> m DataSourceShape class GDataSourcePath dataPath dataAcq where   g'withDataSourceP :: String -> dataPath x -> (dataAcq x -> m r) -> m r instance GDataSourceAcq f => GDataSourceAcq (M1 i c f) where   g'ds'Shape (M1 f) = g'ds'Shape f instance GDataSourcePath f g => GDataSourcePath (M1 i c f) (M1 i c' g) where   g'withDataSourceP f (M1 d) gg = g'withDataSourceP f d (gg . M1) instance (GDataSourceAcq f, GDataSourceAcq f') => GDataSourceAcq (f :*: f') where   g'ds'Shape (f :*: f') = liftA2 combine'Shape (g'ds'Shape f) (g'ds'Shape f') instance (GDataSourcePath f g, GDataSourcePath f' g') => GDataSourcePath (f :*: f') (g :*: g') where   g'withDataSourceP file (f :*: f') gg =     g'withDataSourceP file f $ \g ->     g'withDataSourceP file f' $ \g' ->       gg (g :*: g') instance DataSource a => GDataSourceAcq (K1 i (DataSourceT Acq a)) where   g'ds'Shape (K1 acq) = ds'Shape acq instance DataSource a => GDataSourcePath (K1 i (DataSourceT Path a)) (K1 i (DataSourceT Acq a)) where   g'withDataSourceP file (K1 acq) gg =     withDataSourceP file acq $ \dat ->       gg (K1 dat) From frederic-emmanuel.picca at synchrotron-soleil.fr Wed Apr 9 08:23:04 2025 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Wed, 9 Apr 2025 10:23:04 +0200 (CEST) Subject: [Haskell-cafe] Is there a way to make this code compose generic ? In-Reply-To: <84083cc5-0e73-450e-b7de-ef5bc691eefa@gmail.com> References: <1691274023.93414477.1744035349527.JavaMail.zimbra@synchrotron-soleil.fr> <84083cc5-0e73-450e-b7de-ef5bc691eefa@gmail.com> Message-ID: <1846636753.94661711.1744186984085.JavaMail.zimbra@synchrotron-soleil.fr> Hello Li-yao thanks a lot for you explanations, it helps me a lot. I end up with this error (beware the long error message...) src/Hkl/Binoculars/Projections/Config/Sample.hs:68:14: error: [GHC-39999] • Could not deduce ‘Hkl.DataSource.GDataSourceAcq (GHC.Generics.C1 (GHC.Generics.MetaCons "DataSourceT'Sample" GHC.Generics.PrefixI False) (((GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Double)) GHC.Generics.:*: GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Double))) GHC.Generics.:*: (GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Double)) GHC.Generics.:*: GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Degree)))) GHC.Generics.:*: ((GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Degree)) GHC.Generics.:*: GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Degree))) GHC.Generics.:*: (GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Degree)) GHC.Generics.:*: (GHC.Generics.S1 (GHC.Generics.MetaSel GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Degree)) GHC.Generics.:*: GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Degree)))))) GHC.Generics.:+: GHC.Generics.C1 (GHC.Generics.MetaCons "DataSourceT'Sample'Or" GHC.Generics.PrefixI False) (GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Sample)) GHC.Generics.:*: GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Sample))))’ Nothing arising from a use of ‘generic'ds'Shape’ from the context: Pipes.Safe.MonadSafe m bound by the type signature for: ds'Shape :: forall (m :: * -> *). Pipes.Safe.MonadSafe m => DataSourceT DSAcq Sample -> m DataSourceShape at src/Hkl/Binoculars/Projections/Config/Sample.hs:68:3-10 • In the expression: generic'ds'Shape In an equation for ‘ds'Shape’: ds'Shape = generic'ds'Shape In the instance declaration for ‘DataSource Sample’ | 68 | ds'Shape = generic'ds'Shape | ^^^^^^^^^^^^^^^^ It works great if I have this type. instance DataSource Sample where data DataSourceT k Sample = DataSourceT'Sample (DataSourceT k Double) -- a (DataSourceT k Double) -- b (DataSourceT k Double) -- c (DataSourceT k Degree) -- alpha (DataSourceT k Degree) -- beta (DataSourceT k Degree) -- gamma (DataSourceT k Degree) -- ux (DataSourceT k Degree) -- uy (DataSourceT k Degree) -- uz deriving (Generic) ds'Shape = generic'ds'Shape but not If I need to add this other constructor | DataSourceT'Sample'Or (DataSourceT k Sample) (DataSourceT k Sample) is it connected to this ? GHC.Generics.:+: GHC.Generics.C1 There is no instance for :+: in your proposition. These `Or` Constructor are usefull with the default withDatasourcePOr of the cladd DataSource , it is a sort of fallback. try the first and if something goes wrong try the second one. withDataSourcePOr ∷ (Location l, MonadSafe m) ⇒ ScanFile l → DataSourceT DSPath a → DataSourceT DSPath a → (DataSourceT DSAcq a → m r) → m r withDataSourcePOr f l r g = withDataSourceP f l g `catch` λexl → withDataSourceP f r g `catch` λexr → throwM $ CanNotOpenDataSource'Or exl exr This is how I define the fallback when declaring the instance from this Or constructor withDataSourceP f (DataSourcePath'Sample'Or l r) g = withDataSourcePOr f l r g I don ot know if this is the right design... thanks Fred From frederic-emmanuel.picca at synchrotron-soleil.fr Wed Apr 9 14:41:49 2025 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Wed, 9 Apr 2025 16:41:49 +0200 (CEST) Subject: [Haskell-cafe] Is there a way to make this code compose generic ? In-Reply-To: <84083cc5-0e73-450e-b7de-ef5bc691eefa@gmail.com> References: <1691274023.93414477.1744035349527.JavaMail.zimbra@synchrotron-soleil.fr> <84083cc5-0e73-450e-b7de-ef5bc691eefa@gmail.com> Message-ID: <1951469514.95120075.1744209709200.JavaMail.zimbra@synchrotron-soleil.fr> Another question related to this one > data ExampleData > instance DataSource ExampleData where >   data DataSourceT k ExampleData = DataSource'ExampleData >     (DataSourceT k BaseData) >     (DataSourceT k BaseData) >     (DataSourceT k BaseData) >     (DataSourceT k BaseData) >     (DataSourceT k BaseData) >     deriving Generic >   ds'Shape = generic'ds'Shape >   withDataSourceP = generic'withDataSourceP > Do you think that it is possible to derive the DataSourceT Acq and Path from the ExampleData type data ExampleData = ExampleData A B it seems mechanical to me data DataSourceT k ExampleDAta = DataSource'ExampleData (DataSourceT k A) (DataSourceT k B) I tryed with HKD like this -- "Higher-Kinded Data" type family HKD f a where HKD Identity a = a HKD f a = f a data ExampleData' f = ExampleData (HKD f A) (HKD f B) where but then I do not know howto define the type family for DataSourceT with this ExampleData' f Cheers Fred From lysxia at gmail.com Wed Apr 9 18:16:44 2025 From: lysxia at gmail.com (Li-yao Xia) Date: Wed, 9 Apr 2025 20:16:44 +0200 Subject: [Haskell-cafe] Is there a way to make this code compose generic ? In-Reply-To: <1951469514.95120075.1744209709200.JavaMail.zimbra@synchrotron-soleil.fr> References: <1691274023.93414477.1744035349527.JavaMail.zimbra@synchrotron-soleil.fr> <84083cc5-0e73-450e-b7de-ef5bc691eefa@gmail.com> <1951469514.95120075.1744209709200.JavaMail.zimbra@synchrotron-soleil.fr> Message-ID: The DataSourceT type is already HKDified. You can make it the parameter of the class directly: class DataSource d where   ds'Shape :: MonadSafe m => d Acq -> m DataSourceShape   withDataSourceP :: MonadSafe m => ... -> d Path -> (d Acq -> m r) -> m r data Sample k = MkSample   (DataSourceDouble k) -- define a wrapper for each base type which will be the new argument for the corresponding DataSource instance   (Degree k)   -- (...) instance DataSource Sample where   -- (...) For your issue with sums, it doesn't seem right to encode alternative "data paths" as extra constructors. Correct me if you had a different idea in mind. To start, given the DataSource method: withDataSourceP :: MonadSafe m => ... -> d Path -> (d Acq -> m r) -> m r you can implement: withDataSourcesP :: (DataSource d, MonadSafe m) => ... -> [d Path] -> (d Acq -> m r) -> m r by trying `withDataSourceP` with each element in the list. Now I'm guessing that the reason you wanted an `Or` constructor was so that you could list alternatives to populate individual components of your struct. For example, maybe there are N possible sources for some data alpha, and M possible sources for some data beta, and you don't want to turn that into a flat list of N*M ways to get (alpha, beta). The goal is for `Sample k` to look like this when `k = Path`: data Sample Path = MkSample   [DataSourceDouble Path]   [Degree Path]   -- (...) but stay like this when `k = Acq`: data Sample Acq = MkSample   (DataSourceDouble Acq)   (Degree Acq) That is possible by creating a field wrapper parameterized by `k`: data Sample k = MkSample   (Wrap k (DataSourceDouble k))   (Wrap k (Degree k)) So that Wrap Path t = [t] and Wrap Acq t = t. type family Wrap (k :: DSKind) t where   Wrap Path t = [t]   Wrap Acq t = t Below is a compilable example, modified from my previous email with the changes described above. On the generic side, the main change is that some (DataSourceT Path a) become [a Path] (with the list type!) and some calls to withDataSourceP become withDataSourcesP that I introduced above. Cheers, Li-yao --- {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module G where import GHC.Generics import Data.Kind (Type) -- * Interface data DataSourceShape   = DummyDSS Int combine'Shape :: DataSourceShape -> DataSourceShape -> DataSourceShape combine'Shape (DummyDSS x) (DummyDSS y) = DummyDSS (x + y) -- simplified variants of catch and throw for the sake of example class MonadCatch m where   throw_ :: m a   catch_ :: m a -> m a -> m a data DSKind = Acq | Path type family DSWrap (k :: DSKind) (t :: Type) :: Type where   DSWrap Acq t = t   DSWrap Path t = [t] type DSWrap_ f k = DSWrap k (f k) class DataSource d where   ds'Shape :: Monad m => d Acq -> m DataSourceShape   withDataSourceP :: MonadCatch m => String -> d Path -> (d Acq -> m r) -> m r withDataSourcesP :: (DataSource d, MonadCatch m) => String -> [d Path] -> (d Acq -> m r) -> m r withDataSourcesP file [] _ = throw_ withDataSourcesP file (s : ss) k = withDataSourceP file s k `catch_` withDataSourcesP file ss k -- | Generic 'ds'Shape' generic'ds'Shape :: (Monad m, Generic (d Acq), GDataSourceAcq (Rep (d Acq))) => d Acq -> m DataSourceShape generic'ds'Shape = g'ds'Shape . from -- | Generic 'withDataSourceP' generic'withDataSourceP ::   (Generic (d Path), Generic (d Acq), GDataSourcePath (Rep (d Path)) (Rep (d Acq)), MonadCatch m) =>   String -> d Path -> (d Acq -> m r) -> m r generic'withDataSourceP file src gg = g'withDataSourceP file (from src) (gg . to) -- ** Base instance data family BaseData (k :: DSKind) newtype instance BaseData Acq = BaseDataAcq String newtype instance BaseData Path = BaseDataPath [String] instance DataSource BaseData where   ds'Shape _ = pure (DummyDSS 1)   withDataSourceP _ _ k = k (BaseDataAcq "source") -- * Generic example usage data ExampleData (k :: DSKind)   = ExampleData       (DSWrap_ BaseData k)       (DSWrap_ BaseData k)       (DSWrap_ BaseData k)       (DSWrap_ BaseData k)       (DSWrap_ BaseData k)   deriving Generic instance DataSource ExampleData where   ds'Shape = generic'ds'Shape   withDataSourceP = generic'withDataSourceP -- * Generic implementation class GDataSourceAcq dataAcq where   g'ds'Shape :: Monad m => dataAcq x -> m DataSourceShape class GDataSourcePath dataPath dataAcq where   g'withDataSourceP :: MonadCatch m => String -> dataPath x -> (dataAcq x -> m r) -> m r instance GDataSourceAcq f => GDataSourceAcq (M1 i c f) where   g'ds'Shape (M1 f) = g'ds'Shape f instance GDataSourcePath f g => GDataSourcePath (M1 i c f) (M1 i c' g) where   g'withDataSourceP f (M1 d) gg = g'withDataSourceP f d (gg . M1) instance (GDataSourceAcq f, GDataSourceAcq f') => GDataSourceAcq (f :*: f') where   g'ds'Shape (f :*: f') = liftA2 combine'Shape (g'ds'Shape f) (g'ds'Shape f') instance (GDataSourcePath f g, GDataSourcePath f' g') => GDataSourcePath (f :*: f') (g :*: g') where   g'withDataSourceP file (f :*: f') gg =     g'withDataSourceP file f $ \g ->     g'withDataSourceP file f' $ \g' ->       gg (g :*: g') instance DataSource a => GDataSourceAcq (K1 i (a Acq)) where   g'ds'Shape (K1 acq) = ds'Shape acq instance DataSource a => GDataSourcePath (K1 i [a Path]) (K1 i (a Acq)) where   g'withDataSourceP file (K1 acq) gg =     withDataSourcesP file acq $ \dat ->       gg (K1 dat) From proflandy at gmail.com Thu Apr 10 02:32:49 2025 From: proflandy at gmail.com (lloyd allison) Date: Thu, 10 Apr 2025 12:32:49 +1000 Subject: [Haskell-cafe] type-class and subclasses Message-ID: I have a general question: I would like to have a type-class C in which types that are instances of C have some type parameters and then a subclass S of C where some of the type parameters of an instance of S are more constrained in some way -- perhaps by being equal and/or being instances of some other class. I have an entirely artificial example (att.) that illustrates this situation and struggled (it's a while since I wrote much Haskell) to get it past the ghc type checker until stumbling across GADTs which do seem to do the trick, so I could leave it at that but... ...I am very far from sure that this is the correct way to look at the problem and am hoping for some illumination. regards Lloyd. -- No AI was used in composing this message. -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: eg.hs Type: text/x-haskell Size: 2741 bytes Desc: not available URL: From dominik.schrempf at gmail.com Thu Apr 10 03:23:02 2025 From: dominik.schrempf at gmail.com (Dominik Schrempf) Date: Thu, 10 Apr 2025 05:23:02 +0200 Subject: [Haskell-cafe] type-class and subclasses In-Reply-To: (lloyd allison's message of "Thu, 10 Apr 2025 12:32:49 +1000") References: Message-ID: <87a58on1ih.fsf@gmail.com> Hi! I am not doing too much type-fu, but I think you can pull the type variables into the class definitions so you can access them for adding constraints when defining the instances. Then, you do not need any special extension (GHC2021). I hope this helps! (I also separated your Pair class into the Pair and CombinablePair classes). Dominik import Prelude hiding (fst, snd) class Pair pt u v where fst :: pt u v -> u snd :: pt u v -> v class CombinablePair pt u v w where f :: pt u v -> pt v w -> pt u w class (Pair pt u v, Num u, u ~ v) => PairNum pt u v where total :: pt u v -> u -------- -- Ptype data Ptype u v = ConsPtype !u !v deriving (Show) instance Pair Ptype u v where fst (ConsPtype x _) = x snd (ConsPtype _ y) = y instance CombinablePair Ptype u v w where f (ConsPtype a _) (ConsPtype _ d) = ConsPtype a d fromPairNum :: (Pair pt u v) => pt u v -> Ptype u v fromPairNum pn = ConsPtype (fst pn) (snd pn) --------- -- PNtype data PNtype u v = (Num u, Num v) => ConsPNtype !u !v instance Pair PNtype u v where fst (ConsPNtype x _) = x snd (ConsPNtype _ y) = y instance (u ~ v, v ~ w) => CombinablePair PNtype u v w where f (ConsPNtype a b) (ConsPNtype c d) = ConsPNtype (a + c) (b + d) instance (Num u, u ~ v) => PairNum PNtype u v where total (ConsPNtype x y) = x + y lloyd allison writes: > I have a general question: > I would like to have a type-class C in which types that are instances of C have > some type parameters and then a subclass S of C where some of the type > parameters of an instance of S are more constrained in some way -- perhaps by > being equal and/or being instances of some other class. > > I have an entirely artificial example (att.) that illustrates this situation and > struggled (it's a while since I wrote much Haskell) to get it past the ghc type > checker until stumbling across GADTs which do seem to do the trick, so I could > leave it at that but... > ...I am very far from sure that this is the correct way to look at the problem > and am hoping for some illumination. > > regards > Lloyd. From anka.213 at gmail.com Thu Apr 10 08:41:59 2025 From: anka.213 at gmail.com (=?utf-8?Q?Andreas_K=C3=A4llberg?=) Date: Thu, 10 Apr 2025 10:41:59 +0200 Subject: [Haskell-cafe] type-class and subclasses In-Reply-To: References: Message-ID: <0EAB369D-DBDB-4BF7-B6CF-40674A8ABE45@gmail.com> GADTs does indeed resolve the issue in this specific case, as in that case the constructor carries the evidence of the equality constraint. However if we for example wanted to add a constructor method to your pair class: class Pair pt where -- … mkPair :: u -> v -> pt u v then it would no longer work, as you no longer have a pt in the arguments that carries the equality proof between u and v. If you want it to work in that case, then one option is that you could add a constraint-kinded type parameter to your class, which lets instances specify custom constraints to the type variables: class Pair c pt where mkPair :: c u v => u -> v -> pt u v instance Pair (~) Ptype where -- … this can however lead to issues with ambiguous types, since users of the type class methods needs to know the constraint to decide which instance to use. We can resolve this either using functional dependencies or type families: class PairFunDep c pt | pt -> c where mkPair :: c u v => u -> v -> pt u v instance PairFunDep (~) Ptype where -- … class PairTypeFam pt where type PairConstraint pt :: u -> v -> Constraint mkPair :: PairConstraint pt u v => u -> v -> pt u v instance PairTypeFam Ptype where type PairConstraint Ptype u v = u ~ v -- … Regards, Anka > On 10 Apr 2025, at 04:33, lloyd allison wrote: >  > I have a general question: > I would like to have a type-class C in which types that are instances of C have some type parameters and then a subclass S of C where some of the type parameters of an instance of S are more constrained in some way -- perhaps by being equal and/or being instances of some other class. > > I have an entirely artificial example (att.) that illustrates this situation and struggled (it's a while since I wrote much Haskell) to get it past the ghc type checker until stumbling across GADTs which do seem to do the trick, so I could leave it at that but... > ...I am very far from sure that this is the correct way to look at the problem and am hoping for some illumination. > > regards > Lloyd. > -- > No AI was used in composing this message. > > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From andrask at chalmers.se Fri Apr 11 12:20:37 2025 From: andrask at chalmers.se (Andras Kovacs) Date: Fri, 11 Apr 2025 12:20:37 +0000 Subject: [Haskell-cafe] TyDe 2025 - Call for Papers & Extended Abstracts Message-ID: ========================================================================= The Tenth International Workshop on TYPE-DRIVEN DEVELOPMENT Call for papers and extended abstracts Singapore, 12 October 2025 https://icfp25.sigplan.org/home/tyde-2025 ========================================================================= The Workshop on Type-Driven Development (TyDe) aims to show how static type information may be used effectively in the development of computer programs. Co-located with ICFP and SPLASH, this workshop brings together leading researchers and practitioners who are using or exploring types as a means of program development. We welcome all contributions, both theoretical and practical, on a range of topics including: * dependently typed programming; * generic programming; * design and implementation of programming languages, exploiting types in novel ways; * exploiting typed data, data dependent data, or type providers; * static and dynamic analyses of typed programs; * tools, IDEs, or testing tools exploiting type information; * pearls, being elegant, instructive examples of types used in the derivation, calculation, or construction of programs. ### Important dates ### * Mon 9 Jun 2025 (AoE): Submission deadline for papers and extended abstracts * Wed 16 Jul 2025: Notification of acceptance * Wed 30 Jul 2025: Submission of camera-ready papers to ACM * Sun 12 Oct 2025: Workshop ### Proceedings and Copyright ### We will have formal proceedings for full-length papers, published by the ACM. Accepted papers will be included in the ACM Digital Library. Authors must grant ACM publication rights upon acceptance, but may retain copyright if they wish. Authors are encouraged to publish auxiliary material with their paper (source code, test data, and so forth). The proceedings will be freely available for download from the ACM Digital Library from one week before the start of the conference until two weeks after the conference. The official publication date is the date the papers are made available in the ACM Digital Library. This date may be up to two weeks prior to the first day of the conference. The official publication date affects the deadline for any patent filings related to published work. ### Submission Details ### Submissions should fall into one of two categories: * regular research papers (12 pages); * extended abstracts (3 pages). The bibliography will not be counted against the page limits for either category. Regular research papers are expected to present novel and interesting research results, and will be included in the formal proceedings. Extended abstracts should report work in progress that the authors would like to present at the workshop. Extended abstracts will be distributed to workshop attendees but will not be published in the formal proceedings. We welcome submissions from PC members (with the exception of the two co-chairs), but these submissions will be held to a higher standard. Submission is handled through HotCRP: > https://tyde25.hotcrp.com All submissions should be in portable document format (PDF) and formatted using the ACM SIGPLAN style guidelines: > https://www.sigplan.org/Resources/Author/ Note that submissions should use the new ‘acmart’ format and the two-column ‘sigplan’ subformat (not to be confused with the one-column ‘acmsmall’ subformat). Extended abstracts must be submitted with the label ‘Extended Abstract’ clearly in the title. ### Presentations ### We expect that each accepted submission is presented at the workshop. Presentations are around 20 minutes plus questions. Remote presentation is possible. ### Participant Support ### Student attendees with accepted papers can apply for a SIGPLAN PAC grant to help cover participation-related expenses. PAC also offers other support, such as for child-care expenses during the meeting or for accommodations for members with physical disabilities. For details on the PAC program, see its web page: > https://www.sigplan.org/PAC/ -------------- next part -------------- An HTML attachment was scrubbed... URL: From proflandy at gmail.com Wed Apr 16 07:35:23 2025 From: proflandy at gmail.com (lloyd allison) Date: Wed, 16 Apr 2025 17:35:23 +1000 Subject: [Haskell-cafe] type-class and subclasses In-Reply-To: <0EAB369D-DBDB-4BF7-B6CF-40674A8ABE45@gmail.com> References: <0EAB369D-DBDB-4BF7-B6CF-40674A8ABE45@gmail.com> Message-ID: thank you for the suggestions. I obviously have some more reading to do(!) and experiments to try regards Lloyd -- On Thu, 10 Apr 2025 at 18:42, Andreas Källberg wrote: > GADTs does indeed resolve the issue in this specific case, as in that case > the constructor carries the evidence of the equality constraint. However if > we for example wanted to add a constructor method to your pair class: > > class Pair pt where > -- … > mkPair :: u -> v -> pt u v > > then it would no longer work, as you no longer have a pt in the arguments > that carries the equality proof between u and v. > > If you want it to work in that case, then one option is that you could add > a constraint-kinded type parameter to your class, which lets instances > specify custom constraints to the type variables: > > class Pair c pt where > mkPair :: c u v => u -> v -> pt u v > > instance Pair (~) Ptype where > -- … > > this can however lead to issues with ambiguous types, since users of the > type class methods needs to know the constraint to decide which instance to > use. We can resolve this either using functional dependencies or type > families: > > class PairFunDep c pt | pt -> c where > mkPair :: c u v => u -> v -> pt u v > > instance PairFunDep (~) Ptype where > -- … > > class PairTypeFam pt where > type PairConstraint pt :: u -> v -> Constraint > mkPair :: PairConstraint pt u v => u -> v -> pt u v > > instance PairTypeFam Ptype where > type PairConstraint Ptype u v = u ~ v > -- … > > Regards, > Anka > > > On 10 Apr 2025, at 04:33, lloyd allison wrote: > >  > > I have a general question: > > I would like to have a type-class C in which types that are instances of > C have some type parameters and then a subclass S of C where some of the > type parameters of an instance of S are more constrained in some way -- > perhaps by being equal and/or being instances of some other class. > > > > I have an entirely artificial example (att.) that illustrates this > situation and struggled (it's a while since I wrote much Haskell) to get it > past the ghc type checker until stumbling across GADTs which do seem to do > the trick, so I could leave it at that but... > > ...I am very far from sure that this is the correct way to look at the > problem and am hoping for some illumination. > > > > regards > > Lloyd. > > -- > > No AI was used in composing this message. > > > > > > > > _______________________________________________ > > Haskell-Cafe mailing list > > To (un)subscribe, modify options or view archives go to: > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > Only members subscribed via the mailman list are allowed to post. > -- No AI was used in composing this message. -------------- next part -------------- An HTML attachment was scrubbed... URL: