From fumiexcel at gmail.com Tue Jul 7 08:47:55 2020 From: fumiexcel at gmail.com (Fumiaki Kinoshita) Date: Tue, 7 Jul 2020 17:47:55 +0900 Subject: Proposal: k ~ l => IsLabel k (Proxy l) Message-ID: I propose adding an IsLabel instance to Proxy where fromLabel = Proxy This is the only reasonable instance I can think of, and AFAIK there's no plan which would conflict [0]. The proposed instance allows us to explore API designs involving type-level strings with much less syntactic noise ( #foo is easier to type than @"foo"). I admit that the motivation is weak, but I think it's nice to have. [0] https://gitlab.haskell.org/ghc/ghc/-/wikis/records/overloaded-record-fields/magic-classes -------------- next part -------------- An HTML attachment was scrubbed... URL: From emertens at gmail.com Tue Jul 7 15:07:13 2020 From: emertens at gmail.com (Eric Mertens) Date: Tue, 7 Jul 2020 08:07:13 -0700 Subject: Proposal: k ~ l => IsLabel k (Proxy l) In-Reply-To: References: Message-ID: That instance seems fine to me. It won't solve the general case of proxy arguments are those should typically be type variables rather than fixed Proxy type, so using an overloaded label would be ambiguous without a type signature: example :: proxy a -> Int So if you were designing an API intended to be used with an overloaded label it would probably make sense to pick a different type and just define the instance locally: data StringProxy (str :: Symbol) = StringProxy; instance x ~ a => IsLabel x (StringProxy a) where fromLabel = StringProxy since you were building an API intended to be used with overloaded labels. The user would find this less surprising as you'd be able to attach documentation to StringProxy explaining how it was intended to be used. -Eric On Tue, Jul 7, 2020 at 1:48 AM Fumiaki Kinoshita wrote: > I propose adding an IsLabel instance to Proxy where > > fromLabel = Proxy > > This is the only reasonable instance I can think of, and AFAIK there's no > plan which would conflict [0]. > > The proposed instance allows us to explore API designs involving > type-level strings with much less syntactic noise ( #foo is easier to type > than @"foo"). I admit that the motivation is weak, but I think it's nice to > have. > > [0] > https://gitlab.haskell.org/ghc/ghc/-/wikis/records/overloaded-record-fields/magic-classes > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -- Eric Mertens -------------- next part -------------- An HTML attachment was scrubbed... URL: From fumiexcel at gmail.com Thu Jul 9 06:14:26 2020 From: fumiexcel at gmail.com (Fumiaki Kinoshita) Date: Thu, 9 Jul 2020 15:14:26 +0900 Subject: Package takeover: thyme and enummapset-th In-Reply-To: References: Message-ID: There isn't observable activity on upstream repositories either; I think it is no exaggeration to say that they are no longer maintained. https://github.com/liyang/thyme https://github.com/liyang/vector-th-unbox/ CCing to the Hackage administrators. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From haskell.org at liyang.hu Thu Jul 9 09:14:54 2020 From: haskell.org at liyang.hu (Liyang HU) Date: Thu, 9 Jul 2020 10:14:54 +0100 Subject: Package takeover: thyme and enummapset-th In-Reply-To: References: Message-ID: Hi Fumiaki, Hope you are well. Yes, please take them over. Thank you, /Liyang On Thu, 9 Jul 2020, 07:14 Fumiaki Kinoshita, wrote: > There isn't observable activity on upstream repositories either; I think > it is no exaggeration to say that they are no longer maintained. > > https://github.com/liyang/thyme > https://github.com/liyang/vector-th-unbox/ > > CCing to the Hackage administrators. > >> -------------- next part -------------- An HTML attachment was scrubbed... URL: From lazybonesxp at gmail.com Thu Jul 9 09:59:06 2020 From: lazybonesxp at gmail.com (Rinat Stryungis) Date: Thu, 9 Jul 2020 12:59:06 +0300 Subject: Proposal for removing separate `Nat` in favour of promoted `Natural` type. Message-ID: Hello, libraries! I want to present a proposal for changes in the `Base` library. The changes in my proposal partially solve the following issue: https://gitlab.haskell.org/ghc/ghc/-/issues/10776 and remove the separate built-in kind `Nat` in favor of promoted type `Natural`. It means that previously one can't directly promote a data type with Natural fields: data MyPointN = PointN Natural Natural -- could not be promoted data MyPointP = PointP Nat Nat -- could be promoted, but uninhabited in terms type M = PointP 1 10 but now one could promote the `Natural` data type: data MyPoint = Point Natural Natural type MyTLPoint1 = Point 1 10 The proposed changes both simplify the internals of the GHC by removing separate kind and related things and make using of the type-level naturals more convenient for users. Also new type synonym type Nat = Natural appeared in the Data.Type.TypeNats in the name of backward compatibility. I've opened a new MR with the patch. In the patch with the already implemented promotion of Naturals, one could find new and updated tests and docs. Also, I want to say about the breakages: 1. One must enable `TypeSynonymInstances` in order to define instances for `Nat`. 2. Different instances for `Nat` and `Natural` won't type check anymore. 3. Type checker plugins that work with the natural numbers now should use `naturalTy` kind instead of removed `typeNatKind` Anyone interested is welcome to look at the MR and discuss the proposal and its implementation. https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3583 The latter is very short and easy, thanks to the recently merged patch with a new `ghc-bignum` library. It greatly simplified my work. Thanks and best regards. Rinat Stryungis. -------------- next part -------------- An HTML attachment was scrubbed... URL: From oleg.grenrus at iki.fi Thu Jul 9 12:09:08 2020 From: oleg.grenrus at iki.fi (Oleg Grenrus) Date: Thu, 9 Jul 2020 15:09:08 +0300 Subject: Proposal for removing separate `Nat` in favour of promoted `Natural` type. In-Reply-To: References: Message-ID: <0c02c459-c683-2d4f-2237-5b13f210393b@iki.fi> There is an old GHC issue https://gitlab.haskell.org/ghc/ghc/-/issues/10776 which got recently a PR https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3583 - Oleg On 9.7.2020 12.59, Rinat Stryungis wrote: > Hello, libraries! > > I want to present a proposal for changes in the `Base` library. > The changes in my proposal partially solve the following issue: >     https://gitlab.haskell.org/ghc/ghc/-/issues/10776 > and remove the separate built-in kind `Nat` in favor of promoted type > `Natural`. > > It means that previously one can't directly promote a data type with > Natural fields: > >     data MyPointN = PointN Natural Natural -- could not be promoted >     data MyPointP = PointP Nat Nat         -- could be promoted, but > uninhabited in terms > >     type M = PointP 1 10   > > but now one could promote the `Natural` data type: > >     data MyPoint = Point Natural Natural >     type MyTLPoint1 = Point 1 10 > > The proposed changes both simplify the internals of the GHC by removing > separate kind and related things and make using of the type-level > naturals more convenient for users. > > Also new type synonym > >     type Nat = Natural > > appeared in the Data.Type.TypeNats in the name of backward compatibility. > > I've opened a new MR with the patch. In the patch with the already > implemented promotion of Naturals, one could find new and updated > tests and docs. > > Also, I want to say about the breakages:   > > 1. One must enable `TypeSynonymInstances` in order to define instances > for `Nat`. > 2. Different instances for `Nat` and `Natural` won't type check anymore. > 3. Type checker plugins that work with the natural numbers now >    should use `naturalTy` kind instead of removed `typeNatKind` > > Anyone interested is welcome to look at the MR and discuss the > proposal and its implementation. > > https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3583 > > The latter is very short and easy, thanks to the recently merged patch > with a new `ghc-bignum` library. It greatly simplified my work. > > Thanks and best regards. > Rinat Stryungis.  > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries -------------- next part -------------- An HTML attachment was scrubbed... URL: From oleg.grenrus at iki.fi Thu Jul 9 12:10:33 2020 From: oleg.grenrus at iki.fi (Oleg Grenrus) Date: Thu, 9 Jul 2020 15:10:33 +0300 Subject: Proposal for removing separate `Nat` in favour of promoted `Natural` type. In-Reply-To: <0c02c459-c683-2d4f-2237-5b13f210393b@iki.fi> References: <0c02c459-c683-2d4f-2237-5b13f210393b@iki.fi> Message-ID: <7ea59f3c-61ba-ed9c-4dc3-4dec8456c3b5@iki.fi> I should have read the whole email before replying... Sorry for the noise. On 9.7.2020 15.09, Oleg Grenrus wrote: > > There is an old GHC issue > https://gitlab.haskell.org/ghc/ghc/-/issues/10776 which got recently a > PR https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3583 > > - Oleg > > On 9.7.2020 12.59, Rinat Stryungis wrote: >> Hello, libraries! >> >> I want to present a proposal for changes in the `Base` library. >> The changes in my proposal partially solve the following issue: >>     https://gitlab.haskell.org/ghc/ghc/-/issues/10776 >> and remove the separate built-in kind `Nat` in favor of promoted type >> `Natural`. >> >> It means that previously one can't directly promote a data type with >> Natural fields: >> >>     data MyPointN = PointN Natural Natural -- could not be promoted >>     data MyPointP = PointP Nat Nat         -- could be promoted, but >> uninhabited in terms >> >>     type M = PointP 1 10   >> >> but now one could promote the `Natural` data type: >> >>     data MyPoint = Point Natural Natural >>     type MyTLPoint1 = Point 1 10 >> >> The proposed changes both simplify the internals of the GHC by removing >> separate kind and related things and make using of the type-level >> naturals more convenient for users. >> >> Also new type synonym >> >>     type Nat = Natural >> >> appeared in the Data.Type.TypeNats in the name of backward >> compatibility. >> >> I've opened a new MR with the patch. In the patch with the already >> implemented promotion of Naturals, one could find new and updated >> tests and docs. >> >> Also, I want to say about the breakages:   >> >> 1. One must enable `TypeSynonymInstances` in order to define >> instances for `Nat`. >> 2. Different instances for `Nat` and `Natural` won't type check anymore. >> 3. Type checker plugins that work with the natural numbers now >>    should use `naturalTy` kind instead of removed `typeNatKind` >> >> Anyone interested is welcome to look at the MR and discuss the >> proposal and its implementation. >> >> https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3583 >> >> The latter is very short and easy, thanks to the recently merged >> patch with a new `ghc-bignum` library. It greatly simplified my work. >> >> Thanks and best regards. >> Rinat Stryungis.  >> >> _______________________________________________ >> Libraries mailing list >> Libraries at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries -------------- next part -------------- An HTML attachment was scrubbed... URL: From daniel.rogozin at serokell.io Fri Jul 10 16:02:07 2020 From: daniel.rogozin at serokell.io (Daniel Rogozin) Date: Fri, 10 Jul 2020 19:02:07 +0300 Subject: Fwd: The Char Kind: proposal In-Reply-To: References: Message-ID: Greetings, I would like to propose and discuss several changes related to the character kind. Some of those changes were implemented jointly with Rinat Stryungis, my Serokell teammate. The purpose of this patch is to provide a possibility of analysing type-level strings (symbols) as term-level ones. This feature allows users to implement such programs as type-level parsers. One needs to have full-fledged support of type-level characters as well as we already have for strings and numbers. In addition to this functionality, it makes sense to introduce the set of type-families, counterparts of functions defined in the Data.Char module in order to work with type-level strings and chars as usual (more or less). For more convenience, it’s worth having some of the character-related type families as built-ins and generating the rest of ones as type synonyms. The patch fixes #11342, an issue opened by Alexander Vieth several years ago. In this patch, we introduced the Char Kind, a kind of type-level characters, with the additional type-families, type-level counterparts of functions from the `Data.Char` module. In contrast to Vieth’s approach, we use the same Char type and don’t introduce the different `Character` kind. We provide slightly more helpers to work with the Char kind, see below. You may take a look at this merge request with proposed updates: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3598. First of all, we overview the additional type families implemented by us in this patch. type family CmpChar (a :: Char) (b :: Char) :: Ordering Comparison of type-level characters, as a type family. A type-level analogue of the function `compare` specified for characters. type family LeqChar (a :: Char) (b :: Char) :: Bool This is a type-level comparison of characters as well. `LeqChar` yields a Boolean value and corresponds to `(<=)`. type family ConsSymbol (a :: Char) (b :: Symbol) :: Symbol This extends a type-level symbol with a type-level character type family UnconsSymbol (a :: Symbol) :: Maybe (Char, Symbol) This type family yields type-level `Just` storing the first character of a symbol and its tail if it is nonempty and `Nothing` otherwise. Type-level counterparts of the functions `toUpper`, `toLower`, and `toTitle` from 'Data.Char'. type family ToUpper (a :: Char) :: Char type family ToLower (a :: Char) :: Char type family ToTitle (a :: Char) :: Char These type families are type-level analogues of the functions `ord` and `chr` from Data.Char respectively. type family CharToNat (a :: Char) :: Nat type family NatToChar (a :: Nat) :: Char A type-level analogue of the function `generalCategory` from `Data.Kind`. type family GeneralCharCategory (a :: Char) :: GeneralCategory The second group of type families consists of built-in unary predicates. All of them are based on their corresponding term-level analogues from `Data.Char`. The precise list is the following one: type family IsAlpha (a :: Char) :: Bool type family IsAlphaNum (a :: Char) :: Bool type family IsControl (a :: Char) :: Bool type family IsPrint (a :: Char) :: Bool type family IsUpper (a :: Char) :: Bool type family IsLower (a :: Char) :: Bool type family IsSpace (a :: Char) :: Bool type family IsDigit (a :: Char) :: Bool type family IsOctDigit (a :: Char) :: Bool type family IsHexDigit (a :: Char) :: Bool type family IsLetter (a :: Char) :: Bool We also provide several type-level predicates implemented via the `GeneralCharCategory` type family. type IsMark a = IsMarkCategory (GeneralCharCategory a) type IsNumber a = IsNumberCategory (GeneralCharCategory a) type IsPunctuation a = IsPunctuationCategory (GeneralCharCategory a) type IsSymbol a = IsSymbolCategory (GeneralCharCategory a) type IsSeparator a = IsSeparatorCategory (GeneralCharCategory a) Here is an example of an implementation: type IsMark a = IsMarkCategory (GeneralCharCategory a) type family IsMarkCategory (c :: GeneralCategory) :: Bool where IsMarkCategory 'NonSpacingMark = 'True IsMarkCategory 'SpacingCombiningMark = 'True IsMarkCategory 'EnclosingMark = 'True IsMarkCategory _ = 'False Built-in type families I described above are supported with the corresponding definitions and functions in `compiler/GHC/Builtin/Names.hs`, `compiler/GHC/Builtin/Types.hs`, and `compiler/GHC/Builtin/Types/Literals.hs`. In addition to type families, our patch contain the following updates: 1. parsing the 'x' syntax 2. type-checking 'x' :: Char 3. type-checking Refl :: 'x' :~: 'x' 4. Typeable / TypeRep support 5. template-haskell support 6. Haddock related updates 7. tests At the moment, the merge request has some minor imperfections for polishing and improvement, but we have a prototype of a possible implementation. The aim of my email is to receive your feedback on this patch. Kind regards, Danya Rogozin. -------------- next part -------------- An HTML attachment was scrubbed... URL: From fumiexcel at gmail.com Mon Jul 13 03:27:23 2020 From: fumiexcel at gmail.com (Fumiaki Kinoshita) Date: Mon, 13 Jul 2020 12:27:23 +0900 Subject: Package takeover: thyme and enummapset-th In-Reply-To: References: Message-ID: Oh hi, I'm doing well. If you have time, can you edit the package information and add me (FumiakiKinoshita) as a maintainer? If you don't, that's fine - I'll ask the administrator. Kind regards, 2020年7月9日(木) 18:15 Liyang HU : > Hi Fumiaki, > > Hope you are well. Yes, please take them over. > > Thank you, > /Liyang > > > > > On Thu, 9 Jul 2020, 07:14 Fumiaki Kinoshita, wrote: > >> There isn't observable activity on upstream repositories either; I think >> it is no exaggeration to say that they are no longer maintained. >> >> https://github.com/liyang/thyme >> https://github.com/liyang/vector-th-unbox/ >> >> CCing to the Hackage administrators. >> >>> -------------- next part -------------- An HTML attachment was scrubbed... URL: From lazybonesxp at gmail.com Mon Jul 13 13:20:42 2020 From: lazybonesxp at gmail.com (Rinat Stryungis) Date: Mon, 13 Jul 2020 16:20:42 +0300 Subject: Proposal for adding explicit fixity for (~) and (~~) Message-ID: Hello, libraries! I want to present a proposal for changes in the `ghc-prim` library. It solves the following issue: https://gitlab.haskell.org/ghc/ghc/-/issues/18252 by adding an explicit fixity for the `(~)` type operator. It is set equal to 4: infix 4 ~, ~~ And there are two reasons for that: 1. These fixities are equal to the corresponding fixities of `(:~:)` and `(:~~:)` 2. They are less than `GHC.TypeLits.+` and expressions like `5 + 5 ~ 10` could be written without brackets. Also, it looks like the change does not break anything and all existing tests are passed. The patch is already implemented and could be seen by the following link: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3610 Also, I've updated documentation and added tests. Welcome to discuss the change and its implementation. Best regards, Rinat Stryungis. -------------- next part -------------- An HTML attachment was scrubbed... URL: From simon.jakobi at googlemail.com Mon Jul 13 20:59:24 2020 From: simon.jakobi at googlemail.com (Simon Jakobi) Date: Mon, 13 Jul 2020 22:59:24 +0200 Subject: Symmetric difference for Set and IntSet In-Reply-To: References: <8885A454-A5BA-469C-81D4-D721E78EF91D@gmail.com> Message-ID: I have opened https://github.com/haskell/containers/issues/732 to track this idea. Am Fr., 26. Juni 2020 um 19:27 Uhr schrieb David Feuer : > > Map merges can do even more, because they work with arbitrary Applicative functors. So a functor like > > data Triple a = Triple a a a > instance Applicative Triple where > pure a = Triple a a a > liftA2 f (Triple x y z) (Triple p q r) = Triple (f x p) (f y q) (f z r) > > can be used to calculate union, intersection, *and* symmetric difference all in one go. I should just bite the bullet and implement that for sets. > > On Fri, Jun 26, 2020, 1:16 PM Andrew Lelechenko wrote: >> >> On 18 Jun 2020, at 23:42, Bardur Arantsson wrote: >> > I think it's probably going to be useful, but I would suggest an >> > algorithm which actually returns each of the terms here (as a tuple), i.e. >> > >> > The "added" bits >> > The "removed" bits >> > The "common" bits >> > >> > This may not be *that* useful for sets per se, but I've lost count of >> > how often I've had to implement a similar thing for maps. >> >> >> This is probably orthogonal to my proposal here, because it does not improve the performance of symmetricDifference. Maps are more flexible in this aspect, because there are merge tactics, which allow to encode any set operation. >> >> Best regards, >> Andrew >> _______________________________________________ >> Libraries mailing list >> Libraries at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries From david.feuer at gmail.com Tue Jul 14 20:02:52 2020 From: david.feuer at gmail.com (David Feuer) Date: Tue, 14 Jul 2020 16:02:52 -0400 Subject: containers-0.6.3.1 Message-ID: At long last, we have released containers-0.6.3.1. The most important changes in this release are bug fixes for IntMap traversals: * Fix traverse and traverseWithKey for IntMap, which would previously produce invalid IntMaps when the input contained negative keys (Thanks, Felix Paulusma). * Fix the traversal order of various functions for Data.IntMap: traverseWithKey, traverseMaybeWithKey, filterWithKeyA, minimum, maximum, mapAccum, mapAccumWithKey, mapAccumL, mapAccumRWithKey, mergeA (Thanks, Felix Paulusma, Simon Jakobi). These now traverse in key order; previously they would traverse non-negative keys before negative keys. If you traverse any IntMaps, please take note of these changes. We also have several additions to the API: * Add compose for Map and IntMap (Thanks, Alexandre Esteves). * Add alterF for Set and IntSet (Thanks, Simon Jakobi). * Add Data.IntSet.mapMonotonic (Thanks, Javran Cheng). * Add instance Bifoldable Map (Thanks, Joseph C. Sible). Performance improvements of note: * Make (<*) for Data.Sequence incrementally asymptotically optimal (Thanks, David Feuer). This finally completes the task, begun in December 2014, of making all the Applicative methods for sequences asymptotically optimal even when their results are consumed incrementally. Many thanks to Li-Yao Xia and Bertram Felgenhauer for helping to clean up and begin to document this rather tricky code. * Speed up fromList and related functions in Data.IntSet, Data.IntMap and Data.IntMap.Strict (Thanks, Bertram Felgenhauer). * Use count{Leading,Trailing}Zeros in Data.IntSet internals (Thanks, Alex Biehl). There are also numerous documentation improvements and packaging updates. Please see the changelog for full details. Thanks to all the contributors, The containers team From carter.schonwald at gmail.com Tue Jul 14 23:19:37 2020 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Tue, 14 Jul 2020 19:19:37 -0400 Subject: [Haskell-cafe] containers-0.6.3.1 In-Reply-To: References: Message-ID: Great stuff! On Tue, Jul 14, 2020 at 4:04 PM David Feuer wrote: > At long last, we have released containers-0.6.3.1. The most important > changes in this release are bug fixes for IntMap traversals: > > * Fix traverse and traverseWithKey for IntMap, which would previously > produce invalid IntMaps when the input contained negative keys > (Thanks, Felix Paulusma). > > * Fix the traversal order of various functions for Data.IntMap: > traverseWithKey, traverseMaybeWithKey, filterWithKeyA, minimum, > maximum, mapAccum, mapAccumWithKey, mapAccumL, mapAccumRWithKey, > mergeA (Thanks, Felix Paulusma, Simon Jakobi). These now traverse in > key order; previously they would traverse non-negative keys before > negative keys. > > If you traverse any IntMaps, please take note of these changes. > > We also have several additions to the API: > > * Add compose for Map and IntMap (Thanks, Alexandre Esteves). > > * Add alterF for Set and IntSet (Thanks, Simon Jakobi). > > * Add Data.IntSet.mapMonotonic (Thanks, Javran Cheng). > > * Add instance Bifoldable Map (Thanks, Joseph C. Sible). > > Performance improvements of note: > > * Make (<*) for Data.Sequence incrementally asymptotically optimal > (Thanks, David Feuer). This finally completes the task, begun in > December 2014, of making all the Applicative methods for sequences > asymptotically optimal even when their results are consumed > incrementally. Many thanks to Li-Yao Xia and Bertram Felgenhauer for > helping to clean up and begin to document this rather tricky code. > > * Speed up fromList and related functions in Data.IntSet, Data.IntMap > and Data.IntMap.Strict (Thanks, Bertram Felgenhauer). > > * Use count{Leading,Trailing}Zeros in Data.IntSet internals (Thanks, > Alex Biehl). > > There are also numerous documentation improvements and packaging > updates. Please see the changelog for full details. > > Thanks to all the contributors, > The containers team > _______________________________________________ > 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. -------------- next part -------------- An HTML attachment was scrubbed... URL: From masaeedu at gmail.com Thu Jul 16 02:00:22 2020 From: masaeedu at gmail.com (Asad Saeeduddin) Date: Wed, 15 Jul 2020 22:00:22 -0400 Subject: Alternative instance for Compose Message-ID: Hello folks, base 4.14 has the following instance for `Compose f g`: instance (Alternative f, Applicative g) => Alternative (Compose f g) where empty = Compose empty (<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a)) :: forall a . Compose f g a -> Compose f g a -> Compose f g a This instance doesn't really do anything with the `Applicative g` constraint it is demanding. It's also kind of unclear what utility it delivers, given that the resulting Alternative instance is indistinguishable from the outer functor's Alternative instance. In other words: `getCompose $ Compose x <|> Compose y == x <|> y`. It seems to me a more useful instance would be: instance (Applicative f, Alternative g) => Alternative (Compose f g) where empty = Compose $ pure empty (<|>) = _ $ liftA2 (<|>) This is also nicer in a mathematical sense: `Applicative` functors correspond to lax monoidal functors from `Hask, (- , -), ()` to `Hask, (-, -), ()`. We can interpret `Alternative`s as lax monoidal functors from `Hask, Either - -, Void` to `Hask, (-, -), ()`. Compatible lax monoidal functors compose, but if you think about the relevant "types" of the functors a bit, you'll realize that while we can compose an `Applicative` after an `Alternative` to get another `Alternative`, the reverse does not work. Hence the instance we have today, which has no choice but to just ignore the `Applicative` constraint it is demanding. Does it make sense to replace the instance we have today with the `pure empty`, `liftA2 (<|>)` one? Thanks, Asad -------------- next part -------------- An HTML attachment was scrubbed... URL: From oleg.grenrus at iki.fi Thu Jul 16 17:27:56 2020 From: oleg.grenrus at iki.fi (Oleg Grenrus) Date: Thu, 16 Jul 2020 20:27:56 +0300 Subject: Looking for co-maintainers(s) for github package. Message-ID: <688e49da-d178-2ee9-aed4-4e1255506d50@iki.fi> Hi list, I have now been a maintainer of `github` [1] package for about four years. GitHub still develops and changes their API (good) and still doesn't provide machine readable specification (bad), thus the package needs some active maintenance. As I'm not using the package anymore myself, I often forget about its existence. Therefore I'm looking for a (co-)maintainers which use `github` package themselves, and could eventually take over the maintenance. In the past year I haven't written any code for the package myself, only reviewing and merging other people contributions, and preparing releases when there are enough changes. I don't ask you to do anything else either. - Oleg "phadej" Grenrus [1]: https://hackage.haskell.org/package/github From ndospark320 at gmail.com Fri Jul 17 06:48:33 2020 From: ndospark320 at gmail.com (Dannyu NDos) Date: Fri, 17 Jul 2020 15:48:33 +0900 Subject: Laziness on new "random" package Message-ID: Though it is reasonable to make utilities monadic, they lack a crucial property: *laziness*. I have the following datatype: newtype ArbReal = ArbReal (Word -> Integer) This represents arbitrary real numbers by being able to compute arbitrary decimal places after the decimal point. For example, to compute pi, let f be the function passed to constructor ArbReal. Then f 0 = 3, f 1 = 31, f 2 = 314, and so on. I can implement instance Random ArbReal: instance Random ArbReal where random g = let (h, i) = split g d:digits = randomRs (0 :: Word, 9) h getNum [] = 0 getNum (d:ds) = toInteger d + 10 * getNum ds takeDigits n = getNum (reverse (take n digits)) + toInteger (fromEnum (d >= 5)) in (ArbReal (takeDigits . fromIntegral), i) randomR (lo, hi) g = let (x, h) = random g in (lo + x * (hi - lo), h) But I see no way to implement an instance of UniformRange ArbReal, for it relies on randomRs, which is lazy. Neither ST nor IO is able to contain such laziness. -------------- next part -------------- An HTML attachment was scrubbed... URL: From carter.schonwald at gmail.com Fri Jul 17 12:37:53 2020 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Fri, 17 Jul 2020 08:37:53 -0400 Subject: Laziness on new "random" package In-Reply-To: References: Message-ID: You want to use a stateT esque monad that does a split within the bind. Quickcheck should have an example of this. On Fri, Jul 17, 2020 at 2:47 AM Dannyu NDos wrote: > Though it is reasonable to make utilities monadic, they lack a crucial > property: *laziness*. > > I have the following datatype: > > newtype ArbReal = ArbReal (Word -> Integer) > > This represents arbitrary real numbers by being able to compute arbitrary > decimal places after the decimal point. For example, to compute pi, let f > be the function passed to constructor ArbReal. Then f 0 = 3, f 1 = 31, f 2 > = 314, and so on. > > I can implement instance Random ArbReal: > > instance Random ArbReal where > random g = let > (h, i) = split g > d:digits = randomRs (0 :: Word, 9) h > getNum [] = 0 > getNum (d:ds) = toInteger d + 10 * getNum ds > takeDigits n = getNum (reverse (take n digits)) + toInteger > (fromEnum (d >= 5)) > in (ArbReal (takeDigits . fromIntegral), i) > randomR (lo, hi) g = let > (x, h) = random g > in (lo + x * (hi - lo), h) > > But I see no way to implement an instance of UniformRange ArbReal, for it > relies on randomRs, which is lazy. Neither ST nor IO is able to contain > such laziness. > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -------------- next part -------------- An HTML attachment was scrubbed... URL: From keith.wygant at gmail.com Tue Jul 21 00:17:06 2020 From: keith.wygant at gmail.com (Keith) Date: Tue, 21 Jul 2020 00:17:06 +0000 Subject: Alternative instance for Compose In-Reply-To: References: Message-ID: <074F291B-0358-47DF-9219-6F7C5A98B29B@gmail.com> With [], Maybe, and some other Alternative Functors, we have the nice property that empty <*> x = empty. (Think near-semiring.) But with your lifted version, empty <*> Compose empty = Compose empty. The authentically empty 'empty' is still the true zero element. -Keith — Sent from my phone with K-9 Mail. On July 16, 2020 2:00:22 AM UTC, Asad Saeeduddin wrote: >Hello folks, > >base 4.14 has the following instance for `Compose f g`: > >instance (Alternative f, Applicative g) => Alternative (Compose f g) where > empty = Compose empty > (<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a)) > :: forall a . Compose f g a -> Compose f g a -> Compose f g a > >This instance doesn't really do anything with the `Applicative g` >constraint it is demanding. It's also kind of unclear what utility it >delivers, given that the resulting Alternative instance is >indistinguishable from the outer functor's Alternative instance. In >other words: `getCompose $ Compose x <|> Compose y == x <|> y`. > >It seems to me a more useful instance would be: > >instance (Applicative f, Alternative g) => Alternative (Compose f g) where > empty = Compose $ pure empty > (<|>) = _ $ liftA2 (<|>) > >This is also nicer in a mathematical sense: `Applicative` functors >correspond to lax monoidal functors from `Hask, (- , -), ()` to `Hask, >(-, -), ()`. We can interpret `Alternative`s as lax monoidal functors >from `Hask, Either - -, Void` to `Hask, (-, -), ()`. Compatible lax >monoidal functors compose, but if you think about the relevant "types" >of the functors a bit, you'll realize that while we can compose an >`Applicative` after an `Alternative` to get another `Alternative`, the >reverse does not work. Hence the instance we have today, which has no >choice but to just ignore the `Applicative` constraint it is demanding. > >Does it make sense to replace the instance we have today with the `pure >empty`, `liftA2 (<|>)` one? > >Thanks, >Asad -------------- next part -------------- An HTML attachment was scrubbed... URL: