From joshchia at gmail.com Mon Jan 1 16:04:52 2018 From: joshchia at gmail.com (=?UTF-8?B?4piCSm9zaCBDaGlhICjorJ3ku7vkuK0p?=) Date: Tue, 2 Jan 2018 00:04:52 +0800 Subject: [Haskell-cafe] Shadowing record field names In-Reply-To: References: <7a31cf92-d596-5107-5cb9-db4fde790239@gmail.com> Message-ID: Tikhon's approach is interesting and seems potentially useful. Li-yao mentioned generic-lens, so I came up with an approach similar to Tikhon's but using generic-lens instead of TH, and prepending 'f' to the field name to get the lens name for additional safety from name collision (though still not absolute safety). In the example, it would be even better if I could use '#fXx' instead of '#fxx' (camel-casing the first letter of 'xx'), but type-level letter-case conversion seems quite troublesome to do. Any comments? Library code (Adapted from https://raw.githubusercontent.com/kcsongor/generic-lens/master/src/Data/Generics/Labels.hs. ): {-# LANGUAGE DataKinds, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications , TypeFamilies, UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module FieldLabel where import GHC.OverloadedLabels import GHC.TypeLits (AppendSymbol, KnownSymbol) import Data.Generics.Product.Fields (HasField, field) instance ( KnownSymbol lfield, lfield ~ AppendSymbol "f" field , HasField field s t a b, Functor f, sft ~ (s -> f t) ) => IsLabel lfield ((a -> f b) -> sft) where fromLabel = field @field User code: {-# LANGUAGE DeriveGeneric, OverloadedLabels #-} import Control.Lens ((^.)) import GHC.Generics import FieldLabel () data Foo = Foo { xx :: Int, yy :: Char } deriving (Generic, Show) foo :: Foo foo = Foo 1 'a' main :: IO () main = print $ foo ^. #fxx On Sun, Dec 24, 2017 at 3:47 AM, Tikhon Jelvis wrote: > This is a real pain point with records in Haskell. > > The fundamental problem is that unlike most languages with records or > object, field names are treated as normal identifiers in Haskell. Other > languages make fields special—you can only use them with the . operator > or in other select contexts. The advantage is that you can do things like > `a.author == author`; the disadvantage is that fields become a second-class > citizen. > > At work, we have a solution that's really nice to use built on top of > DuplicateRecordFields and OverloadedLabels. Our approach follows the ideas > in the OverloadedRecordFields proposal but with a lens flavor—very > similar to the overloaded-records[1] package. (We don't use that package > directly because I wrote our own version before I knew about it and I like > the ergonomics of our internal version a bit more.) > > We have a couple of typeclasses for reading and writing fields: > > class HasField (field :: Symbol) s a | s -> a where > getField :: s -> a > > class UpdatesField (field :: Symbol) s t b | name t -> b, name s b -> t > where > updateField :: s -> b -> t > > A record field can be both read and updated: > > type Field field s t a b = (HasField field s a, UpdatesField field name s > t b) > > field :: forall (name :: Symbol) s t a b. Field name s t a b => Lens s t a > b > field = lens (getField @name) (updateField @name) > > Then we have some Template Haskell for generating instances of these > classes. Here's a contrived example: > > data Foo a = Foo { bar :: [a] } > > record ''Foo > > which generates: > > instance HasField "bar" (Foo a) a where > getField = bar > > instance UpdatesField "bar" (Foo a) (Foo b) b where > updateField foo bar' = foo { bar = bar' } > > Given these, we can already write code looking up fields as lenses: > > > Foo [1,2,3] ^. field @"bar" > [1,2,3] > > Now fields aren't normal identifiers any more, the names can be shared > over different records (with DuplicateRecordFields) and you can write > functions polymorphic over any record with a given field. > > The names and details here are a bit different, but I believe this is > otherwise exactly what overloaded-records gives you. You could also replace > the TH to generate instances with generics in the style of the generic-lens > library. > > However, the field @"bar" is painfully verbose. We solve this using > OverloadedLabels and a somewhat shady orphan instance for IsLabel: > > instance (Functor f, Field name s t a b, a' ~ (a -> f b), b' ~ (s -> f t)) > => IsLabel name (a' -> b') where > fromLabel = field @name > > The details are a bit fiddly, but this is what we need to make type > inference work correctly. This lets us replace field @"name" with #name: > > > Foo [1,2,3] ^. #bar > [1,2,3] > > Foo [1,2,3] & #bar . each %~ show > Foo { bar = ["1","2","3"] } > > The downside is that this is an orphan instance for IsLabel for *all > functions*. You would not want to use this in a library but it's fine in an > executable as long as you don't mind potentially needing to reword things > if a similar IsLabel instance is added to base. (A risk I'm willing to take > for better syntax :)) > > Apart from that (somewhat serious) downside, the final result is pretty > much perfect: fields are first-class citizens (as lenses) and are not in > the same scope as identifiers. We've been using this extensively throughout > our whole project and it's been perfect—perhaps surprisingly, we haven't > run into any issues with type inference or type error messages (beyond what > you normally get with lens). > > With this addition, Haskell records went from being a real blemish on the > language to being the best I've ever used. The orphan instance is a > definite red flag and you should absolutely *not* have that instance in a > library, but if you're working on a standalone executable or some extensive > internal code, I think it's absolutely worth it. > > [1]: https://hackage.haskell.org/package/overloaded-records > > [2]: https://hackage.haskell.org/package/generic-lens > > > On Sat, Dec 23, 2017 at 6:41 AM, Li-yao Xia wrote: > >> I don't think "authorL" hurts readability. It just seems the logical >> choice if "author" is already taken. >> >> Have you seen generic-lens? The lens for the "author" field is (field >> @"author") so there is some added noise compared to "authorL", but it can >> be used as a TH-free alternative to makeClassy. >> >> type Field name a = forall s. HasField name s s a a => Lens s s a a >> >> authorL :: Field "author" Author >> authorL = field @"author" >> >> Cheers, >> Li-yao >> >> >> On 12/23/2017 08:36 AM, ☂Josh Chia (謝任中) wrote: >> >>> Quite often, I need to use record types like this: >>> >>> data Whole1 = Whole1 { part :: Part, ... } >>> data Whole2 = Whole2 { part :: Part, ... } >>> >>> Where Whole1 & Whole2 are types of things that have a Part and some >>> other things. E.g. a Book has an Author, a Title, etc and so does an >>> Article. >>> >>> The problem is that I'm not actually allowed to use the same name >>> (author/part) in two different record types. Some people use lens to solve >>> this. You can have a lens called 'author' for dealing with the Author in >>> both Book and Article (e.g. using makeClassy). >>> >>> That's fine, but there's yet another problem. Let's say I have a >>> function that takes an Author and a [Library] and returns all the Libraries >>> that have Books or Articles matching the Author. So: >>> >>> findAuthorLibraries :: Author -> [Library] -> [Library] >>> findAuthorLibraries author libraries = ... >>> >>> But I already have a lens called 'author' and ghc will complain about >>> shadowing. So, to avoid shadowing, should I use 'theAuthor' instead of >>> 'author' for the function argument? Or, should I name the lens >>> 'authorLens', 'authorL' or 'lAuthor' instead of 'author'? Prefixing with >>> 'the' is quite unreadable because whether or not an argument has that >>> prefix depends on whether there's a lens with a conflicting name so it adds >>> noise to the code. Adding a 'Lens' prefix to the 'author' lens also seems >>> quite an overbearing eyesore because for consistency I would have to use >>> the prefix for all my field-accessing lenses. >>> >>> Maybe I should use Lens.Control.TH.makeClassy and then define: >>> >>> findAuthorLibraries :: HasAuthor a => a -> [Library] -> [Library] >>> findAuthorLibraries hasAuthor libraries = ... >>> >>> But that may be making my function more complicated and general than I >>> want, affecting readability, simplicity, compilation time and maybe even >>> performance. >>> >>> In summary, I find that there are ways around the problem but they >>> really affect readability. >>> >>> I could also disable the warning about shadowing but that seems pretty >>> dangerous. It may be OK to disable the warning for the specific cases where >>> a function argument shadows something from the topmost scope, but GHC does >>> not allow such selective disabling of that warning. >>> >>> In a code base that deals mainly with concrete business logic, this >>> problem probably crops up more than in a code base that deals mainly with >>> more abstract things. >>> >>> What do people do to address this problem? Any recommendations or best >>> practices? >>> >>> Josh >>> >>> >>> _______________________________________________ >>> 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. >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From gershomb at gmail.com Tue Jan 2 01:24:45 2018 From: gershomb at gmail.com (Gershom B) Date: Mon, 1 Jan 2018 20:24:45 -0500 Subject: [Haskell-cafe] PSA: `cabal update` command needs manual unsticking Message-ID: Dear Haskellers, A recent update to hackage, which fixed up the 01-index.tar.gz file, revealed a bug in existing versions of cabal-install, when index files are cleaned up. This bug means that the `cabal update` command, which updates the hackage index file, will fail silently and leave the old file in place. It is easy to get things working again, but it requires manual intervention. Here is the most straightforward way to get things working again: On gnu/linux or mac: rm ~/.cabal/packages/hackage.haskell.org/01-index.* On windows: remove the same files, but from %appdata%\cabal\packages\hackage.haskell.org rerun `cabal update` to fetch a new 01-index. Apologies all for the inconvenience and any confusion this may have caused. There is a PR to fix this behavior in the works, but since the problem is on the client side, the fix will only improve the situations for new versions of `cabal`. Happy New Years to all, and cheers to a very functional 2018, Gershom p.s.: since the problem comes in unpacking the 01-index.tar.gz into the 01-index.tar, you can also just untar that file in place manually, or force cabal into doing the same by running `touch ~/.cabal/packages/hackage.haskell.org/01-index.tar` From svenpanne at gmail.com Tue Jan 2 09:47:33 2018 From: svenpanne at gmail.com (Sven Panne) Date: Tue, 2 Jan 2018 10:47:33 +0100 Subject: [Haskell-cafe] PSA: `cabal update` command needs manual unsticking In-Reply-To: References: Message-ID: 2018-01-02 2:24 GMT+01:00 Gershom B : > A recent update to hackage, which fixed up the 01-index.tar.gz file, > revealed a bug in existing versions of cabal-install, when index files > are cleaned up. This bug means that the `cabal update` command, which > updates the hackage index file, will fail silently and leave the old > file in place. It is easy to get things working again, but it requires > manual intervention. [...] Quick question: Are stack users affected, too, or only cabal users? I'm just asking because as a stack user you have ~/.stack/indices/Hackage/01-index.* files lying around, too... -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at snoyman.com Tue Jan 2 09:52:37 2018 From: michael at snoyman.com (Michael Snoyman) Date: Tue, 2 Jan 2018 11:52:37 +0200 Subject: [Haskell-cafe] PSA: `cabal update` command needs manual unsticking In-Reply-To: References: Message-ID: On Tue, Jan 2, 2018 at 11:47 AM, Sven Panne wrote: > 2018-01-02 2:24 GMT+01:00 Gershom B : > >> A recent update to hackage, which fixed up the 01-index.tar.gz file, >> revealed a bug in existing versions of cabal-install, when index files >> are cleaned up. This bug means that the `cabal update` command, which >> updates the hackage index file, will fail silently and leave the old >> file in place. It is easy to get things working again, but it requires >> manual intervention. [...] > > > Quick question: Are stack users affected, too, or only cabal users? I'm > just asking because as a stack user you have ~/.stack/indices/Hackage/01-index.* > files lying around, too... > > Hey Sven, Gershom sent me an email about this earlier, and I looked into it. As far as I can tell, Stack is _not_ affected by this, since—although it uses the same hackage-security library as cabal-install—it follows a different codepath outside of hackage-security for downloading tarballs. I'm not 100% certain Stack is immune, however, so if someone notices a problem, please report it. Michael -------------- next part -------------- An HTML attachment was scrubbed... URL: From romanandreg at gmail.com Tue Jan 2 15:15:58 2018 From: romanandreg at gmail.com (=?UTF-8?B?Um9tw6FuIEdvbnrDoWxleg==?=) Date: Tue, 02 Jan 2018 15:15:58 +0000 Subject: [Haskell-cafe] ANN: capataz-0.0.0.1 - An OTP-like supervisor library for Haskell In-Reply-To: References: Message-ID: Hello, I'm glad to share the release of a new library for supervising Haskell threads inspired in OTP/Akka called capataz * Hackage: http://hackage.haskell.org/package/capataz * Github: https://github.com/roman/Haskell-capataz * Documentation/Tutorials: https://romanandreg.gitbooks.io/capataz/content/ capataz enhances the reliability of your concurrent applications by offering supervision of threads that run in your application. Advantages over standard libraries: * Links related long-living processes together under a common capataz supervisor, with restart/shutdown order. * Set restart strategies (Permanent, Transient, Temporary) on `IO` sub-routines on a granular level * Set restart strategies on a pool of long-living worker threads (AllForOne, OneForOne) * Complete telemetry on your supervised threads lifecycle (start, error, restarts, shutdown) * Drop-in replacement of forkIO invocations Please feel free to reach out if you are curious and have any ideas/improvements. Cheers. Roman.- -------------- next part -------------- An HTML attachment was scrubbed... URL: From reiner.pope at gmail.com Wed Jan 3 02:51:40 2018 From: reiner.pope at gmail.com (Reiner Pope) Date: Wed, 03 Jan 2018 02:51:40 +0000 Subject: [Haskell-cafe] How does the RTS pin ByteArray# objects during FFI calls? Message-ID: Hi Haskell-Cafe, I understand from https://mail.haskell.org/pipermail/haskell-cafe/2014-June/114763.html that it is safe to pass ByteArray# objects to FFI calls, using the UnliftedFFITypes language extension. As I understand it, the implicit guarantee is that the RTS will pin the ByteArray#'s address in memory for the duration of the FFI call -- even if the ByteArray# wasn't allocated pinned. I'm curious: how does the RTS achieve this "retroactive" pinning? The documentation at https://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC/Pinned suggests that *all* ByteArrays are allocated pinned to account for the possibility that they will in future be passed to the FFI. Is this really the case? This seems like it forces an unreasonably slow allocator on small (say, ~10-byte) ByteArray allocations where the GC's usual bump-pointer allocator might otherwise be preferable. Regards, Reiner -------------- next part -------------- An HTML attachment was scrubbed... URL: From drkoster at qq.com Wed Jan 3 03:31:37 2018 From: drkoster at qq.com (winter) Date: Wed, 3 Jan 2018 11:31:37 +0800 Subject: [Haskell-cafe] How does the RTS pin ByteArray# objects during FFI calls? In-Reply-To: References: Message-ID: You’d better use `UnliftedFFITypes` with unsafe FFI calls, since unsafe FFI calls act like fat prim-ops. GC can happen during safe FFI calls, safe FFI calls are running on other OS threads rather than GHC scheduling threads. Note: older version of GHCi used to implemented unsafe FFI using safe FFI, there’s an issue about this here: https://ghc.haskell.org/trac/ghc/ticket/8281 > On 3 Jan 2018, at 10:51 AM, Reiner Pope wrote: > > Hi Haskell-Cafe, > > I understand from https://mail.haskell.org/pipermail/haskell-cafe/2014-June/114763.html that it is safe to pass ByteArray# objects to FFI calls, using the UnliftedFFITypes language extension. As I understand it, the implicit guarantee is that the RTS will pin the ByteArray#'s address in memory for the duration of the FFI call -- even if the ByteArray# wasn't allocated pinned. > > I'm curious: how does the RTS achieve this "retroactive" pinning? The documentation at https://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC/Pinned suggests that all ByteArrays are allocated pinned to account for the possibility that they will in future be passed to the FFI. Is this really the case? This seems like it forces an unreasonably slow allocator on small (say, ~10-byte) ByteArray allocations where the GC's usual bump-pointer allocator might otherwise be preferable. > > Regards, > Reiner > _______________________________________________ > 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 reiner.pope at gmail.com Wed Jan 3 06:33:34 2018 From: reiner.pope at gmail.com (Reiner Pope) Date: Wed, 03 Jan 2018 06:33:34 +0000 Subject: [Haskell-cafe] How does the RTS pin ByteArray# objects during FFI calls? In-Reply-To: References: Message-ID: I see, so you're saying that there is no pinning of ByteArray# objects during FFI calls, and the only property that guarantees correctness of these FFI calls is that no GC happens during the FFI call. Furthermore, that guarantee is only available for FFI calls tagged 'unsafe'. Good to know! The bug you linked you linked is scary in how much code is buggy in this regard. Thanks for the heads-up! Reiner On Tue, Jan 2, 2018 at 7:31 PM winter wrote: > You’d better use `UnliftedFFITypes` with unsafe FFI calls, since unsafe > FFI calls act like fat prim-ops. > > GC can happen during safe FFI calls, safe FFI calls are running on other > OS threads rather than GHC scheduling threads. > > Note: older version of GHCi used to implemented unsafe FFI using safe FFI, > there’s an issue about this here: > https://ghc.haskell.org/trac/ghc/ticket/8281 > > > On 3 Jan 2018, at 10:51 AM, Reiner Pope wrote: > > Hi Haskell-Cafe, > > I understand from > https://mail.haskell.org/pipermail/haskell-cafe/2014-June/114763.html that > it is safe to pass ByteArray# objects to FFI calls, using the > UnliftedFFITypes language extension. As I understand it, the implicit > guarantee is that the RTS will pin the ByteArray#'s address in memory for > the duration of the FFI call -- even if the ByteArray# wasn't allocated > pinned. > > I'm curious: how does the RTS achieve this "retroactive" pinning? The > documentation at > https://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC/Pinned suggests > that *all* ByteArrays are allocated pinned to account for the possibility > that they will in future be passed to the FFI. Is this really the case? > This seems like it forces an unreasonably slow allocator on small (say, > ~10-byte) ByteArray allocations where the GC's usual bump-pointer allocator > might otherwise be preferable. > > Regards, > Reiner > > _______________________________________________ > 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 johannes.waldmann at htwk-leipzig.de Wed Jan 3 11:03:31 2018 From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann) Date: Wed, 3 Jan 2018 12:03:31 +0100 Subject: [Haskell-cafe] =?utf-8?q?looking_for_deep_learning_explanation_a_?= =?utf-8?q?la_L=C3=A4mmel=27s_map-reduce_paper?= Message-ID: <1bb58cee-7cbc-8fa9-d2bc-c9544f586d80@htwk-leipzig.de> Dear Cafe, I like this paper (R. Lämmel in SCP 2008) very much https://userpages.uni-koblenz.de/~laemmel/MapReduce/ both for contents and for style - and I wonder if there's something similar ("Haskell for design recovery", "rigorous description", "executable specification") on deep learning. Mainly for understanding/teaching without all the hype. (But of course, an accelerate-* implementation would be nice.) Yes I know that hyperbole *is* the main thing in this area. Happy New Year - J. From nathan.collins at gmail.com Thu Jan 4 18:38:09 2018 From: nathan.collins at gmail.com (Nathan Collins) Date: Thu, 4 Jan 2018 10:38:09 -0800 Subject: [Haskell-cafe] PSA: `cabal update` command needs manual unsticking In-Reply-To: References: Message-ID: In case this confuses anyone else, I think this PSA only applies if you're using cabal-install version 2.*, but please correct me if I'm wrong. I had some ~/.cabal/packages/hackage.haskell.org/00-index.* files, but not any 01-index.* files, and running `cabal update` didn't change that. Then I noticed I was using cabal-install version 1.24.0.2. When I upgraded to cabal-install version 2.0.0.1 and did another `cabal update` the 01-index.* files appeared. Cheers, -nathan On Mon, Jan 1, 2018 at 5:24 PM, Gershom B wrote: > Dear Haskellers, > > A recent update to hackage, which fixed up the 01-index.tar.gz file, > revealed a bug in existing versions of cabal-install, when index files > are cleaned up. This bug means that the `cabal update` command, which > updates the hackage index file, will fail silently and leave the old > file in place. It is easy to get things working again, but it requires > manual intervention. Here is the most straightforward way to get > things working again: > > On gnu/linux or mac: rm ~/.cabal/packages/hackage.haskell.org/01-index.* > On windows: remove the same files, but from > %appdata%\cabal\packages\hackage.haskell.org > > rerun `cabal update` to fetch a new 01-index. > > Apologies all for the inconvenience and any confusion this may have > caused. There is a PR to fix this behavior in the works, but since the > problem is on the client side, the fix will only improve the > situations for new versions of `cabal`. > > Happy New Years to all, and cheers to a very functional 2018, > Gershom > > p.s.: since the problem comes in unpacking the 01-index.tar.gz into > the 01-index.tar, you can also just untar that file in place manually, > or force cabal into doing the same by running `touch > ~/.cabal/packages/hackage.haskell.org/01-index.tar` > _______________________________________________ > 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 allbery.b at gmail.com Thu Jan 4 22:23:55 2018 From: allbery.b at gmail.com (Brandon Allbery) Date: Thu, 4 Jan 2018 17:23:55 -0500 Subject: [Haskell-cafe] PSA: `cabal update` command needs manual unsticking In-Reply-To: References: Message-ID: Correct: cabal-install 1.x still uses the old index format (00-index). The logic is different for 01-index, in order to support incremental update (appending when possible, instead of always having to download the whole thing again like with 00-index). On Thu, Jan 4, 2018 at 1:38 PM, Nathan Collins wrote: > In case this confuses anyone else, I think this PSA only applies if > you're using cabal-install version 2.*, but please correct me if I'm > wrong. > > I had some ~/.cabal/packages/hackage.haskell.org/00-index.* files, but > not any 01-index.* files, and running `cabal update` didn't change > that. Then I noticed I was using cabal-install version 1.24.0.2. When > I upgraded to cabal-install version 2.0.0.1 and did another `cabal > update` the 01-index.* files appeared. > > Cheers, > > -nathan > > On Mon, Jan 1, 2018 at 5:24 PM, Gershom B wrote: > > Dear Haskellers, > > > > A recent update to hackage, which fixed up the 01-index.tar.gz file, > > revealed a bug in existing versions of cabal-install, when index files > > are cleaned up. This bug means that the `cabal update` command, which > > updates the hackage index file, will fail silently and leave the old > > file in place. It is easy to get things working again, but it requires > > manual intervention. Here is the most straightforward way to get > > things working again: > > > > On gnu/linux or mac: rm ~/.cabal/packages/hackage.haskell.org/01-index.* > > On windows: remove the same files, but from > > %appdata%\cabal\packages\hackage.haskell.org > > > > rerun `cabal update` to fetch a new 01-index. > > > > Apologies all for the inconvenience and any confusion this may have > > caused. There is a PR to fix this behavior in the works, but since the > > problem is on the client side, the fix will only improve the > > situations for new versions of `cabal`. > > > > Happy New Years to all, and cheers to a very functional 2018, > > Gershom > > > > p.s.: since the problem comes in unpacking the 01-index.tar.gz into > > the 01-index.tar, you can also just untar that file in place manually, > > or force cabal into doing the same by running `touch > > ~/.cabal/packages/hackage.haskell.org/01-index.tar` > > _______________________________________________ > > 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. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From takenobu.hs at gmail.com Fri Jan 5 05:34:28 2018 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Fri, 5 Jan 2018 14:34:28 +0900 Subject: [Haskell-cafe] Syntax highlight for numeric literals Message-ID: Dear cafe, I wrote and pushed a bit about the syntax highlights of numeric literals for `BinaryLiterals`, `HexFloatLiterals` and `NumericUnderscores` extensions on editors. https://github.com/takenobu-hs/haskell-numeric-highlight I'm glad if this helps you. Regards, Takenobu -------------- next part -------------- An HTML attachment was scrubbed... URL: From carter.schonwald at gmail.com Fri Jan 5 14:33:50 2018 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Fri, 05 Jan 2018 14:33:50 +0000 Subject: [Haskell-cafe] PSA: `cabal update` command needs manual unsticking In-Reply-To: References: Message-ID: My cabal v2 seemed to be using 00 indices. Much to my confusion. Maybe I should reinstall it and check my config ;) On Thu, Jan 4, 2018 at 5:25 PM Brandon Allbery wrote: > Correct: cabal-install 1.x still uses the old index format (00-index). The > logic is different for 01-index, in order to support incremental update > (appending when possible, instead of always having to download the whole > thing again like with 00-index). > > On Thu, Jan 4, 2018 at 1:38 PM, Nathan Collins > wrote: > >> In case this confuses anyone else, I think this PSA only applies if >> you're using cabal-install version 2.*, but please correct me if I'm >> wrong. >> >> I had some ~/.cabal/packages/hackage.haskell.org/00-index.* files, but >> not any 01-index.* files, and running `cabal update` didn't change >> that. Then I noticed I was using cabal-install version 1.24.0.2. When >> I upgraded to cabal-install version 2.0.0.1 and did another `cabal >> update` the 01-index.* files appeared. >> >> Cheers, >> >> -nathan >> >> On Mon, Jan 1, 2018 at 5:24 PM, Gershom B wrote: >> > Dear Haskellers, >> > >> > A recent update to hackage, which fixed up the 01-index.tar.gz file, >> > revealed a bug in existing versions of cabal-install, when index files >> > are cleaned up. This bug means that the `cabal update` command, which >> > updates the hackage index file, will fail silently and leave the old >> > file in place. It is easy to get things working again, but it requires >> > manual intervention. Here is the most straightforward way to get >> > things working again: >> > >> > On gnu/linux or mac: rm ~/.cabal/packages/ >> hackage.haskell.org/01-index.* >> > On windows: remove the same files, but from >> > %appdata%\cabal\packages\hackage.haskell.org >> > >> > rerun `cabal update` to fetch a new 01-index. >> > >> > Apologies all for the inconvenience and any confusion this may have >> > caused. There is a PR to fix this behavior in the works, but since the >> > problem is on the client side, the fix will only improve the >> > situations for new versions of `cabal`. >> > >> > Happy New Years to all, and cheers to a very functional 2018, >> > Gershom >> > >> > p.s.: since the problem comes in unpacking the 01-index.tar.gz into >> > the 01-index.tar, you can also just untar that file in place manually, >> > or force cabal into doing the same by running `touch >> > ~/.cabal/packages/hackage.haskell.org/01-index.tar` >> >> > _______________________________________________ >> > 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. > > > > > -- > brandon s allbery kf8nh sine nomine > associates > allbery.b at gmail.com > ballbery at sinenomine.net > unix, openafs, kerberos, infrastructure, xmonad > http://sinenomine.net > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/glasgow-haskell-users > -------------- next part -------------- An HTML attachment was scrubbed... URL: From iustin at k1024.org Sun Jan 7 13:09:04 2018 From: iustin at k1024.org (Iustin Pop) Date: Sun, 7 Jan 2018 14:09:04 +0100 Subject: [Haskell-cafe] Syntax highlight for numeric literals In-Reply-To: References: Message-ID: <20180107130904.GA5326@teal.hq.k1024.org> On 2018-01-05 14:34:28, Takenobu Tani wrote: > Dear cafe, > > I wrote and pushed a bit about the syntax highlights of numeric literals > for `BinaryLiterals`, `HexFloatLiterals` and `NumericUnderscores` > extensions on editors. > > https://github.com/takenobu-hs/haskell-numeric-highlight > > I'm glad if this helps you. This is interesting, thanks. I'm surprised that Emacs/haskell-mode is the only case where the 'exact' version cannot be implemented. Do you know/can you explain why? thank you, iustin From takenobu.hs at gmail.com Sun Jan 7 14:01:03 2018 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Sun, 7 Jan 2018 23:01:03 +0900 Subject: [Haskell-cafe] Syntax highlight for numeric literals In-Reply-To: <20180107130904.GA5326@teal.hq.k1024.org> References: <20180107130904.GA5326@teal.hq.k1024.org> Message-ID: Hi iustin, Thank you for reply. > I'm surprised that Emacs/haskell-mode is the only case where the 'exact' version cannot be implemented. Do you know/can you explain why? It's simple. `font-lock` was a bit difficult for me :) Haskell-mode highlights strings (e.g. constructor, type, ...) other than numeric literals. (Numeric literals are not highlighted.) In order to correct the highlights of numeric literals, it seems necessary to accurately define highlights other than numeric literals. Regards, Takenobu 2018-01-07 22:09 GMT+09:00 Iustin Pop : > On 2018-01-05 14:34:28, Takenobu Tani wrote: > > Dear cafe, > > > > I wrote and pushed a bit about the syntax highlights of numeric literals > > for `BinaryLiterals`, `HexFloatLiterals` and `NumericUnderscores` > > extensions on editors. > > > > https://github.com/takenobu-hs/haskell-numeric-highlight > > > > I'm glad if this helps you. > > This is interesting, thanks. I'm surprised that Emacs/haskell-mode is > the only case where the 'exact' version cannot be implemented. Do you > know/can you explain why? > > thank you, > iustin > -------------- next part -------------- An HTML attachment was scrubbed... URL: From blaze at ruddy.ru Mon Jan 8 17:54:22 2018 From: blaze at ruddy.ru (Andrey Sverdlichenko) Date: Mon, 08 Jan 2018 17:54:22 +0000 Subject: [Haskell-cafe] Package takeover: re2 Message-ID: I'd like to take over maintenance of the package re2. It is built against old version of re2 library, never updated after 2014 and listed as "deprecated" on the author's website. I rather update this one than add another package for the same bindings. I tried to contact owner a week ago, but to no avail. My hackage username is blaze. -------------- next part -------------- An HTML attachment was scrubbed... URL: From johannes.waldmann at htwk-leipzig.de Mon Jan 8 18:05:22 2018 From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann) Date: Mon, 8 Jan 2018 19:05:22 +0100 Subject: [Haskell-cafe] =?utf-8?q?looking_for_deep_learning_explanation_a_?= =?utf-8?q?la_L=C3=A4mmel=27s_map-reduce_paper?= In-Reply-To: <1bb58cee-7cbc-8fa9-d2bc-c9544f586d80@htwk-leipzig.de> References: <1bb58cee-7cbc-8fa9-d2bc-c9544f586d80@htwk-leipzig.de> Message-ID: <5525585c-cf2a-20d3-984f-d8e491103d6e@htwk-leipzig.de> > ... I wonder if there's something similar ("Haskell for design > recovery", "rigorous description", "executable specification") > on deep learning. perhaps this (although the goal is different) https://blog.jle.im/entries/series/+practical-dependent-types-in-haskell.html - J From tanielsen at gmail.com Mon Jan 8 21:33:52 2018 From: tanielsen at gmail.com (Tom Nielsen) Date: Mon, 8 Jan 2018 21:33:52 +0000 Subject: [Haskell-cafe] =?utf-8?q?looking_for_deep_learning_explanation_a_?= =?utf-8?q?la_L=C3=A4mmel=27s_map-reduce_paper?= In-Reply-To: <1bb58cee-7cbc-8fa9-d2bc-c9544f586d80@htwk-leipzig.de> References: <1bb58cee-7cbc-8fa9-d2bc-c9544f586d80@htwk-leipzig.de> Message-ID: Although the analogies are somewhat stretched, there is this: http://colah.github.io/posts/2015-09-NN-Types-FP/ Tom On Wed, Jan 3, 2018 at 11:03 AM, Johannes Waldmann < johannes.waldmann at htwk-leipzig.de> wrote: > Dear Cafe, > > I like this paper (R. Lämmel in SCP 2008) very much > https://userpages.uni-koblenz.de/~laemmel/MapReduce/ > both for contents and for style - > > and I wonder if there's something similar ("Haskell for design > recovery", "rigorous description", "executable specification") > on deep learning. > > Mainly for understanding/teaching without all the hype. > (But of course, an accelerate-* implementation would be nice.) > > Yes I know that hyperbole *is* the main thing in this area. > > Happy New Year - J. > _______________________________________________ > 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 blaze at ruddy.ru Tue Jan 9 04:25:10 2018 From: blaze at ruddy.ru (Andrey Sverdlichenko) Date: Tue, 09 Jan 2018 04:25:10 +0000 Subject: [Haskell-cafe] Package takeover: re2 In-Reply-To: References: Message-ID: Thanks! On Mon, Jan 8, 2018 at 11:20 PM John Millikin wrote: > Just added you to the maintainer's list. Sorry for the delayed response, > I've been away from reliable internet for a few weeks. > > When you upload the next version, please also update the contact info to > yours. I'll say on my site that you're the new maintainer. > > On Mon, Jan 8, 2018 at 9:54 AM, Andrey Sverdlichenko > wrote: > >> I'd like to take over maintenance of the package re2. It is built >> against old version of re2 library, never updated after 2014 and listed as >> "deprecated" on the author's website. I rather update this one than add >> another package for the same bindings. >> >> I tried to contact owner a week ago, but to no avail. My hackage username >> is blaze. >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Tue Jan 9 22:55:26 2018 From: david.feuer at gmail.com (David Feuer) Date: Tue, 9 Jan 2018 17:55:26 -0500 Subject: [Haskell-cafe] Getting some funny brackets in Haddock docs Message-ID: The containers Haddock documentation currently represents sequences, sets, and maps via the relevant `fromList` function. For example, Data.Map gives the example findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x' I find these `fromList` calls exceedingly distracting, and I think they obscure the key ideas. Of course, I *could* just specify at the top that the documentation assumes OverloadedLists, but I think that's likely to be somewhat confusing, especially to beginners. My preference would really be to represent these data structures using funny brackets of some sort. Perhaps ⟦7,34,12⟧ for a sequence, ⦃40,3⦄ for a set, and ⟪(12,"alpha"), (14,"bravo")⟫ for a map. But there are three problems: 1. How can I insert the brackets conveniently? I definitely don't want to fill the module with Unicode. My preference would be to use \{ and \} or \[ and \] and have them get replaced by the left and right brackets appropriate to the module in question. But I don't actually know how to do that. 2. Funny brackets could presumably cause trouble for people who don't have appropriate fonts available. How could I mitigate this? 3. This whole idea could cause trouble for people who want to copy and paste examples from the documentation. Are people likely to want to do that? If so, how might I mitigate that problem? Are there tricks I can play to make copy/paste turn a funny left bracket into `fromList [` and a funny right bracket into `]`, and also not break things for non-HTML backends? Thanks, David From michael at orlitzky.com Wed Jan 10 04:08:45 2018 From: michael at orlitzky.com (Michael Orlitzky) Date: Tue, 9 Jan 2018 23:08:45 -0500 Subject: [Haskell-cafe] Getting some funny brackets in Haddock docs In-Reply-To: References: Message-ID: On 01/09/2018 05:55 PM, David Feuer wrote: > The containers Haddock documentation currently represents sequences, > sets, and maps via the relevant `fromList` function. For example, > Data.Map gives the example > > findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x' > > I find these `fromList` calls exceedingly distracting, and I think > they obscure the key ideas. Of course, I *could* just specify at the > top that the documentation assumes OverloadedLists, but I think that's > likely to be somewhat confusing, especially to beginners. If you think that's confusing, just wait til you try to explain that unicode snowman means circumfix fromList. How about, >>> let map_with_no_1 = fromList [(5,'a'), (3,'b')] >>> let default_value = 'x' >>> findWithDefault default_value 1 map_with_no_1 == default_value True From parsonsmatt at gmail.com Wed Jan 10 04:20:02 2018 From: parsonsmatt at gmail.com (Matt) Date: Tue, 9 Jan 2018 21:20:02 -0700 Subject: [Haskell-cafe] Getting some funny brackets in Haddock docs In-Reply-To: References: Message-ID: An extremely common complaint about Haskell coming from other languages is the proliferation of un-Googleable operators and symbols. I would be unhappy to see these changes made, especially as the fancy brackets aren't valid code (and thus can't be Hoogled or copy/pasted). I suspect that every non-maintainer of the containers documentation would need to look these symbols up every time they consulted the documentation, as the documentation would likely be the only place they're used. The `fromList` calls are perhaps a little noisy -- having literal syntax like Python's for maps and sets would be nice, but that's probably not going to fly given that `containers` isn't part of `base` or the Report. Matt Parsons On Tue, Jan 9, 2018 at 9:08 PM, Michael Orlitzky wrote: > On 01/09/2018 05:55 PM, David Feuer wrote: > > The containers Haddock documentation currently represents sequences, > > sets, and maps via the relevant `fromList` function. For example, > > Data.Map gives the example > > > > findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x' > > > > I find these `fromList` calls exceedingly distracting, and I think > > they obscure the key ideas. Of course, I *could* just specify at the > > top that the documentation assumes OverloadedLists, but I think that's > > likely to be somewhat confusing, especially to beginners. > > If you think that's confusing, just wait til you try to explain that > unicode snowman means circumfix fromList. > > How about, > > >>> let map_with_no_1 = fromList [(5,'a'), (3,'b')] > >>> let default_value = 'x' > >>> findWithDefault default_value 1 map_with_no_1 == default_value > True > _______________________________________________ > 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 johannes.waldmann at htwk-leipzig.de Wed Jan 10 10:55:01 2018 From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann) Date: Wed, 10 Jan 2018 11:55:01 +0100 Subject: [Haskell-cafe] Getting some funny brackets in Haddock docs Message-ID: <0905c144-e62c-bdd6-c72c-096fae922ca2@htwk-leipzig.de> OverloadedLists solves this, in a way? Prelude> :set -XOverloadedLists Prelude> import qualified Data.Map.Strict as M Prelude M> M.size [(2,3)] 1 because of the IsList instance https://hackage.haskell.org/package/containers-0.5.10.2/docs/src/Data.Map.Internal.html#line-3233 Do we want to use this in code examples in the docs? Equivalently, is it recommended to use this notation in actual code? The problem I see is that this (and similar) extensions will be active for all literals in a module - while we only want it for literals of some specific type. I know this is handled in the parser, and we don't know the types at this point. - J From steven at steshaw.org Wed Jan 10 11:28:42 2018 From: steven at steshaw.org (Steven Shaw) Date: Wed, 10 Jan 2018 21:28:42 +1000 Subject: [Haskell-cafe] Getting some funny brackets in Haddock docs In-Reply-To: <0905c144-e62c-bdd6-c72c-096fae922ca2@htwk-leipzig.de> References: <0905c144-e62c-bdd6-c72c-096fae922ca2@htwk-leipzig.de> Message-ID: Johanne ​s, can you explain again what's wrong with the code example you gave. It looks like you're saying that `M.size [(2,3)]` should not be 1 (but I'm not sure). David, perhaps you could add your own neat GHC language extension for UnicodeOverloadedLists which lets you use those unicode characters to delimit lists in addition to the usual []. When, I'd think it best to assume `UnicodeOverloadedLists` is enabled by making a comment at the top of the documentation. The just put those unicode character into the documentation. Damn people those that stare at the square boxes ;). I have no idea how unicode characters work with fonts 😅 ... There are so many approaches though. You could teach Haddock how to syntax highlight Haskell code​ ​ ​ (ghc-exactprint?). Then use a pretty-printer that uses your favourite sequence delimiters — perhaps ⟦⟧.​ Then ensure that you display the Haskell code blocks using your new pretty-printer. Also, you'll need a regular Haskell pretty-printer for use with a "copy" icon to allow folks to copy "regular" Haskell to try in their REPLs (so you probably need to "inject" a tiny bit of JS into the docs). That sounds like a lot of work so you could hack something together with JS (or GHCJS), munging the normal Haddock output to your tastes.​ If you use GHCJS, you could perhaps even still use ghc-exactprint to help munge the
 sections.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 

From mail at joachim-breitner.de  Wed Jan 10 11:44:49 2018
From: mail at joachim-breitner.de (Joachim Breitner)
Date: Wed, 10 Jan 2018 12:44:49 +0100
Subject: [Haskell-cafe] Getting some funny brackets in Haddock docs
In-Reply-To: 
References: 
Message-ID: <1515584689.7310.0.camel@joachim-breitner.de>

Hi,

Am Dienstag, den 09.01.2018, 17:55 -0500 schrieb David Feuer:
> The containers Haddock documentation currently represents sequences,
> sets, and maps via the relevant `fromList` function. For example,
> Data.Map gives the example
> 
>   findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x'
> 
> I find these `fromList` calls exceedingly distracting, and I think
> they obscure the key ideas. 

they are maybe somewhat verbose and distracting, but they are also
explicit (compared to OverloadedLists) and do not introduce new stuff
(compared to funny brackets). I would leave it as it is.

Joachim

-- 
Joachim Breitner
  mail at joachim-breitner.de
  http://www.joachim-breitner.de/
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 833 bytes
Desc: This is a digitally signed message part
URL: 

From johannes.waldmann at htwk-leipzig.de  Wed Jan 10 11:50:05 2018
From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann)
Date: Wed, 10 Jan 2018 12:50:05 +0100
Subject: [Haskell-cafe] Getting some funny brackets in Haddock docs
In-Reply-To: 
References: <0905c144-e62c-bdd6-c72c-096fae922ca2@htwk-leipzig.de>
 
Message-ID: <59eede92-4a6b-5496-b582-607a0ddab796@htwk-leipzig.de>

Hi,

> It looks like you're saying that `M.size [(2,3)]` should not be 1 (but
> I'm not sure).

Sorry for being terse.
No, that was just a comment about syntax, not semantics.

I was just stating that because of the IsList instance,
we can write  [(2,3)]  instead of  M.fromList [(2,3)]

This would give shorter text in the examples in the API doc -
and has the immense benefit that it already works as-is,
does not need any haddock changes, unicodes, JS, etc.

But it would hide the type distinction (Map vs. List)
so it might turn out to be unhelpful.

- J

From leiva.steven at gmail.com  Wed Jan 10 15:22:49 2018
From: leiva.steven at gmail.com (Steven Leiva)
Date: Wed, 10 Jan 2018 09:22:49 -0600
Subject: [Haskell-cafe] Getting some funny brackets in Haddock docs
In-Reply-To: <59eede92-4a6b-5496-b582-607a0ddab796@htwk-leipzig.de>
References: <0905c144-e62c-bdd6-c72c-096fae922ca2@htwk-leipzig.de>
 
 <59eede92-4a6b-5496-b582-607a0ddab796@htwk-leipzig.de>
Message-ID: 

I consider myself a Haskell beginner, and I think that the current
situation (with the use of *fromList*) will be less confusing than the
funny brackets.

Even if you could make it so that copy/past would turn funny brackets into
fromList, it would still be surprising behavior. When the code does
something unexpected, we are going to try to put in the funny brackets in
the repl. (Maybe that's more for programming beginners versus Haskell
beginners, but let's not discount them either).

I haven't read the docs, and I understand that your primary concern is the
noise from *fromList*, but I think leaving things as is and adding some
wording that says "Hey, if you want to avoid having *fromList* everywhere
in your own code, you can add OverloadedList  extension" would be the most
approachable. (Shouldn't be too much to ask a beginner to at least read the
preamble of a module's docs).

Just my 2 cents.

On Wed, Jan 10, 2018 at 5:50 AM, Johannes Waldmann <
johannes.waldmann at htwk-leipzig.de> wrote:

> Hi,
>
> > It looks like you're saying that `M.size [(2,3)]` should not be 1 (but
> > I'm not sure).
>
> Sorry for being terse.
> No, that was just a comment about syntax, not semantics.
>
> I was just stating that because of the IsList instance,
> we can write  [(2,3)]  instead of  M.fromList [(2,3)]
>
> This would give shorter text in the examples in the API doc -
> and has the immense benefit that it already works as-is,
> does not need any haddock changes, unicodes, JS, etc.
>
> But it would hide the type distinction (Map vs. List)
> so it might turn out to be unhelpful.
>
> - J
> _______________________________________________
> 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.
>



-- 
Steven Leiva
305.528.6038
leiva.steven at gmail.com
http://www.linkedin.com/in/stevenleiva
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 

From matt at m-renaud.com  Wed Jan 10 15:54:51 2018
From: matt at m-renaud.com (Matt Renaud)
Date: Wed, 10 Jan 2018 07:54:51 -0800
Subject: [Haskell-cafe] Getting some funny brackets in Haddock docs
In-Reply-To: 
References: <0905c144-e62c-bdd6-c72c-096fae922ca2@htwk-leipzig.de>
 
 <59eede92-4a6b-5496-b582-607a0ddab796@htwk-leipzig.de>
 
Message-ID: 

Thanks for the input Steven! We did what you mentioned (adding a tip about
Overloaded lists near the top) in the containers introduction and
walkthrough at https://haskell-containers.readthedocs.io/en/latest/set.
html#short-example. It sounds like we should do the same thing in the
Haddocks.

I'm also in agreeance that the examples should be copy-pasteable into
Haskell source files or the repl. I think what Michael suggested (moving
the set/map/sequence construction to a line above and assigning it to a
variable) is a good compromise; there's no special syntax added and the
actual use of the function becomes less "noisy".

On Wed, Jan 10, 2018, 7:24 AM Steven Leiva  wrote:

> I consider myself a Haskell beginner, and I think that the current
> situation (with the use of *fromList*) will be less confusing than the
> funny brackets.
>
> Even if you could make it so that copy/past would turn funny brackets into
> fromList, it would still be surprising behavior. When the code does
> something unexpected, we are going to try to put in the funny brackets in
> the repl. (Maybe that's more for programming beginners versus Haskell
> beginners, but let's not discount them either).
>
> I haven't read the docs, and I understand that your primary concern is the
> noise from *fromList*, but I think leaving things as is and adding some
> wording that says "Hey, if you want to avoid having *fromList* everywhere
> in your own code, you can add OverloadedList  extension" would be the most
> approachable. (Shouldn't be too much to ask a beginner to at least read the
> preamble of a module's docs).
>
> Just my 2 cents.
>
> On Wed, Jan 10, 2018 at 5:50 AM, Johannes Waldmann <
> johannes.waldmann at htwk-leipzig.de> wrote:
>
>> Hi,
>>
>> > It looks like you're saying that `M.size [(2,3)]` should not be 1 (but
>> > I'm not sure).
>>
>> Sorry for being terse.
>> No, that was just a comment about syntax, not semantics.
>>
>> I was just stating that because of the IsList instance,
>> we can write  [(2,3)]  instead of  M.fromList [(2,3)]
>>
>> This would give shorter text in the examples in the API doc -
>> and has the immense benefit that it already works as-is,
>> does not need any haddock changes, unicodes, JS, etc.
>>
>> But it would hide the type distinction (Map vs. List)
>> so it might turn out to be unhelpful.
>>
>> - J
>> _______________________________________________
>> 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.
>>
>
>
>
> --
> Steven Leiva
> 305.528.6038 <(305)%20528-6038>
> leiva.steven at gmail.com
> http://www.linkedin.com/in/stevenleiva
> _______________________________________________
> 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 evan at evanrutledgeborden.dreamhosters.com  Wed Jan 10 19:49:54 2018
From: evan at evanrutledgeborden.dreamhosters.com (evan@evan-borden.com)
Date: Wed, 10 Jan 2018 12:49:54 -0700
Subject: [Haskell-cafe] ANN: network-2.6.3.3
Message-ID: 

Announcing network-2.6.3.3

 * Add a function to show the defaultHints without reading their
undefined fields
   [#291](https://github.com/haskell/network/pull/292)
 * Improve exception error messages for getAddrInfo and getNameInfo
   [#289](https://github.com/haskell/network/pull/289)
 * Deprecating SockAddrCan.

As always a huge thank you to the network contributors.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 

From benjamin.redelings at gmail.com  Thu Jan 11 16:27:47 2018
From: benjamin.redelings at gmail.com (Benjamin Redelings)
Date: Thu, 11 Jan 2018 08:27:47 -0800
Subject: [Haskell-cafe] Non-deterministic function/expression types in
	Haskell?
Message-ID: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>

Hi,

0.  Does anyone know of any simple extensions of the HM type system to 
non-deterministic functions?  The reason that I'm asking is that for 
probabilistic programming in the lambda calculus, there are two ways of 
writing expressions:

(a) stochastic: let x = sample $ normal 0 1 in x*x

     or simply (sample $ normal 0 1)^2

(b) "mochastic": do {x <- normal 0 1; return (x*x)}

The "mo" in the second one refers to the use of monads.  That is the 
approach taken in the paper "Practical Probabilistic Programming with 
monads" (http://mlg.eng.cam.ac.uk/pub/pdf/SciGhaGor15.pdf) which I 
really enjoyed.

However, I am interested in the stochastic form here.  There are a 
number of reasons, such as the fact that the monadic representation 
forces serialization on things that need not be serial.  In fact, 
though, I'm not trying to prove which one is best, I am just interested 
in exploring the non-monadic approach as well.

1. So, is it possible to do a simple extension to the type system to 
express non-determinism?  I found this paper (Implicit Self-Adjusting 
Computation for Purely Functional Programs) that uses "level" tags on 
types to express either (i) security or (ii) changeability.  The first 
idea (for example) is that each type is tagged with one of two "levels", 
say Public and Secure, so that we actually have Int[Public] or 
Int[Secure].  Any function that consumes a Secure value must (i) must 
return a Secure type and (ii) has the arrow in its type labelled with 
[Secure].  I won't explain the "changeable" idea because its kind of 
complicated, but I am very interested in it.

2. This is kind of tangential to the point of my question, but to 
explain the examples below, it might be important to distinguish 
sampling from a distribution from the distribution itself.  So, normal 0 
1 won't generate a random sample.  Instead, normal 0 1 () will generate 
a random sample.  This allows us to pass (normal 0 1) to another 
function which applies it multiple times to generate multiple samples 
from the same distribution.

    -- sample from a distribution dist
    sample dist = dist ()

    --- take n samples from a distribution dist
    iid n dist = take n (map sample $ repeat dist)

Here we see some of the value of using the stochastic approach, versus 
the "mochastic" approach: we can use normal Haskell syntax to handle 
lists of random values!

3. So, I'm wondering if its possible to extend the HM type system to 
handle non-determinism in a similar fashion by either (i) having some 
function types be non-deterministic and/or (ii) having term types be 
non-deterministic.  Taking the second approach, I suggest tagging each  
type with level [D] (for deterministic) or [N] (for non-deterministic). 
Notation-wise, if a determinism level is unspecified, then this means (I 
think) quantifying over determinism levels.  A function that samples 
from the normal distribution we would get a type like:

    normal:: double -> double -> () -> double[N]

Our goal would be that an expression that consumes a non-deterministic 
expression must itself be non-deterministic, and any function that takes 
a non-deterministic input must have a non-deterministic output.   We 
could implement that using rules something like this, where {a,b} are 
type variables and {l1,l2} are level variables.

x:a[l1] :: a[l1]
\x:a[l1] -> E:b[l2]  :: a[l1] -> b[max l1 l2]
E[a[l1]->b[l2]] E[a[l]] :: b[l2]

The idea is that max l1 l2 would yield N (non-deterministic) if either 
l1=N or l2=N, because N > D.

4. Putting non-determinism into the type system would affect GHC in a 
few ways:

(a) we shouldn't pull non-deterministic expressions out of lambdas:

    We should NOT change
        \x -> let y=sample $ normal 0 1 in y+x
    into
       let y = sample $ normal 0 1 in \x -> y+x

(b) we should merge variables with identical values if the types are 
non-deterministic.

    For example it is OK to change
       let {x=normal 0 1; y = normal 0 1 in (sample x * sample y)}
    into
       let {x=normal 0 1} in sample x

    However it is NOT OK to change
       let {x=sample $ normal 0 1; y = sample $ normal 0 1} in x*y
    into
       let {x=sample $ normal 0 1} in x*x

Perhaps this would be useful in other contexts?

5. If what I've written makes sense, then the types of the functions 
'sample' and 'iid' would be:

sample:: (()->a[N]) -> a[N]

iid:: Int -> (() -> a[N]) -> [a[N]]

6.  This is quite a long e-mail, so to summarize, I am interested in 
whether or not there are any simple systems for putting non-determinism 
into HM.  Is the use of tagged types known NOT to work?  Is there are 
work on this that I should be aware of?

Any help much appreciated! :-)

take care,

-BenRI


From simonpj at microsoft.com  Thu Jan 11 17:08:10 2018
From: simonpj at microsoft.com (Simon Peyton Jones)
Date: Thu, 11 Jan 2018 17:08:10 +0000
Subject: [Haskell-cafe] Internships at Microsoft Research Cambridge
Message-ID: 

Happy New Year!
Would anyone like to come to Microsoft Research Cambridge for an internship?
For the first time, this year we have put together a list of all the open internship slots, with brief descriptions and closing dates.   This is in part due to our efforts to reach more people, and attract a broader, more diverse range of applicants.
There are lots of projects on that page, but I'd like to highlight one group in particular.  I'm personally involved in a project with four intern slots, in which we are using insights from functional programming got improve the experience of using spreadsheets - the world's most widely used functional programming languages.  This focus on end-user programming means that we need interns with wide interests and skills.  More details are below (copy/pasted from the web page).  The application deadline is 31 January 2018.  (NB: other slots have other deadlines.)
Thanks
Simon

Functional programming and spreadsheets

Supervisors: Simon Peyton Jones, Andy Gordon, Claudio Russo, Neil Toronto, Advait Sarkar

Start Date: June/July 2018

Applications close January 31 2018

Reference #: MSRC226
We hope to hire four interns during 2018 with a focus on using insights from functional programming to improve the experience of using spreadsheets. The exact internship project will be chosen to fit the expertise of successful applicants, but we are interested in a broad range of areas including:

  *   Improving the experience of authoring formulae in a spreadsheet
  *   Compiling spreadsheets for faster execution
  *   Using insights from type systems to catch programming errors sooner
  *   Generalisation and program synthesis
  *   Demonstrating radical improvements in the range of applications that can be tackled with spreadsheets.
We are looking for three interns with programming-language expertise, and one with a strong background in HCI and user experience.

You would be working with leaders in both functional programming (Andy Gordon, Simon Peyton Jones) and user experience (Advait Sarkar, Kenton O'Hara). There is a genuine possibility that your work could have real-world impact.
By way of general background, you may want to read Simon Peyton Jones et al's papers "A user-centred approach to functions in Excel" and "Champagne Prototyping: A Research Technique for Early Evaluation of Complex End-User Programming Systems".


-------------- next part --------------
An HTML attachment was scrubbed...
URL: 

From oleg.grenrus at iki.fi  Thu Jan 11 17:17:06 2018
From: oleg.grenrus at iki.fi (Oleg Grenrus)
Date: Thu, 11 Jan 2018 19:17:06 +0200
Subject: [Haskell-cafe] Non-deterministic function/expression types in
 Haskell?
In-Reply-To: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>
References: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>
Message-ID: <66d75a6f-6fa1-734a-e7e9-ea6aae067c7c@iki.fi>

Hi Benjamin

Let's see what you ask for, you have *new* syntax for types:

    a[N] and a[D]

what are a[N][N] or a[N][D] or a[N][D] or a[D][D]?

Aren't they a[N], a[N], a[N] and a[D] respectively?
That's what monads are about!

So

   a[N] ~ Distr a
   a[D] ~ Identity a ~ a

No need to complicate type-system! You just to not be afraid of monads!

Monads aren't sequencing, they are computational context.

I guess, you just want more natural term-level syntax.

You can use ApplicativeDo [1] (in GHC-8.0+), so e.g.

    do x <- normal 0 1
       y <- normal 0 1
       return (f x y)

will be transformed into

    liftA2 f (normal 0 1) (normal 0 1)

That's almost like

    f (normal 0 1) (normal 0 1)

if you have proper syntax highlighting ;)

Note: various term syntax extensions been proposed.
E.g. idiom brackets in the "Applicative programming with effects" [2]:

   (| f (normal 0 1) (normal 0 1) |)

to mean

   pure f <*> normal 0 1 <*> normal 0 1

which is equivalent to above liftA2 expression. If you like that, you
can check
"the Strathclyde Haskell Enhancement", it supports idiom brackets.

[1]
https://www.microsoft.com/en-us/research/publication/desugaring-haskells-do-notation-into-applicative-operations/
[2] http://strictlypositive.org/IdiomLite.pdf
[3] https://personal.cis.strath.ac.uk/conor.mcbride/pub/she/

On 11.01.2018 18:27, Benjamin Redelings wrote:
> Hi,
>
> 0.  Does anyone know of any simple extensions of the HM type system to
> non-deterministic functions?  The reason that I'm asking is that for
> probabilistic programming in the lambda calculus, there are two ways
> of writing expressions:
>
> (a) stochastic: let x = sample $ normal 0 1 in x*x
>
>     or simply (sample $ normal 0 1)^2
>
> (b) "mochastic": do {x <- normal 0 1; return (x*x)}
>
> The "mo" in the second one refers to the use of monads.  That is the
> approach taken in the paper "Practical Probabilistic Programming with
> monads" (http://mlg.eng.cam.ac.uk/pub/pdf/SciGhaGor15.pdf) which I
> really enjoyed.
>
> However, I am interested in the stochastic form here.  There are a
> number of reasons, such as the fact that the monadic representation
> forces serialization on things that need not be serial.  In fact,
> though, I'm not trying to prove which one is best, I am just
> interested in exploring the non-monadic approach as well.
>
> 1. So, is it possible to do a simple extension to the type system to
> express non-determinism?  I found this paper (Implicit Self-Adjusting
> Computation for Purely Functional Programs) that uses "level" tags on
> types to express either (i) security or (ii) changeability.  The first
> idea (for example) is that each type is tagged with one of two
> "levels", say Public and Secure, so that we actually have Int[Public]
> or Int[Secure].  Any function that consumes a Secure value must (i)
> must return a Secure type and (ii) has the arrow in its type labelled
> with [Secure].  I won't explain the "changeable" idea because its kind
> of complicated, but I am very interested in it.
>
> 2. This is kind of tangential to the point of my question, but to
> explain the examples below, it might be important to distinguish
> sampling from a distribution from the distribution itself.  So, normal
> 0 1 won't generate a random sample.  Instead, normal 0 1 () will
> generate a random sample.  This allows us to pass (normal 0 1) to
> another function which applies it multiple times to generate multiple
> samples from the same distribution.
>
>    -- sample from a distribution dist
>    sample dist = dist ()
>
>    --- take n samples from a distribution dist
>    iid n dist = take n (map sample $ repeat dist)
>
> Here we see some of the value of using the stochastic approach, versus
> the "mochastic" approach: we can use normal Haskell syntax to handle
> lists of random values!
>
> 3. So, I'm wondering if its possible to extend the HM type system to
> handle non-determinism in a similar fashion by either (i) having some
> function types be non-deterministic and/or (ii) having term types be
> non-deterministic.  Taking the second approach, I suggest tagging
> each  type with level [D] (for deterministic) or [N] (for
> non-deterministic). Notation-wise, if a determinism level is
> unspecified, then this means (I think) quantifying over determinism
> levels.  A function that samples from the normal distribution we would
> get a type like:
>
>    normal:: double -> double -> () -> double[N]
>
> Our goal would be that an expression that consumes a non-deterministic
> expression must itself be non-deterministic, and any function that
> takes a non-deterministic input must have a non-deterministic
> output.   We could implement that using rules something like this,
> where {a,b} are type variables and {l1,l2} are level variables.
>
> x:a[l1] :: a[l1]
> \x:a[l1] -> E:b[l2]  :: a[l1] -> b[max l1 l2]
> E[a[l1]->b[l2]] E[a[l]] :: b[l2]
>
> The idea is that max l1 l2 would yield N (non-deterministic) if either
> l1=N or l2=N, because N > D.
>
> 4. Putting non-determinism into the type system would affect GHC in a
> few ways:
>
> (a) we shouldn't pull non-deterministic expressions out of lambdas:
>
>    We should NOT change
>        \x -> let y=sample $ normal 0 1 in y+x
>    into
>       let y = sample $ normal 0 1 in \x -> y+x
>
> (b) we should merge variables with identical values if the types are
> non-deterministic.
>
>    For example it is OK to change
>       let {x=normal 0 1; y = normal 0 1 in (sample x * sample y)}
>    into
>       let {x=normal 0 1} in sample x
>
>    However it is NOT OK to change
>       let {x=sample $ normal 0 1; y = sample $ normal 0 1} in x*y
>    into
>       let {x=sample $ normal 0 1} in x*x
>
> Perhaps this would be useful in other contexts?
>
> 5. If what I've written makes sense, then the types of the functions
> 'sample' and 'iid' would be:
>
> sample:: (()->a[N]) -> a[N]
>
> iid:: Int -> (() -> a[N]) -> [a[N]]
>
> 6.  This is quite a long e-mail, so to summarize, I am interested in
> whether or not there are any simple systems for putting
> non-determinism into HM.  Is the use of tagged types known NOT to
> work?  Is there are work on this that I should be aware of?
>
> Any help much appreciated! :-)
>
> take care,
>
> -BenRI
>
> _______________________________________________
> 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 --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 819 bytes
Desc: OpenPGP digital signature
URL: 

From siddu.druid at gmail.com  Thu Jan 11 18:40:31 2018
From: siddu.druid at gmail.com (Siddharth Bhat)
Date: Thu, 11 Jan 2018 18:40:31 +0000
Subject: [Haskell-cafe] Internships at Microsoft Research Cambridge
In-Reply-To: 
References: 
Message-ID: 

Are bachelor level students allowed to apply? I have relevant experience in
compilers and HPC, and I'd love to work on GHC related things next year.
I'm an undergrad, however :)

Thanks,
Siddharth

On Thu 11 Jan, 2018, 22:42 Simon Peyton Jones via Haskell-Cafe, <
haskell-cafe at haskell.org> wrote:

> Happy New Year!
>
> Would anyone like to come to Microsoft Research Cambridge for an
> internship?
>
> For the first time, this year we have put together a* list of all the
> open internship slots
> *,
> with brief descriptions and closing dates.   This is in part due to our
> efforts to reach more people, and attract a broader, more diverse range of
> applicants.
>
> There are lots of projects on that page, but I’d like to highlight one
> group in particular.  I’m personally involved in a project with four intern
> slots, in which we are *using insights from functional programming got
> improve the experience of using spreadsheets* – the world’s most widely
> used functional programming languages.  This focus on end-user programming
> means that we need interns with wide interests and skills.  More details
> are below (copy/pasted from the web page).  *The application deadline is
> 31 January 2018*.  (NB: other slots have other deadlines.)
>
> Thanks
>
> Simon
>
>
> Functional programming and spreadsheets
>
> Supervisors: Simon Peyton Jones
> , Andy Gordon
> , Claudio Russo
> , Neil Toronto, Advait
> Sarkar 
>
> Start Date: June/July 2018
>
> Applications close January 31 2018
>
> Reference #: MSRC226
>
> We hope to hire four interns during 2018 with a focus on using insights
> from functional programming to improve the experience of using
> spreadsheets. The exact internship project will be chosen to fit the
> expertise of successful applicants, but we are interested in a broad range
> of areas including:
>
>    - Improving the experience of authoring formulae in a spreadsheet
>    - Compiling spreadsheets for faster execution
>    - Using insights from type systems to catch programming errors sooner
>    - Generalisation and program synthesis
>    - Demonstrating radical improvements in the range of applications that
>    can be tackled with spreadsheets.
>
> We are looking for *three* interns with programming-language expertise,
> and *one* with a strong background in HCI and user experience.
>
> You would be working with leaders in both functional programming (Andy
> Gordon, Simon Peyton Jones) and user experience (Advait Sarkar, Kenton
> O’Hara). There is a genuine possibility that your work could have
> real-world impact.
>
> By way of general background, you may want to read Simon Peyton Jones et
> al’s papers “A user-centred approach to functions in Excel
> ” and “Champagne Prototyping:
> A Research Technique for Early Evaluation of Complex End-User Programming
> Systems ”.
>
>
>
>
> _______________________________________________
> 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.

-- 
Sending this from my phone, please excuse any typos!
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 

From benjamin.redelings at gmail.com  Thu Jan 11 19:41:03 2018
From: benjamin.redelings at gmail.com (Benjamin Redelings)
Date: Thu, 11 Jan 2018 11:41:03 -0800
Subject: [Haskell-cafe] Non-deterministic function/expression types in
 Haskell?
In-Reply-To: <66d75a6f-6fa1-734a-e7e9-ea6aae067c7c@iki.fi>
References: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>
 <66d75a6f-6fa1-734a-e7e9-ea6aae067c7c@iki.fi>
Message-ID: <335fe5ec-45c2-5b68-da0e-76fa559bc9b3@gmail.com>

Hi Oleg,

I like monads, really I do.  I am just not asking a question about how I 
can (or should) use monads.

I guess we can split my question into two branches:
(a) why are monads a perfect solution to my problem?
(b) can we extend the HM type system to support non-determinism directly?

What I am actually interested in is (b), so I don't want to get 
sidetracked with (a) if it means ignoring (b).  I will think if I can 
respond to (a) without completely getting side-tracked and ignoring 
(b).  Does that make sense?

take care,

-BenRI

P.S. Thanks for the links!

From oleg.grenrus at iki.fi  Thu Jan 11 20:02:34 2018
From: oleg.grenrus at iki.fi (Oleg Grenrus)
Date: Thu, 11 Jan 2018 22:02:34 +0200
Subject: [Haskell-cafe] Non-deterministic function/expression types in
 Haskell?
In-Reply-To: <335fe5ec-45c2-5b68-da0e-76fa559bc9b3@gmail.com>
References: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>
 <66d75a6f-6fa1-734a-e7e9-ea6aae067c7c@iki.fi>
 <335fe5ec-45c2-5b68-da0e-76fa559bc9b3@gmail.com>
Message-ID: <7ee4878a-8780-4771-db21-27847f646888@iki.fi>

(a) Non-determism is an effect, e.g. simple list is non-determinism
monad, for small discrete distributions!
(b) Yes. We can write effectful code "implicitly"
  - You might look into *Automatically Escaping Monads*
  - https://www.youtube.com/watch?v=wG8AErq6Bbo, slides:
http://benl.ouroborus.net/talks/2016-HIW-Escape.pdf
  - http://disciple.ouroborus.net/ or https://github.com/DDCSF/ddc

Interstingly, while searching for the paper, I stumbled upon Oleg
Kiselyov's  (not me) paper from
*Effects Without Monads: Non-determinism*, which is a different approach.
Maybe that's what you are looking after
http://okmij.org/ftp/tagless-final/nondet-paper.pdf

- Oleg

On 11.01.2018 21:41, Benjamin Redelings wrote:
> Hi Oleg,
>
> I like monads, really I do.  I am just not asking a question about how
> I can (or should) use monads.
>
> I guess we can split my question into two branches:
> (a) why are monads a perfect solution to my problem?
> (b) can we extend the HM type system to support non-determinism directly?
>
> What I am actually interested in is (b), so I don't want to get
> sidetracked with (a) if it means ignoring (b).  I will think if I can
> respond to (a) without completely getting side-tracked and ignoring
> (b).  Does that make sense?
>
> take care,
>
> -BenRI
>
> P.S. Thanks for the links!
>

-------------- next part --------------
A non-text attachment was scrubbed...
Name: 0xB8BB0BA4.asc
Type: application/pgp-keys
Size: 28502 bytes
Desc: not available
URL: 

From simonpj at microsoft.com  Thu Jan 11 17:08:10 2018
From: simonpj at microsoft.com (Simon Peyton Jones)
Date: Thu, 11 Jan 2018 17:08:10 +0000
Subject: [Haskell-cafe] Internships at Microsoft Research Cambridge
Message-ID: 

Happy New Year!
Would anyone like to come to Microsoft Research Cambridge for an internship?
For the first time, this year we have put together a list of all the open internship slots, with brief descriptions and closing dates.   This is in part due to our efforts to reach more people, and attract a broader, more diverse range of applicants.
There are lots of projects on that page, but I'd like to highlight one group in particular.  I'm personally involved in a project with four intern slots, in which we are using insights from functional programming got improve the experience of using spreadsheets - the world's most widely used functional programming languages.  This focus on end-user programming means that we need interns with wide interests and skills.  More details are below (copy/pasted from the web page).  The application deadline is 31 January 2018.  (NB: other slots have other deadlines.)
Thanks
Simon

Functional programming and spreadsheets

Supervisors: Simon Peyton Jones, Andy Gordon, Claudio Russo, Neil Toronto, Advait Sarkar

Start Date: June/July 2018

Applications close January 31 2018

Reference #: MSRC226
We hope to hire four interns during 2018 with a focus on using insights from functional programming to improve the experience of using spreadsheets. The exact internship project will be chosen to fit the expertise of successful applicants, but we are interested in a broad range of areas including:

  *   Improving the experience of authoring formulae in a spreadsheet
  *   Compiling spreadsheets for faster execution
  *   Using insights from type systems to catch programming errors sooner
  *   Generalisation and program synthesis
  *   Demonstrating radical improvements in the range of applications that can be tackled with spreadsheets.
We are looking for three interns with programming-language expertise, and one with a strong background in HCI and user experience.

You would be working with leaders in both functional programming (Andy Gordon, Simon Peyton Jones) and user experience (Advait Sarkar, Kenton O'Hara). There is a genuine possibility that your work could have real-world impact.
By way of general background, you may want to read Simon Peyton Jones et al's papers "A user-centred approach to functions in Excel" and "Champagne Prototyping: A Research Technique for Early Evaluation of Complex End-User Programming Systems".


-------------- next part --------------
An HTML attachment was scrubbed...
URL: 

From monkleyon at gmail.com  Thu Jan 11 22:18:08 2018
From: monkleyon at gmail.com (MarLinn)
Date: Thu, 11 Jan 2018 23:18:08 +0100
Subject: [Haskell-cafe] Non-deterministic function/expression types in
 Haskell?
In-Reply-To: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>
References: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>
Message-ID: 


> 3. So, I'm wondering if its possible to extend the HM type system to 
> handle non-determinism in a similar fashion by either (i) having some 
> function types be non-deterministic and/or (ii) having term types be 
> non-deterministic.  Taking the second approach, I suggest tagging each 
> type with level [D] (for deterministic) or [N] (for 
> non-deterministic). Notation-wise, if a determinism level is 
> unspecified, then this means (I think) quantifying over determinism 
> levels.  A function that samples from the normal distribution we would 
> get a type like:
>
>    normal:: double -> double -> () -> double[N]

Keep in mind that I don't know the first thing about type systems. I 
just babble about what feels right.
With this said, this sounds like a completely new kind of term to me. 
Any by "kind", I mean as in "k" or "*". So some of the original examples 
could look like

     {-# LANGUAGE KindSignatures, NonDeterminism #-}

     normal :: Double -> Double -> () -> Double :: n

     sample :: (() -> a :: n) -> a :: n

     iid :: Int -> (() -> a :: n) -> [a :: n]

     constN :: (a :: *) -> (b :: n) -> (a :: *) -- also this: non-deterministic argument, but deterministic result

where "n" is a new kind annotation replacing the [N] and the implicit 
"*" replaces the [D]. So the rules would have to be on the kind-level I 
suppose?

Cheers.


From jgbm at acm.org  Fri Jan 12 00:53:28 2018
From: jgbm at acm.org (J. Garrett Morris)
Date: Thu, 11 Jan 2018 18:53:28 -0600
Subject: [Haskell-cafe] Non-deterministic function/expression types in
	Haskell?
In-Reply-To: <335fe5ec-45c2-5b68-da0e-76fa559bc9b3@gmail.com>
References: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>
 <66d75a6f-6fa1-734a-e7e9-ea6aae067c7c@iki.fi>
 <335fe5ec-45c2-5b68-da0e-76fa559bc9b3@gmail.com>
Message-ID: 

On Thu, Jan 11, 2018 at 1:41 PM, Benjamin Redelings
 wrote:
> (a) why are monads a perfect solution to my problem?
> (b) can we extend the HM type system to support non-determinism directly?

Yes, there are type systems that express effects differently.  No,
they don't really do anything different than monads would do.

The classic paper on the subject is probably Wadler's "The Marriage of
Effects and Monads".

http://homepages.inf.ed.ac.uk/wadler/papers/effectstocl/effectstocl.pdf

That said, there are a variety of other language features building on
the idea of effects.  Look for any of the literature on algebraic
effects or effect handlers.  Many of them use non-determinism as an
example.

 /g


-- 
Prosperum ac felix scelus virtus vocatur
 -- Seneca

From yotam2206 at gmail.com  Fri Jan 12 12:18:10 2018
From: yotam2206 at gmail.com (Yotam Ohad)
Date: Fri, 12 Jan 2018 12:18:10 +0000
Subject: [Haskell-cafe] Fails to `stack exec` a Yesod app
Message-ID: 

Hi, I have the following project (https://github.com/yohad/TheMafsidan).
'stack build` works with no errors but when I try to run it I get
App: static: getDirectoryContents:openDirStream: does not exist (No such
file or directory)

Anyone has a clue on how to fix this?

Yotam
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 

From benjamin.redelings at gmail.com  Fri Jan 12 16:26:42 2018
From: benjamin.redelings at gmail.com (Benjamin Redelings)
Date: Fri, 12 Jan 2018 08:26:42 -0800
Subject: [Haskell-cafe] Non-deterministic (stochastic?)
 function/expression types in Haskell?
In-Reply-To: <7ee4878a-8780-4771-db21-27847f646888@iki.fi>
References: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>
 <66d75a6f-6fa1-734a-e7e9-ea6aae067c7c@iki.fi>
 <335fe5ec-45c2-5b68-da0e-76fa559bc9b3@gmail.com>
 <7ee4878a-8780-4771-db21-27847f646888@iki.fi>
Message-ID: <87c53da9-b197-94bb-d28a-580d5f69d6a7@gmail.com>

Hi Oleg,

Thanks for the links!  These are quite interesting.

1. Here is one situation that occurs in evolutionary biology where I 
would want to have the full range of Haskell syntax available to me.  
Consider a binary tree, where each tree node has an integer name in 
[1..num_nodes tree].  The function (parent tree n) gives the parent of 
node n and (root tree) gives the root node.

-- the expected value for a node is the value at its parent
    mean node tree x | node == root tree   = 0
                     | otherwise           = x!!parent tree node

-- given a tree, simulate down the tree,
    simulate_on_tree tree  = let x = [sample $ normal (mean node tree x) 1 | node <- [1..num_nodes tree]]

My understanding is that you cannot refer to the result of a computation 
while performing a computation, as in:

     do {x <- simulate_on_tree tree x}

Am I missing something?


On 01/11/2018 12:02 PM, Oleg Grenrus wrote:
> (a) Non-determism is an effect, e.g. simple list is non-determinism monad, for small discrete distributions!

2.  Why would we want to consider non-determinism (in the sense of 
returning an unpredictable value) as an effect?  Certainly running a 
non-deterministic function does not change global state like modifying 
an IORef would.  I'm also thinking of functions that are (somehow) TRULY 
random, so they are not keeping a hidden state around somewhere.  I'm 
calling them "non-deterministic" instead of "random" because I want to 
ignore (for the moment) the probability distribution, and just say that 
the result is arbitrary.

3. Sampling from a normal distribution gives ONE value, and the list of 
possible values is .... large :-)  [i.e. it would include all Double 
values.]


> (b) Yes. We can write effectful code "implicitly"
>    - You might look into *Automatically Escaping Monads*
>    - https://www.youtube.com/watch?v=wG8AErq6Bbo, slides:
> http://benl.ouroborus.net/talks/2016-HIW-Escape.pdf
>    - http://disciple.ouroborus.net/ or https://github.com/DDCSF/ddc
4. Interesting - I like his approach to making the box / run 
instructions implicit.

> Interstingly, while searching for the paper, I stumbled upon Oleg
> Kiselyov's  (not me) paper from
> *Effects Without Monads: Non-determinism*, which is a different approach.
> Maybe that's what you are looking after
> http://okmij.org/ftp/tagless-final/nondet-paper.pdf
5. In this paper, it seems that non-determinism means returning ALL 
possible outcomes.  However, what I meant is arbitrarily choosing ONE 
possible outcome.  My terminology is probably being imported from 
statistics - is there a different word I should use here?

-BenRI

From benjamin.redelings at gmail.com  Fri Jan 12 16:38:48 2018
From: benjamin.redelings at gmail.com (Benjamin Redelings)
Date: Fri, 12 Jan 2018 08:38:48 -0800
Subject: [Haskell-cafe] Non-deterministic function/expression types in
 Haskell?
In-Reply-To: <66d75a6f-6fa1-734a-e7e9-ea6aae067c7c@iki.fi>
References: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>
 <66d75a6f-6fa1-734a-e7e9-ea6aae067c7c@iki.fi>
Message-ID: <19eb1b18-0d7b-a2d0-a685-91b77c8ede69@gmail.com>

Hi Oleg,


On 01/11/2018 09:17 AM, Oleg Grenrus wrote:
> Hi Benjamin
>
> Let's see what you ask for, you have *new* syntax for types:
>
>      a[N] and a[D]
>
> what are a[N][N] or a[N][D] or a[N][D] or a[D][D]?
>
> Aren't they a[N], a[N], a[N] and a[D] respectively?
> That's what monads are about!
Just to be clear, I'm not using [N] as an operator on types, but as part 
of the type. So a type could be something like the pair (Int,D) or 
(Int,N).  In that context a[N][N] is not part of the system.
>
> So
>
>     a[N] ~ Distr a
>     a[D] ~ Identity a ~ a
>
> No need to complicate type-system! You just to not be afraid of monads!
>
> Monads aren't sequencing, they are computational context.
>
> I guess, you just want more natural term-level syntax.
>
> You can use ApplicativeDo [1] (in GHC-8.0+), so e.g.
>
>      do x <- normal 0 1
>         y <- normal 0 1
>         return (f x y)
>
> will be transformed into
>
>      liftA2 f (normal 0 1) (normal 0 1)
>
> That's almost like
>
>      f (normal 0 1) (normal 0 1)
>
> if you have proper syntax highlighting ;)
>
> Note: various term syntax extensions been proposed.
> E.g. idiom brackets in the "Applicative programming with effects" [2]:
>
>     (| f (normal 0 1) (normal 0 1) |)
>
> to mean
>
>     pure f <*> normal 0 1 <*> normal 0 1
>
> which is equivalent to above liftA2 expression. If you like that, you
> can check
> "the Strathclyde Haskell Enhancement", it supports idiom brackets.
In my other message I posted an example that doesn't fit this very well:

do { x <- f x } does not work, where as let x = f x does work. Basically 
I'm trying to avoid monads because I want to use the full features of 
the Haskell language, instead of programming in an embedded language.  
In that context "more natural" term-level syntax is not sufficient.

Also, it seems possible that everything in Haskell COULD be written in a 
monad.  We could eliminate recursive let bindings, and tell people to 
create a giant state machine which they use by reading and writing 
IORefs. But then you also eliminate some of the point of using Haskell 
and may as well go write in C or something.  So it seems to me that just 
because you CAN use a monad doesn't mean you SHOULD use a monad, and the 
question is "when is a monad better than something else?"

Does that make sense?  Am I missing something?

-BenRI

From allbery.b at gmail.com  Fri Jan 12 18:00:17 2018
From: allbery.b at gmail.com (Brandon Allbery)
Date: Fri, 12 Jan 2018 13:00:17 -0500
Subject: [Haskell-cafe] Non-deterministic function/expression types in
	Haskell?
In-Reply-To: <19eb1b18-0d7b-a2d0-a685-91b77c8ede69@gmail.com>
References: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>
 <66d75a6f-6fa1-734a-e7e9-ea6aae067c7c@iki.fi>
 <19eb1b18-0d7b-a2d0-a685-91b77c8ede69@gmail.com>
Message-ID: 

You seem rather confused as to what a monad is. It is not about "everything
is in an IORef", for one. (IO is not the only Monad, nor are the others
pretending to be IO.)

On Fri, Jan 12, 2018 at 11:38 AM, Benjamin Redelings <
benjamin.redelings at gmail.com> wrote:

> Hi Oleg,
>
>
> On 01/11/2018 09:17 AM, Oleg Grenrus wrote:
>
>> Hi Benjamin
>>
>> Let's see what you ask for, you have *new* syntax for types:
>>
>>      a[N] and a[D]
>>
>> what are a[N][N] or a[N][D] or a[N][D] or a[D][D]?
>>
>> Aren't they a[N], a[N], a[N] and a[D] respectively?
>> That's what monads are about!
>>
> Just to be clear, I'm not using [N] as an operator on types, but as part
> of the type. So a type could be something like the pair (Int,D) or
> (Int,N).  In that context a[N][N] is not part of the system.
>
>>
>> So
>>
>>     a[N] ~ Distr a
>>     a[D] ~ Identity a ~ a
>>
>> No need to complicate type-system! You just to not be afraid of monads!
>>
>> Monads aren't sequencing, they are computational context.
>>
>> I guess, you just want more natural term-level syntax.
>>
>> You can use ApplicativeDo [1] (in GHC-8.0+), so e.g.
>>
>>      do x <- normal 0 1
>>         y <- normal 0 1
>>         return (f x y)
>>
>> will be transformed into
>>
>>      liftA2 f (normal 0 1) (normal 0 1)
>>
>> That's almost like
>>
>>      f (normal 0 1) (normal 0 1)
>>
>> if you have proper syntax highlighting ;)
>>
>> Note: various term syntax extensions been proposed.
>> E.g. idiom brackets in the "Applicative programming with effects" [2]:
>>
>>     (| f (normal 0 1) (normal 0 1) |)
>>
>> to mean
>>
>>     pure f <*> normal 0 1 <*> normal 0 1
>>
>> which is equivalent to above liftA2 expression. If you like that, you
>> can check
>> "the Strathclyde Haskell Enhancement", it supports idiom brackets.
>>
> In my other message I posted an example that doesn't fit this very well:
>
> do { x <- f x } does not work, where as let x = f x does work. Basically
> I'm trying to avoid monads because I want to use the full features of the
> Haskell language, instead of programming in an embedded language.  In that
> context "more natural" term-level syntax is not sufficient.
>
> Also, it seems possible that everything in Haskell COULD be written in a
> monad.  We could eliminate recursive let bindings, and tell people to
> create a giant state machine which they use by reading and writing IORefs.
> But then you also eliminate some of the point of using Haskell and may as
> well go write in C or something.  So it seems to me that just because you
> CAN use a monad doesn't mean you SHOULD use a monad, and the question is
> "when is a monad better than something else?"
>
> Does that make sense?  Am I missing something?
>
>
> -BenRI
> _______________________________________________
> 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                               sine nomine associates
allbery.b at gmail.com                                  ballbery at sinenomine.net
unix, openafs, kerberos, infrastructure, xmonad        http://sinenomine.net
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 

From john at degoes.net  Fri Jan 12 18:30:47 2018
From: john at degoes.net (John A. De Goes)
Date: Fri, 12 Jan 2018 11:30:47 -0700
Subject: [Haskell-cafe] LambdaConf 2018: Call for Proposals
Message-ID: <60EA3521-4C95-4D6C-912A-9877B399FC8C@degoes.net>

 Dear Haskell Enthusiast:
We are pleased to announce the Call for Proposals for LambdaConf 2018 .

LambdaConf is the largest interdisciplinary functional programming conference in the Mountain West, and one of the largest and most well-known functional programming conferences in the world. 

The conference takes place June 3rd - 5th, in Boulder, Colorado, at the University of Colorado Boulder, and is preceded by commercial training opportunities and followed by a day of third-party mini-conferences on selected topics.

If you are an educator, a researcher, a speaker, a speaker coach, or someone aspiring to one of the preceding, then we warmly welcome you to submit a proposal for LambdaConf 2018 . No prior experience is necessary for most proposals, and we welcome beginner-level content.

The Call for Proposals closes at the beginning of February 2018. We recommend submitting as early as you can to ensure sufficient time for editing.

LambdaConf attracts everyone from the FP-curious to researchers advancing state-of-the-art; hobbyists, professionals, academics and students. Material at all levels, including beginner content and very advanced content, will find an audience at LambdaConf.

Historically, LambdaConf has enjoyed a large selection of sessions on statically-typed functional programming, and a smaller selection of sessions on dynamically-typed functional programming. Some sessions are not tied to specific programming languages, but rather cover topics in abstract algebra, category theory, type theory, programming language theory, functional architecture, and so on, either generally or in a way that applies across many programming languages.

LambdaConf looks for sessions in the following areas:

Languages. Proposals that overview or dive into specific features of functional, math, or logic programming languages (both new and existing), with the goal of exposing developers to new ideas or helping them master features of languages they already know.
Libraries. Proposals that discuss libraries that leverage functional or logic programming to help programmers solve real-world problems.
Concepts. Proposals that discuss functional programming idioms, patterns, or abstractions; or concepts from mathematics, logic, and computer science, all directed at helping developers write software that's easier to test, easier to reason about, and easier to change safely.
Applications. Proposals that discuss how functional programming can help with specific aspects of modern software development, including scalability, distributed systems, concurrency, data processing, security, performance, correctness, user-interfaces, machine learning, and big data.
Use Cases. Proposals that discuss how functional programming enabled a project or team to thrive, or deliver more business value than possible with other approaches.
Cherry Picking. Proposals that show how techniques and approaches from functional programming can be adapted and incorporated into mainstream development languages and practices, to the benefit of developers using them.
Cautionary Tales. Proposals that call attention to difficulties of functional programming (both as a cautionary tale but also to raise awareness), especially such proposals that suggest alternatives or a path forward.
Efficacy. Proposals that present data, measurements, or analysis that suggests different techniques, paradigms, languages, libraries, concepts, or approaches have different efficacies for given specified metrics, which provide actionable takeaways to practicing functional and logic programmers.
Off-Topic. Proposals that have appeal to a mainstream developer audience (the number of off-topic proposals we accept is small, but we do accept some, especially for keynotes).
LambdaConf accepts proposals for the following types of sessions:

Leap Workshops (6h). Leap Workshops are approximately 6 hours in length. They are in-depth, hands-on workshops designed to teach mainstream functional programming topics in enough detail, attendees can immediately apply what they learn in their jobs.  We require that speakers follow our recommended format for Leap Workshops, although we allow exceptions for experienced teachers.
Hop Workshops (2h). Hop Workshops are 2 hours in length. Like Leap Workshops, these workshops are in-depth and hands-on, but they cover reduced content and may be specialized to topics that may not have mainstream appeal. We require that speakers follow our recommended format for Hop Workshops, although we allow exceptions for experienced teachers.
De Novo Sessions (50m). De Novo Sessions are 50 minutes in length. These sessions are designed to present original work from industry and academia. While the requirements for proposals are more rigorous, there is less competition for De Novo slots.
Educational Sessions (50m). Educational Sessions are 50 minutes in length. These sessions are designed to clearly and concisely teach one useful concept, skill, aspect, library, or language to attendees.
Inspire Talks (5m). Inspire talks are 5 minutes in length and focus on clear communication of a single takeaway. These sessions are intended to inspire attendees to learn more about particular subjects or to try new approaches, and must follow Ignite-style, which consists of 20 slides, each auto-advancing after 15 seconds.
Keynotes (40m). Keynotes are 40 minutes in length, and are presented before all attendees (there are no other sessions concurrent with keynotes). Keynotes are designed to offer thought-provoking, opinionated, and insightful commentary on topics of interest to the community.
Level of reimbursement varies based on the type of proposal you are selected for:

Leap Workshops (6 hours). Speakers for Leap Workshops receive a free ticket, a speaker gift, a speaker dinner, up to 4 days accommodations, full travel reimbursement, and a small honorarium.
Hop Workshops (2 hours) / Educational (50m) / De Novo (50m) / Keynote (50m). Speakers for Hop Workshops, Educational, De Novo, and Keynote receive a free ticket, a speaker gift, a speaker dinner, and up to 4 days accommodations. Speakers may also request travel assistance, which is dealt out based on availability and need, and which may cover up to $250 for domestic travel, and $500 for international travel.
Inspire (5m). As Inspire talks are only 5 minutes in length, Inspire speakers receive a speaker gift and a speaker dinner, but must purchase a ticket and pay for travel and accommodations on their own.
If you are accepted for a specific type of proposal (e.g. Educational), we cannot guarantee that you will get a slot of this type. Based on scheduling requirements, feedback from the committee, or feedback from your speaker coach, we may require you to change the format of your session.

You may submit as many proposals as you like, though we recommend spending more time refining fewer proposals, since the quality of your proposals has a significant effect on their chances of acceptance by the blind committee. If you wish to maximize your chances of having a proposal accepted, we also recommend spreading 2-3 proposals across multiple categories, because some categories are fiercely competitive, while others are less competitive.

For more information, please see the Call for Proposals website .

Regards,
--
John A. De Goes
john at degoes.net
Follow me on Twitter @jdegoes






-------------- next part --------------
An HTML attachment was scrubbed...
URL: 

From alex.solla at gmail.com  Fri Jan 12 18:36:21 2018
From: alex.solla at gmail.com (Alexander Solla)
Date: Fri, 12 Jan 2018 10:36:21 -0800
Subject: [Haskell-cafe] Non-deterministic function/expression types in
	Haskell?
In-Reply-To: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>
References: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>
Message-ID: 

The `random-fu` package has a monad called `Random` to
encapsulate/construct random variables (i.e., for simulation).

Whether monads are a "perfect" solution to your problem depends on what
your random variables represent.  In most "finite" cases of jointly
distributed random variables, you can get away with just applicative
functors.  But this wouldn't do if you were modeling something like a
normal random walk.

The sequencing property isn't something you "need" to care about when
you're not using it (unless it causes performance issues).  After all, even
hand-written math is written down "in order", even mathematical expressions
have parse trees with implicit partial orders, etc.

On Thu, Jan 11, 2018 at 8:27 AM, Benjamin Redelings <
benjamin.redelings at gmail.com> wrote:

> Hi,
>
> 0.  Does anyone know of any simple extensions of the HM type system to
> non-deterministic functions?  The reason that I'm asking is that for
> probabilistic programming in the lambda calculus, there are two ways of
> writing expressions:
>
> (a) stochastic: let x = sample $ normal 0 1 in x*x
>
>     or simply (sample $ normal 0 1)^2
>
> (b) "mochastic": do {x <- normal 0 1; return (x*x)}
>
> The "mo" in the second one refers to the use of monads.  That is the
> approach taken in the paper "Practical Probabilistic Programming with
> monads" (http://mlg.eng.cam.ac.uk/pub/pdf/SciGhaGor15.pdf) which I really
> enjoyed.
>
> However, I am interested in the stochastic form here.  There are a number
> of reasons, such as the fact that the monadic representation forces
> serialization on things that need not be serial.  In fact, though, I'm not
> trying to prove which one is best, I am just interested in exploring the
> non-monadic approach as well.
>
> 1. So, is it possible to do a simple extension to the type system to
> express non-determinism?  I found this paper (Implicit Self-Adjusting
> Computation for Purely Functional Programs) that uses "level" tags on types
> to express either (i) security or (ii) changeability.  The first idea (for
> example) is that each type is tagged with one of two "levels", say Public
> and Secure, so that we actually have Int[Public] or Int[Secure].  Any
> function that consumes a Secure value must (i) must return a Secure type
> and (ii) has the arrow in its type labelled with [Secure].  I won't explain
> the "changeable" idea because its kind of complicated, but I am very
> interested in it.
>
> 2. This is kind of tangential to the point of my question, but to explain
> the examples below, it might be important to distinguish sampling from a
> distribution from the distribution itself.  So, normal 0 1 won't generate a
> random sample.  Instead, normal 0 1 () will generate a random sample.  This
> allows us to pass (normal 0 1) to another function which applies it
> multiple times to generate multiple samples from the same distribution.
>
>    -- sample from a distribution dist
>    sample dist = dist ()
>
>    --- take n samples from a distribution dist
>    iid n dist = take n (map sample $ repeat dist)
>
> Here we see some of the value of using the stochastic approach, versus the
> "mochastic" approach: we can use normal Haskell syntax to handle lists of
> random values!
>
> 3. So, I'm wondering if its possible to extend the HM type system to
> handle non-determinism in a similar fashion by either (i) having some
> function types be non-deterministic and/or (ii) having term types be
> non-deterministic.  Taking the second approach, I suggest tagging each
> type with level [D] (for deterministic) or [N] (for non-deterministic).
> Notation-wise, if a determinism level is unspecified, then this means (I
> think) quantifying over determinism levels.  A function that samples from
> the normal distribution we would get a type like:
>
>    normal:: double -> double -> () -> double[N]
>
> Our goal would be that an expression that consumes a non-deterministic
> expression must itself be non-deterministic, and any function that takes a
> non-deterministic input must have a non-deterministic output.   We could
> implement that using rules something like this, where {a,b} are type
> variables and {l1,l2} are level variables.
>
> x:a[l1] :: a[l1]
> \x:a[l1] -> E:b[l2]  :: a[l1] -> b[max l1 l2]
> E[a[l1]->b[l2]] E[a[l]] :: b[l2]
>
> The idea is that max l1 l2 would yield N (non-deterministic) if either
> l1=N or l2=N, because N > D.
>
> 4. Putting non-determinism into the type system would affect GHC in a few
> ways:
>
> (a) we shouldn't pull non-deterministic expressions out of lambdas:
>
>    We should NOT change
>        \x -> let y=sample $ normal 0 1 in y+x
>    into
>       let y = sample $ normal 0 1 in \x -> y+x
>
> (b) we should merge variables with identical values if the types are
> non-deterministic.
>
>    For example it is OK to change
>       let {x=normal 0 1; y = normal 0 1 in (sample x * sample y)}
>    into
>       let {x=normal 0 1} in sample x
>
>    However it is NOT OK to change
>       let {x=sample $ normal 0 1; y = sample $ normal 0 1} in x*y
>    into
>       let {x=sample $ normal 0 1} in x*x
>
> Perhaps this would be useful in other contexts?
>
> 5. If what I've written makes sense, then the types of the functions
> 'sample' and 'iid' would be:
>
> sample:: (()->a[N]) -> a[N]
>
> iid:: Int -> (() -> a[N]) -> [a[N]]
>
> 6.  This is quite a long e-mail, so to summarize, I am interested in
> whether or not there are any simple systems for putting non-determinism
> into HM.  Is the use of tagged types known NOT to work?  Is there are work
> on this that I should be aware of?
>
> Any help much appreciated! :-)
>
> take care,
>
> -BenRI
>
> _______________________________________________
> 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 ivan.miljenovic at gmail.com  Fri Jan 12 22:28:09 2018
From: ivan.miljenovic at gmail.com (Ivan Lazar Miljenovic)
Date: Sat, 13 Jan 2018 08:28:09 +1000
Subject: [Haskell-cafe] Fails to `stack exec` a Yesod app
In-Reply-To: 
References: 
Message-ID: 

On 12 January 2018 at 22:18, Yotam Ohad  wrote:
> Hi, I have the following project (https://github.com/yohad/TheMafsidan).
> 'stack build` works with no errors but when I try to run it I get
> App: static: getDirectoryContents:openDirStream: does not exist (No such
> file or directory)
>
> Anyone has a clue on how to fix this?

It would help diagnosing this if you provide the exact list of
commands you are trying to run.  Also, what OS are you using?

>
> Yotam
>
> _______________________________________________
> 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.



-- 
Ivan Lazar Miljenovic
Ivan.Miljenovic at gmail.com
http://IvanMiljenovic.wordpress.com

From whosekiteneverfly at gmail.com  Sat Jan 13 01:24:11 2018
From: whosekiteneverfly at gmail.com (Yuji Yamamoto)
Date: Sat, 13 Jan 2018 10:24:11 +0900
Subject: [Haskell-cafe] LambdaConf 2018: Call for Proposals
In-Reply-To: <60EA3521-4C95-4D6C-912A-9877B399FC8C@degoes.net>
References: <60EA3521-4C95-4D6C-912A-9877B399FC8C@degoes.net>
Message-ID: 

 Hi, John!

Thanks for the announcement.

I found the URL https://lambdaconf2018.dryfta.com/en/abstract-submission
redirects me
to a login-required page:
https://lambdaconf2018.dryfta.com/en/userlogin/register/login.
I guess you've forgotten to publish the page!

2018-01-13 3:30 GMT+09:00 John A. De Goes :

>  Dear Haskell Enthusiast:
>
> We are pleased to announce the Call for Proposals for LambdaConf 2018
> .
>
> LambdaConf is the largest interdisciplinary functional programming
> conference in the Mountain West, and one of the largest and most well-known
> functional programming conferences in the world.
>
> The conference takes place June 3rd - 5th, in Boulder, Colorado, at the
> University of Colorado Boulder, and is preceded by commercial training
> opportunities and followed by a day of third-party mini-conferences on
> selected topics.
>
> If you are an educator, a researcher, a speaker, a speaker coach, or
> someone aspiring to one of the preceding, then we warmly welcome you to
> submit a proposal for LambdaConf 2018
> . No prior
> experience is necessary for most proposals, and we welcome beginner-level
> content.
>
> The Call for Proposals closes at the beginning of February 2018. We
> recommend submitting as early as you can to ensure sufficient time for
> editing.
>
> LambdaConf attracts everyone from the FP-curious to researchers advancing
> state-of-the-art; hobbyists, professionals, academics and students.
> Material at all levels, including beginner content and very advanced
> content, will find an audience at LambdaConf.
>
> Historically, LambdaConf has enjoyed a large selection of sessions on
> statically-typed functional programming, and a smaller selection of
> sessions on dynamically-typed functional programming. Some sessions are not
> tied to specific programming languages, but rather cover topics in abstract
> algebra, category theory, type theory, programming language theory,
> functional architecture, and so on, either generally or in a way that
> applies across many programming languages.
>
> LambdaConf looks for sessions in the following areas:
>
>    - Languages. Proposals that overview or dive into specific features of
>    functional, math, or logic programming languages (both new and existing),
>    with the goal of exposing developers to new ideas or helping them master
>    features of languages they already know.
>    - Libraries. Proposals that discuss libraries that leverage functional
>    or logic programming to help programmers solve real-world problems.
>    - Concepts. Proposals that discuss functional programming idioms,
>    patterns, or abstractions; or concepts from mathematics, logic, and
>    computer science, all directed at helping developers write software that's
>    easier to test, easier to reason about, and easier to change safely.
>    - Applications. Proposals that discuss how functional programming can
>    help with specific aspects of modern software development, including
>    scalability, distributed systems, concurrency, data processing, security,
>    performance, correctness, user-interfaces, machine learning, and big data.
>    - Use Cases. Proposals that discuss how functional programming enabled
>    a project or team to thrive, or deliver more business value than possible
>    with other approaches.
>    - Cherry Picking. Proposals that show how techniques and approaches
>    from functional programming can be adapted and incorporated into mainstream
>    development languages and practices, to the benefit of developers using
>    them.
>    - Cautionary Tales. Proposals that call attention to difficulties of
>    functional programming (both as a cautionary tale but also to raise
>    awareness), especially such proposals that suggest alternatives or a path
>    forward.
>    - Efficacy. Proposals that present data, measurements, or analysis
>    that suggests different techniques, paradigms, languages, libraries,
>    concepts, or approaches have different efficacies for given specified
>    metrics, which provide actionable takeaways to practicing functional and
>    logic programmers.
>    - Off-Topic. Proposals that have appeal to a mainstream developer
>    audience (the number of off-topic proposals we accept is small, but we do
>    accept some, especially for keynotes).
>
> LambdaConf accepts proposals for the following types of sessions:
>
>    - Leap Workshops (6h). Leap Workshops are approximately 6 hours in
>    length. They are in-depth, hands-on workshops designed to teach mainstream
>    functional programming topics in enough detail, attendees can immediately
>    apply what they learn in their jobs.  We require that speakers follow our
>    recommended format for Leap Workshops, although we allow exceptions for
>    experienced teachers.
>    - Hop Workshops (2h). Hop Workshops are 2 hours in length. Like Leap
>    Workshops, these workshops are in-depth and hands-on, but they cover
>    reduced content and may be specialized to topics that may not have
>    mainstream appeal. We require that speakers follow our recommended format
>    for Hop Workshops, although we allow exceptions for experienced teachers.
>    - De Novo Sessions (50m). De Novo Sessions are 50 minutes in length.
>    These sessions are designed to present original work from industry and
>    academia. While the requirements for proposals are more rigorous, there is
>    less competition for De Novo slots.
>    - Educational Sessions (50m). Educational Sessions are 50 minutes in
>    length. These sessions are designed to clearly and concisely teach one
>    useful concept, skill, aspect, library, or language to attendees.
>    - Inspire Talks (5m). Inspire talks are 5 minutes in length and focus
>    on clear communication of a single takeaway. These sessions are intended to
>    inspire attendees to learn more about particular subjects or to try new
>    approaches, and must follow Ignite-style, which consists of 20 slides, each
>    auto-advancing after 15 seconds.
>    - Keynotes (40m). Keynotes are 40 minutes in length, and are presented
>    before all attendees (there are no other sessions concurrent with
>    keynotes). Keynotes are designed to offer thought-provoking, opinionated,
>    and insightful commentary on topics of interest to the community.
>
> Level of reimbursement varies based on the type of proposal you are
> selected for:
>
>    - Leap Workshops (6 hours). Speakers for Leap Workshops receive a free
>    ticket, a speaker gift, a speaker dinner, up to 4 days accommodations, full
>    travel reimbursement, and a small honorarium.
>    - Hop Workshops (2 hours) / Educational (50m) / De Novo (50m) /
>    Keynote (50m). Speakers for Hop Workshops, Educational, De Novo, and
>    Keynote receive a free ticket, a speaker gift, a speaker dinner, and up to
>    4 days accommodations. Speakers may also request travel assistance, which
>    is dealt out based on availability and need, and which may cover up to $250
>    for domestic travel, and $500 for international travel.
>    - Inspire (5m). As Inspire talks are only 5 minutes in length, Inspire
>    speakers receive a speaker gift and a speaker dinner, but must purchase a
>    ticket and pay for travel and accommodations on their own.
>
> If you are accepted for a specific type of proposal (e.g. Educational),
> we cannot guarantee that you will get a slot of this type. Based on
> scheduling requirements, feedback from the committee, or feedback from your
> speaker coach, we may require you to change the format of your session.
>
> You may submit as many proposals as you like, though we recommend spending
> more time refining fewer proposals, since the quality of your proposals has
> a significant effect on their chances of acceptance by the blind committee.
> If you wish to maximize your chances of having a proposal accepted, we also
> recommend spreading 2-3 proposals across multiple categories, because some
> categories are fiercely competitive, while others are less competitive.
>
> For more information, please see the Call for Proposals website
> .
> Regards,
> --
> John A. De Goes
> john at degoes.net
> Follow me on Twitter @jdegoes
>
>
>
>
>
>
>
> _______________________________________________
> 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.
>



-- 
山本悠滋
twitter: @igrep
GitHub: https://github.com/igrep
GitLab: https://gitlab.com/igrep
Facebook: http://www.facebook.com/igrep
Google+: https://plus.google.com/u/0/+YujiYamamoto_igrep
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 

From michael at snoyman.com  Sat Jan 13 15:47:08 2018
From: michael at snoyman.com (Michael Snoyman)
Date: Sat, 13 Jan 2018 15:47:08 +0000
Subject: [Haskell-cafe] Fails to `stack exec` a Yesod app
In-Reply-To: 
References: 
Message-ID: 

Pretty sure you have some code still remaining from the scaffolding that
refers to a static directory, but that the directory doesn't exist any more.

On Fri, Jan 12, 2018, 2:19 PM Yotam Ohad  wrote:

> Hi, I have the following project (https://github.com/yohad/TheMafsidan).
> 'stack build` works with no errors but when I try to run it I get
> App: static: getDirectoryContents:openDirStream: does not exist (No such
> file or directory)
>
> Anyone has a clue on how to fix this?
>
> Yotam
> _______________________________________________
> 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 olf at aatal-apotheke.de  Sat Jan 13 21:45:02 2018
From: olf at aatal-apotheke.de (Olaf Klinke)
Date: Sat, 13 Jan 2018 22:45:02 +0100
Subject: [Haskell-cafe] Non-deterministic function/expression types in
	Haskell?
Message-ID: 

Long story short: You can stay inside Haskell's type system or extend it, but you end up with monads either way. I'll explain why. 

> (a) why are monads a perfect solution to my problem?
Two reasons. First: Probability distributions do form a monad [Giry,CS,Kock]. It's a mathematical fact. So why not exploit it? It gives you powerful combinators and powerful abstractions. 
Second: Because the requirements on the type modificators [N] and [D] are describing many features monads have. First observe that you don't really need [D] because any deterministic computation can be embedded into the non-deterministic computations by making the set of possibilities a singleton. That is precisely what 'return' does in the context of monads. (Think of return for the list monad.)
> any function that takes a non-deterministic input must have a non-deterministic output.
That is common with monads, too: There is no generic function that can extract values out of monads.  
> we should merge variables with identical values if the types are non-deterministic.
That is problematic on several levels. First, is "identical values" decidable by the compiler? Second, equality might depend on the implementation, which might change. For example, (normal 0 1) could contain a random number generator with an intrinsic state. 
> sample:: (()->a[N]) -> a[N]
Observe that, disregarding non-terminating computations, any type t is isomorphic to () -> t. Knowing this, your statement seems to imply that a non-deterministic computation is identified with what you can sample from it. 
> iid:: Int -> (() -> a[N]) -> [a[N]]
The function Control.Monad.sequence plays this role for monads, with a slightly different type signature. 
Control.Monad.sequence . Data.List.repeat :: Monad m => m a -> m [a]
Let the name not deceive you: It is not about sequential computations, rather about ordering the random variables sequentially. 

> (b) can we extend the HM type system to support non-determinism directly?
Yes, you can. But then you have a different language. There many publications describing that [Draheim,Lago,Borgström,RP]. In a nutshell, start with the simply typed lambda calculus and add an operation 

choose :: I -> a -> a -> a

where I is the the type of real numbers 0 <= x <= 1. 'choose' makes a weighted probabilistic choice between its second and third argument. 
However, in order to describe what programs in (lambda calculus + choose) actually _mean_, you need two things:
(1) Define what the compiled program should do at runtime (operational semantics).
(2) Define what the program means, mathematically (denotational semantics).

For (1), the prevailing approach seems to be to equate a probabilistic term with its behaviour under sampling. Markov Chains are popular [MCMC]. I read it's non-trivial, however, to find a Markov chain that behaves according to a mathematically defined probability distribution. The probability that you know more about that than I do is 1.

For (2), the mathematical meaning of ordinary Haskell programs are given via the following mapping. Every Haskell type t is associated with a domain D [DOM] and each Haskell function of type t -> t' is associated with a mathematical function f: D -> D' between the associated domains. Whenever non-determinism is involved, e.g. a probabilistic computation on type t, then instead of D one uses P(D), a suitable "powerdomain". There are various P for various sorts of non-determinism (see the work of Gordon Plotkin), and each of them is a monad on the category of domains. A major problem is whether the P for probabilisitc choice works well with e.g. function types. That is why many papers restrict themselves to first-order functions. Another notoriously hard problem is to combine different sorts of non-determinism. It is like combining monads in Haskell: Some monads have monad transformers associated with them, but some don't. 

Finally, you might want to play with non-determinism other than the probabilistic one. For example, there is the infinite-search package on hackage, which provides a monad of plain non-deterministic choice beyond finite lists. It is even possible to define a Haskell probability monad in the same spirit. I can provide some code if you wish. 

Regards,
Olaf

References
[Giry] http://dx.doi.org/10.1007/BFb0092872
[CS] http://dx.doi.org/10.1007/s10485-013-9324-9
[Kock] http://www.tac.mta.ca/tac/volumes/26/4/26-04.pdf
[Draheim] http://www.springer.com/de/book/9783642551970
[Lago] https://arxiv.org/abs/1104.0195
[Borgström] https://arxiv.org/abs/1512.08990
[RP] http://www.cs.tufts.edu/~nr/pubs/pmonad.pdf
[MCMC] http://okmij.org/ftp/kakuritu/Hakaru10/index.html
[DOM] http://www.worldscientific.com/worldscibooks/10.1142/6284

From simon at joyful.com  Sun Jan 14 18:33:40 2018
From: simon at joyful.com (Simon Michael)
Date: Sun, 14 Jan 2018 10:33:40 -0800
Subject: [Haskell-cafe] ANN: shelltestrunner 1.9 - Easy,
 repeatable testing of CLI programs/commands
Message-ID: 

I'm pleased to announce a new release of shelltestrunner! 

shelltestrunner (executable: shelltest) is a portable
command-line tool for testing command-line programs, or general shell
commands, released under GPLv3+.  It reads simple test specifications
defining a command to run, some input, and the expected output,
stderr, and exit status.  It can run tests in parallel, selectively,
with a timeout, in color, etc. 
Projects using it include hledger, Agda, and berp.

The last release was 1.3.5, in 2015. The new version is 1.9, which 
has substantial improvements and is recommended for all users. 
More real-world testing and contributions will help us deliver 2.0.  

New in 1.9 (2018/1/14):

* two new test file formats, allowing input re-use and lighter syntax
* new -l/--list flag lists the tests found
* new -D/--defmacro option allows text substitution (Taavi Valjaots)
* new --xmlout option saves test results as xml (Taavi Valjaots)
* tests with Windows line endings now also work on unix (Taavi Valjaots)
* shelltestrunner's tests should now pass on Windows (Taavi Valjaots)
* flags formerly passed through to test-framework are now built in
* >>>= with nothing after it now matches any exit status
* failure messages now show the test command (John Chee)
* include shelltestrunner's tests in cabal sdist archive (Iustin Pop)
* build with latest deps and stackage resolvers
* shelltestrunner's code and home page have moved to github

Thanks to release contributors Taavi Valjaots, Andrés Sicard-Ramírez, 
Iustin Pop and John Chee.

Install: 

$ stack install shelltestrunner-1.9

or:

$ cabal update && cabal install shelltestrunner-1.9

Home, docs: https://github.com/simonmichael/shelltestrunner 

-------------- next part --------------
An HTML attachment was scrubbed...
URL: 

From dominikbollmann at gmail.com  Sun Jan 14 20:14:02 2018
From: dominikbollmann at gmail.com (Dominik Bollmann)
Date: Sun, 14 Jan 2018 21:14:02 +0100
Subject: [Haskell-cafe] How to improve the running time of my algorithm
Message-ID: <87vag45hbp.fsf@t450s.i-did-not-set--mail-host-address--so-tickle-me>


Hello Haskell-Cafe,

While playing with dynamic programming problems, I've been trying to
solve the "Abbreviation" problem found on hackerrank.com at
https://www.hackerrank.com/challenges/abbr/problem.

Briefly, this problem asks to decide whether a source string s can be
abbreviated into a target string t by capitalizing some of the
characters in s and deleting its afterwards remaining lowercase
characters. For example, the string s = "aBbdD" can be abbreviated as
target t = "BBD", but target t' = "XYZZ" is not an abbreviation for
source s' = "xyz".

My solution to this problem is the following memoization-based
function `isAbbreviation`:


```
import Control.Monad
import Control.Monad.State
import Data.Char
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.String
import Data.Text (Text)
import qualified Data.Text as Text
import System.IO

type Store = Map (Text, Text) Bool

isAbbrMemo :: Text -> Text -> State Store Bool
isAbbrMemo s t
  | Text.null t = extend s t $ return (Text.all isLower s)
  | Text.null s = extend s t $ return False
  | otherwise   =
      let (a, as) = fromJust $ Text.uncons s
          (b, bs) = fromJust $ Text.uncons t
      in extend s t $ matches a as b bs
  where
    matches a as b bs
      | isLower a && toUpper a /= b = isAbbrMemo as (b `Text.cons` bs)
      | isLower a && toUpper a == b = (||) <$> isAbbrMemo as bs
                                           <*> isAbbrMemo as (b `Text.cons` bs)
      | isUpper a && a /= b         = return False
      | isUpper a && a == b         = isAbbrMemo as bs

extend :: Text -> Text -> State Store Bool -> State Store Bool
extend s t m = do
  st <- get
  case Map.lookup (s,t) st of
    Just v  -> return v
    Nothing -> do
      v <- m
      modify $ Map.insert (s,t) v
      return v

isAbbreviation :: Text -> Text -> Bool
isAbbreviation s t = evalState (isAbbrMemo s t) Map.empty

main :: IO ()
main = do
  queries <- readQueries stdin
  let answers = map yesNo $ map (uncurry isAbbreviation) queries
  forM_ answers putStrLn

yesNo :: Bool -> String
yesNo True  = "YES"
yesNo False = "NO"

readQueries :: IsString a => Handle -> IO [(a, a)]
readQueries h = do
  numQueries <- read <$> hGetLine h :: IO Int
  forM [1..numQueries] $ \_qid -> do
    s <- hGetLine h
    t <- hGetLine h
    return (fromString s, fromString t)
```

However, running `isAbbreviation` on Hackerrank's input #13 still
takes around 38 seconds on my machine and is therefore too slow to be an
accepted solution. The input of question is attached as a text file.

My question is therefore: Where could I further improve the running time
of the function `isAbbreviation`? Is there any low-hanging fruit to
improve upon? Or is my dynamic-programming based approach somehow
flawed in general? (in which I should rather rethink the problem?)

Any observations, remarks, and improvements on the above code snippet
are greatly appreciated :-)

Thanks, Dominik.

-------------- next part --------------
An embedded and charset-unspecified text was scrubbed...
Name: 13.input
URL: 

From will.yager at gmail.com  Sun Jan 14 21:47:38 2018
From: will.yager at gmail.com (William Yager)
Date: Sun, 14 Jan 2018 16:47:38 -0500
Subject: [Haskell-cafe] How to improve the running time of my algorithm
In-Reply-To: <87vag45hbp.fsf@t450s.i-did-not-set--mail-host-address--so-tickle-me>
References: <87vag45hbp.fsf@t450s.i-did-not-set--mail-host-address--so-tickle-me>
Message-ID: 

Hello Dominik,

I'm not sure what exactly your algorithm is, but one thing that stands out
to me is the use of (Text,Text) index pairs instead of something more
efficient.

Here is an algorithm that I wrote which (without any optimization tricks)
seems to be fast and correct: https://pastebin.com/rDxUFbt3

Dynamic Programming in Haskell is a pleasure due to laziness, especially if
the choice variables are dense in the integers.

In this case, I have a Vector (Vector Bool), where the outer vector is
indexed by position into the lowercase string and the inner vector is
indexed by position into the uppercase string. vec ! i ! j is True iff
there is a solution to the problem for the first i characters in the
lowercase string and the first j characters in the uppercase string.
Because Vectors are lazy (unless you use one of the packed varieties) you
can assign each vector element the value corresponding to its solution -
before you even know what the solution is!

To get the final solution, you simply look at the vector element
corresponding to using the entirety of both strings. This will force
evaluation of the last cell, which will force the evaluation of some other
cells, which will force the evaluation of some other cells, etc. etc. If a
cell is ever accessed more than once, it still only gets computed one time,
so we have memoization.

This form is a little weird and took me a while to get the first time I saw
it, but I was delighted when I fully understood it.

If your choice variables are not dense in the integers, you can do the same
approach using a memo-trie, although there is a constant factor performance
loss compared to vectors.

--Will

On Sun, Jan 14, 2018 at 3:14 PM, Dominik Bollmann  wrote:

>
> Hello Haskell-Cafe,
>
> While playing with dynamic programming problems, I've been trying to
> solve the "Abbreviation" problem found on hackerrank.com at
> https://www.hackerrank.com/challenges/abbr/problem.
>
> Briefly, this problem asks to decide whether a source string s can be
> abbreviated into a target string t by capitalizing some of the
> characters in s and deleting its afterwards remaining lowercase
> characters. For example, the string s = "aBbdD" can be abbreviated as
> target t = "BBD", but target t' = "XYZZ" is not an abbreviation for
> source s' = "xyz".
>
> My solution to this problem is the following memoization-based
> function `isAbbreviation`:
>
>
> ```
> import Control.Monad
> import Control.Monad.State
> import Data.Char
> import Data.Map.Strict (Map)
> import qualified Data.Map.Strict as Map
> import Data.Maybe
> import Data.String
> import Data.Text (Text)
> import qualified Data.Text as Text
> import System.IO
>
> type Store = Map (Text, Text) Bool
>
> isAbbrMemo :: Text -> Text -> State Store Bool
> isAbbrMemo s t
>   | Text.null t = extend s t $ return (Text.all isLower s)
>   | Text.null s = extend s t $ return False
>   | otherwise   =
>       let (a, as) = fromJust $ Text.uncons s
>           (b, bs) = fromJust $ Text.uncons t
>       in extend s t $ matches a as b bs
>   where
>     matches a as b bs
>       | isLower a && toUpper a /= b = isAbbrMemo as (b `Text.cons` bs)
>       | isLower a && toUpper a == b = (||) <$> isAbbrMemo as bs
>                                            <*> isAbbrMemo as (b
> `Text.cons` bs)
>       | isUpper a && a /= b         = return False
>       | isUpper a && a == b         = isAbbrMemo as bs
>
> extend :: Text -> Text -> State Store Bool -> State Store Bool
> extend s t m = do
>   st <- get
>   case Map.lookup (s,t) st of
>     Just v  -> return v
>     Nothing -> do
>       v <- m
>       modify $ Map.insert (s,t) v
>       return v
>
> isAbbreviation :: Text -> Text -> Bool
> isAbbreviation s t = evalState (isAbbrMemo s t) Map.empty
>
> main :: IO ()
> main = do
>   queries <- readQueries stdin
>   let answers = map yesNo $ map (uncurry isAbbreviation) queries
>   forM_ answers putStrLn
>
> yesNo :: Bool -> String
> yesNo True  = "YES"
> yesNo False = "NO"
>
> readQueries :: IsString a => Handle -> IO [(a, a)]
> readQueries h = do
>   numQueries <- read <$> hGetLine h :: IO Int
>   forM [1..numQueries] $ \_qid -> do
>     s <- hGetLine h
>     t <- hGetLine h
>     return (fromString s, fromString t)
> ```
>
> However, running `isAbbreviation` on Hackerrank's input #13 still
> takes around 38 seconds on my machine and is therefore too slow to be an
> accepted solution. The input of question is attached as a text file.
>
> My question is therefore: Where could I further improve the running time
> of the function `isAbbreviation`? Is there any low-hanging fruit to
> improve upon? Or is my dynamic-programming based approach somehow
> flawed in general? (in which I should rather rethink the problem?)
>
> Any observations, remarks, and improvements on the above code snippet
> are greatly appreciated :-)
>
> Thanks, Dominik.
>
>
> _______________________________________________
> 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 aquagnu at gmail.com  Mon Jan 15 08:08:20 2018
From: aquagnu at gmail.com (PY)
Date: Mon, 15 Jan 2018 10:08:20 +0200
Subject: [Haskell-cafe] Non-deterministic (stochastic?)
 function/expression types in Haskell?
In-Reply-To: <87c53da9-b197-94bb-d28a-580d5f69d6a7@gmail.com>
References: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>
 <66d75a6f-6fa1-734a-e7e9-ea6aae067c7c@iki.fi>
 <335fe5ec-45c2-5b68-da0e-76fa559bc9b3@gmail.com>
 <7ee4878a-8780-4771-db21-27847f646888@iki.fi>
 <87c53da9-b197-94bb-d28a-580d5f69d6a7@gmail.com>
Message-ID: 

Hello, Benjamin. Nature of Haskell is to treat random values under 
monad. Because generator returns different values on calls with the same 
arguments. So, no way to "declare" such function as "nondeterministic" 
function. Haskell is not good language for such job. But there are more 
suitable languages for such kind of tasks. If you prefer Haskell-like 
syntax, better will be to use ML family language: modern F#, Ocaml or 
SML, where IO will not be involved - all is under IO explicitly. But 
there is another good choice: *Mercury*. It supports (sure, because it's 
declarative language and is based on Prolog) special notations for 
computations:

  * non-deterministic
  * deterministic
  * semi-deterministic
  * multisolution

(see more about these declarations here: 
https://www.mercurylang.org/information/doc-release/mercury_ref/Determinism-categories.html#Determinism-categories)/
/

Also it has type system close to Haskell: with type-families, 
existential types, abstract types and so on, also it supports functional 
programming totally...

But, I'm sure, no problem to develop some DSL for Haskell which will 
hide some details ;)

===
Best regards, Paul
//

12.01.2018 18:26, Benjamin Redelings пишет:
> Hi Oleg,
>
> Thanks for the links!  These are quite interesting.
>
> 1. Here is one situation that occurs in evolutionary biology where I 
> would want to have the full range of Haskell syntax available to me.  
> Consider a binary tree, where each tree node has an integer name in 
> [1..num_nodes tree].  The function (parent tree n) gives the parent of 
> node n and (root tree) gives the root node.
>
> -- the expected value for a node is the value at its parent
>    mean node tree x | node == root tree   = 0
>                     | otherwise           = x!!parent tree node
>
> -- given a tree, simulate down the tree,
>    simulate_on_tree tree  = let x = [sample $ normal (mean node tree 
> x) 1 | node <- [1..num_nodes tree]]
>
> My understanding is that you cannot refer to the result of a 
> computation while performing a computation, as in:
>
>     do {x <- simulate_on_tree tree x}
>
> Am I missing something?
>
>
> On 01/11/2018 12:02 PM, Oleg Grenrus wrote:
>> (a) Non-determism is an effect, e.g. simple list is non-determinism 
>> monad, for small discrete distributions!
>
> 2.  Why would we want to consider non-determinism (in the sense of 
> returning an unpredictable value) as an effect?  Certainly running a 
> non-deterministic function does not change global state like modifying 
> an IORef would.  I'm also thinking of functions that are (somehow) 
> TRULY random, so they are not keeping a hidden state around 
> somewhere.  I'm calling them "non-deterministic" instead of "random" 
> because I want to ignore (for the moment) the probability 
> distribution, and just say that the result is arbitrary.
>
> 3. Sampling from a normal distribution gives ONE value, and the list 
> of possible values is .... large :-)  [i.e. it would include all 
> Double values.]
>
>
>> (b) Yes. We can write effectful code "implicitly"
>>    - You might look into *Automatically Escaping Monads*
>>    - https://www.youtube.com/watch?v=wG8AErq6Bbo, slides:
>> http://benl.ouroborus.net/talks/2016-HIW-Escape.pdf
>>    - http://disciple.ouroborus.net/ or https://github.com/DDCSF/ddc
> 4. Interesting - I like his approach to making the box / run 
> instructions implicit.
>
>> Interstingly, while searching for the paper, I stumbled upon Oleg
>> Kiselyov's  (not me) paper from
>> *Effects Without Monads: Non-determinism*, which is a different 
>> approach.
>> Maybe that's what you are looking after
>> http://okmij.org/ftp/tagless-final/nondet-paper.pdf
> 5. In this paper, it seems that non-determinism means returning ALL 
> possible outcomes.  However, what I meant is arbitrarily choosing ONE 
> possible outcome.  My terminology is probably being imported from 
> statistics - is there a different word I should use here?
>
> -BenRI
> _______________________________________________
> 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 sivanov at colimite.fr  Mon Jan 15 10:51:44 2018
From: sivanov at colimite.fr (Sergiu Ivanov)
Date: Mon, 15 Jan 2018 11:51:44 +0100
Subject: [Haskell-cafe] Non-deterministic (stochastic?)
	function/expression types in Haskell?
In-Reply-To: 
References: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>
 <66d75a6f-6fa1-734a-e7e9-ea6aae067c7c@iki.fi>
 <335fe5ec-45c2-5b68-da0e-76fa559bc9b3@gmail.com>
 <7ee4878a-8780-4771-db21-27847f646888@iki.fi>
 <87c53da9-b197-94bb-d28a-580d5f69d6a7@gmail.com>
 
Message-ID: <878tcz5r9b.fsf@colimite.fr>

Hello,

Thus quoth  PY  on Mon Jan 15 2018 at 09:08 (+0100):
>
> But there is another good choice: *Mercury*. It supports (sure,
> because it's declarative language and is based on Prolog) special
> notations for computations:

If you prefer a more Haskellish syntax, you may also want to look at
Curry :

  http://www-ps.informatik.uni-kiel.de/currywiki/

Curry has a built-in function called "choice" which allows
"non-deterministic, set-valued" functions.

Now, whichever tool you use, you are probably going to wind up with
monads or with monads in disguise, as Olaf points out.  (And sometimes
disguise may be quite important.)

--
Sergiu
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 487 bytes
Desc: not available
URL: 

From john at degoes.net  Mon Jan 15 17:13:03 2018
From: john at degoes.net (John A. De Goes)
Date: Mon, 15 Jan 2018 10:13:03 -0700
Subject: [Haskell-cafe] LambdaConf 2018: Call for Proposals
In-Reply-To: 
References: <60EA3521-4C95-4D6C-912A-9877B399FC8C@degoes.net>
 
Message-ID: <7D5F736D-223A-4900-A935-A09741E88408@degoes.net>


Hi Yuji,

Unfortunately, you have to create an account before you can submit a proposal to the CFP. The account functions as your speaker profile / biography.

Apologies for the inconvenience!
--
John A. De Goes
john at degoes.net
Follow me on Twitter @jdegoes






> On Jan 12, 2018, at 6:24 PM, Yuji Yamamoto  wrote:
> 
>  Hi, John!
> 
> Thanks for the announcement.
> 
> I found the URL https://lambdaconf2018.dryfta.com/en/abstract-submission  redirects me
> to a login-required page: https://lambdaconf2018.dryfta.com/en/userlogin/register/login .
> I guess you've forgotten to publish the page!
> 
> 2018-01-13 3:30 GMT+09:00 John A. De Goes >:
>  Dear Haskell Enthusiast:
> We are pleased to announce the Call for Proposals for LambdaConf 2018 .
> 
> LambdaConf is the largest interdisciplinary functional programming conference in the Mountain West, and one of the largest and most well-known functional programming conferences in the world. 
> 
> The conference takes place June 3rd - 5th, in Boulder, Colorado, at the University of Colorado Boulder, and is preceded by commercial training opportunities and followed by a day of third-party mini-conferences on selected topics.
> 
> If you are an educator, a researcher, a speaker, a speaker coach, or someone aspiring to one of the preceding, then we warmly welcome you to submit a proposal for LambdaConf 2018 . No prior experience is necessary for most proposals, and we welcome beginner-level content.
> 
> The Call for Proposals closes at the beginning of February 2018. We recommend submitting as early as you can to ensure sufficient time for editing.
> 
> LambdaConf attracts everyone from the FP-curious to researchers advancing state-of-the-art; hobbyists, professionals, academics and students. Material at all levels, including beginner content and very advanced content, will find an audience at LambdaConf.
> 
> Historically, LambdaConf has enjoyed a large selection of sessions on statically-typed functional programming, and a smaller selection of sessions on dynamically-typed functional programming. Some sessions are not tied to specific programming languages, but rather cover topics in abstract algebra, category theory, type theory, programming language theory, functional architecture, and so on, either generally or in a way that applies across many programming languages.
> 
> LambdaConf looks for sessions in the following areas:
> 
> Languages. Proposals that overview or dive into specific features of functional, math, or logic programming languages (both new and existing), with the goal of exposing developers to new ideas or helping them master features of languages they already know.
> Libraries. Proposals that discuss libraries that leverage functional or logic programming to help programmers solve real-world problems.
> Concepts. Proposals that discuss functional programming idioms, patterns, or abstractions; or concepts from mathematics, logic, and computer science, all directed at helping developers write software that's easier to test, easier to reason about, and easier to change safely.
> Applications. Proposals that discuss how functional programming can help with specific aspects of modern software development, including scalability, distributed systems, concurrency, data processing, security, performance, correctness, user-interfaces, machine learning, and big data.
> Use Cases. Proposals that discuss how functional programming enabled a project or team to thrive, or deliver more business value than possible with other approaches.
> Cherry Picking. Proposals that show how techniques and approaches from functional programming can be adapted and incorporated into mainstream development languages and practices, to the benefit of developers using them.
> Cautionary Tales. Proposals that call attention to difficulties of functional programming (both as a cautionary tale but also to raise awareness), especially such proposals that suggest alternatives or a path forward.
> Efficacy. Proposals that present data, measurements, or analysis that suggests different techniques, paradigms, languages, libraries, concepts, or approaches have different efficacies for given specified metrics, which provide actionable takeaways to practicing functional and logic programmers.
> Off-Topic. Proposals that have appeal to a mainstream developer audience (the number of off-topic proposals we accept is small, but we do accept some, especially for keynotes).
> LambdaConf accepts proposals for the following types of sessions:
> 
> Leap Workshops (6h). Leap Workshops are approximately 6 hours in length. They are in-depth, hands-on workshops designed to teach mainstream functional programming topics in enough detail, attendees can immediately apply what they learn in their jobs.  We require that speakers follow our recommended format for Leap Workshops, although we allow exceptions for experienced teachers.
> Hop Workshops (2h). Hop Workshops are 2 hours in length. Like Leap Workshops, these workshops are in-depth and hands-on, but they cover reduced content and may be specialized to topics that may not have mainstream appeal. We require that speakers follow our recommended format for Hop Workshops, although we allow exceptions for experienced teachers.
> De Novo Sessions (50m). De Novo Sessions are 50 minutes in length. These sessions are designed to present original work from industry and academia. While the requirements for proposals are more rigorous, there is less competition for De Novo slots.
> Educational Sessions (50m). Educational Sessions are 50 minutes in length. These sessions are designed to clearly and concisely teach one useful concept, skill, aspect, library, or language to attendees.
> Inspire Talks (5m). Inspire talks are 5 minutes in length and focus on clear communication of a single takeaway. These sessions are intended to inspire attendees to learn more about particular subjects or to try new approaches, and must follow Ignite-style, which consists of 20 slides, each auto-advancing after 15 seconds.
> Keynotes (40m). Keynotes are 40 minutes in length, and are presented before all attendees (there are no other sessions concurrent with keynotes). Keynotes are designed to offer thought-provoking, opinionated, and insightful commentary on topics of interest to the community.
> Level of reimbursement varies based on the type of proposal you are selected for:
> 
> Leap Workshops (6 hours). Speakers for Leap Workshops receive a free ticket, a speaker gift, a speaker dinner, up to 4 days accommodations, full travel reimbursement, and a small honorarium.
> Hop Workshops (2 hours) / Educational (50m) / De Novo (50m) / Keynote (50m). Speakers for Hop Workshops, Educational, De Novo, and Keynote receive a free ticket, a speaker gift, a speaker dinner, and up to 4 days accommodations. Speakers may also request travel assistance, which is dealt out based on availability and need, and which may cover up to $250 for domestic travel, and $500 for international travel.
> Inspire (5m). As Inspire talks are only 5 minutes in length, Inspire speakers receive a speaker gift and a speaker dinner, but must purchase a ticket and pay for travel and accommodations on their own.
> If you are accepted for a specific type of proposal (e.g. Educational), we cannot guarantee that you will get a slot of this type. Based on scheduling requirements, feedback from the committee, or feedback from your speaker coach, we may require you to change the format of your session.
> 
> You may submit as many proposals as you like, though we recommend spending more time refining fewer proposals, since the quality of your proposals has a significant effect on their chances of acceptance by the blind committee. If you wish to maximize your chances of having a proposal accepted, we also recommend spreading 2-3 proposals across multiple categories, because some categories are fiercely competitive, while others are less competitive.
> 
> For more information, please see the Call for Proposals website .
> 
> Regards,
> --
> John A. De Goes
> john at degoes.net 
> Follow me on Twitter @jdegoes
> 
> 
> 
> 
> 
> 
> 
> _______________________________________________
> 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.
> 
> 
> 
> -- 
> 山本悠滋
> twitter: @igrep
> GitHub: https://github.com/igrep 
> GitLab: https://gitlab.com/igrep 
> Facebook: http://www.facebook.com/igrep 
> Google+: https://plus.google.com/u/0/+YujiYamamoto_igrep 
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 

From jake.waksbaum at gmail.com  Mon Jan 15 17:53:31 2018
From: jake.waksbaum at gmail.com (Jake)
Date: Mon, 15 Jan 2018 17:53:31 +0000
Subject: [Haskell-cafe] Non-deterministic (stochastic?)
 function/expression types in Haskell?
In-Reply-To: <878tcz5r9b.fsf@colimite.fr>
References: <6d44646a-2f5b-97fe-6bb1-96fb4aa02f32@gmail.com>
 <66d75a6f-6fa1-734a-e7e9-ea6aae067c7c@iki.fi>
 <335fe5ec-45c2-5b68-da0e-76fa559bc9b3@gmail.com>
 <7ee4878a-8780-4771-db21-27847f646888@iki.fi>
 <87c53da9-b197-94bb-d28a-580d5f69d6a7@gmail.com>
  <878tcz5r9b.fsf@colimite.fr>
Message-ID: 

Hi Ben,

Not sure I understand exactly if this what you want, but if the problem is
recursion within monads you might want to take a look at MonadFix or
recursive do notation. If I understood more about how they worked I'd give
an example, but I don't; I just know they're related to recursion in monads.

https://ocharles.org.uk/blog/posts/2014-12-09-recursive-do.html
https://downloads.haskell.org/~ghc/7.8.1/docs/html/users_guide/syntax-extns.html#recursive-do-notation

בתאריך יום ב׳, 15 בינו׳ 2018, 5:53, מאת Sergiu Ivanov ‏:

> Hello,
>
> Thus quoth  PY  on Mon Jan 15 2018 at 09:08 (+0100):
> >
> > But there is another good choice: *Mercury*. It supports (sure,
> > because it's declarative language and is based on Prolog) special
> > notations for computations:
>
> If you prefer a more Haskellish syntax, you may also want to look at
> Curry :
>
>   http://www-ps.informatik.uni-kiel.de/currywiki/
>
> Curry has a built-in function called "choice" which allows
> "non-deterministic, set-valued" functions.
>
> Now, whichever tool you use, you are probably going to wind up with
> monads or with monads in disguise, as Olaf points out.  (And sometimes
> disguise may be quite important.)
>
> --
> Sergiu
> _______________________________________________
> 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 benjamin.redelings at gmail.com  Mon Jan 15 18:17:46 2018
From: benjamin.redelings at gmail.com (Benjamin Redelings)
Date: Mon, 15 Jan 2018 13:17:46 -0500
Subject: [Haskell-cafe] Non-deterministic function/expression types in
 Haskell?
In-Reply-To: 
References: 
Message-ID: <88c7b3e3-024f-0dd3-8928-5fc0f6f76512@gmail.com>

Hi Olaf,

     Thanks!  This was helpful.  I'll engage below:


On 01/13/2018 04:45 PM, Olaf Klinke wrote:
> Long story short: You can stay inside Haskell's type system or extend it, but you end up with monads either way. I'll explain why.
I might see what you mean about ending up with monads either way. 
Specifically, I think its important to separate random distributions 
from their random samples, which might correspond (in a Random-like 
monad) to the difference between an action and performing the action.  
Is this something like what you are saying?  I think there may still be 
some extra value to the type system I mentioned in performing CSE 
(common sub-expression elimination) safely.

>
>> (a) why are monads a perfect solution to my problem?
> Two reasons. First: Probability distributions do form a monad [Giry,CS,Kock]. It's a mathematical fact. So why not exploit it? It gives you powerful combinators and powerful abstractions.
They certainly do.  I've written a haskell interpreter, and my 
definitions for a (very hacky) Random monad are here, with two different 
interpreters for it (sample and sample') below:

https://github.com/bredelings/BAli-Phy/blob/9c96374013453fe382e609cca357a2c0f3f154b2/modules/Distributions.hs#L14

I'm currently exploiting the monadic structure.  For example, given a 
distribution dist, I basically use 'sequence (replicate n dist)' to 
sample n i.i.d. values from it.  So, to some extent I could see the fact 
that Monads provide a 'sequence' function as a benefit.  In the 
framework I proposed we would have to write 'map sample (replicate n 
dist)', which does not seem very burdensome though.

The fact that you have to run these distributions inside of an 
interpreter also makes some things easy that would be difficult to do 
otherwise, since the interpreter (a) can carry around modifiable state 
and (b) creates a call stack, like in call-by-value languages.  In 
contrast if you say something like "let {x = normal 0 1 ()} in x*x", 
then it doesn't really have a call chain, since the thunk for x can get 
forced from multiple different contexts that were not responsible for 
the allocation of the thunk on the heap. Instead it seems that each heap 
location has a let-allocation chain, but without any intepreter state 
threaded through the chain.  Does that make sense?  Is there any 
literature on the let-allocation chain?  It seems like this would come 
up during debugging.

Despite all this, it still seems to me that there might be reasons not 
to "exploit" the monadic structure of probability distributions, at 
least not in the traditional fashion.  See below.
> Second: Because the requirements on the type modificators [N] and [D] are describing many features monads have. First observe that you don't really need [D] because any deterministic computation can be embedded into the non-deterministic computations by making the set of possibilities a singleton. That is precisely what 'return' does in the context of monads. (Think of return for the list monad.)
>> any function that takes a non-deterministic input must have a non-deterministic output.
> That is common with monads, too: There is no generic function that can extract values out of monads.
Hmm.... one reason I'm hesitant to "exploit" the monadic structure of 
Random is that I don't want to have the [D] values outside the monad and 
[N] values inside it.  The need to use a function like "return" to lift 
(if that is the right terminology) non-monadic values into the monad, 
and the need to run [N] terms in an interpreter to un-lift values of the 
monad seems to be more of an obstruction than a benefit.  It means that 
you can't do things that you could do with normal haskell functions.

For example, with a normal haskell function you could write `let {x = f 
0 x} in x`.  However, with a monadic object you can't write `do {x <- f 
0 x; return x}`.

Hmm.... I guess you could maybe do `let {x = interpret $ do {y <- f 0 x; 
return y}} in x` though, where 'interpret' is an interpreter for the 
monad.  Hmm.... I don't know.  This seems weird.  It certainly seems 
more verbose than `let {x = sample $ f 0 x} in x`.

OK!  So, let's say that 'unsafePerformIO' is an interpreter for the IO 
monad.  In my non-monadic framework, I am suggesting that we define:

sample:: (() -> a[N]) -> a[N]
sample dist = dist ()

In the monadic framework, we define something like

random_iterpreter = Random a -> IO a
sample :: Random a -> a
sample dist  = (unsafePerformIO . random_iterpreter) dist

Then, I think we get equivalent *expressiveness* without modifying the 
HM type system.  Furthermore, I think that (unsafePerformIO . 
random_interpreter) can be completely safe if we imagine that we can 
generate truly random variables somehow.  However, I think that the 
extension to the HM type system still is useful in solving some problems 
that are created by using unsafePerformIO with CSE (see below).

>
>> we should merge variables with identical values if the types are non-deterministic.
> That is problematic on several levels. First, is "identical values" decidable by the compiler? Second, equality might depend on the implementation, which might change.

I'm assuming we only consider expressions equivalent if they have the 
same syntax tree.  (So that should avoid problems with overloading ==).  
This leaves the second problem, you mention:

> For example, (normal 0 1) could contain a random number generator with an intrinsic state.
If we have "let {x=normal 0 1;y=normal 0 1} in E" then the two normal 0 
1 actions could be executed in either order.  However, for random 
samples I think that is not a problem in some situations, since the 
distributions would be the same.  However, regardless of whether we care 
about ordering, it is definitely wrong to merge x and y to get "let 
{x=normal 0 1} in E[y := x]".  I think this is the problem you are 
talking about.

But this problem is exactly what I am proposing a solution for!  The 
idea is that 'normal' would have type 'double -> double -> double[N]', 
and therefore merging the expressions would be prohibited by the rule 
that says we cannot merge two identical expressions of type a[N] (see my 
original e-mail).

Interestingly, this could maybe used to handle cases like "let {x = 
unsafePerformIO $ readchar file; y = unsafePerformIO $ readchar file} in 
E".  We could define unsafePerformIO as having type

unsafePerformIO: IO a -> a[N].

This would NOT solve the problem that the code could perform the 
readchar's in either order, but it WOULD avoid merging x & y.  I guess 
one question is: does GHC avoid this merger already?  And, if so, does 
it avoid this merger by refusing to merge variables?  If GHC refuses to 
merge variables with identical ASTs that call unsafePerformIO then I 
would assert that it is ALREADY using the type system I am proposing.

>> sample:: (()->a[N]) -> a[N]
> Observe that, disregarding non-terminating computations, any type t is isomorphic to () -> t. Knowing this, your statement seems to imply that a non-deterministic computation is identified with what you can sample from it.
Hmm... I'm not sure this is right. I agree that type t[D] is isomorphic 
with () -> t[D], because it is easy enough to come up with an 
isomorphism f where (f (f_inverse value)) = value, and also (f_inverse 
(f (f_inverse value))) = value.

     f::forall level.(()->t[level]) -> t[level]
     f dist = dist ()

     f::forall level.t[level] -> () -> t[level]
     f_inverse value = \() -> value

But the whole point of having t[N] is that ()->t[N] should not be 
isomorphic to t[N].  Thus, if we evaluate let {x = f (f_inverse E); y = 
f (f_inverse E) in F} where E is non-deterministic, then I think x and y 
can be different.  I think this means that f is not an isomorphism when 
applied to non-deterministic expression, so that you should say 
"disregarding non-terminating or non-deterministic" computations.

There are some complications here, in that I am quantifying over [N,D] 
levels in the definitions of f and f_inverse, so that they take their 
[N,D] levels from their arguments.  I am treating variables as 
non-values, since they stand for entire expressions that might be 
substituted for them.  My hope is that this allows placing the [N,D] 
levels on the input and result types instead of on the arrow, but there 
could be problems with this.  It is counter-intuitive, since normal 0 1 
() could yield the value 2, and 2 itself is not random, but was obtained 
randomly.  But I think that the system works if implemented, though it 
might not match the standard interpretation of types?

>
>> iid:: Int -> (() -> a[N]) -> [a[N]]
> The function Control.Monad.sequence plays this role for monads, with a slightly different type signature.
> Control.Monad.sequence . Data.List.repeat :: Monad m => m a -> m [a]
> Let the name not deceive you: It is not about sequential computations, rather about ordering the random variables sequentially.
Hmm... I don't completely understand this.  Are you saying that E1 >>= 
(\x -> E2) does not require that E1 is performed before E2?  That seems 
possible only if E2 does not use x.  But maybe I'm missing something.

>
>> (b) can we extend the HM type system to support non-determinism directly?
> Yes, you can. But then you have a different language. There many publications describing that [Draheim,Lago,Borgström,RP]. In a nutshell, start with the simply typed lambda calculus and add an operation
Hmm.... I intentionally attempt to define "non-deterministic" 
expressions instead of "probabilistic" expressions precisely to avoid 
this problem :-)  Thus, my version of 'choose'  simply states that 
'choose 1 2' can return either 1 or 2. It does not say anything about 
the probability of returning either choice, only that both are "valid" 
reductions.  Therefore, my version of choose would have type:

choose: a -> a -> a[N].

> choose :: I -> a -> a -> a
>
> where I is the the type of real numbers 0 <= x <= 1. 'choose' makes a weighted probabilistic choice between its second and third argument.
I'm not completely sure of the role of the real number here.  Are we 
saying that 'choose 0.6 0 1' would (for example) return 0 with 
probability 0.6 and 1 with probability 0.4?  It seems that you could 
maybe define a function that takes 2 random numbers:

choose :: I -> I -> a -> a -> a

where
   (a) choose u p 0 1 would return 0 if u

IO ().  This makes the program deterministic if we know the value of the real number, but probabilistic if we supply a uniform 0 1 random number. > However, in order to describe what programs in (lambda calculus + choose) actually _mean_, you need two things: > (1) Define what the compiled program should do at runtime (operational semantics). > (2) Define what the program means, mathematically (denotational semantics). Hmm.... yeah I think the denotational semantics could be quite hard.  I think that Chung Chieh Shan is working on some aspect of this this, especially measures on R^n. > For (1), the prevailing approach seems to be to equate a probabilistic term with its behaviour under sampling. Markov Chains are popular [MCMC]. I read it's non-trivial, however, to find a Markov chain that behaves according to a mathematically defined probability distribution. The probability that you know more about that than I do is 1. Ha ha :-)  Yes, designing MCMC approaches to sample from a distribution is hard.  Obviously for some expressions like sampling from a normal you don't need MCMC.  I would imagine that one approach to this is simply only allow primitives that you can get by transforming a Uniform[0,1] random variable, or perhaps fairly simple rejection sampling.  Then maybe MCMC-type things would be implemented as probabilistic programs (e.g. not primitive operations). > For (2), the mathematical meaning of ordinary Haskell programs are given via the following mapping. Every Haskell type t is associated with a domain D [DOM] and each Haskell function of type t -> t' is associated with a mathematical function f: D -> D' between the associated domains. Whenever non-determinism is involved, e.g. a probabilistic computation on type t, then instead of D one uses P(D), a suitable "powerdomain". Hmm... I'm guessing (having not looked at the papers below yet except kind of the Haraku paper) that the powerdomain for Double is the measurable sets (aka Borel sets) for the Reals... > There are various P for various sorts of non-determinism (see the work of Gordon Plotkin), and each of them is a monad on the category of domains. A major problem is whether the P for probabilisitc choice works well with e.g. function types. That is why many papers restrict themselves to first-order functions. Another notoriously hard problem is to combine different sorts of non-determinism. It is like combining monads in Haskell: Some monads have monad transformers associated with them, but some don't. Interesting.  I'll take a look at the papers you mention.  I have wondered where some of the restrictions come from. > Finally, you might want to play with non-determinism other than the probabilistic one. For example, there is the infinite-search package on hackage, which provides a monad of plain non-deterministic choice beyond finite lists. It is even possible to define a Haskell probability monad in the same spirit. I can provide some code if you wish. Thanks so much for explaining things to me in detail, and for the helpful links! -BenRI > Regards, > Olaf > > References > [Giry] http://dx.doi.org/10.1007/BFb0092872 > [CS] http://dx.doi.org/10.1007/s10485-013-9324-9 > [Kock] http://www.tac.mta.ca/tac/volumes/26/4/26-04.pdf > [Draheim] http://www.springer.com/de/book/9783642551970 > [Lago] https://arxiv.org/abs/1104.0195 > [Borgström] https://arxiv.org/abs/1512.08990 > [RP] http://www.cs.tufts.edu/~nr/pubs/pmonad.pdf > [MCMC] http://okmij.org/ftp/kakuritu/Hakaru10/index.html > [DOM] http://www.worldscientific.com/worldscibooks/10.1142/6284 From olf at aatal-apotheke.de Mon Jan 15 21:18:10 2018 From: olf at aatal-apotheke.de (Olaf Klinke) Date: Mon, 15 Jan 2018 22:18:10 +0100 Subject: [Haskell-cafe] Non-deterministic function/expression types in Haskell? In-Reply-To: <88c7b3e3-024f-0dd3-8928-5fc0f6f76512@gmail.com> References: <88c7b3e3-024f-0dd3-8928-5fc0f6f76512@gmail.com> Message-ID: <2C254BFE-18CE-4EC5-A983-5B43618CC9C5@aatal-apotheke.de> Benjamin, I am a domain theorist and not an expert on writing compilers/interpreters. Hence I can not comment on your proposals of call-by-value and interpreter state. What I wanted to say with my catchphrase is that you have to do the same amount of work. But in the first case, where you have a DSL, the work (= the random monad) is visible to the programmer, whereas in the second case only the author of the compiler gets to see the monad. But the denotational semantics can be the same. If you go for a DSL (which is specifically what you want ot avoid), then a Kleisli category is how it is done. Look at Kleisli in Control.Arrow. For non-probabilistic non-determinism, take the category (Kleisli []). Every morphism a -> b then really is a Haskell function a -> [b], but the Arrow notation hides this. Then choose has the rather trivial implementation choose :: Kleisli [] (a,a) a choose = Kleisli (\(x,y) -> [x,y]) You could abstract this into a type class: class (Arrow a) => Nondet a where choose :: a (x,x) x Let's try this: import Prelude hiding ((.),id) import Control.Category import Control.Monad data KleisliDN m x y = D (x -> y) | N (x -> m y) instance Monad m => Category (KleisliDN m) where id = D id (D g) . (D f) = D (g . f) (N g) . (N f) = N (g <=< f) (D g) . (N f) = N (liftM g . f) (N g) . (D f) = N (g . f) data DN m x = Det x | Nondet (m x) Observe that Kleisli m () x is isomorophic to DN m x, so here you have explicit tagging with D and N on the value-level. If you want the compiler to reject certain combinations of D and N, then write a typeclass class (Category c, Category d) => Subcategory c d where liftMorphism :: c a b -> d a b instance Monad m => Subcategory (->) (Kleisli m) where liftMorphism f = Kleisli (return.f) and use the category (->) for D and Kleisli m for N. > Am 15.01.2018 um 19:17 schrieb Benjamin Redelings : > > But this problem is exactly what I am proposing a solution for! The idea is that 'normal' would have type 'double -> double -> double[N]', and therefore merging the expressions would be prohibited by the rule that says we cannot merge two identical expressions of type a[N] (see my original e-mail). > > Interestingly, this could maybe used to handle cases like "let {x = unsafePerformIO $ readchar file; y = unsafePerformIO $ readchar file} in E". We could define unsafePerformIO as having type > > unsafePerformIO: IO a -> a[N]. > > This would NOT solve the problem that the code could perform the readchar's in either order, but it WOULD avoid merging x & y. I guess one question is: does GHC avoid this merger already? And, if so, does it avoid this merger by refusing to merge variables? If GHC refuses to merge variables with identical ASTs that call unsafePerformIO then I would assert that it is ALREADY using the type system I am proposing. > >>> sample:: (()->a[N]) -> a[N] >> Observe that, disregarding non-terminating computations, any type t is isomorphic to () -> t. Knowing this, your statement seems to imply that a non-deterministic computation is identified with what you can sample from it. > Hmm... I'm not sure this is right. I agree that type t[D] is isomorphic with () -> t[D], because it is easy enough to come up with an isomorphism f where (f (f_inverse value)) = value, and also (f_inverse (f (f_inverse value))) = value. > > f::forall level.(()->t[level]) -> t[level] > f dist = dist () > > f::forall level.t[level] -> () -> t[level] > f_inverse value = \() -> value > > But the whole point of having t[N] is that ()->t[N] should not be isomorphic to t[N]. Thus, if we evaluate let {x = f (f_inverse E); y = f (f_inverse E) in F} where E is non-deterministic, then I think x and y can be different. With my code above, the types are isomorphic: toKleisli :: DN m x -> KleisliDN m () x toKleisli (Det x) = D (const x) toKleisli (Nondet mx) = N (const mx) fromKleisli :: KleisliDN m () x -> DN m x fromKleisli (D f) = Det (f ()) fromKleisli (N f) = Nondet (f ()) () -> t[N] takes a unit and returns a process randomly generating a t. Since there is only one unit, there is only one process described by this function. I've seen functions of type () -> t in OCaml where they are used to bring lazy evaluation into an otherwise strict language. > I think this means that f is not an isomorphism when applied to non-deterministic expression, so that you should say "disregarding non-terminating or non-deterministic" computations. > > There are some complications here, in that I am quantifying over [N,D] levels in the definitions of f and f_inverse, so that they take their [N,D] levels from their arguments. I am treating variables as non-values, since they stand for entire expressions that might be substituted for them. My hope is that this allows placing the [N,D] levels on the input and result types instead of on the arrow, but there could be problems with this. It is counter-intuitive, since normal 0 1 () could yield the value 2, and 2 itself is not random, but was obtained randomly. But I think that the system works if implemented, though it might not match the standard interpretation of types? I don't get all of what you are saying here. But it reminds me of monadic bind. When you say: do x <- normal 0 1 if x == 2 then return True else return False then the resulting Boolean is still in the monad, and the type of the overall expression tells you that the 2 is a random one. > >> choose :: I -> a -> a -> a >> >> where I is the the type of real numbers 0 <= x <= 1. 'choose' makes a weighted probabilistic choice between its second and third argument. > I'm not completely sure of the role of the real number here. Are we saying that 'choose 0.6 0 1' would (for example) return 0 with probability 0.6 and 1 with probability 0.4? Exactly. And that is all you need for probabilistic choice, in the following categorical sense. The probabilistic powerdomain of a domain D is the free convex cone over D. A convex cone is a structure that supports the operation choose and multiplication by real numbers from the unit interval [0,1]. (Here we allow total probabilities less than 1, otherwise we don't have a domain. The true probability distributions sit at the top of this domain. The free convex cone over the two-element set {x,y} is a triangle, with "certainly x" at the top left, "certainly y" at the top right, and the constant zero measure at the bottom corner.) > It seems that you could maybe define a function that takes 2 random numbers: > > choose :: I -> I -> a -> a -> a > > where > (a) choose u p 0 1 would return 0 if u

(b) the number u is *implicitly* supplied to the function. So, the user writes "choose 0.6 0 1". > (c) the type of main would be Main: I -> IO (). This makes the program deterministic if we know the value of the real number, but probabilistic if we supply a uniform 0 1 random number. That sounds like PRNG to me. If you know the seed, you know the outcome. > >> However, in order to describe what programs in (lambda calculus + choose) actually _mean_, you need two things: >> (1) Define what the compiled program should do at runtime (operational semantics). >> (2) Define what the program means, mathematically (denotational semantics). > Hmm.... yeah I think the denotational semantics could be quite hard. I think that Chung Chieh Shan is working on some aspect of this this, especially measures on R^n. That was my point: With monads, the denotational semantics is easy. The operational semantics is hard. > >> For (2), the mathematical meaning of ordinary Haskell programs are given via the following mapping. Every Haskell type t is associated with a domain D [DOM] and each Haskell function of type t -> t' is associated with a mathematical function f: D -> D' between the associated domains. Whenever non-determinism is involved, e.g. a probabilistic computation on type t, then instead of D one uses P(D), a suitable "powerdomain". > Hmm... I'm guessing (having not looked at the papers below yet except kind of the Haraku paper) that the powerdomain for Double is the measurable sets (aka Borel sets) for the Reals... No, the probabilistic powerspace of D is the set of all measures on the Borel sigma-algebra of D, ordered pointwise. That is, f <= g if f(A) <= g(A) for all measurable sets A. The beautiful thing about this is that the monadic bind is precisely integration against a measure. >> There are various P for various sorts of non-determinism (see the work of Gordon Plotkin), and each of them is a monad on the category of domains. A major problem is whether the P for probabilisitc choice works well with e.g. function types. That is why many papers restrict themselves to first-order functions. Another notoriously hard problem is to combine different sorts of non-determinism. It is like combining monads in Haskell: Some monads have monad transformers associated with them, but some don't. > Interesting. I'll take a look at the papers you mention. I have wondered where some of the restrictions come from. It's whack-a-mole of the categorical kind. There are various subcategories of domains. For example, all Haskell types map to domains that have the additional property "bifinite". One can show that the probabilistic powerdomain of any domain is a domain, but the probabilistic powerdomain of a bifinite domain is never bifinite. Hence there can be no Haskell type that faithfully represents all the random computations of a given type. It is known that the probabilistic powerdomain of a "continuous" domain is again continuous. Sadly, the continuous domains don't have function spaces that are continuous. Thus you get a semantics for a language with choice, but where functions are not first-class citizens. Olaf From ben at well-typed.com Tue Jan 16 18:35:18 2018 From: ben at well-typed.com (Ben Gamari) Date: Tue, 16 Jan 2018 13:35:18 -0500 Subject: [Haskell-cafe] Versioning of libraries bundled with GHC pre-releases Message-ID: <87o9ltzm78.fsf@smart-cactus.org> TL;DR. We propose to start following the PVP for core libraries shipped with GHC alpha release. Let us know what you think. Hello everyone, GHC has recently been reworking its release policy, increasing the release cadence to two releases per year. We hope that this change facilitates earlier and more thorough testing of GHC. Of course, a compiler is worth little if no real-world packages can be built with it. Historically library maintainers have been reluctant to offer releases claiming compatibility with pre-release GHCs due to the lax versioning guarantees offered by such pre-releases. Specifically, changes to libraries shipped with GHC pre-releases have historically not had proper distinct version numbers, causing unnecessary breakage for released code (e.g. [1]). To make maintainers feel more at ease with releasing libraries compatible with GHC alpha releases, we propose to start using the Package Versioning Policy (PVP) [2] to version GHC's core libraries with each alpha release. That is, libraries which are not source-identical will get at very least a minor bump with each alpha release. By "core libraries" we mean the set of: * base * template-haskell * integer-gmp * integer-simple * hpc * ghci * ghc-compact * all GHC dependencies not maintained by GHC HQ * ghc-prim * ghc-boot * ghc-boot-th Following the PVP will allow maintainers to safely release libraries to Hackage without fear that they will break when the final GHC 8.4.1 release is made, easing the testing process for everyone. If you have an opinion one way or another on this matter please do share it on this list. Cheers, - Ben [1] https://github.com/tibbe/hashable/issues/143 [2] https://pvp.haskell.org/ -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From danburton.email at gmail.com Tue Jan 16 19:11:45 2018 From: danburton.email at gmail.com (Dan Burton) Date: Tue, 16 Jan 2018 11:11:45 -0800 Subject: [Haskell-cafe] Versioning of libraries bundled with GHC pre-releases In-Reply-To: <87o9ltzm78.fsf@smart-cactus.org> References: <87o9ltzm78.fsf@smart-cactus.org> Message-ID: +1 I would appreciate this. -- Dan Burton On Tue, Jan 16, 2018 at 10:35 AM, Ben Gamari wrote: > > TL;DR. We propose to start following the PVP for core libraries shipped > with GHC alpha release. Let us know what you think. > > > Hello everyone, > > GHC has recently been reworking its release policy, increasing the > release cadence to two releases per year. We hope that this change > facilitates earlier and more thorough testing of GHC. Of course, > a compiler is worth little if no real-world packages can be built with > it. > > Historically library maintainers have been reluctant to offer releases > claiming compatibility with pre-release GHCs due to the lax versioning > guarantees offered by such pre-releases. Specifically, changes to > libraries shipped with GHC pre-releases have historically not had > proper distinct version numbers, causing unnecessary breakage for > released code (e.g. [1]). > > To make maintainers feel more at ease with releasing libraries > compatible with GHC alpha releases, we propose to start using the > Package Versioning Policy (PVP) [2] to version GHC's core libraries with > each alpha release. That is, libraries which are not source-identical > will get at very least a minor bump with each alpha release. > > By "core libraries" we mean the set of: > > * base > * template-haskell > * integer-gmp > * integer-simple > * hpc > * ghci > * ghc-compact > * all GHC dependencies not maintained by GHC HQ > * ghc-prim > * ghc-boot > * ghc-boot-th > > Following the PVP will allow maintainers to safely release libraries to > Hackage without fear that they will break when the final GHC 8.4.1 > release is made, easing the testing process for everyone. > > If you have an opinion one way or another on this matter please do share > it on this list. > > Cheers, > > - Ben > > > [1] https://github.com/tibbe/hashable/issues/143 > [2] https://pvp.haskell.org/ > > _______________________________________________ > 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 oleg.grenrus at iki.fi Tue Jan 16 20:14:22 2018 From: oleg.grenrus at iki.fi (Oleg Grenrus) Date: Tue, 16 Jan 2018 22:14:22 +0200 Subject: [Haskell-cafe] Versioning of libraries bundled with GHC pre-releases In-Reply-To: <87o9ltzm78.fsf@smart-cactus.org> References: <87o9ltzm78.fsf@smart-cactus.org> Message-ID: <21676f54-f7da-6eb9-1958-2159f30a284f@iki.fi> Hi Ben, Note that PVP dictates to do _major_ bump every time a breaking changes is introduced: 1. Breaking change. If any entity was removed, or the types of any entities or the definitions of datatypes or classes were changed, or orphan instances were added or any instances were removed, then the new A.B MUST be greater than the previous A.B. This means that first alpha-release for e.g. GHC-8.4.1/base-4.11.0.0 or GHC-8.6.1/base-4.12.0.0 will force to freeze both GHC and base. For example "Make the Div and Mod type families `infixl 7`" commit https://github.com/ghc/ghc/commit/fdfaa56b04b2cefb86e4dc557b1d163fd2e062dc is a breaking change. OTOH it's pity not to fix new feature before it's officially released. I cannot judge how much ghc-the-lib public API changes. TL;DR first alpha release is too early to do "PVP dictated freeze". I think that we need *staging* (mutable) package repository, where package authors can upload packages using lighter release procedure. Let's keep Hackage to high standards, and test in a staging environment, not the production one. - Oleg On 16.01.2018 20:35, Ben Gamari wrote: > TL;DR. We propose to start following the PVP for core libraries shipped > with GHC alpha release. Let us know what you think. > > > Hello everyone, > > GHC has recently been reworking its release policy, increasing the > release cadence to two releases per year. We hope that this change > facilitates earlier and more thorough testing of GHC. Of course, > a compiler is worth little if no real-world packages can be built with > it. > > Historically library maintainers have been reluctant to offer releases > claiming compatibility with pre-release GHCs due to the lax versioning > guarantees offered by such pre-releases. Specifically, changes to > libraries shipped with GHC pre-releases have historically not had > proper distinct version numbers, causing unnecessary breakage for > released code (e.g. [1]). > > To make maintainers feel more at ease with releasing libraries > compatible with GHC alpha releases, we propose to start using the > Package Versioning Policy (PVP) [2] to version GHC's core libraries with > each alpha release. That is, libraries which are not source-identical > will get at very least a minor bump with each alpha release. > > By "core libraries" we mean the set of: > > * base > * template-haskell > * integer-gmp > * integer-simple > * hpc > * ghci > * ghc-compact > * all GHC dependencies not maintained by GHC HQ > * ghc-prim > * ghc-boot > * ghc-boot-th > > Following the PVP will allow maintainers to safely release libraries to > Hackage without fear that they will break when the final GHC 8.4.1 > release is made, easing the testing process for everyone. > > If you have an opinion one way or another on this matter please do share > it on this list. > > Cheers, > > - Ben > > > [1] https://github.com/tibbe/hashable/issues/143 > [2] https://pvp.haskell.org/ > > > _______________________________________________ > 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 -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 819 bytes Desc: OpenPGP digital signature URL: From ivan.miljenovic at gmail.com Tue Jan 16 23:34:21 2018 From: ivan.miljenovic at gmail.com (Ivan Lazar Miljenovic) Date: Wed, 17 Jan 2018 10:34:21 +1100 Subject: [Haskell-cafe] ANNOUNCE: servant-pandoc 0.5.0.0 Message-ID: I'm pleased to announce the latest release of the servant-pandoc library: https://hackage.haskell.org/package/servant-pandoc-0.5.0.0 servant-pandoc allows you to take the documentation created with servant-docs and use Pandoc to convert it into whichever format you want (rather than the Markdown generated by servant-docs). The main changes in this release are to provide compatibility with servant-docs-0.11.1; specifically, servant-pandoc now emits all the information that servant-docs does with the same configuration options. As such, there are behavioural changes which necessitated the major version bump. -- Ivan Lazar Miljenovic Ivan.Miljenovic at gmail.com http://IvanMiljenovic.wordpress.com From ben at well-typed.com Wed Jan 17 19:25:55 2018 From: ben at well-typed.com (Ben Gamari) Date: Wed, 17 Jan 2018 14:25:55 -0500 Subject: [Haskell-cafe] Versioning of libraries bundled with GHC pre-releases In-Reply-To: <21676f54-f7da-6eb9-1958-2159f30a284f@iki.fi> References: <87o9ltzm78.fsf@smart-cactus.org> <21676f54-f7da-6eb9-1958-2159f30a284f@iki.fi> Message-ID: <87efmoz3r6.fsf@smart-cactus.org> Oleg Grenrus writes: > Hi Ben, > > Note that PVP dictates to do _major_ bump every time a breaking changes > is introduced: > Right; this is what I was trying to imply when I said "at least a minor bump" in the initial email. > 1. Breaking change. If any entity was removed, or the types of any > entities or the definitions of datatypes or classes were changed, or > orphan instances were added or any instances were removed, then the > new A.B MUST be greater than the previous A.B. > > This means that first alpha-release for e.g. GHC-8.4.1/base-4.11.0.0 or > GHC-8.6.1/base-4.12.0.0 will force to freeze both GHC and base. > > For example "Make the Div and Mod type families `infixl 7`" commit > https://github.com/ghc/ghc/commit/fdfaa56b04b2cefb86e4dc557b1d163fd2e062dc > is a breaking change. OTOH it's pity not to fix new feature before it's > officially released. > Yes, the fact that this sort of thing would require a decision between a major bump or punting until the next release is terribly unfortunate. In an idea world we would simply "be careful" and make sure tha major interface decisions are made by the time of the first alpha but unfortunately, as the above commit illustrates, mistakes are bound to happen. I don't know the right compromise here. > I cannot judge how much ghc-the-lib public API changes. > > TL;DR first alpha release is too early to do "PVP dictated freeze". > This may well be so. Hopefully this thread will help us determine the costs and benefits of freezing during the alpha phase. > I think that we need *staging* (mutable) package repository, where > package authors can upload packages using lighter release procedure. > Let's keep Hackage to high standards, and test in a staging environment, > not the production one. > That is reasonable; however, I am a bit worried that our current tooling isn't quite up to the task. Herbert's head.hackage effort is a great start, but I fear that the friction of maintaining and using the patchset may hamper adoption. Cheers, - Ben -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From aquagnu at gmail.com Thu Jan 18 09:10:47 2018 From: aquagnu at gmail.com (PY) Date: Thu, 18 Jan 2018 11:10:47 +0200 Subject: [Haskell-cafe] Http client: tlsManagerSettings Message-ID: Hello List! I see that tlsManagerSettings eats > 55Mb. Is it normal? It happens when it reads certificates. So, if it's normal, is it possible that it will consume much-much more on other systems/environments? On what does it depend? === Best regards, Paul From simonpj at microsoft.com Thu Jan 18 17:14:03 2018 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Thu, 18 Jan 2018 17:14:03 +0000 Subject: [Haskell-cafe] A small milestone Message-ID: Cherished friends Today is my sixtieth birthday. It is just over forty years since Phil and I called in at Yale on my way to FPCA, and floated the idea of Haskell with Paul Hudak. (It wasn't called Haskell then, of course.) Rather a lot of water has flowed under the bridge since then. GHC's bug tracker is up to 14,683 tickets; I have read every one of them. But the best thing is Haskell's rich community of smart, motivated, passionate, and friendly colleagues. There was a time when I knew every Haskell programmer on the planet, but we are far, far beyond that point. Now it's beyond me even to keep up with the huge wave of elegant and creative ideas, tools, libraries, and blog posts that you generate. (Kudos to Taylor - and doubtless other colleagues -- for the Haskell Weekly News, which I love.) But despite its size, it's a community that is still characterised by a love of elegance, and a desire to distil the essence of an idea and encapsulate it in an abstraction, all tempered with respect and tolerance. We don't always live up to these ideals, but by and large we do. Thank you all. Onward and upward! Simon PS: as birthday recreation I'm working on https://ghc.haskell.org/trac/ghc/wiki/QuantifiedContexts -------------- next part -------------- An HTML attachment was scrubbed... URL: From simonpj at microsoft.com Thu Jan 18 17:37:06 2018 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Thu, 18 Jan 2018 17:37:06 +0000 Subject: [Haskell-cafe] A small milestone In-Reply-To: References: Message-ID: Hmm. Maybe 1987 was thirty years ago, not forty. Clearly old age saps one’s mental arithmetic. Best to read the paper 😊. Simon From: Haskell-Cafe [mailto:haskell-cafe-bounces at haskell.org] On Behalf Of Simon Peyton Jones via Haskell-Cafe Sent: 18 January 2018 17:14 To: haskell at haskell.org; Haskell Cafe Subject: [Haskell-cafe] A small milestone Cherished friends Today is my sixtieth birthday. It is just over forty thirty years since Phil and I called in at Yale on my way to FPCA, and floated the idea of Haskell with Paul Hudak. (It wasn’t called Haskell then, of course.) Rather a lot of water has flowed under the bridge since then. GHC’s bug tracker is up to 14,683 tickets; I have read every one of them. But the best thing is Haskell’s rich community of smart, motivated, passionate, and friendly colleagues. There was a time when I knew every Haskell programmer on the planet, but we are far, far beyond that point. Now it’s beyond me even to keep up with the huge wave of elegant and creative ideas, tools, libraries, and blog posts that you generate. (Kudos to Taylor – and doubtless other colleagues -- for the Haskell Weekly News, which I love.) But despite its size, it’s a community that is still characterised by a love of elegance, and a desire to distil the essence of an idea and encapsulate it in an abstraction, all tempered with respect and tolerance. We don’t always live up to these ideals, but by and large we do. Thank you all. Onward and upward! Simon PS: as birthday recreation I’m working on https://ghc.haskell.org/trac/ghc/wiki/QuantifiedContexts -------------- next part -------------- An HTML attachment was scrubbed... URL: From hjgtuyl at chello.nl Fri Jan 19 02:16:00 2018 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Fri, 19 Jan 2018 03:16:00 +0100 Subject: [Haskell-cafe] A small milestone In-Reply-To: References: Message-ID: Congratulations and thanks for all the work on the beautiful language I have been studying and using the last fifteen years. Regards, Henk-Jan van Tuyl On Thu, 18 Jan 2018 18:37:06 +0100, Simon Peyton Jones via Haskell-Cafe wrote: > Hmm. Maybe 1987 was thirty years ago, not forty. Clearly old age saps > one’s mental arithmetic. Best to read the > paper > 😊. > Simon > From: Haskell-Cafe [mailto:haskell-cafe-bounces at haskell.org] On Behalf > Of Simon Peyton Jones via Haskell-Cafe > Sent: 18 January 2018 17:14 > To: haskell at haskell.org; Haskell Cafe > Subject: [Haskell-cafe] A small milestone > > Cherished friends > Today is my sixtieth birthday. > It is just over forty thirty years since Phil and I called in at Yale on > my way to FPCA, and floated the idea of Haskell with Paul > Hudak. > (It wasn’t called Haskell then, of course.) Rather a lot of water has > flowed under the bridge since then. GHC’s bug tracker is up to 14,683 > tickets; I have read every one of them. > But the best thing is Haskell’s rich community of smart, motivated, > passionate, and friendly colleagues. There was a time when I knew every > Haskell programmer on the planet, but we are far, far beyond that > point. Now it’s beyond me even to keep up with the huge wave of elegant > and creative ideas, tools, libraries, and blog posts that you > generate. (Kudos to Taylor – and doubtless other colleagues -- for the > Haskell Weekly > News, > which I love.) But despite its size, it’s a community that is still > characterised by a love of elegance, and a desire to distil the essence > of an idea and encapsulate it in an abstraction, all tempered with > respect and tolerance. We don’t always live up to these ideals, but by > and large we do. > Thank you all. Onward and upward! > Simon > PS: as birthday recreation I’m working on > https://ghc.haskell.org/trac/ghc/wiki/QuantifiedContexts -- Message from Stanford University: Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://foldingathome.stanford.edu/ -- http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From aquagnu at gmail.com Fri Jan 19 08:44:07 2018 From: aquagnu at gmail.com (PY) Date: Fri, 19 Jan 2018 10:44:07 +0200 Subject: [Haskell-cafe] GHC option for performance related output files folder? Message-ID: Hello, All. I made instrumental build which generates profiling information. Cabal's options are: ghc-options:     -Wall                    -O2                    -threaded                    -prof                    -fprof-auto                    -rtsopts                    -fprof-cafs                    "-with-rtsopts=-N -s -h -i0.1 -p -M1G -SMyApplication-S.log" so running application generates files: /MyApplication-S.log, MyApplication.hp, MyApplication.prof/ but in current working directory - which is the problem (also I need to run it on Windows and Linux). Is it possible to specify directory of those output files with some option? Without this I get "Can't open ... file..." due to permission error - Haskell Runtime tries to save all of them in current folder (on Linux and on Windows standard folders for binaries is not allowed for writing, sure). === Best regards, Paul -------------- next part -------------- An HTML attachment was scrubbed... URL: From hafnersimon at gmail.com Fri Jan 19 13:47:00 2018 From: hafnersimon at gmail.com (Simon Hafner) Date: Fri, 19 Jan 2018 14:47:00 +0100 Subject: [Haskell-cafe] Adding packages from within ghci session Message-ID: Hello I've been exploring some code via ghci, and I've found myself in this loop: - write some code - figure out I need another package (e.g. mtl for runReaderT) - add package to cabal specification - reload stack ghci - Ctrl+R all the statements to replay the session so far Is there a way to speed up the loop, e.g. via loading packages directly from ghci or saving/replaying a session? Cheers, Simon From ollie at ocharles.org.uk Fri Jan 19 15:16:17 2018 From: ollie at ocharles.org.uk (Oliver Charles) Date: Fri, 19 Jan 2018 15:16:17 +0000 Subject: [Haskell-cafe] Adding packages from within ghci session In-Reply-To: References: Message-ID: I think you can do :"set -package foo". Does that do what you want? On 19 Jan 2018 1:49 pm, "Simon Hafner" wrote: > Hello > > I've been exploring some code via ghci, and I've found myself in this loop: > > - write some code > - figure out I need another package (e.g. mtl for runReaderT) > - add package to cabal specification > - reload stack ghci > - Ctrl+R all the statements to replay the session so far > > Is there a way to speed up the loop, e.g. via loading packages > directly from ghci or saving/replaying a session? > > Cheers, > Simon > _______________________________________________ > 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 palotai.robin at gmail.com Fri Jan 19 19:56:05 2018 From: palotai.robin at gmail.com (Robin Palotai) Date: Fri, 19 Jan 2018 20:56:05 +0100 Subject: [Haskell-cafe] Created haskell-indexer-users mailing list Message-ID: Hello Cafe, I created https://groups.google.com/forum/#!forum/haskell-indexer-users, please join if you use / interested in using haskell-indexer [1]! Quoting Section 4.5.5 of the latest HCAR [2], > > Haskell Indexer is a Kythe extension for working with Haskell source code. > Kythe is language-agnostic ecosystem for building tools that work with > code. An example is code search with cross-reference support: > https://cs.chromium.org/. Haskell Indexer makes it possible to use > Kythe-based tools with Haskell. With Haskell Indexer it’s possible to list > all use-sites of any given function (get reverse-references) and explore > the code without any IDE setup. > A portion of GHC and Stackage is indexed and available at > http://stuff.codereview.me/. Thank you & happy coding, Robin [1] https://github.com/google/haskell-indexer [2] https://www.haskell.org/communities/11-2017/html/report.html -------------- next part -------------- An HTML attachment was scrubbed... URL: From neil_mayhew at users.sourceforge.net Fri Jan 19 21:14:27 2018 From: neil_mayhew at users.sourceforge.net (Neil Mayhew) Date: Fri, 19 Jan 2018 14:14:27 -0700 Subject: [Haskell-cafe] A small milestone In-Reply-To: References: Message-ID: On 2018-01-18 07:16 PM, Henk-Jan van Tuyl wrote: > Congratulations and thanks for all the work on the beautiful language > I have been studying and using the last fifteen years. I would like to echo that. I would also like to thank you, Simon, for your courteous, positive, humble and cooperative attitude that has set the tone for our whole community. I had been programming for over thirty years when I discovered Haskell, and through it functional programming, in 2008. It was a complete revelation to me, and I've not looked back. I now don't want to work in any other language if I can possibly help it. I think Haskell hits a sweet spot of expressiveness, safety and performance that is unmatched among mainstream languages. I've experimented with some other functional languages, and I think Haskell stands head and shoulders above them all. Happy Birthday, Simon :-) —Neil -------------- next part -------------- An HTML attachment was scrubbed... URL: From greg7mdp at gmail.com Fri Jan 19 21:57:23 2018 From: greg7mdp at gmail.com (Gregory Popovitch) Date: Fri, 19 Jan 2018 16:57:23 -0500 Subject: [Haskell-cafe] A small milestone In-Reply-To: References: Message-ID: Amen to that! Discovering Haskell was a revelation for me as well. I couldn't believe the beauty of it. Despite reading a lot about Haskell, and watching some very entertaining videos featuring SPJ among others, I never got comfortable at it (using C++ in my day job). Still, it is a great inspiration for me. I am delighted that this beautiful language exists, and I do hope that one day I'll be decent at it, but even if I don't I am richer for it. Happy birthday Simon, and many thanks! -greg _____ From: Haskell-Cafe [mailto:haskell-cafe-bounces at haskell.org] On Behalf Of Neil Mayhew Sent: Friday, January 19, 2018 4:14 PM To: Haskell Cafe Subject: Re: [Haskell-cafe] A small milestone On 2018-01-18 07:16 PM, Henk-Jan van Tuyl wrote: Congratulations and thanks for all the work on the beautiful language I have been studying and using the last fifteen years. I would like to echo that. I would also like to thank you, Simon, for your courteous, positive, humble and cooperative attitude that has set the tone for our whole community. I had been programming for over thirty years when I discovered Haskell, and through it functional programming, in 2008. It was a complete revelation to me, and I've not looked back. I now don't want to work in any other language if I can possibly help it. I think Haskell hits a sweet spot of expressiveness, safety and performance that is unmatched among mainstream languages. I've experimented with some other functional languages, and I think Haskell stands head and shoulders above them all. Happy Birthday, Simon :-) -Neil -------------- next part -------------- An HTML attachment was scrubbed... URL: From spam at scientician.net Fri Jan 19 23:40:31 2018 From: spam at scientician.net (Bardur Arantsson) Date: Sat, 20 Jan 2018 00:40:31 +0100 Subject: [Haskell-cafe] A small milestone In-Reply-To: References: Message-ID: On 2018-01-19 22:14, Neil Mayhew wrote: > On 2018-01-18 07:16 PM, Henk-Jan van Tuyl wrote: >> Congratulations and thanks for all the work on the beautiful language >> I have been studying and using the last fifteen years. > > I would like to echo that. I would also like to thank you, Simon, for > your courteous, positive, humble and cooperative attitude that has set > the tone for our whole community. > +1 From mgsloan at gmail.com Sat Jan 20 04:38:58 2018 From: mgsloan at gmail.com (Michael Sloan) Date: Fri, 19 Jan 2018 20:38:58 -0800 Subject: [Haskell-cafe] Adding packages from within ghci session In-Reply-To: References: Message-ID: I've tested this out but can't get it to work. Seems like ghci can only see packages that existed when it was loaded. Would be a good thing to add to ghci or intero. If this was possible, then you could have a ghci macro that ran `stack build foo`, and, once it completed did `:set -package foo`. On Fri, Jan 19, 2018 at 7:16 AM, Oliver Charles wrote: > I think you can do :"set -package foo". > > Does that do what you want? > > On 19 Jan 2018 1:49 pm, "Simon Hafner" wrote: >> >> Hello >> >> I've been exploring some code via ghci, and I've found myself in this >> loop: >> >> - write some code >> - figure out I need another package (e.g. mtl for runReaderT) >> - add package to cabal specification >> - reload stack ghci >> - Ctrl+R all the statements to replay the session so far >> >> Is there a way to speed up the loop, e.g. via loading packages >> directly from ghci or saving/replaying a session? >> >> Cheers, >> Simon >> _______________________________________________ >> 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 ollie at ocharles.org.uk Sat Jan 20 10:22:14 2018 From: ollie at ocharles.org.uk (Oliver Charles) Date: Sat, 20 Jan 2018 10:22:14 +0000 Subject: [Haskell-cafe] Adding packages from within ghci session In-Reply-To: References: Message-ID: Oh, I just remembered - I do this with `cabal repl`. So what I'm doing is usually starting with a small set of `build-depends` entries, and then changing my .cabal file and extending my REPL. I'm not installing new packages though. I agree, this would be a nice feature. On Sat, Jan 20, 2018 at 4:38 AM, Michael Sloan wrote: > I've tested this out but can't get it to work. Seems like ghci can > only see packages that existed when it was loaded. Would be a good > thing to add to ghci or intero. > > If this was possible, then you could have a ghci macro that ran `stack > build foo`, and, once it completed did `:set -package foo`. > > On Fri, Jan 19, 2018 at 7:16 AM, Oliver Charles > wrote: > > I think you can do :"set -package foo". > > > > Does that do what you want? > > > > On 19 Jan 2018 1:49 pm, "Simon Hafner" wrote: > >> > >> Hello > >> > >> I've been exploring some code via ghci, and I've found myself in this > >> loop: > >> > >> - write some code > >> - figure out I need another package (e.g. mtl for runReaderT) > >> - add package to cabal specification > >> - reload stack ghci > >> - Ctrl+R all the statements to replay the session so far > >> > >> Is there a way to speed up the loop, e.g. via loading packages > >> directly from ghci or saving/replaying a session? > >> > >> Cheers, > >> Simon > >> _______________________________________________ > >> 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. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From martin.drautzburg at web.de Sat Jan 20 14:00:27 2018 From: martin.drautzburg at web.de (martin) Date: Sat, 20 Jan 2018 15:00:27 +0100 Subject: [Haskell-cafe] FRP: Why is Behavior not a Monad? Message-ID: <5A634B7B.7070007@web.de> Hello all, it appears to be difficult to define a Monad instance for Behavior and in many (if not all) reactive libraries Behavior is not a Monad. Why is that so? If a Beahvior is conceptionally a function from Time to something, newtype Behavior a = Behavior (Time -> a) then its Monad instance should work like a Reader Monad. Alternatively one can look at the join function join :: Behavior (Behavior a) -> Behavior a. This corresponds to the situation where you switch between Channels on a TV remote controle and each Channel is a behavior of Image. Then join Behavior (Behavior image) should give you the video stream you see on the screen. How can one possibly live without this operation? I assume this has something to do with the actual implementation and not so much with the semantics, because semantically I don't see any problems. So, - why is Behavior not a Monad and - how would you express the TV-remote example without a Monad? From martin.drautzburg at web.de Sat Jan 20 14:09:52 2018 From: martin.drautzburg at web.de (martin) Date: Sat, 20 Jan 2018 15:09:52 +0100 Subject: [Haskell-cafe] FRP: how does integration work? Message-ID: <5A634DB0.5010802@web.de> Hello all, I am at best half-educated when it comes to FRP, so feel free to direct me to the homework I should do before asking obvious questions. I vaguely remember Paul Hudak talking about integrating a Signal (aka Behavior). Now I have this image in my head, where a Behavior is like vector graphics, except its domain Time and not space. Also I heard the term "late sampling" in conjunction with FRP. Bot ideas make sense to me. So if I look at integration in vector graphics, I might want to get the area between a curve and the x-axis. If I render the curve and then count the pixels between the curve and x-axis, the result will depend on the resolution. With a very low resolution, I'll get a crude approximation of the true area and as I increase the resolution I'll get better approximations and with infinite resolution I'll get the true area. So the result of integration seems to depend on the chosen resolution. Conversely, with pixel graphics, the resolution is fixed right from the start and I cannot not up the resolution at all, at best I could downsample. In FRP I should have something like: newtype Behavior a = Behavior (Time -> a) type Curve = Behavior Double integral :: Curve -> Double -> Curve -- 2nd parameter is the integration constant But what do I get when I take the value of the integral at a given point in time? integralAt :: Time -> Curve -> Double integralAt t curve = let (Behaviour i) = integral curve 0 in i t Nowhere do I mention any (temporal) resolution. How does the integral function know which resoltion to choose? From martin.drautzburg at web.de Sat Jan 20 14:12:20 2018 From: martin.drautzburg at web.de (martin) Date: Sat, 20 Jan 2018 15:12:20 +0100 Subject: [Haskell-cafe] How to use FRP for Simulation Message-ID: <5A634E44.1070109@web.de> Hello all, the answer to the question "what is FRP good for?" often includes "simulation". I somewhat understand the "reactive" situation, where an FRP system receives Events from the outside world and computes Events to be sent to the outside world. To do so, the computation uses Behaviors which are essentially time-varying states. I also read, that the programmer should not be allowed to literally define Events and Behaviors, or she might end up writing bad prograns which exhibit time or space leaks. She should only be allowed to define transformations. Now in a discrete event simulation (DES) there is a lot of "event stuff" going on and FRP looks like a good paradigm. However, in a simulation nothing comes from the outside world and not much goes to the outside world. There is a simulation result, but it is just a result like any other and doesn't have much to do with Time. A DES is not really a reactive system at all. In DES there is typically a set of initial Events and more events are created as the simulation progresses. I cannot see how this can be done without the power to explicitly create Events. Also these Events point to the "future" and must therefore carry an explicit (simulated) Time, whereas (IIRC) in FRP, Events do not necessarily carry an explicit Time. They just occur, and if you need the time, you look at the clock (a Behavior Time). So what exactly is meant by "FRP is useful for simulation". Does it mean that a DES engine can be written in FRP style or does it mean something else? If one can indeed write a DES engine in FPR style, what is the correct way of thinking about it? From vagarenko at gmail.com Sat Jan 20 15:15:27 2018 From: vagarenko at gmail.com (Alexey Vagarenko) Date: Sat, 20 Jan 2018 20:15:27 +0500 Subject: [Haskell-cafe] FRP: Why is Behavior not a Monad? In-Reply-To: <5A634B7B.7070007@web.de> References: <5A634B7B.7070007@web.de> Message-ID: Both `reflex`[1] and `frpnow`[2] provide Monad instance for behavior. AFAIK only `reactive-banana` and arrowized FRP libraries don't have it. [1] https://github.com/reflex-frp/reflex/blob/develop/src/Reflex/Class.hs#L598 [2] https://hackage.haskell.org/package/frpnow-0.18/docs/Control-FRPNow-Core.html Virus-free. www.avg.com <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> 2018-01-20 19:00 GMT+05:00 martin : > Hello all, > > it appears to be difficult to define a Monad instance for Behavior and in > many (if not all) reactive libraries Behavior > is not a Monad. Why is that so? > > If a Beahvior is conceptionally a function from Time to something, > > newtype Behavior a = Behavior (Time -> a) > > then its Monad instance should work like a Reader Monad. > > Alternatively one can look at the join function > > join :: Behavior (Behavior a) -> Behavior a. > > This corresponds to the situation where you switch between Channels on a > TV remote controle and each Channel is a > behavior of Image. Then > > join Behavior (Behavior image) > > should give you the video stream you see on the screen. How can one > possibly live without this operation? > > I assume this has something to do with the actual implementation and not > so much with the semantics, because > semantically I don't see any problems. > > So, > - why is Behavior not a Monad and > - how would you express the TV-remote example without a Monad? > > > _______________________________________________ > 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 ollie at ocharles.org.uk Sat Jan 20 15:48:19 2018 From: ollie at ocharles.org.uk (Oliver Charles) Date: Sat, 20 Jan 2018 15:48:19 +0000 Subject: [Haskell-cafe] FRP: Why is Behavior not a Monad? In-Reply-To: References: <5A634B7B.7070007@web.de> Message-ID: https://github.com/HeinrichApfelmus/reactive-banana/issues/101 discusses Monad Behaviour in the context of reactive-banana On 20 Jan 2018 3:19 pm, "Alexey Vagarenko" wrote: > Both `reflex`[1] and `frpnow`[2] provide Monad instance for behavior. > AFAIK only `reactive-banana` and arrowized FRP libraries don't have it. > > [1] https://github.com/reflex-frp/reflex/blob/develop/src/ > Reflex/Class.hs#L598 > [2] https://hackage.haskell.org/package/frpnow-0.18/docs/ > Control-FRPNow-Core.html > > > Virus-free. > www.avg.com > > <#m_7775439266333022182_DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> > > 2018-01-20 19:00 GMT+05:00 martin : > >> Hello all, >> >> it appears to be difficult to define a Monad instance for Behavior and in >> many (if not all) reactive libraries Behavior >> is not a Monad. Why is that so? >> >> If a Beahvior is conceptionally a function from Time to something, >> >> newtype Behavior a = Behavior (Time -> a) >> >> then its Monad instance should work like a Reader Monad. >> >> Alternatively one can look at the join function >> >> join :: Behavior (Behavior a) -> Behavior a. >> >> This corresponds to the situation where you switch between Channels on a >> TV remote controle and each Channel is a >> behavior of Image. Then >> >> join Behavior (Behavior image) >> >> should give you the video stream you see on the screen. How can one >> possibly live without this operation? >> >> I assume this has something to do with the actual implementation and not >> so much with the semantics, because >> semantically I don't see any problems. >> >> So, >> - why is Behavior not a Monad and >> - how would you express the TV-remote example without a Monad? >> >> >> _______________________________________________ >> 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. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ivan.perez at keera.co.uk Sat Jan 20 17:02:32 2018 From: ivan.perez at keera.co.uk (Ivan Perez) Date: Sat, 20 Jan 2018 12:02:32 -0500 Subject: [Haskell-cafe] FRP: Why is Behavior not a Monad? In-Reply-To: <5A634B7B.7070007@web.de> References: <5A634B7B.7070007@web.de> Message-ID: We do have them in Dunai [1], which combines both arrowized and classic FRP in an efficient and elegant solution. Yampa [2] (Arrowized FRP) can be built on top of Dunai and we have real games and apps running on top of this [3]. The issue is described very well in Section 2, "Efficient and Compositional Higher-Order Streams", by Gergely Patai [4]. Ivan [1] http://github.com/ivanperez-keera/dunai [2] http://github.com/ivanperez-keera/Yampa [3] http://www.cs.nott.ac.uk/~psxip1/#FRPRefactored [4] http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.182.2374&rep=rep1&type=pdf On 20 January 2018 at 09:00, martin wrote: > Hello all, > > it appears to be difficult to define a Monad instance for Behavior and in > many (if not all) reactive libraries Behavior > is not a Monad. Why is that so? > > If a Beahvior is conceptionally a function from Time to something, > > newtype Behavior a = Behavior (Time -> a) > > then its Monad instance should work like a Reader Monad. > > Alternatively one can look at the join function > > join :: Behavior (Behavior a) -> Behavior a. > > This corresponds to the situation where you switch between Channels on a > TV remote controle and each Channel is a > behavior of Image. Then > > join Behavior (Behavior image) > > should give you the video stream you see on the screen. How can one > possibly live without this operation? > > I assume this has something to do with the actual implementation and not > so much with the semantics, because > semantically I don't see any problems. > > So, > - why is Behavior not a Monad and > - how would you express the TV-remote example without a Monad? > > > _______________________________________________ > 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 andrew.lelechenko at gmail.com Sat Jan 20 18:45:17 2018 From: andrew.lelechenko at gmail.com (Andrew Lelechenko) Date: Sat, 20 Jan 2018 18:45:17 +0000 Subject: [Haskell-cafe] Taking over maintainership of exact-pi Message-ID: <2A8272FA-F807-4C4E-84C8-E6139A41DBDF@gmail.com> I would like to take over `exact-pi` package (https://hackage.haskell.org/package/exact-pi). Unfortunately, the package became incompatible with upcoming GHC 8.4 and needs an upgrade. The relevant pull request (https://github.com/dmcclean/exact-pi/pull/5), prepared by @konn, has been open for a month without response. I also tried to reach its maintainer Douglas McClean (cced) by email, but have not heard back. I am so interested in upgrading `exact-pi`, because it is a dependency of my package `arithmoi`. — Best regards, Andrew From douglas.mcclean at gmail.com Sat Jan 20 19:18:54 2018 From: douglas.mcclean at gmail.com (Douglas McClean) Date: Sat, 20 Jan 2018 14:18:54 -0500 Subject: [Haskell-cafe] Taking over maintainership of exact-pi In-Reply-To: <2A8272FA-F807-4C4E-84C8-E6139A41DBDF@gmail.com> References: <2A8272FA-F807-4C4E-84C8-E6139A41DBDF@gmail.com> Message-ID: Sorry everyone, new baby. Will review PR by end of weekend. On Jan 20, 2018 1:45 PM, "Andrew Lelechenko" wrote: > I would like to take over `exact-pi` package (https://hackage.haskell.org/ > package/exact-pi). > Unfortunately, the package became incompatible with upcoming GHC 8.4 and > needs an upgrade. The relevant pull request (https://github.com/dmcclean/ > exact-pi/pull/5), prepared by @konn, has been open for a month without > response. I also tried to reach its maintainer Douglas McClean (cced) by > email, but have not heard back. > > I am so interested in upgrading `exact-pi`, because it is a dependency of > my package `arithmoi`. > > — > Best regards, > Andrew > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ben at well-typed.com Sun Jan 21 20:14:46 2018 From: ben at well-typed.com (Ben Gamari) Date: Sun, 21 Jan 2018 15:14:46 -0500 Subject: [Haskell-cafe] [ANNOUNCE] GHC 8.4.1-alpha2 available References: <87bmitcejz.fsf@ben-laptop.smart-cactus.org> Message-ID: <87shazx94g.fsf@smart-cactus.org> The GHC development team is pleased to announce the second alpha release of the 8.4.1 release. The usual release artifacts are available from https://downloads.haskell.org/~ghc/8.4.1-alpha2 Note that this alpha, like alpha1, is unfortunately afflicted by #14678. We will try to get an alpha3 out as soon as this issue has been resolved. However, as this alpha has a number of fixes since alpha1, we have decided it would be best not to delay it any further. Also, due to user demand we now offer a binary distribution for 64-bit Fedora 27; this distribution links against ncurses6. This is in contrast to the Debian 8 distribution, which links against ncurses5. Users of newer distributions (Fedora 27, Debian sid) should use this distribution. Note that this release drops compatibility with GCC 4.6 and earlier. While we generally try to place as few constraints on system toolchain as possible, this release depends upon the __atomic__ builtins provided by GCC 4.7 and later (see #14244). === Notes on release scheduling === The 8.4.1 release marks the first release where GHC will be adhering to its new, higher-cadence release schedule [1]. Under this new scheme, major releases will be made in 6-month intervals with interstitial minor releases as necessary. In order to minimize the likelihood of schedule slippage and to ensure adequate testing, each major release will be preceeded by a number of regular alpha releases. We will begin issuing these releases roughly three months before the final date of the major release and will issue roughly one every two weeks during this period. This high release cadence will allow us to quickly get fixes in to users hands and allow better feedback on the status of the release. GHC 8.4 is slated to be released in mid-February but, due to technical constraints, we are starting the alpha-release cycle a bit later than planned under the above schedule. For this reason, it would be greatly appreciated if users could put this alpha through its paces to make up for lost time. As always, do let us know if you encounter any trouble in the course of testing. Thanks for your help! Cheers, - Ben [1] https://ghc.haskell.org/trac/ghc/blog/2017-release-schedule -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From eraker at gmail.com Sun Jan 21 23:38:42 2018 From: eraker at gmail.com (erik) Date: Sun, 21 Jan 2018 15:38:42 -0800 Subject: [Haskell-cafe] Large JSON File Processing Message-ID: Hello Haskell Cafe, I have written a small, pretty simple program but I am finding it hard to reason about its behavior (and also about the best way to do what I want), so I would like to ask you all for some suggestions. For reference, here's a Stack Overflow question where I described what's going on, but I'll also describe it below. My program does the following: 1. Recursively list a directory, 2. Parse the JSON files from the directory list into identifiable objects/records, 3. Look for matching key-value pairs, and 4. Return filenames where matches have been found. A few details for more context: - I have to filter between 500,000 and 1 million files (I'm typically trying to reduce down to between 1,000 and 40,000 that represent a particular project). I usually just need the filenames. - Each file is quite large, some of them 5mb or 10mb, and it's not uncommon for them to have deeply nested keys (40,000 keys or so). My first version of this program was simple, synchronous, and as straightforward as I could come up with. However, the memory usage increased monotonically. Profiling, I found that most of the time was spent in JSON-parsing into Objects before my code could turn the objects into records (also, as you might imagine, tons of time in garbage collection). For my second version, I switched to conduit and it seemed to solve the increasing memory issue. My core function now looked like this: conduitFilesFilter :: ProjectFilter -> Path Abs Dir -> IO [Path Abs File] conduitFilesFilter projFilter dirname' = do (_, allFiles) <- listDirRecur dirname' C.runConduit $ C.yieldMany allFiles .| C.filterMC (filterMatchingFile projFilter) .| C.sinkList This was still slow and certainly still synchronous. What I really wanted was to run that "filterMatchingFile..." part in parallel across a number of CPUs. As an aside, my filtering function looks like this: filterMatchingFile :: ProjectFilter -> Path Abs File -> IO Bool filterMatchingFile (ProjectFilter filterFunc) fpath = do let fp = toFilePath fpath bs <- B.readFile fp case validImplProject bs of -- this is pretty much just `decodeStrict` Nothing -> pure False (Just proj') -> pure $ filterFunc proj' Here are the stats from running this: 115,961,554,600 bytes allocated in the heap 35,870,639,768 bytes copied during GC 56,467,720 bytes maximum residency (681 sample(s)) 1,283,008 bytes maximum slop 145 MB total memory in use (0 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 108716 colls, 108716 par 76.915s 20.571s 0.0002s 0.0266s Gen 1 681 colls, 680 par 0.530s 0.147s 0.0002s 0.0009s Parallel GC work balance: 14.99% (serial 0%, perfect 100%) TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.001s ( 0.007s elapsed) MUT time 34.813s ( 42.938s elapsed) GC time 77.445s ( 20.718s elapsed) EXIT time 0.000s ( 0.010s elapsed) Total time 112.260s ( 63.672s elapsed) Alloc rate 3,330,960,996 bytes per MUT second Productivity 31.0% of total user, 67.5% of total elapsed gc_alloc_block_sync: 188614 whitehole_spin: 0 gen[0].sync: 33 gen[1].sync: 811204 I thought about writing a plainer (non-conduit) parallel version but I was afraid of the memory issue. I tried to write a Conduit-plus-channels version but it didn't work. Finally, I wrote a version using stm-conduit, which I thought might be a bit more efficient. It seems to be slightly better, but it's not really the kind of parallelization I was imagining: conduitAsyncFilterFiles :: ProjectFilter -> Path Abs Dir -> IO [String] conduitAsyncFilterFiles projFilter dirname' = do (_, allFiles) <- listDirRecur dirname' buffer 10 (C.yieldMany allFiles .| (C.mapMC (readFileWithPath . toFilePath))) (C.mapC (filterProjForFilename projFilter) .| C.filterC isJust .| C.mapC fromJust .| C.sinkList) The first conduit passed to `buffer` does something like the following: parseStrict . B.readFile. This still wasn't too great, but after reading about handing garbage collection in smarter ways, I found that I could run my application like this: stack exec search-json -- --searchPath $FILES --name hello +RTS -s -A32m -n4m And the "productivity" would shoot up quite a lot presumably because I'm doing less frequent garbage collection. My program also got a bit faster: 36,379,265,096 bytes allocated in the heap 1,238,438,160 bytes copied during GC 22,996,264 bytes maximum residency (85 sample(s)) 3,834,152 bytes maximum slop 207 MB total memory in use (14 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 211 colls, 211 par 1.433s 0.393s 0.0019s 0.0077s Gen 1 85 colls, 84 par 0.927s 0.256s 0.0030s 0.0067s Parallel GC work balance: 67.93% (serial 0%, perfect 100%) TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.001s ( 0.004s elapsed) MUT time 12.636s ( 12.697s elapsed) GC time 2.359s ( 0.650s elapsed) EXIT time -0.015s ( 0.003s elapsed) Total time 14.982s ( 13.354s elapsed) Alloc rate 2,878,972,840 bytes per MUT second Productivity 84.2% of total user, 95.1% of total elapsed gc_alloc_block_sync: 9612 whitehole_spin: 0 gen[0].sync: 2044 gen[1].sync: 47704 Thanks for reading thus far. I now have three questions. 1. I understand that my program necessarily creates tons of garbage because it parses and then throws away 5mb of JSON 500,000 times. However, I don't really understand why this helps "+RTS -A32m -n4m" and I'm always reluctant to sprinkle in magic I don't fully understand. Can anyone help me understand what this means? 2. It seems that the allocation limit is really something I should be using, but I can't figure out how to successfully add it to my package.yml with the other options. From the documentation for GHC 8.2, I thought it needed to look like this but it never works, usually telling me that -A32m and -n4m are not recognizable flags (how do I add them in to my package.yml so I don't have to pass them when running the program?): ghc-options: - -threaded - -rtsopts - "-with-rtsopts=-N4 -A32m -n4m" 3. Finally, the most important question I have is this. When I run this program on OSX, it runs successfully through to completion. However, *a few minutes after terminating*, my terminal becomes unresponsive. I use emacs for my editor, typically launched from a terminal window and that too becomes unresponsive. This is not a typical outcome for any programs I write and it happens *every time* I run this particular application, so I know that this application is to blame. The crazy thing is that force quitting the terminal or logging out doesn't help: I have to actually restart my computer to use the terminal application again. Other details that may help: - This crash happens after the process id for my program has terminated. - Watching its progress in HTOP, it never comes close to running out of memory: the value hovers in the same place. I can't really deploy an application that has this potential-crashing problem, but I don't know to debug this issue. My total stab-in-the-dark idea is that heap allocations somehow are unrecoverable even after the process has terminated? Can anyone offer suggestions on things to look for or ways to debug and/or fix this issue? Finally, if anyone has suggestions on better ways to structure my application or parallelize the slow parts, I'll happily take those. Thanks again for reading. I appreciate any suggestions you may have. Best, -- Erik Aker -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at snoyman.com Mon Jan 22 06:12:47 2018 From: michael at snoyman.com (Michael Snoyman) Date: Mon, 22 Jan 2018 08:12:47 +0200 Subject: [Haskell-cafe] Large JSON File Processing In-Reply-To: References: Message-ID: I just wanted to comment on the conduit aspect of this in particular. Looking at your first version: conduitFilesFilter :: ProjectFilter -> Path Abs Dir -> IO [Path Abs File] conduitFilesFilter projFilter dirname' = do (_, allFiles) <- listDirRecur dirname' C.runConduit $ C.yieldMany allFiles .| C.filterMC (filterMatchingFile projFilter) .| C.sinkList This isn't taking full advantage of conduit: you're reading in a list of the files in the file system, instead of streaming those values. And the output is a list of `String`, instead of streaming out those `String`s. More idiomatic would look something like: sourceFilesFilter projFilter dirname' = sourceDirectoryDeep False dirname' .| filterMC (filterMatchingFile projFilter) And then, wherever you're consuming the output, to do so in a streaming fashion, e.g.: runConduitRes $ sourceFilesFilter projFilter dirname' .| mapM_C print This should help with the increasing memory usage, though it will do nothing about the runtime overhead of parsing the JSON itself. On Mon, Jan 22, 2018 at 1:38 AM, erik wrote: > Hello Haskell Cafe, > > I have written a small, pretty simple program but I am finding it hard to > reason about its behavior (and also about the best way to do what I want), > so I would like to ask you all for some suggestions. > > For reference, here's a Stack Overflow question > > where I described what's going on, but I'll also describe it below. > > My program does the following: > > 1. Recursively list a directory, > 2. Parse the JSON files from the directory list into identifiable > objects/records, > 3. Look for matching key-value pairs, and > 4. Return filenames where matches have been found. > > A few details for more context: > > - I have to filter between 500,000 and 1 million files (I'm typically > trying to reduce down to between 1,000 and 40,000 that represent a > particular project). I usually just need the filenames. > - Each file is quite large, some of them 5mb or 10mb, and it's not > uncommon for them to have deeply nested keys (40,000 keys or so). > > My first version of this program was simple, synchronous, and as > straightforward as I could come up with. However, the memory usage > increased monotonically. Profiling, I found that most of the time was spent > in JSON-parsing into Objects before my code could turn the objects into > records (also, as you might imagine, tons of time in garbage collection). > > For my second version, I switched to conduit and it seemed to solve the > increasing memory issue. My core function now looked like this: > > conduitFilesFilter :: ProjectFilter -> Path Abs Dir -> IO [Path Abs File] > conduitFilesFilter projFilter dirname' = do > (_, allFiles) <- listDirRecur dirname' > C.runConduit $ > C.yieldMany allFiles > .| C.filterMC (filterMatchingFile projFilter) > .| C.sinkList > > > This was still slow and certainly still synchronous. What I really wanted > was to run that "filterMatchingFile..." part in parallel across a number of > CPUs. As an aside, my filtering function looks like this: > > filterMatchingFile :: ProjectFilter -> Path Abs File -> IO Bool > filterMatchingFile (ProjectFilter filterFunc) fpath = do > let fp = toFilePath fpath > bs <- B.readFile fp > case validImplProject bs of -- this is pretty much just `decodeStrict` > Nothing -> pure False > (Just proj') -> pure $ filterFunc proj' > > Here are the stats from running this: > > 115,961,554,600 bytes allocated in the heap > 35,870,639,768 bytes copied during GC > 56,467,720 bytes maximum residency (681 sample(s)) > 1,283,008 bytes maximum slop > 145 MB total memory in use (0 MB lost due to fragmentation) > > Tot time (elapsed) Avg pause Max pause > Gen 0 108716 colls, 108716 par 76.915s 20.571s 0.0002s 0.0266s > Gen 1 681 colls, 680 par 0.530s 0.147s 0.0002s 0.0009s > > Parallel GC work balance: 14.99% (serial 0%, perfect 100%) > > TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) > > SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) > > INIT time 0.001s ( 0.007s elapsed) > MUT time 34.813s ( 42.938s elapsed) > GC time 77.445s ( 20.718s elapsed) > EXIT time 0.000s ( 0.010s elapsed) > Total time 112.260s ( 63.672s elapsed) > > Alloc rate 3,330,960,996 bytes per MUT second > > Productivity 31.0% of total user, 67.5% of total elapsed > > gc_alloc_block_sync: 188614 > whitehole_spin: 0 > gen[0].sync: 33 > gen[1].sync: 811204 > > > I thought about writing a plainer (non-conduit) parallel version but I was > afraid of the memory issue. I tried to write a Conduit-plus-channels > version but it didn't work. > > Finally, I wrote a version using stm-conduit, which I thought might be a > bit more efficient. It seems to be slightly better, but it's not really the > kind of parallelization I was imagining: > > conduitAsyncFilterFiles :: ProjectFilter -> Path Abs Dir -> IO [String] > conduitAsyncFilterFiles projFilter dirname' = do > (_, allFiles) <- listDirRecur dirname' > buffer 10 > (C.yieldMany allFiles > .| (C.mapMC (readFileWithPath . toFilePath))) > (C.mapC (filterProjForFilename projFilter) > .| C.filterC isJust > .| C.mapC fromJust > .| C.sinkList) > > The first conduit passed to `buffer` does something like the following: parseStrict > . B.readFile. > > This still wasn't too great, but after reading about handing garbage > collection in smarter ways, I found that I could run my application like > this: > > stack exec search-json -- --searchPath $FILES --name hello +RTS -s -A32m -n4m > > And the "productivity" would shoot up quite a lot presumably because I'm > doing less frequent garbage collection. My program also got a bit faster: > > 36,379,265,096 bytes allocated in the heap > 1,238,438,160 bytes copied during GC > 22,996,264 bytes maximum residency (85 sample(s)) > 3,834,152 bytes maximum slop > 207 MB total memory in use (14 MB lost due to fragmentation) > > Tot time (elapsed) Avg pause Max pause > Gen 0 211 colls, 211 par 1.433s 0.393s 0.0019s 0.0077s > Gen 1 85 colls, 84 par 0.927s 0.256s 0.0030s 0.0067s > > Parallel GC work balance: 67.93% (serial 0%, perfect 100%) > > TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) > > SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) > > INIT time 0.001s ( 0.004s elapsed) > MUT time 12.636s ( 12.697s elapsed) > GC time 2.359s ( 0.650s elapsed) > EXIT time -0.015s ( 0.003s elapsed) > Total time 14.982s ( 13.354s elapsed) > > Alloc rate 2,878,972,840 bytes per MUT second > > Productivity 84.2% of total user, 95.1% of total elapsed > > gc_alloc_block_sync: 9612 > whitehole_spin: 0 > gen[0].sync: 2044 > gen[1].sync: 47704 > > > Thanks for reading thus far. I now have three questions. > > 1. I understand that my program necessarily creates tons of garbage > because it parses and then throws away 5mb of JSON 500,000 times. However, > I don't really understand why this helps "+RTS -A32m -n4m" and I'm always > reluctant to sprinkle in magic I don't fully understand. Can anyone help me > understand what this means? > > 2. It seems that the allocation limit is really something I should be > using, but I can't figure out how to successfully add it to my package.yml > with the other options. From the documentation for GHC 8.2, I thought it > needed to look like this but it never works, usually telling me that -A32m > and -n4m are not recognizable flags (how do I add them in to my package.yml > so I don't have to pass them when running the program?): > > ghc-options: > - -threaded > - -rtsopts > - "-with-rtsopts=-N4 -A32m -n4m" > > 3. Finally, the most important question I have is this. When I run this > program on OSX, it runs successfully through to completion. However, *a > few minutes after terminating*, my terminal becomes unresponsive. I use > emacs for my editor, typically launched from a terminal window and that too > becomes unresponsive. This is not a typical outcome for any programs I > write and it happens *every time* I run this particular application, so I > know that this application is to blame. > > The crazy thing is that force quitting the terminal or logging out doesn't > help: I have to actually restart my computer to use the terminal > application again. Other details that may help: > > - This crash happens after the process id for my program has > terminated. > - Watching its progress in HTOP, it never comes close to running out > of memory: the value hovers in the same place. > > I can't really deploy an application that has this potential-crashing > problem, but I don't know to debug this issue. My total stab-in-the-dark > idea is that heap allocations somehow are unrecoverable even after the > process has terminated? Can anyone offer suggestions on things to look for > or ways to debug and/or fix this issue? > > Finally, if anyone has suggestions on better ways to structure my > application or parallelize the slow parts, I'll happily take those. > > Thanks again for reading. I appreciate any suggestions you may have. > > Best, > > -- > Erik Aker > > _______________________________________________ > 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 simonpj at microsoft.com Mon Jan 22 12:44:52 2018 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Mon, 22 Jan 2018 12:44:52 +0000 Subject: [Haskell-cafe] SLURP: a single unified registry for Haskell packages Message-ID: Friends Hackage has been extraordinarily successful as a single repository through which to share Haskell packages. It has supported the emergence of variety of tools to locate Haskell packages, build them and install them (cabal-install, Stack, Nix, ...). But in recent years there has been increasing friction over, * Hackage's policies, especially concerning version bounds; * Hackage's guarantees, especially around durability of package content and metadata; * Hackage's features, especially the visual presentation and package documentation. If we do not resolve this friction, it seems likely that the Haskell library ecosystem will soon "fork", with two separate repositories, one optimised for Cabal and one for Stack. This would be extremely counter-productive for Haskell users. Thus motivated, over the last few months we have talked a lot to colleagues, including ones in the Hackage and Stack communities. We have emerged with SLURP, a proposal that could go a long way towards supporting the upsides of a diverse ecosystem, without the sad downsides of forking into mutually-exclusive sub-communities. Here is the SLURP proposal. We invite the Haskell community to debate it. SLURP is meant to enable both Hackage and Stackage (and perhaps more services in the future) to in the future make choices autonomously without hurting other package services. But it will only work if the implementors of both Hackage and Stackage are willing to participate. We respect their autonomy in this matter, but we urge them to give this proposal serious consideration in the best interests of the community and Haskell's success. We have carefully designed SLURP to be as minimal and non-invasive as possible, so that it can be adopted without much trouble. Of course, we are open to debate about the specific details. We do have an offer from someone willing to implement SLURP. We also strongly urge members of the community to express clear views about the importance --- or otherwise --- of adopting something like SLURP. You are, after all, the community that GHC, Hackage, Stackage, Cabal, etc are designed to serve, so your views about what best meets your needs are critically important. Mathieu Boespflug (@mboes) Manuel Chakravarty (@mchakravarty) Simon Marlow (@simonmar) Simon Peyton Jones (@simonpj) Alan Zimmerman (@alanz) -------------- next part -------------- An HTML attachment was scrubbed... URL: From eraker at gmail.com Mon Jan 22 19:15:02 2018 From: eraker at gmail.com (erik) Date: Mon, 22 Jan 2018 11:15:02 -0800 Subject: [Haskell-cafe] Large JSON File Processing In-Reply-To: References: Message-ID: Hi Cafe, Follow-up on my crashing terminal question, in case anyone read that and was puzzling over it: I think my application may not be to blame. I would like to withdraw that last question until I can establish that my application is definitely causing the crash. Sorry for the confusion. Thanks, Erik On Sun, Jan 21, 2018 at 3:38 PM, erik wrote: > Hello Haskell Cafe, > > I have written a small, pretty simple program but I am finding it hard to > reason about its behavior (and also about the best way to do what I want), > so I would like to ask you all for some suggestions. > > For reference, here's a Stack Overflow question > > where I described what's going on, but I'll also describe it below. > > My program does the following: > > 1. Recursively list a directory, > 2. Parse the JSON files from the directory list into identifiable > objects/records, > 3. Look for matching key-value pairs, and > 4. Return filenames where matches have been found. > > A few details for more context: > > - I have to filter between 500,000 and 1 million files (I'm typically > trying to reduce down to between 1,000 and 40,000 that represent a > particular project). I usually just need the filenames. > - Each file is quite large, some of them 5mb or 10mb, and it's not > uncommon for them to have deeply nested keys (40,000 keys or so). > > My first version of this program was simple, synchronous, and as > straightforward as I could come up with. However, the memory usage > increased monotonically. Profiling, I found that most of the time was spent > in JSON-parsing into Objects before my code could turn the objects into > records (also, as you might imagine, tons of time in garbage collection). > > For my second version, I switched to conduit and it seemed to solve the > increasing memory issue. My core function now looked like this: > > conduitFilesFilter :: ProjectFilter -> Path Abs Dir -> IO [Path Abs File] > conduitFilesFilter projFilter dirname' = do > (_, allFiles) <- listDirRecur dirname' > C.runConduit $ > C.yieldMany allFiles > .| C.filterMC (filterMatchingFile projFilter) > .| C.sinkList > > > This was still slow and certainly still synchronous. What I really wanted > was to run that "filterMatchingFile..." part in parallel across a number of > CPUs. As an aside, my filtering function looks like this: > > filterMatchingFile :: ProjectFilter -> Path Abs File -> IO Bool > filterMatchingFile (ProjectFilter filterFunc) fpath = do > let fp = toFilePath fpath > bs <- B.readFile fp > case validImplProject bs of -- this is pretty much just `decodeStrict` > Nothing -> pure False > (Just proj') -> pure $ filterFunc proj' > > Here are the stats from running this: > > 115,961,554,600 bytes allocated in the heap > 35,870,639,768 bytes copied during GC > 56,467,720 bytes maximum residency (681 sample(s)) > 1,283,008 bytes maximum slop > 145 MB total memory in use (0 MB lost due to fragmentation) > > Tot time (elapsed) Avg pause Max pause > Gen 0 108716 colls, 108716 par 76.915s 20.571s 0.0002s 0.0266s > Gen 1 681 colls, 680 par 0.530s 0.147s 0.0002s 0.0009s > > Parallel GC work balance: 14.99% (serial 0%, perfect 100%) > > TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) > > SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) > > INIT time 0.001s ( 0.007s elapsed) > MUT time 34.813s ( 42.938s elapsed) > GC time 77.445s ( 20.718s elapsed) > EXIT time 0.000s ( 0.010s elapsed) > Total time 112.260s ( 63.672s elapsed) > > Alloc rate 3,330,960,996 bytes per MUT second > > Productivity 31.0% of total user, 67.5% of total elapsed > > gc_alloc_block_sync: 188614 > whitehole_spin: 0 > gen[0].sync: 33 > gen[1].sync: 811204 > > > I thought about writing a plainer (non-conduit) parallel version but I was > afraid of the memory issue. I tried to write a Conduit-plus-channels > version but it didn't work. > > Finally, I wrote a version using stm-conduit, which I thought might be a > bit more efficient. It seems to be slightly better, but it's not really the > kind of parallelization I was imagining: > > conduitAsyncFilterFiles :: ProjectFilter -> Path Abs Dir -> IO [String] > conduitAsyncFilterFiles projFilter dirname' = do > (_, allFiles) <- listDirRecur dirname' > buffer 10 > (C.yieldMany allFiles > .| (C.mapMC (readFileWithPath . toFilePath))) > (C.mapC (filterProjForFilename projFilter) > .| C.filterC isJust > .| C.mapC fromJust > .| C.sinkList) > > The first conduit passed to `buffer` does something like the following: parseStrict > . B.readFile. > > This still wasn't too great, but after reading about handing garbage > collection in smarter ways, I found that I could run my application like > this: > > stack exec search-json -- --searchPath $FILES --name hello +RTS -s -A32m -n4m > > And the "productivity" would shoot up quite a lot presumably because I'm > doing less frequent garbage collection. My program also got a bit faster: > > 36,379,265,096 bytes allocated in the heap > 1,238,438,160 bytes copied during GC > 22,996,264 bytes maximum residency (85 sample(s)) > 3,834,152 bytes maximum slop > 207 MB total memory in use (14 MB lost due to fragmentation) > > Tot time (elapsed) Avg pause Max pause > Gen 0 211 colls, 211 par 1.433s 0.393s 0.0019s 0.0077s > Gen 1 85 colls, 84 par 0.927s 0.256s 0.0030s 0.0067s > > Parallel GC work balance: 67.93% (serial 0%, perfect 100%) > > TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) > > SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) > > INIT time 0.001s ( 0.004s elapsed) > MUT time 12.636s ( 12.697s elapsed) > GC time 2.359s ( 0.650s elapsed) > EXIT time -0.015s ( 0.003s elapsed) > Total time 14.982s ( 13.354s elapsed) > > Alloc rate 2,878,972,840 bytes per MUT second > > Productivity 84.2% of total user, 95.1% of total elapsed > > gc_alloc_block_sync: 9612 > whitehole_spin: 0 > gen[0].sync: 2044 > gen[1].sync: 47704 > > > Thanks for reading thus far. I now have three questions. > > 1. I understand that my program necessarily creates tons of garbage > because it parses and then throws away 5mb of JSON 500,000 times. However, > I don't really understand why this helps "+RTS -A32m -n4m" and I'm always > reluctant to sprinkle in magic I don't fully understand. Can anyone help me > understand what this means? > > 2. It seems that the allocation limit is really something I should be > using, but I can't figure out how to successfully add it to my package.yml > with the other options. From the documentation for GHC 8.2, I thought it > needed to look like this but it never works, usually telling me that -A32m > and -n4m are not recognizable flags (how do I add them in to my package.yml > so I don't have to pass them when running the program?): > > ghc-options: > - -threaded > - -rtsopts > - "-with-rtsopts=-N4 -A32m -n4m" > > 3. Finally, the most important question I have is this. When I run this > program on OSX, it runs successfully through to completion. However, *a > few minutes after terminating*, my terminal becomes unresponsive. I use > emacs for my editor, typically launched from a terminal window and that too > becomes unresponsive. This is not a typical outcome for any programs I > write and it happens *every time* I run this particular application, so I > know that this application is to blame. > > The crazy thing is that force quitting the terminal or logging out doesn't > help: I have to actually restart my computer to use the terminal > application again. Other details that may help: > > - This crash happens after the process id for my program has > terminated. > - Watching its progress in HTOP, it never comes close to running out > of memory: the value hovers in the same place. > > I can't really deploy an application that has this potential-crashing > problem, but I don't know to debug this issue. My total stab-in-the-dark > idea is that heap allocations somehow are unrecoverable even after the > process has terminated? Can anyone offer suggestions on things to look for > or ways to debug and/or fix this issue? > > Finally, if anyone has suggestions on better ways to structure my > application or parallelize the slow parts, I'll happily take those. > > Thanks again for reading. I appreciate any suggestions you may have. > > Best, > > -- > Erik Aker > -- Erik Aker -------------- next part -------------- An HTML attachment was scrubbed... URL: From bneijt at gmail.com Mon Jan 22 21:47:50 2018 From: bneijt at gmail.com (Bram Neijt) Date: Mon, 22 Jan 2018 22:47:50 +0100 Subject: [Haskell-cafe] SLURP: a single unified registry for Haskell packages In-Reply-To: References: Message-ID: Great idea, I just have a few (3) questions that I would like to see clarified in the document: 1) I don't understand this URL: GET /package/:pkgname/preferred returns a JSON structure listing all versions Why is it not /package/:pkgname/versions to get a list of versions? What does preferred mean in this context? 2) Must the package URL end with .tar.gz? Stack supports plain tar and zip as well and if we start enforcing this, maybe tar.xz would be a better choice for a new system. 3) Would a contact or e-mail address not be a sensible thing to add to the registration PUT json? This would allow the SLURP trustees to contact somebody, e.g.: {"name": "mypackage", "location": "https://myserver.com/package/mypackage" , "author": "admin at example.com"} Greetings, Bram On Mon, Jan 22, 2018 at 1:44 PM, Simon Peyton Jones via Haskell-Cafe wrote: > Friends > > Hackage has been extraordinarily successful as a single repository through > which to share Haskell packages. It has supported the emergence of variety > of tools to locate Haskell packages, build them and install them > (cabal-install, Stack, Nix, ...). But in recent years there has been > increasing friction over, > > Hackage’s policies, especially concerning version bounds; > Hackage's guarantees, especially around durability of package content and > metadata; > Hackage's features, especially the visual presentation and package > documentation. > > If we do not resolve this friction, it seems likely that the Haskell library > ecosystem will soon “fork”, with two separate repositories, one optimised > for Cabal and one for Stack. This would be extremely counter-productive for > Haskell users. > > Thus motivated, over the last few months we have talked a lot to colleagues, > including ones in the Hackage and Stack communities. We have emerged with > SLURP, a proposal that could go a long way towards supporting the upsides of > a diverse ecosystem, without the sad downsides of forking into > mutually-exclusive sub-communities. > > Here is the SLURP proposal. We invite the Haskell community to debate it. > > SLURP is meant to enable both Hackage and Stackage (and perhaps more > services in the future) to in the future make choices autonomously without > hurting other package services. But it will only work if the implementors of > both Hackage and Stackage are willing to participate. We respect their > autonomy in this matter, but we urge them to give this proposal serious > consideration in the best interests of the community and Haskell's success. > We have carefully designed SLURP to be as minimal and non-invasive as > possible, so that it can be adopted without much trouble. Of course, we are > open to debate about the specific details. > > We do have an offer from someone willing to implement SLURP. > > We also strongly urge members of the community to express clear views about > the importance --- or otherwise --- of adopting something like SLURP. You > are, after all, the community that GHC, Hackage, Stackage, Cabal, etc are > designed to serve, so your views about what best meets your needs are > critically important. > > Mathieu Boespflug (@mboes) > Manuel Chakravarty (@mchakravarty) > Simon Marlow (@simonmar) > Simon Peyton Jones (@simonpj) > Alan Zimmerman (@alanz) > > > > > _______________________________________________ > 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 mail at joachim-breitner.de Mon Jan 22 23:12:37 2018 From: mail at joachim-breitner.de (Joachim Breitner) Date: Mon, 22 Jan 2018 18:12:37 -0500 Subject: [Haskell-cafe] SLURP: a single unified registry for Haskell packages In-Reply-To: References: Message-ID: <1516662757.1033.8.camel@joachim-breitner.de> Hi, > Here is the SLURP proposal. We invite the Haskell community to debate > it. for those who did not find it: The “official” discussion is happening here: https://github.com/haskell/ecosystem-proposals/pull/4 (good luck catching up with reading that…) Joachim -- Joachim Breitner mail at joachim-breitner.de http://www.joachim-breitner.de/ -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 833 bytes Desc: This is a digitally signed message part URL: From jm at alliot.org Tue Jan 23 13:35:04 2018 From: jm at alliot.org (Jean-Marc Alliot) Date: Tue, 23 Jan 2018 14:35:04 +0100 Subject: [Haskell-cafe] I really don't understand this Message-ID: I apologize if my question is stupid, but here is a simple Haskell program which never stops. However, if I comment the line (which is apparently useless): v<-acc The program works like a charm... I am using GHC 8.0.2 (debian sid) and multiset 0.3.3. If anyone has an idea, I would gladly hear it. Thanks in advance PS: don't try to understand what the program is doing; it is just the reduction to a few lines of a much larger code; I have tried to find a smaller subset which is not working "properly". PPS: The program can also be downloaded from: http://www.alliot.fr/tmp/example.hs import qualified Data.IntMultiSet as IMS b :: IMS.IntMultiSet b = IMS.fromList ([1, 2, 3, 4]) search :: IMS.IntMultiSet -> Int -> IO Bool search mynumbers nb = ins mynumbers (return False) where ins numbers acc = do v <- acc IMS.fold (\x acc1 -> let numbers2 = IMS.delete x numbers in IMS.fold (\y acc2 -> let numbers3 = IMS.delete y numbers2 res = x + y in if res == nb then (return True) else ins (IMS.insert res numbers3) acc2) acc1 numbers2) acc numbers main = do v <- search b 999999999 print v From lysxia at gmail.com Tue Jan 23 15:03:58 2018 From: lysxia at gmail.com (Li-yao Xia) Date: Tue, 23 Jan 2018 10:03:58 -0500 Subject: [Haskell-cafe] I really don't understand this In-Reply-To: References: Message-ID: <25ccfa3c-0d2d-2f8e-a4d6-fec12c453a6f@gmail.com> Bonjour Jean-Marc, "acc" contains the computation of the whole search up to a point. Calling it once (as part of the fold) makes it grow linearly in the size of the search space, but calling it twice (once more as "v <- acc") makes it grow exponentially. Cordialement, Li-yao On 01/23/2018 08:35 AM, Jean-Marc Alliot wrote: > I apologize if my question is stupid, but here is a simple Haskell > program which never stops. > > However, if I comment the line (which is apparently useless): > v<-acc > The program works like a charm... > > I am using GHC 8.0.2 (debian sid) and multiset 0.3.3. If anyone has an > idea,  I would gladly hear it. > > Thanks in advance > > PS: don't try to understand what the program is doing; it is just the > reduction to a few lines of a much larger code; I have tried to find a > smaller subset which is not working "properly". >  PPS: The program can also be downloaded from: > http://www.alliot.fr/tmp/example.hs > > import qualified Data.IntMultiSet as IMS > > b :: IMS.IntMultiSet > b = IMS.fromList ([1, 2, 3, 4]) > > search :: IMS.IntMultiSet -> Int -> IO Bool > search mynumbers nb = ins mynumbers (return False) >   where >     ins numbers acc = do >       v <- acc >       IMS.fold >         (\x acc1 -> >            let numbers2 = IMS.delete x numbers >             in IMS.fold >                  (\y acc2 -> >                     let numbers3 = IMS.delete y numbers2 >                         res = x + y >                      in if res == nb >                           then (return True) >                           else ins (IMS.insert res numbers3) acc2) >                  acc1 >                  numbers2) >         acc >         numbers > > main = do >   v <- search b 999999999 >   print v > _______________________________________________ > 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 jm at alliot.org Tue Jan 23 19:39:40 2018 From: jm at alliot.org (Jean-Marc Alliot) Date: Tue, 23 Jan 2018 20:39:40 +0100 Subject: [Haskell-cafe] I really don't understand this In-Reply-To: <25ccfa3c-0d2d-2f8e-a4d6-fec12c453a6f@gmail.com> References: <25ccfa3c-0d2d-2f8e-a4d6-fec12c453a6f@gmail.com> Message-ID: <1ec1bca1-6824-f4a9-9fb1-01f90f7aaad9@alliot.org> Thank you very much for your answer, but I still don't get it (I might be not bright enough :-)) I rewrote the program to suppress all syntactic sugar; for me, the value of the first argument of >>= is never used, so I can't see why it changes anything to put acc as the first argument or anything else (such as return false for example...). I would really appreciate a pointer to a chapter of any manual or introduction to Haskell which would be able to explain why with acc as first argument of (>==) the program runs at least 2 hours (I stopped it after 2 hours) and with (return False) it takes less than one second, while the actual value of the first argument of (>>=) is meaningless. Thanks again for answering import qualified Data.IntMultiSet as IMS b :: IMS.IntMultiSet b = IMS.fromList ([1, 2, 3, 4]) search2 :: IMS.IntMultiSet -> Int -> IO Bool search2 mynumbers nb = ins mynumbers (return False) where ins numbers acc = (>>=) acc (\_ -> IMS.fold (\x acc1 -> let numbers2 = IMS.delete x numbers in IMS.fold (\y acc2 -> let numbers3 = IMS.delete y numbers2 res = x + y in if res == nb then (return True) else ins (IMS.insert res numbers3) acc2) acc1 numbers2) acc numbers) main = do v <- search2 b 999999999 print v Le 23/01/2018 à 16:03, Li-yao Xia a écrit : > Bonjour Jean-Marc, > > "acc" contains the computation of the whole search up to a point. > Calling it once (as part of the fold) makes it grow linearly in the > size of the search space, but calling it twice (once more as "v <- > acc") makes it grow exponentially. > > Cordialement, > Li-yao > > On 01/23/2018 08:35 AM, Jean-Marc Alliot wrote: >> I apologize if my question is stupid, but here is a simple Haskell >> program which never stops. >> >> However, if I comment the line (which is apparently useless): >> v<-acc >> The program works like a charm... >> >> I am using GHC 8.0.2 (debian sid) and multiset 0.3.3. If anyone has >> an idea, I would gladly hear it. >> >> Thanks in advance >> >> PS: don't try to understand what the program is doing; it is just the >> reduction to a few lines of a much larger code; I have tried to find >> a smaller subset which is not working "properly". >> PPS: The program can also be downloaded from: >> http://www.alliot.fr/tmp/example.hs >> >> import qualified Data.IntMultiSet as IMS >> >> b :: IMS.IntMultiSet >> b = IMS.fromList ([1, 2, 3, 4]) >> >> search :: IMS.IntMultiSet -> Int -> IO Bool >> search mynumbers nb = ins mynumbers (return False) >> where >> ins numbers acc = do >> v <- acc >> IMS.fold >> (\x acc1 -> >> let numbers2 = IMS.delete x numbers >> in IMS.fold >> (\y acc2 -> >> let numbers3 = IMS.delete y numbers2 >> res = x + y >> in if res == nb >> then (return True) >> else ins (IMS.insert res numbers3) acc2) >> acc1 >> numbers2) >> acc >> numbers >> >> main = do >> v <- search b 999999999 >> print v >> _______________________________________________ >> 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 david.feuer at gmail.com Tue Jan 23 20:19:50 2018 From: david.feuer at gmail.com (David Feuer) Date: Tue, 23 Jan 2018 15:19:50 -0500 Subject: [Haskell-cafe] ANN: containers-0.5.11.0 Message-ID: We have just released containers version 0.5.11.0. This is the first release since Matt Renaud joined the maintenance team. Matt has focused on documentation, code quality, and testing, and made some substantial contributions in these areas. This release comes with quite a few new functions and instances, written by quite a few different contributors. It also includes a complete overhaul of the sorting machinery in Data.Sequence thanks to Donnacha Oisín Kidney. And Matt Renaud has launched a brand new set of tutorial documentation at https://haskell-containers.readthedocs.io/en/latest/ Many thanks to all the contributors who made this release possible! The complete changelog can be found below. David Feuer Matt Renaud Wren Romano New functions and class instances * Add a `MonadFix` instance for `Data.Sequence`. * Add a `MonadFix` instance for `Data.Tree`. * Add `powerSet`, `cartesianProduct`, and `disjointUnion` for `Data.Set`. (Thanks, Edward Kmett.) * Add `disjoint` for `Data.Set` and `Data.IntSet`. (Thanks, Víctor López Juan.) * Add `lookupMin` and `lookupMax` to `Data.IntMap`. (Thanks, bwroga.) * Add `unzip` and `unzipWith` to `Data.Sequence`. Make unzipping build its results in lockstep to avoid certain space leaks. * Add carefully optimized implementations of `sortOn` and `unstableSortOn` to `Data.Sequence`. (Thanks, Donnacha Oisín Kidney.) Changes to existing functions and features * Make `Data.Sequence.replicateM` a synonym for `replicateA` for post-AMP `base`. * Rewrite the `IsString` instance head for sequences, improving compatibility with the list instance and also improving type inference. We used to have instance IsString (Seq Char) Now we commit more eagerly with instance a ~ Char => IsString (Seq a) * Make `>>=` for `Data.Tree` strict in the result of its second argument; being too lazy here is almost useless, and violates one of the monad identity laws. Specifically, `return () >>= \_ -> undefined` should always be `undefined`, but this was not the case. * Harmonize laziness details for `minView` and `maxView` between `Data.IntMap` and `Data.Map`. Performance improvement * Speed up both stable and unstable sorting for `Data.Sequence` (Thanks, Donnacha Oisín Kidney.) Other changes * Update for recent and upcoming GHC and Cabal versions (Thanks, Herbert Valerio Reidel, Simon Jakobi, and Ryan Scott.) * Improve external and internal documentation (Thanks, Oleg Grenrus and Benjamin Hodgson.) * Add tutorial-style documentation. * Add Haddock `@since` annotations for changes made since version 0.5.4 (Thanks, Simon Jakobi.) * Add a (very incomplete) test suite for `Data.Tree`. * Add structural validity checks to the test suites for `Data.IntMap` and `Data.IntSet` (Thanks to Joachim Breitner for catching an error in a first draft.) From ollie at ocharles.org.uk Tue Jan 23 20:41:26 2018 From: ollie at ocharles.org.uk (Oliver Charles) Date: Tue, 23 Jan 2018 20:41:26 +0000 Subject: [Haskell-cafe] ANN: containers-0.5.11.0 In-Reply-To: References: Message-ID: Lots of goodies here! Thank you for all your hard-work, everyone! On Tue, Jan 23, 2018 at 8:19 PM, David Feuer wrote: > We have just released containers version 0.5.11.0. This is the first > release since Matt Renaud joined the maintenance team. Matt has > focused on documentation, code quality, and testing, and made some > substantial contributions in these areas. > > This release comes with quite a few new functions and instances, > written by quite a few different contributors. It also includes a > complete overhaul of the sorting machinery in Data.Sequence thanks to > Donnacha Oisín Kidney. And Matt Renaud has launched a brand new set of > tutorial documentation at > https://haskell-containers.readthedocs.io/en/latest/ > > Many thanks to all the contributors who made this release possible! > The complete changelog can be found below. > > David Feuer > Matt Renaud > Wren Romano > > > New functions and class instances > > * Add a `MonadFix` instance for `Data.Sequence`. > > * Add a `MonadFix` instance for `Data.Tree`. > > * Add `powerSet`, `cartesianProduct`, and `disjointUnion` for > `Data.Set`. (Thanks, Edward Kmett.) > > * Add `disjoint` for `Data.Set` and `Data.IntSet`. (Thanks, Víctor López > Juan.) > > * Add `lookupMin` and `lookupMax` to `Data.IntMap`. (Thanks, bwroga.) > > * Add `unzip` and `unzipWith` to `Data.Sequence`. Make unzipping > build its results in lockstep to avoid certain space leaks. > > * Add carefully optimized implementations of `sortOn` and `unstableSortOn` > to `Data.Sequence`. (Thanks, Donnacha Oisín Kidney.) > > Changes to existing functions and features > > * Make `Data.Sequence.replicateM` a synonym for `replicateA` > for post-AMP `base`. > > * Rewrite the `IsString` instance head for sequences, improving > compatibility > with the list instance and also improving type inference. We used to have > > instance IsString (Seq Char) > > Now we commit more eagerly with > > instance a ~ Char => IsString (Seq a) > > * Make `>>=` for `Data.Tree` strict in the result of its second argument; > being too lazy here is almost useless, and violates one of the monad > identity > laws. Specifically, `return () >>= \_ -> undefined` should always be > `undefined`, but this was not the case. > > * Harmonize laziness details for `minView` and `maxView` between > `Data.IntMap` and `Data.Map`. > > Performance improvement > > * Speed up both stable and unstable sorting for `Data.Sequence` > (Thanks, Donnacha Oisín Kidney.) > > Other changes > > * Update for recent and upcoming GHC and Cabal versions (Thanks, Herbert > Valerio Reidel, Simon Jakobi, and Ryan Scott.) > > * Improve external and internal documentation (Thanks, Oleg Grenrus > and Benjamin Hodgson.) > > * Add tutorial-style documentation. > > * Add Haddock `@since` annotations for changes made since version > 0.5.4 (Thanks, Simon Jakobi.) > > * Add a (very incomplete) test suite for `Data.Tree`. > > * Add structural validity checks to the test suites for `Data.IntMap` > and `Data.IntSet` (Thanks to Joachim Breitner for catching an error > in a first draft.) > _______________________________________________ > 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 lysxia at gmail.com Tue Jan 23 21:08:16 2018 From: lysxia at gmail.com (Li-yao Xia) Date: Tue, 23 Jan 2018 16:08:16 -0500 Subject: [Haskell-cafe] I really don't understand this In-Reply-To: <1ec1bca1-6824-f4a9-9fb1-01f90f7aaad9@alliot.org> References: <25ccfa3c-0d2d-2f8e-a4d6-fec12c453a6f@gmail.com> <1ec1bca1-6824-f4a9-9fb1-01f90f7aaad9@alliot.org> Message-ID: Hi, On 01/23/2018 02:39 PM, Jean-Marc Alliot wrote: > Thank you very much for your answer, but I still don't get it (I might > be not bright enough :-)) > Not at all! This is definitely not an obvious problem. > I rewrote the program to suppress all syntactic sugar; for me, the value > of the first argument of >>= is never used, so I can't see why it > changes anything to put acc as the first argument or anything else (such > as return false for example...). > You can erase (acc :: IO Bool) only if acc is in fact pure (i.e., acc = return b), but how would GHC deduce such a fact? - inlining could take care of it on a case-by-case basis at each call site, but ins is recursive, which prevents inlining; - a more general solution for recursive definitions might be some kind of static analysis, that GHC doesn't do; - using Identity instead of IO, then all computations must be pure, and in fact the optimization would apply automatically as a consequence of the lazy (>>=) for Identity. > I would really appreciate a pointer to a chapter of any manual or > introduction to Haskell which would be able to explain why with acc as > first argument of (>==) the program runs at least 2 hours (I stopped it > after 2 hours) and with (return False) it takes less than one second, > while the actual value of the first argument of (>>=) is meaningless. > I don't have any good pointers unfortunately. But it may help to expand the folds. ins {1,2,3} acc = do acc ins {1+2,3} (ins {1+3,2} (ins {2+1,3} (... (ins {3+2, 1} acc)))) For the first recursive call to ins... ins {1+2,3} acc1 = do acc1 ins {1+2+3} (ins {3+1+2} acc1) ... substitute that in the former (acc1 = ins {1+3,2} (ins {2+1,3} (... acc))) ins {1,2,3} acc = do acc (ins {1+3,2} (... acc)) ins {1+2+3} (ins {3+1+2} (ins {1+3,2} (... acc))) etc. Li-yao From noonslists at gmail.com Wed Jan 24 03:28:06 2018 From: noonslists at gmail.com (Noon van der Silk) Date: Wed, 24 Jan 2018 14:28:06 +1100 Subject: [Haskell-cafe] SLURP: a single unified registry for Haskell packages In-Reply-To: <1516662757.1033.8.camel@joachim-breitner.de> References: <1516662757.1033.8.camel@joachim-breitner.de> Message-ID: i propose we refer to this event as the "slurpocalypse". On Tue, Jan 23, 2018 at 10:12 AM, Joachim Breitner wrote: > Hi, > > > Here is the SLURP proposal. We invite the Haskell community to debate > > it. > > for those who did not find it: The “official” discussion is happening > here: > https://github.com/haskell/ecosystem-proposals/pull/4 > > (good luck catching up with reading that…) > > Joachim > > > -- > Joachim Breitner > mail at joachim-breitner.de > http://www.joachim-breitner.de/ > > _______________________________________________ > 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. > -- Noon Silk, ن https://silky.github.io/ "Every morning when I wake up, I experience an exquisite joy — the joy of being this signature." -------------- next part -------------- An HTML attachment was scrubbed... URL: From wbdehaas at gmail.com Wed Jan 24 12:10:15 2018 From: wbdehaas at gmail.com (Bas de Haas) Date: Wed, 24 Jan 2018 13:10:15 +0100 Subject: [Haskell-cafe] Coding Haskell in a music start-up? Message-ID: Dear Haskellers, Chordify is hiring! Chordify is a young and fast growing music e-learning platform that helps musicians to play their favorite music. We automatically analyse the chords of a piece of music and display them in an intuitive player. Try it yourself at: https://chordify.net/ or download one of our apps https://chordify.net/app The cool thing is: our backend serving our apps and website has been written almost exclusively in Haskell. We hope to broaden our team with a functional programmer and a front-end developer. We are looking for people who are pro-active, independent, and creative to improve Chordify. You’d work in a small team of dedicated people with various backgrounds in which you can make a difference. If you are interested in working at Chordify, you can find the details here: https://chordify.homerun.co/ All the best, Bas de Haas From jm at alliot.org Wed Jan 24 17:02:29 2018 From: jm at alliot.org (Jean-Marc Alliot) Date: Wed, 24 Jan 2018 18:02:29 +0100 Subject: [Haskell-cafe] I really don't understand this In-Reply-To: References: <25ccfa3c-0d2d-2f8e-a4d6-fec12c453a6f@gmail.com> <1ec1bca1-6824-f4a9-9fb1-01f90f7aaad9@alliot.org> Message-ID: First thanks again for the answer, I really appreciate. However, I am still a little bit in doubt, so I decided to write an ocaml search2 function which is almost an exact copy/paste of the Haskell function, including an IO monad implemented in ocaml (included below; I am much more fluent in caml that I have been using for 20 years than I am in Haskell, as you might have guessed). In ocaml, there is no problem at all and everything is running as I expect it to run. I can access and even print the value of acc without modifying the behaviour of the program. The main difference I am aware of is that Haskell is lazy while ocaml is not. So is my interpretation correct if I say that Hakell lazyness is the reason why the Haskell program behaves "oddly" (according to my standards of course, there is no judgement value here)? And if it is so, is it possible to force the evaluation in order to have a program which doesn't run forever just because I am accessing an object? I presume I am still confused and I might be wrong, so thanks again for helping. module IOMonad = struct type 'a t = IO of 'a;; let return x = IO x;; let (>>=) (IO m) (f : ('a -> 'b t)) = (f m);; end;; open IOMonad;; module IMS = CCMultiSet.Make(struct type t = int let compare = compare end);; let delete x s = IMS.remove s x;; let insert x s = IMS.add s x;; let fold f b s = let f2 b n t = f t b in IMS.fold s b f2;; let fromlist = IMS.of_list ;; let search2 mynumbers nb = let rec ins numbers acc = (>>=) acc (fun v -> (* Printf.printf "%b\n" v; *) fold (fun x acc1 -> let numbers2 = delete x numbers in fold (fun y acc2 -> let numbers3 = delete y numbers2 and res = x + y in if res = nb then (return true) else ins (insert res numbers3) acc2) acc1 numbers2) acc numbers) in ins mynumbers (return false);; let b = fromlist [1;2;3;4];; let main = (>>=) (search2 b 99999999) (fun v -> return (if v then Printf.printf "True\n" else Printf.printf "False\n"));; Le 23/01/2018 à 22:08, Li-yao Xia a écrit : > Hi, > > On 01/23/2018 02:39 PM, Jean-Marc Alliot wrote: >> Thank you very much for your answer, but I still don't get it (I >> might be not bright enough :-)) >> > > Not at all! This is definitely not an obvious problem. > >> I rewrote the program to suppress all syntactic sugar; for me, the >> value of the first argument of >>= is never used, so I can't see why >> it changes anything to put acc as the first argument or anything else >> (such as return false for example...). >> > > You can erase (acc :: IO Bool) only if acc is in fact pure (i.e., acc > = return b), but how would GHC deduce such a fact? > > - inlining could take care of it on a case-by-case basis at each call > site, but ins is recursive, which prevents inlining; > > - a more general solution for recursive definitions might be some kind > of static analysis, that GHC doesn't do; > > - using Identity instead of IO, then all computations must be pure, > and in fact the optimization would apply automatically as a > consequence of the lazy (>>=) for Identity. > >> I would really appreciate a pointer to a chapter of any manual or >> introduction to Haskell which would be able to explain why with acc >> as first argument of (>==) the program runs at least 2 hours (I >> stopped it after 2 hours) and with (return False) it takes less than >> one second, while the actual value of the first argument of (>>=) is >> meaningless. >> > > I don't have any good pointers unfortunately. > > But it may help to expand the folds. > > ins {1,2,3} acc = do > acc > ins {1+2,3} (ins {1+3,2} (ins {2+1,3} (... (ins {3+2, 1} acc)))) > > For the first recursive call to ins... > > ins {1+2,3} acc1 = do > acc1 > ins {1+2+3} (ins {3+1+2} acc1) > > ... substitute that in the former (acc1 = ins {1+3,2} (ins {2+1,3} > (... acc))) > > ins {1,2,3} acc = do > acc > (ins {1+3,2} (... acc)) > ins {1+2+3} (ins {3+1+2} (ins {1+3,2} (... acc))) > > etc. > > Li-yao From lysxia at gmail.com Wed Jan 24 17:52:24 2018 From: lysxia at gmail.com (Li-yao Xia) Date: Wed, 24 Jan 2018 12:52:24 -0500 Subject: [Haskell-cafe] I really don't understand this In-Reply-To: References: <25ccfa3c-0d2d-2f8e-a4d6-fec12c453a6f@gmail.com> <1ec1bca1-6824-f4a9-9fb1-01f90f7aaad9@alliot.org> Message-ID: <25dac0cc-5eac-e906-8b9b-8a8c1e88e95f@gmail.com> Hi, On 01/24/2018 12:02 PM, Jean-Marc Alliot wrote: > First thanks again for the answer, I really appreciate. > You're welcome, I'm happy to help! > module IOMonad = struct >   type 'a t = IO of 'a;; >   let return x = IO x;; >   let (>>=) (IO m) (f : ('a -> 'b t)) = (f m);; > end;; > open IOMonad;; The closest thing to Haskell's (IO a) in OCaml is (unit -> 'a). module IOMonad = struct type 'a t = unit -> 'a let return x = fun () -> x let (>>=) m f = fun () -> f (m ()) () end I believe that definition will result in the same looping behavior as with the original Haskell program. It's not really a matter of laziness, but more of (im)purity. In OCaml, functions can have side effects. In Haskell, we must write pure functions that return an effectful computation as a value. In particular, we have the following property in Haskell: let a = print 1 in a >> a -- a :: IO () is equivalent to print 1 >> print 1 because "a" stands for the computation that prints 1 and returns (). Whereas in OCaml: let a = print_int 1 in a; a is not equivalent to print_int 1; print_int 1 here "a" just stands for (), and the effect is performed before it is evaluated. But we can define (print : int -> IO.t ()) as (let print n () = print_int n) in OCaml, with compositional properties similar to Haskell's print. Li-yao From eraker at gmail.com Wed Jan 24 21:52:17 2018 From: eraker at gmail.com (erik) Date: Wed, 24 Jan 2018 13:52:17 -0800 Subject: [Haskell-cafe] Large JSON File Processing In-Reply-To: References: Message-ID: With Michael Snoyman's help, I rewrote my Conduit version of the application (without using stm-conduit). This was a large improvement: my first Conduit version was operating over all data and I didn't realize this. I also increased the nursery size. My revised function ended up looking like this: module Search where import Conduit ((.|))import qualified Conduit as Cimport Control.Monadimport Control.Monad.IO.Class (MonadIO, liftIO)import Control.Monad.Trans.Resource (MonadResource)import qualified Data.ByteString as Bimport Data.List (isPrefixOf)import Data.Maybe (fromJust, isJust)import System.Path.NameManip (guess_dotdot, absolute_path)import System.FilePath (addTrailingPathSeparator, normalise)import System.Directory (getHomeDirectory) import Filters sourceFilesFilter :: (MonadResource m, MonadIO m) => ProjectFilter -> FilePath -> C.ConduitM () String m () sourceFilesFilter projFilter dirname' = C.sourceDirectoryDeep False dirname' .| parseProject projFilter parseProject :: (MonadResource m, MonadIO m) => ProjectFilter -> C.ConduitM FilePath String m () parseProject (ProjectFilter filterFunc) = do C.awaitForever go where go path' = do bytes <- liftIO $ B.readFile path' let isProj = validProject bytes when (isJust isProj) $ do let proj' = fromJust isProj when (filterFunc proj') $ C.yield path' My main just runs the conduit and prints those that pass the filter: mainStreamingConduit :: IO () mainStreamingConduit = do options <- getRecord "Search JSON Files" let filterFunc = makeProjectFilter options searchDir <- absolutize (searchPath options) itExists <- doesDirectoryExist searchDir case itExists of False -> putStrLn "Search Directory does not exist" >> exitWith (ExitFailure 1) True -> C.runConduitRes $ sourceFilesFilter filterFunc searchDir .| C.mapM_ (liftIO . putStrLn) I run it like this (without the stats, typically): stack exec search-json -- --searchPath $FILES --name NAME +RTS -s -A32m -n4m Without increasing nursery size, I get a productivity around 30%. With the above, however, it looks like this: 72,308,248,744 bytes allocated in the heap 733,911,752 bytes copied during GC 7,410,520 bytes maximum residency (8 sample(s)) 863,480 bytes maximum slop 187 MB total memory in use (27 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 580 colls, 580 par 2.731s 0.772s 0.0013s 0.0105s Gen 1 8 colls, 7 par 0.163s 0.044s 0.0055s 0.0109s Parallel GC work balance: 35.12% (serial 0%, perfect 100%) TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.001s ( 0.006s elapsed) MUT time 26.155s ( 31.602s elapsed) GC time 2.894s ( 0.816s elapsed) EXIT time -0.003s ( 0.008s elapsed) Total time 29.048s ( 32.432s elapsed) Alloc rate 2,764,643,665 bytes per MUT second Productivity 90.0% of total user, 97.5% of total elapsed gc_alloc_block_sync: 3494 whitehole_spin: 0 gen[0].sync: 15527 gen[1].sync: 177 I'd still like to figure out how to parallelize the filterProj . parseJson . readFile part, but for now I'm satisfied with what I have. (I also isolated my crashing to another process launched from the same terminal window.) On Sun, Jan 21, 2018 at 10:12 PM, Michael Snoyman wrote: > I just wanted to comment on the conduit aspect of this in particular. > Looking at your first version: > > conduitFilesFilter :: ProjectFilter -> Path Abs Dir -> IO [Path Abs File] > conduitFilesFilter projFilter dirname' = do > (_, allFiles) <- listDirRecur dirname' > C.runConduit $ > C.yieldMany allFiles > .| C.filterMC (filterMatchingFile projFilter) > .| C.sinkList > > > This isn't taking full advantage of conduit: you're reading in a list of > the files in the file system, instead of streaming those values. And the > output is a list of `String`, instead of streaming out those `String`s. > More idiomatic would look something like: > > sourceFilesFilter projFilter dirname' = > sourceDirectoryDeep False dirname' .| filterMC (filterMatchingFile > projFilter) > > And then, wherever you're consuming the output, to do so in a streaming > fashion, e.g.: > > runConduitRes $ sourceFilesFilter projFilter dirname' .| mapM_C print > > This should help with the increasing memory usage, though it will do > nothing about the runtime overhead of parsing the JSON itself. > > On Mon, Jan 22, 2018 at 1:38 AM, erik wrote: > >> Hello Haskell Cafe, >> >> I have written a small, pretty simple program but I am finding it hard to >> reason about its behavior (and also about the best way to do what I want), >> so I would like to ask you all for some suggestions. >> >> For reference, here's a Stack Overflow question >> >> where I described what's going on, but I'll also describe it below. >> >> My program does the following: >> >> 1. Recursively list a directory, >> 2. Parse the JSON files from the directory list into identifiable >> objects/records, >> 3. Look for matching key-value pairs, and >> 4. Return filenames where matches have been found. >> >> A few details for more context: >> >> - I have to filter between 500,000 and 1 million files (I'm typically >> trying to reduce down to between 1,000 and 40,000 that represent a >> particular project). I usually just need the filenames. >> - Each file is quite large, some of them 5mb or 10mb, and it's not >> uncommon for them to have deeply nested keys (40,000 keys or so). >> >> My first version of this program was simple, synchronous, and as >> straightforward as I could come up with. However, the memory usage >> increased monotonically. Profiling, I found that most of the time was spent >> in JSON-parsing into Objects before my code could turn the objects into >> records (also, as you might imagine, tons of time in garbage collection). >> >> For my second version, I switched to conduit and it seemed to solve the >> increasing memory issue. My core function now looked like this: >> >> conduitFilesFilter :: ProjectFilter -> Path Abs Dir -> IO [Path Abs File] >> conduitFilesFilter projFilter dirname' = do >> (_, allFiles) <- listDirRecur dirname' >> C.runConduit $ >> C.yieldMany allFiles >> .| C.filterMC (filterMatchingFile projFilter) >> .| C.sinkList >> >> >> This was still slow and certainly still synchronous. What I really wanted >> was to run that "filterMatchingFile..." part in parallel across a number of >> CPUs. As an aside, my filtering function looks like this: >> >> filterMatchingFile :: ProjectFilter -> Path Abs File -> IO Bool >> filterMatchingFile (ProjectFilter filterFunc) fpath = do >> let fp = toFilePath fpath >> bs <- B.readFile fp >> case validImplProject bs of -- this is pretty much just `decodeStrict` >> Nothing -> pure False >> (Just proj') -> pure $ filterFunc proj' >> >> Here are the stats from running this: >> >> 115,961,554,600 bytes allocated in the heap >> 35,870,639,768 bytes copied during GC >> 56,467,720 bytes maximum residency (681 sample(s)) >> 1,283,008 bytes maximum slop >> 145 MB total memory in use (0 MB lost due to fragmentation) >> >> Tot time (elapsed) Avg pause Max pause >> Gen 0 108716 colls, 108716 par 76.915s 20.571s 0.0002s 0.0266s >> Gen 1 681 colls, 680 par 0.530s 0.147s 0.0002s 0.0009s >> >> Parallel GC work balance: 14.99% (serial 0%, perfect 100%) >> >> TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) >> >> SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) >> >> INIT time 0.001s ( 0.007s elapsed) >> MUT time 34.813s ( 42.938s elapsed) >> GC time 77.445s ( 20.718s elapsed) >> EXIT time 0.000s ( 0.010s elapsed) >> Total time 112.260s ( 63.672s elapsed) >> >> Alloc rate 3,330,960,996 bytes per MUT second >> >> Productivity 31.0% of total user, 67.5% of total elapsed >> >> gc_alloc_block_sync: 188614 >> whitehole_spin: 0 >> gen[0].sync: 33 >> gen[1].sync: 811204 >> >> >> I thought about writing a plainer (non-conduit) parallel version but I >> was afraid of the memory issue. I tried to write a Conduit-plus-channels >> version but it didn't work. >> >> Finally, I wrote a version using stm-conduit, which I thought might be a >> bit more efficient. It seems to be slightly better, but it's not really the >> kind of parallelization I was imagining: >> >> conduitAsyncFilterFiles :: ProjectFilter -> Path Abs Dir -> IO [String] >> conduitAsyncFilterFiles projFilter dirname' = do >> (_, allFiles) <- listDirRecur dirname' >> buffer 10 >> (C.yieldMany allFiles >> .| (C.mapMC (readFileWithPath . toFilePath))) >> (C.mapC (filterProjForFilename projFilter) >> .| C.filterC isJust >> .| C.mapC fromJust >> .| C.sinkList) >> >> The first conduit passed to `buffer` does something like the following: parseStrict >> . B.readFile. >> >> This still wasn't too great, but after reading about handing garbage >> collection in smarter ways, I found that I could run my application like >> this: >> >> stack exec search-json -- --searchPath $FILES --name hello +RTS -s -A32m -n4m >> >> And the "productivity" would shoot up quite a lot presumably because I'm >> doing less frequent garbage collection. My program also got a bit faster: >> >> 36,379,265,096 bytes allocated in the heap >> 1,238,438,160 bytes copied during GC >> 22,996,264 bytes maximum residency (85 sample(s)) >> 3,834,152 bytes maximum slop >> 207 MB total memory in use (14 MB lost due to fragmentation) >> >> Tot time (elapsed) Avg pause Max pause >> Gen 0 211 colls, 211 par 1.433s 0.393s 0.0019s 0.0077s >> Gen 1 85 colls, 84 par 0.927s 0.256s 0.0030s 0.0067s >> >> Parallel GC work balance: 67.93% (serial 0%, perfect 100%) >> >> TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) >> >> SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) >> >> INIT time 0.001s ( 0.004s elapsed) >> MUT time 12.636s ( 12.697s elapsed) >> GC time 2.359s ( 0.650s elapsed) >> EXIT time -0.015s ( 0.003s elapsed) >> Total time 14.982s ( 13.354s elapsed) >> >> Alloc rate 2,878,972,840 bytes per MUT second >> >> Productivity 84.2% of total user, 95.1% of total elapsed >> >> gc_alloc_block_sync: 9612 >> whitehole_spin: 0 >> gen[0].sync: 2044 >> gen[1].sync: 47704 >> >> >> Thanks for reading thus far. I now have three questions. >> >> 1. I understand that my program necessarily creates tons of garbage >> because it parses and then throws away 5mb of JSON 500,000 times. However, >> I don't really understand why this helps "+RTS -A32m -n4m" and I'm >> always reluctant to sprinkle in magic I don't fully understand. Can anyone >> help me understand what this means? >> >> 2. It seems that the allocation limit is really something I should be >> using, but I can't figure out how to successfully add it to my package.yml >> with the other options. From the documentation for GHC 8.2, I thought it >> needed to look like this but it never works, usually telling me that -A32m >> and -n4m are not recognizable flags (how do I add them in to my package.yml >> so I don't have to pass them when running the program?): >> >> ghc-options: >> - -threaded >> - -rtsopts >> - "-with-rtsopts=-N4 -A32m -n4m" >> >> 3. Finally, the most important question I have is this. When I run this >> program on OSX, it runs successfully through to completion. However, *a >> few minutes after terminating*, my terminal becomes unresponsive. I use >> emacs for my editor, typically launched from a terminal window and that too >> becomes unresponsive. This is not a typical outcome for any programs I >> write and it happens *every time* I run this particular application, so >> I know that this application is to blame. >> >> The crazy thing is that force quitting the terminal or logging out >> doesn't help: I have to actually restart my computer to use the terminal >> application again. Other details that may help: >> >> - This crash happens after the process id for my program has >> terminated. >> - Watching its progress in HTOP, it never comes close to running out >> of memory: the value hovers in the same place. >> >> I can't really deploy an application that has this potential-crashing >> problem, but I don't know to debug this issue. My total stab-in-the-dark >> idea is that heap allocations somehow are unrecoverable even after the >> process has terminated? Can anyone offer suggestions on things to look for >> or ways to debug and/or fix this issue? >> >> Finally, if anyone has suggestions on better ways to structure my >> application or parallelize the slow parts, I'll happily take those. >> >> Thanks again for reading. I appreciate any suggestions you may have. >> >> Best, >> >> -- >> Erik Aker >> >> _______________________________________________ >> 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. >> > > -- Erik Aker -------------- next part -------------- An HTML attachment was scrubbed... URL: From rick at owensmurray.com Thu Jan 25 01:12:06 2018 From: rick at owensmurray.com (Rick Owens) Date: Wed, 24 Jan 2018 19:12:06 -0600 Subject: [Haskell-cafe] LTS-10.* missing build-depends suggestion Message-ID: Dear Haskell Café, I am a long-time Haskell developer with a proliferation of private projects. I typically make very heavy use of stack and LTS. Today, I tried to bootstrap my first project using LTS-10.* (with GHC-8.2.2) and I ran into an interesting problem (for me). In the past, with lts-9.* and below, when I started cranking on some code and writing a bunch of imports: > import Control.Monad.Trans.Class (MonadTrans) > import Data.Map (Map) I would try to build first without updating the cabal file build-depends, and I would get something like the following error messages: > /path/to/Module.hs:48:1: error: > Failed to load interface for ‘Data.Map’ > It is a member of the hidden package ‘containers-0.5.7.1’. > Perhaps you need to add ‘containers’ to the build-depends in your .cabal file. > Use -v to see a list of the files searched for. > > /path/to/Module.hs:21:1: error: > Failed to load interface for ‘Control.Monad.Trans.Class’ > It is a member of the hidden package ‘transformers-0.5.2.0’. > Perhaps you need to add ‘transformers’ to the build-depends in your .cabal file. > Use -v to see a list of the files searched for. This was good because the error contained a suggested solution which contained the missing package, and I could sort of lazily add the build-depends I needed without having to memorize a (Module -> Package) mapping. I even had developer tooling to do it automatically. With lts-10.*, however, the analogous error message looks like this: > /path/to/Module.hs:9:1: error: > Could not find module ‘Data.DoubleWord’ > Use -v to see a list of the files searched for. > | > 9 | import Data.DoubleWord (Word256(Word256), Word128(Word128)) > | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ I am wondering, is there a way to bring back the solution suggestion? Not having access to it has made me realize how heavily I was using that feature. What do others think about this missing bit of supplemental error information? Thanks, -Rick Owens -------------- next part -------------- An HTML attachment was scrubbed... URL: From danburton.email at gmail.com Thu Jan 25 02:02:22 2018 From: danburton.email at gmail.com (Dan Burton) Date: Wed, 24 Jan 2018 18:02:22 -0800 Subject: [Haskell-cafe] LTS-10.* missing build-depends suggestion In-Reply-To: References: Message-ID: I believe the particular feature you are talking about is a feature of GHC. Whether a suggestion is show or not merely depends on whether GHC sees the package in question in its package database(s). If you are using stack, then you can look at one of your LTS 9 projects, and run stack exec -- ghc-pkg list In order to see the list of installed packages. (I think something like `cabal exec ghc-pkg list` should do the same for a cabal project.) Identify the packages you tend to use, go into one of your LTS 10 projects, and `stack install pkg1 pkg2 ...` Note that with stack, each minor version of LTS has its own package database, so packages locally installed into lts-10.1 will not necessarily be available in your local instance of lts-10.2. Repeat stack install to taste. tl;dr the trick is to set up your package database so that GHC knows what to suggest for you -- Dan Burton On Wed, Jan 24, 2018 at 5:12 PM, Rick Owens wrote: > Dear Haskell Café, > > I am a long-time Haskell developer with a proliferation of private > projects. I typically make very heavy use of stack and LTS. Today, I tried > to bootstrap my first project using LTS-10.* (with GHC-8.2.2) and I ran > into an interesting problem (for me). > > In the past, with lts-9.* and below, when I started cranking on some code > and writing a bunch of imports: > > > import Control.Monad.Trans.Class (MonadTrans) > > import Data.Map (Map) > > I would try to build first without updating the cabal file build-depends, > and I would get something like the following error messages: > > > /path/to/Module.hs:48:1: error: > > Failed to load interface for ‘Data.Map’ > > It is a member of the hidden package ‘containers-0.5.7.1’. > > Perhaps you need to add ‘containers’ to the build-depends in your > .cabal file. > > Use -v to see a list of the files searched for. > > > > /path/to/Module.hs:21:1: error: > > Failed to load interface for ‘Control.Monad.Trans.Class’ > > It is a member of the hidden package ‘transformers-0.5.2.0’. > > Perhaps you need to add ‘transformers’ to the build-depends in > your .cabal file. > > Use -v to see a list of the files searched for. > > > This was good because the error contained a suggested solution which > contained the missing package, and I could sort of lazily add the > build-depends I needed without having to memorize a (Module -> Package) > mapping. I even had developer tooling to do it automatically. > > With lts-10.*, however, the analogous error message looks like this: > > > /path/to/Module.hs:9:1: error: > > Could not find module ‘Data.DoubleWord’ > > Use -v to see a list of the files searched for. > > | > > 9 | import Data.DoubleWord (Word256(Word256), Word128(Word128)) > > | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ > > I am wondering, is there a way to bring back the solution suggestion? Not > having access to it has made me realize how heavily I was using that > feature. What do others think about this missing bit of supplemental error > information? > > Thanks, > > -Rick Owens > > > > > _______________________________________________ > 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 michael at snoyman.com Thu Jan 25 04:27:37 2018 From: michael at snoyman.com (Michael Snoyman) Date: Thu, 25 Jan 2018 04:27:37 +0000 Subject: [Haskell-cafe] Large JSON File Processing In-Reply-To: References: Message-ID: Parallelization in conduit can usually be achieved with the stm-conduit library, which I believe provides the functionality you're looking for. On Wed, Jan 24, 2018, 11:52 PM erik wrote: > With Michael Snoyman's help, I rewrote my Conduit version of the > application (without using stm-conduit). This was a large improvement: my > first Conduit version was operating over all data and I didn't realize > this. > > I also increased the nursery size. > > My revised function ended up looking like this: > > module Search where > import Conduit ((.|))import qualified Conduit as Cimport Control.Monadimport Control.Monad.IO.Class (MonadIO, liftIO)import Control.Monad.Trans.Resource (MonadResource)import qualified Data.ByteString as Bimport Data.List (isPrefixOf)import Data.Maybe (fromJust, isJust)import System.Path.NameManip (guess_dotdot, absolute_path)import System.FilePath (addTrailingPathSeparator, normalise)import System.Directory (getHomeDirectory) > import Filters > > > sourceFilesFilter :: (MonadResource m, MonadIO m) => ProjectFilter -> FilePath -> C.ConduitM () String m () > sourceFilesFilter projFilter dirname' = > C.sourceDirectoryDeep False dirname' > .| parseProject projFilter > > parseProject :: (MonadResource m, MonadIO m) => ProjectFilter -> C.ConduitM FilePath String m () > parseProject (ProjectFilter filterFunc) = do > C.awaitForever go > where > go path' = do > bytes <- liftIO $ B.readFile path' > let isProj = validProject bytes > when (isJust isProj) $ do > let proj' = fromJust isProj > when (filterFunc proj') $ C.yield path' > > My main just runs the conduit and prints those that pass the filter: > > mainStreamingConduit :: IO () > mainStreamingConduit = do > options <- getRecord "Search JSON Files" > let filterFunc = makeProjectFilter options > searchDir <- absolutize (searchPath options) > itExists <- doesDirectoryExist searchDir > case itExists of > False -> putStrLn "Search Directory does not exist" >> exitWith (ExitFailure 1) > True -> C.runConduitRes $ sourceFilesFilter filterFunc searchDir .| C.mapM_ (liftIO . putStrLn) > > I run it like this (without the stats, typically): > > stack exec search-json -- --searchPath $FILES --name NAME +RTS -s -A32m -n4m > > Without increasing nursery size, I get a productivity around 30%. With the > above, however, it looks like this: > > 72,308,248,744 bytes allocated in the heap > 733,911,752 bytes copied during GC > 7,410,520 bytes maximum residency (8 sample(s)) > 863,480 bytes maximum slop > 187 MB total memory in use (27 MB lost due to fragmentation) > > Tot time (elapsed) Avg pause Max pause > Gen 0 580 colls, 580 par 2.731s 0.772s 0.0013s 0.0105s > Gen 1 8 colls, 7 par 0.163s 0.044s 0.0055s 0.0109s > > Parallel GC work balance: 35.12% (serial 0%, perfect 100%) > > > > TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) > > SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) > > > > INIT time 0.001s ( 0.006s elapsed) > MUT time 26.155s ( 31.602s elapsed) > GC time 2.894s ( 0.816s elapsed) > EXIT time -0.003s ( 0.008s elapsed) > Total time 29.048s ( 32.432s elapsed) > > Alloc rate 2,764,643,665 bytes per MUT second > > Productivity 90.0% of total user, 97.5% of total elapsed > > gc_alloc_block_sync: 3494 > whitehole_spin: 0 > gen[0].sync: 15527 > gen[1].sync: 177 > > I'd still like to figure out how to parallelize the filterProj . > parseJson . readFile part, but for now I'm satisfied with what I have. > > (I also isolated my crashing to another process launched from the same > terminal window.) > > On Sun, Jan 21, 2018 at 10:12 PM, Michael Snoyman > wrote: > >> I just wanted to comment on the conduit aspect of this in particular. >> Looking at your first version: >> >> conduitFilesFilter :: ProjectFilter -> Path Abs Dir -> IO [Path Abs File] >> conduitFilesFilter projFilter dirname' = do >> (_, allFiles) <- listDirRecur dirname' >> C.runConduit $ >> C.yieldMany allFiles >> .| C.filterMC (filterMatchingFile projFilter) >> .| C.sinkList >> >> >> This isn't taking full advantage of conduit: you're reading in a list of >> the files in the file system, instead of streaming those values. And the >> output is a list of `String`, instead of streaming out those `String`s. >> More idiomatic would look something like: >> >> sourceFilesFilter projFilter dirname' = >> sourceDirectoryDeep False dirname' .| filterMC (filterMatchingFile >> projFilter) >> >> And then, wherever you're consuming the output, to do so in a streaming >> fashion, e.g.: >> >> runConduitRes $ sourceFilesFilter projFilter dirname' .| mapM_C print >> >> This should help with the increasing memory usage, though it will do >> nothing about the runtime overhead of parsing the JSON itself. >> >> On Mon, Jan 22, 2018 at 1:38 AM, erik wrote: >> >>> Hello Haskell Cafe, >>> >>> I have written a small, pretty simple program but I am finding it hard >>> to reason about its behavior (and also about the best way to do what I >>> want), so I would like to ask you all for some suggestions. >>> >>> For reference, here's a Stack Overflow question >>> >>> where I described what's going on, but I'll also describe it below. >>> >>> My program does the following: >>> >>> 1. Recursively list a directory, >>> 2. Parse the JSON files from the directory list into identifiable >>> objects/records, >>> 3. Look for matching key-value pairs, and >>> 4. Return filenames where matches have been found. >>> >>> A few details for more context: >>> >>> - I have to filter between 500,000 and 1 million files (I'm >>> typically trying to reduce down to between 1,000 and 40,000 that represent >>> a particular project). I usually just need the filenames. >>> - Each file is quite large, some of them 5mb or 10mb, and it's not >>> uncommon for them to have deeply nested keys (40,000 keys or so). >>> >>> My first version of this program was simple, synchronous, and as >>> straightforward as I could come up with. However, the memory usage >>> increased monotonically. Profiling, I found that most of the time was spent >>> in JSON-parsing into Objects before my code could turn the objects into >>> records (also, as you might imagine, tons of time in garbage collection). >>> >>> For my second version, I switched to conduit and it seemed to solve the >>> increasing memory issue. My core function now looked like this: >>> >>> conduitFilesFilter :: ProjectFilter -> Path Abs Dir -> IO [Path Abs File] >>> conduitFilesFilter projFilter dirname' = do >>> (_, allFiles) <- listDirRecur dirname' >>> C.runConduit $ >>> C.yieldMany allFiles >>> .| C.filterMC (filterMatchingFile projFilter) >>> .| C.sinkList >>> >>> >>> This was still slow and certainly still synchronous. What I really >>> wanted was to run that "filterMatchingFile..." part in parallel across a >>> number of CPUs. As an aside, my filtering function looks like this: >>> >>> filterMatchingFile :: ProjectFilter -> Path Abs File -> IO Bool >>> filterMatchingFile (ProjectFilter filterFunc) fpath = do >>> let fp = toFilePath fpath >>> bs <- B.readFile fp >>> case validImplProject bs of -- this is pretty much just `decodeStrict` >>> Nothing -> pure False >>> (Just proj') -> pure $ filterFunc proj' >>> >>> Here are the stats from running this: >>> >>> 115,961,554,600 bytes allocated in the heap >>> 35,870,639,768 bytes copied during GC >>> 56,467,720 bytes maximum residency (681 sample(s)) >>> 1,283,008 bytes maximum slop >>> 145 MB total memory in use (0 MB lost due to fragmentation) >>> >>> Tot time (elapsed) Avg pause Max pause >>> Gen 0 108716 colls, 108716 par 76.915s 20.571s 0.0002s 0.0266s >>> Gen 1 681 colls, 680 par 0.530s 0.147s 0.0002s 0.0009s >>> >>> Parallel GC work balance: 14.99% (serial 0%, perfect 100%) >>> >>> TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) >>> >>> SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) >>> >>> INIT time 0.001s ( 0.007s elapsed) >>> MUT time 34.813s ( 42.938s elapsed) >>> GC time 77.445s ( 20.718s elapsed) >>> EXIT time 0.000s ( 0.010s elapsed) >>> Total time 112.260s ( 63.672s elapsed) >>> >>> Alloc rate 3,330,960,996 bytes per MUT second >>> >>> Productivity 31.0% of total user, 67.5% of total elapsed >>> >>> gc_alloc_block_sync: 188614 >>> whitehole_spin: 0 >>> gen[0].sync: 33 >>> gen[1].sync: 811204 >>> >>> >>> I thought about writing a plainer (non-conduit) parallel version but I >>> was afraid of the memory issue. I tried to write a Conduit-plus-channels >>> version but it didn't work. >>> >>> Finally, I wrote a version using stm-conduit, which I thought might be a >>> bit more efficient. It seems to be slightly better, but it's not really the >>> kind of parallelization I was imagining: >>> >>> conduitAsyncFilterFiles :: ProjectFilter -> Path Abs Dir -> IO [String] >>> conduitAsyncFilterFiles projFilter dirname' = do >>> (_, allFiles) <- listDirRecur dirname' >>> buffer 10 >>> (C.yieldMany allFiles >>> .| (C.mapMC (readFileWithPath . toFilePath))) >>> (C.mapC (filterProjForFilename projFilter) >>> .| C.filterC isJust >>> .| C.mapC fromJust >>> .| C.sinkList) >>> >>> The first conduit passed to `buffer` does something like the following: parseStrict >>> . B.readFile. >>> >>> This still wasn't too great, but after reading about handing garbage >>> collection in smarter ways, I found that I could run my application like >>> this: >>> >>> stack exec search-json -- --searchPath $FILES --name hello +RTS -s -A32m -n4m >>> >>> And the "productivity" would shoot up quite a lot presumably because I'm >>> doing less frequent garbage collection. My program also got a bit faster: >>> >>> 36,379,265,096 bytes allocated in the heap >>> 1,238,438,160 bytes copied during GC >>> 22,996,264 bytes maximum residency (85 sample(s)) >>> 3,834,152 bytes maximum slop >>> 207 MB total memory in use (14 MB lost due to fragmentation) >>> >>> Tot time (elapsed) Avg pause Max pause >>> Gen 0 211 colls, 211 par 1.433s 0.393s 0.0019s 0.0077s >>> Gen 1 85 colls, 84 par 0.927s 0.256s 0.0030s 0.0067s >>> >>> Parallel GC work balance: 67.93% (serial 0%, perfect 100%) >>> >>> TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) >>> >>> SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) >>> >>> INIT time 0.001s ( 0.004s elapsed) >>> MUT time 12.636s ( 12.697s elapsed) >>> GC time 2.359s ( 0.650s elapsed) >>> EXIT time -0.015s ( 0.003s elapsed) >>> Total time 14.982s ( 13.354s elapsed) >>> >>> Alloc rate 2,878,972,840 bytes per MUT second >>> >>> Productivity 84.2% of total user, 95.1% of total elapsed >>> >>> gc_alloc_block_sync: 9612 >>> whitehole_spin: 0 >>> gen[0].sync: 2044 >>> gen[1].sync: 47704 >>> >>> >>> Thanks for reading thus far. I now have three questions. >>> >>> 1. I understand that my program necessarily creates tons of garbage >>> because it parses and then throws away 5mb of JSON 500,000 times. However, >>> I don't really understand why this helps "+RTS -A32m -n4m" and I'm >>> always reluctant to sprinkle in magic I don't fully understand. Can anyone >>> help me understand what this means? >>> >>> 2. It seems that the allocation limit is really something I should be >>> using, but I can't figure out how to successfully add it to my package.yml >>> with the other options. From the documentation for GHC 8.2, I thought it >>> needed to look like this but it never works, usually telling me that -A32m >>> and -n4m are not recognizable flags (how do I add them in to my package.yml >>> so I don't have to pass them when running the program?): >>> >>> ghc-options: >>> - -threaded >>> - -rtsopts >>> - "-with-rtsopts=-N4 -A32m -n4m" >>> >>> 3. Finally, the most important question I have is this. When I run this >>> program on OSX, it runs successfully through to completion. However, *a >>> few minutes after terminating*, my terminal becomes unresponsive. I use >>> emacs for my editor, typically launched from a terminal window and that too >>> becomes unresponsive. This is not a typical outcome for any programs I >>> write and it happens *every time* I run this particular application, so >>> I know that this application is to blame. >>> >>> The crazy thing is that force quitting the terminal or logging out >>> doesn't help: I have to actually restart my computer to use the terminal >>> application again. Other details that may help: >>> >>> - This crash happens after the process id for my program has >>> terminated. >>> - Watching its progress in HTOP, it never comes close to running out >>> of memory: the value hovers in the same place. >>> >>> I can't really deploy an application that has this potential-crashing >>> problem, but I don't know to debug this issue. My total stab-in-the-dark >>> idea is that heap allocations somehow are unrecoverable even after the >>> process has terminated? Can anyone offer suggestions on things to look for >>> or ways to debug and/or fix this issue? >>> >>> Finally, if anyone has suggestions on better ways to structure my >>> application or parallelize the slow parts, I'll happily take those. >>> >>> Thanks again for reading. I appreciate any suggestions you may have. >>> >>> Best, >>> >>> -- >>> Erik Aker >>> >>> _______________________________________________ >>> 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. >>> >> >> > > > -- > Erik Aker > -------------- next part -------------- An HTML attachment was scrubbed... URL: From eraker at gmail.com Thu Jan 25 04:32:34 2018 From: eraker at gmail.com (erik) Date: Wed, 24 Jan 2018 20:32:34 -0800 Subject: [Haskell-cafe] Large JSON File Processing In-Reply-To: References: Message-ID: > Parallelization in conduit can usually be achieved with the stm-conduit library, which I believe provides the functionality you're looking for. That's what I thought, but I couldn't figure out how one typically would fan-out work across one of the middle conduits. I'd like to run one or two functions across a lot of inputs in parallel, not each section of the whole pipeline in parallel. My attempt at using channels with stm-conduit, dumped all the filepaths into a channel and then I tried to spawn some async conduit workers that would read from the channels and yield their results into a shared downstream channel. Hmm. It still sounds like it should work, actually. I wonder what went wrong. Maybe I should try again. On Wed, Jan 24, 2018 at 8:27 PM, Michael Snoyman wrote: > Parallelization in conduit can usually be achieved with the stm-conduit > library, which I believe provides the functionality you're looking for. > > On Wed, Jan 24, 2018, 11:52 PM erik wrote: > >> With Michael Snoyman's help, I rewrote my Conduit version of the >> application (without using stm-conduit). This was a large improvement: my >> first Conduit version was operating over all data and I didn't realize >> this. >> >> I also increased the nursery size. >> >> My revised function ended up looking like this: >> >> module Search where >> import Conduit ((.|))import qualified Conduit as Cimport Control.Monadimport Control.Monad.IO.Class (MonadIO, liftIO)import Control.Monad.Trans.Resource (MonadResource)import qualified Data.ByteString as Bimport Data.List (isPrefixOf)import Data.Maybe (fromJust, isJust)import System.Path.NameManip (guess_dotdot, absolute_path)import System.FilePath (addTrailingPathSeparator, normalise)import System.Directory (getHomeDirectory) >> import Filters >> >> >> sourceFilesFilter :: (MonadResource m, MonadIO m) => ProjectFilter -> FilePath -> C.ConduitM () String m () >> sourceFilesFilter projFilter dirname' = >> C.sourceDirectoryDeep False dirname' >> .| parseProject projFilter >> >> parseProject :: (MonadResource m, MonadIO m) => ProjectFilter -> C.ConduitM FilePath String m () >> parseProject (ProjectFilter filterFunc) = do >> C.awaitForever go >> where >> go path' = do >> bytes <- liftIO $ B.readFile path' >> let isProj = validProject bytes >> when (isJust isProj) $ do >> let proj' = fromJust isProj >> when (filterFunc proj') $ C.yield path' >> >> My main just runs the conduit and prints those that pass the filter: >> >> mainStreamingConduit :: IO () >> mainStreamingConduit = do >> options <- getRecord "Search JSON Files" >> let filterFunc = makeProjectFilter options >> searchDir <- absolutize (searchPath options) >> itExists <- doesDirectoryExist searchDir >> case itExists of >> False -> putStrLn "Search Directory does not exist" >> exitWith (ExitFailure 1) >> True -> C.runConduitRes $ sourceFilesFilter filterFunc searchDir .| C.mapM_ (liftIO . putStrLn) >> >> I run it like this (without the stats, typically): >> >> stack exec search-json -- --searchPath $FILES --name NAME +RTS -s -A32m -n4m >> >> Without increasing nursery size, I get a productivity around 30%. With >> the above, however, it looks like this: >> >> 72,308,248,744 bytes allocated in the heap >> 733,911,752 bytes copied during GC >> 7,410,520 bytes maximum residency (8 sample(s)) >> 863,480 bytes maximum slop >> 187 MB total memory in use (27 MB lost due to fragmentation) >> >> Tot time (elapsed) Avg pause Max pause >> Gen 0 580 colls, 580 par 2.731s 0.772s 0.0013s 0.0105s >> Gen 1 8 colls, 7 par 0.163s 0.044s 0.0055s 0.0109s >> >> Parallel GC work balance: 35.12% (serial 0%, perfect 100%) >> >> >> >> TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) >> >> SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) >> >> >> >> INIT time 0.001s ( 0.006s elapsed) >> MUT time 26.155s ( 31.602s elapsed) >> GC time 2.894s ( 0.816s elapsed) >> EXIT time -0.003s ( 0.008s elapsed) >> Total time 29.048s ( 32.432s elapsed) >> >> Alloc rate 2,764,643,665 bytes per MUT second >> >> Productivity 90.0% of total user, 97.5% of total elapsed >> >> gc_alloc_block_sync: 3494 >> whitehole_spin: 0 >> gen[0].sync: 15527 >> gen[1].sync: 177 >> >> I'd still like to figure out how to parallelize the filterProj . >> parseJson . readFile part, but for now I'm satisfied with what I have. >> >> (I also isolated my crashing to another process launched from the same >> terminal window.) >> >> On Sun, Jan 21, 2018 at 10:12 PM, Michael Snoyman >> wrote: >> >>> I just wanted to comment on the conduit aspect of this in particular. >>> Looking at your first version: >>> >>> conduitFilesFilter :: ProjectFilter -> Path Abs Dir -> IO [Path Abs File] >>> conduitFilesFilter projFilter dirname' = do >>> (_, allFiles) <- listDirRecur dirname' >>> C.runConduit $ >>> C.yieldMany allFiles >>> .| C.filterMC (filterMatchingFile projFilter) >>> .| C.sinkList >>> >>> >>> This isn't taking full advantage of conduit: you're reading in a list of >>> the files in the file system, instead of streaming those values. And the >>> output is a list of `String`, instead of streaming out those `String`s. >>> More idiomatic would look something like: >>> >>> sourceFilesFilter projFilter dirname' = >>> sourceDirectoryDeep False dirname' .| filterMC (filterMatchingFile >>> projFilter) >>> >>> And then, wherever you're consuming the output, to do so in a streaming >>> fashion, e.g.: >>> >>> runConduitRes $ sourceFilesFilter projFilter dirname' .| mapM_C print >>> >>> This should help with the increasing memory usage, though it will do >>> nothing about the runtime overhead of parsing the JSON itself. >>> >>> On Mon, Jan 22, 2018 at 1:38 AM, erik wrote: >>> >>>> Hello Haskell Cafe, >>>> >>>> I have written a small, pretty simple program but I am finding it hard >>>> to reason about its behavior (and also about the best way to do what I >>>> want), so I would like to ask you all for some suggestions. >>>> >>>> For reference, here's a Stack Overflow question >>>> >>>> where I described what's going on, but I'll also describe it below. >>>> >>>> My program does the following: >>>> >>>> 1. Recursively list a directory, >>>> 2. Parse the JSON files from the directory list into identifiable >>>> objects/records, >>>> 3. Look for matching key-value pairs, and >>>> 4. Return filenames where matches have been found. >>>> >>>> A few details for more context: >>>> >>>> - I have to filter between 500,000 and 1 million files (I'm >>>> typically trying to reduce down to between 1,000 and 40,000 that represent >>>> a particular project). I usually just need the filenames. >>>> - Each file is quite large, some of them 5mb or 10mb, and it's not >>>> uncommon for them to have deeply nested keys (40,000 keys or so). >>>> >>>> My first version of this program was simple, synchronous, and as >>>> straightforward as I could come up with. However, the memory usage >>>> increased monotonically. Profiling, I found that most of the time was spent >>>> in JSON-parsing into Objects before my code could turn the objects into >>>> records (also, as you might imagine, tons of time in garbage collection). >>>> >>>> For my second version, I switched to conduit and it seemed to solve the >>>> increasing memory issue. My core function now looked like this: >>>> >>>> conduitFilesFilter :: ProjectFilter -> Path Abs Dir -> IO [Path Abs File] >>>> conduitFilesFilter projFilter dirname' = do >>>> (_, allFiles) <- listDirRecur dirname' >>>> C.runConduit $ >>>> C.yieldMany allFiles >>>> .| C.filterMC (filterMatchingFile projFilter) >>>> .| C.sinkList >>>> >>>> >>>> This was still slow and certainly still synchronous. What I really >>>> wanted was to run that "filterMatchingFile..." part in parallel across a >>>> number of CPUs. As an aside, my filtering function looks like this: >>>> >>>> filterMatchingFile :: ProjectFilter -> Path Abs File -> IO Bool >>>> filterMatchingFile (ProjectFilter filterFunc) fpath = do >>>> let fp = toFilePath fpath >>>> bs <- B.readFile fp >>>> case validImplProject bs of -- this is pretty much just >>>> `decodeStrict` >>>> Nothing -> pure False >>>> (Just proj') -> pure $ filterFunc proj' >>>> >>>> Here are the stats from running this: >>>> >>>> 115,961,554,600 bytes allocated in the heap >>>> 35,870,639,768 bytes copied during GC >>>> 56,467,720 bytes maximum residency (681 sample(s)) >>>> 1,283,008 bytes maximum slop >>>> 145 MB total memory in use (0 MB lost due to fragmentation) >>>> >>>> Tot time (elapsed) Avg pause Max pause >>>> Gen 0 108716 colls, 108716 par 76.915s 20.571s 0.0002s 0.0266s >>>> Gen 1 681 colls, 680 par 0.530s 0.147s 0.0002s 0.0009s >>>> >>>> Parallel GC work balance: 14.99% (serial 0%, perfect 100%) >>>> >>>> TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) >>>> >>>> SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) >>>> >>>> INIT time 0.001s ( 0.007s elapsed) >>>> MUT time 34.813s ( 42.938s elapsed) >>>> GC time 77.445s ( 20.718s elapsed) >>>> EXIT time 0.000s ( 0.010s elapsed) >>>> Total time 112.260s ( 63.672s elapsed) >>>> >>>> Alloc rate 3,330,960,996 bytes per MUT second >>>> >>>> Productivity 31.0% of total user, 67.5% of total elapsed >>>> >>>> gc_alloc_block_sync: 188614 >>>> whitehole_spin: 0 >>>> gen[0].sync: 33 >>>> gen[1].sync: 811204 >>>> >>>> >>>> I thought about writing a plainer (non-conduit) parallel version but I >>>> was afraid of the memory issue. I tried to write a Conduit-plus-channels >>>> version but it didn't work. >>>> >>>> Finally, I wrote a version using stm-conduit, which I thought might be >>>> a bit more efficient. It seems to be slightly better, but it's not really >>>> the kind of parallelization I was imagining: >>>> >>>> conduitAsyncFilterFiles :: ProjectFilter -> Path Abs Dir -> IO [String] >>>> conduitAsyncFilterFiles projFilter dirname' = do >>>> (_, allFiles) <- listDirRecur dirname' >>>> buffer 10 >>>> (C.yieldMany allFiles >>>> .| (C.mapMC (readFileWithPath . toFilePath))) >>>> (C.mapC (filterProjForFilename projFilter) >>>> .| C.filterC isJust >>>> .| C.mapC fromJust >>>> .| C.sinkList) >>>> >>>> The first conduit passed to `buffer` does something like the following: parseStrict >>>> . B.readFile. >>>> >>>> This still wasn't too great, but after reading about handing garbage >>>> collection in smarter ways, I found that I could run my application like >>>> this: >>>> >>>> stack exec search-json -- --searchPath $FILES --name hello +RTS -s -A32m -n4m >>>> >>>> And the "productivity" would shoot up quite a lot presumably because >>>> I'm doing less frequent garbage collection. My program also got a bit >>>> faster: >>>> >>>> 36,379,265,096 bytes allocated in the heap >>>> 1,238,438,160 bytes copied during GC >>>> 22,996,264 bytes maximum residency (85 sample(s)) >>>> 3,834,152 bytes maximum slop >>>> 207 MB total memory in use (14 MB lost due to fragmentation) >>>> >>>> Tot time (elapsed) Avg pause Max pause >>>> Gen 0 211 colls, 211 par 1.433s 0.393s 0.0019s 0.0077s >>>> Gen 1 85 colls, 84 par 0.927s 0.256s 0.0030s 0.0067s >>>> >>>> Parallel GC work balance: 67.93% (serial 0%, perfect 100%) >>>> >>>> TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) >>>> >>>> SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) >>>> >>>> INIT time 0.001s ( 0.004s elapsed) >>>> MUT time 12.636s ( 12.697s elapsed) >>>> GC time 2.359s ( 0.650s elapsed) >>>> EXIT time -0.015s ( 0.003s elapsed) >>>> Total time 14.982s ( 13.354s elapsed) >>>> >>>> Alloc rate 2,878,972,840 bytes per MUT second >>>> >>>> Productivity 84.2% of total user, 95.1% of total elapsed >>>> >>>> gc_alloc_block_sync: 9612 >>>> whitehole_spin: 0 >>>> gen[0].sync: 2044 >>>> gen[1].sync: 47704 >>>> >>>> >>>> Thanks for reading thus far. I now have three questions. >>>> >>>> 1. I understand that my program necessarily creates tons of garbage >>>> because it parses and then throws away 5mb of JSON 500,000 times. However, >>>> I don't really understand why this helps "+RTS -A32m -n4m" and I'm >>>> always reluctant to sprinkle in magic I don't fully understand. Can anyone >>>> help me understand what this means? >>>> >>>> 2. It seems that the allocation limit is really something I should be >>>> using, but I can't figure out how to successfully add it to my package.yml >>>> with the other options. From the documentation for GHC 8.2, I thought it >>>> needed to look like this but it never works, usually telling me that -A32m >>>> and -n4m are not recognizable flags (how do I add them in to my package.yml >>>> so I don't have to pass them when running the program?): >>>> >>>> ghc-options: >>>> - -threaded >>>> - -rtsopts >>>> - "-with-rtsopts=-N4 -A32m -n4m" >>>> >>>> 3. Finally, the most important question I have is this. When I run this >>>> program on OSX, it runs successfully through to completion. However, *a >>>> few minutes after terminating*, my terminal becomes unresponsive. I >>>> use emacs for my editor, typically launched from a terminal window and that >>>> too becomes unresponsive. This is not a typical outcome for any programs I >>>> write and it happens *every time* I run this particular application, >>>> so I know that this application is to blame. >>>> >>>> The crazy thing is that force quitting the terminal or logging out >>>> doesn't help: I have to actually restart my computer to use the terminal >>>> application again. Other details that may help: >>>> >>>> - This crash happens after the process id for my program has >>>> terminated. >>>> - Watching its progress in HTOP, it never comes close to running >>>> out of memory: the value hovers in the same place. >>>> >>>> I can't really deploy an application that has this potential-crashing >>>> problem, but I don't know to debug this issue. My total stab-in-the-dark >>>> idea is that heap allocations somehow are unrecoverable even after the >>>> process has terminated? Can anyone offer suggestions on things to look for >>>> or ways to debug and/or fix this issue? >>>> >>>> Finally, if anyone has suggestions on better ways to structure my >>>> application or parallelize the slow parts, I'll happily take those. >>>> >>>> Thanks again for reading. I appreciate any suggestions you may have. >>>> >>>> Best, >>>> >>>> -- >>>> Erik Aker >>>> >>>> _______________________________________________ >>>> 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. >>>> >>> >>> >> >> >> -- >> Erik Aker >> > -- Erik Aker -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at snoyman.com Thu Jan 25 04:38:16 2018 From: michael at snoyman.com (Michael Snoyman) Date: Thu, 25 Jan 2018 06:38:16 +0200 Subject: [Haskell-cafe] LTS-10.* missing build-depends suggestion In-Reply-To: References: Message-ID: FWIW, I've also noticed that with LTS 10/GHC 8.2.2 I no longer get the package name suggestions, even when I know I have the package installed. I don't know if it's an issue with Stack or GHC, I haven't investigated. But I can't think of something on the Stack side which would make the behavior different between GHC 8.0.2 and GHC 8.2.2. On Thu, Jan 25, 2018 at 4:02 AM, Dan Burton wrote: > I believe the particular feature you are talking about is a feature of > GHC. Whether a suggestion is show or not merely depends on whether GHC sees > the package in question in its package database(s). > > If you are using stack, then you can look at one of your LTS 9 projects, > and run > > stack exec -- ghc-pkg list > > In order to see the list of installed packages. (I think something like > `cabal exec ghc-pkg list` should do the same for a cabal project.) > > Identify the packages you tend to use, go into one of your LTS 10 > projects, and `stack install pkg1 pkg2 ...` > > Note that with stack, each minor version of LTS has its own package > database, so packages locally installed into lts-10.1 will not necessarily > be available in your local instance of lts-10.2. Repeat stack install to > taste. > > tl;dr the trick is to set up your package database so that GHC knows what > to suggest for you > > -- Dan Burton > > On Wed, Jan 24, 2018 at 5:12 PM, Rick Owens wrote: > >> Dear Haskell Café, >> >> I am a long-time Haskell developer with a proliferation of private >> projects. I typically make very heavy use of stack and LTS. Today, I tried >> to bootstrap my first project using LTS-10.* (with GHC-8.2.2) and I ran >> into an interesting problem (for me). >> >> In the past, with lts-9.* and below, when I started cranking on some code >> and writing a bunch of imports: >> >> > import Control.Monad.Trans.Class (MonadTrans) >> > import Data.Map (Map) >> >> I would try to build first without updating the cabal file build-depends, >> and I would get something like the following error messages: >> >> > /path/to/Module.hs:48:1: error: >> > Failed to load interface for ‘Data.Map’ >> > It is a member of the hidden package ‘containers-0.5.7.1’. >> > Perhaps you need to add ‘containers’ to the build-depends in your >> .cabal file. >> > Use -v to see a list of the files searched for. >> > >> > /path/to/Module.hs:21:1: error: >> > Failed to load interface for ‘Control.Monad.Trans.Class’ >> > It is a member of the hidden package ‘transformers-0.5.2.0’. >> > Perhaps you need to add ‘transformers’ to the build-depends in >> your .cabal file. >> > Use -v to see a list of the files searched for. >> >> >> This was good because the error contained a suggested solution which >> contained the missing package, and I could sort of lazily add the >> build-depends I needed without having to memorize a (Module -> Package) >> mapping. I even had developer tooling to do it automatically. >> >> With lts-10.*, however, the analogous error message looks like this: >> >> > /path/to/Module.hs:9:1: error: >> > Could not find module ‘Data.DoubleWord’ >> > Use -v to see a list of the files searched for. >> > | >> > 9 | import Data.DoubleWord (Word256(Word256), Word128(Word128)) >> > | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ >> >> I am wondering, is there a way to bring back the solution suggestion? Not >> having access to it has made me realize how heavily I was using that >> feature. What do others think about this missing bit of supplemental error >> information? >> >> Thanks, >> >> -Rick Owens >> >> >> >> >> _______________________________________________ >> 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. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From danburton.email at gmail.com Thu Jan 25 07:29:45 2018 From: danburton.email at gmail.com (Dan Burton) Date: Wed, 24 Jan 2018 23:29:45 -0800 Subject: [Haskell-cafe] LTS-10.* missing build-depends suggestion In-Reply-To: References: Message-ID: Hm, you're right. Seems like a GHC thing. I've tested a simple file with "import Data.Map" on both a stack project and a cabal project -- with containers installed in ghc's main package-db, as verified via stack/cabal exec ghc-pkg list containers -- and it doesn't give the hint in either case. Taking it a step further and removing cabal/stack out of the equation... $ cat Main.hs module Main where import Data.Map main = putStrLn "It compiles" $ ghc-pkg list containers /usr/local/Cellar/ghc/8.2.2/lib/ghc-8.2.2/package.conf.d containers-0.5.10.2 $ ghc --make -hide-all-packages -package base Main.hs [1 of 1] Compiling Main ( Main.hs, Main.o ) Main.hs:2:1: error: Could not find module ‘Data.Map’ Use -v to see a list of the files searched for. | 2 | import Data.Map | ^^^^^^^^^^^^^^^ $ ghc --make -hide-all-packages -package base -package containers Main.hs [1 of 1] Compiling Main ( Main.hs, Main.o ) Linking Main ... -- Dan Burton On Wed, Jan 24, 2018 at 8:38 PM, Michael Snoyman wrote: > FWIW, I've also noticed that with LTS 10/GHC 8.2.2 I no longer get the > package name suggestions, even when I know I have the package installed. I > don't know if it's an issue with Stack or GHC, I haven't investigated. But > I can't think of something on the Stack side which would make the behavior > different between GHC 8.0.2 and GHC 8.2.2. > > On Thu, Jan 25, 2018 at 4:02 AM, Dan Burton > wrote: > >> I believe the particular feature you are talking about is a feature of >> GHC. Whether a suggestion is show or not merely depends on whether GHC sees >> the package in question in its package database(s). >> >> If you are using stack, then you can look at one of your LTS 9 projects, >> and run >> >> stack exec -- ghc-pkg list >> >> In order to see the list of installed packages. (I think something like >> `cabal exec ghc-pkg list` should do the same for a cabal project.) >> >> Identify the packages you tend to use, go into one of your LTS 10 >> projects, and `stack install pkg1 pkg2 ...` >> >> Note that with stack, each minor version of LTS has its own package >> database, so packages locally installed into lts-10.1 will not necessarily >> be available in your local instance of lts-10.2. Repeat stack install to >> taste. >> >> tl;dr the trick is to set up your package database so that GHC knows what >> to suggest for you >> >> -- Dan Burton >> >> On Wed, Jan 24, 2018 at 5:12 PM, Rick Owens wrote: >> >>> Dear Haskell Café, >>> >>> I am a long-time Haskell developer with a proliferation of private >>> projects. I typically make very heavy use of stack and LTS. Today, I tried >>> to bootstrap my first project using LTS-10.* (with GHC-8.2.2) and I ran >>> into an interesting problem (for me). >>> >>> In the past, with lts-9.* and below, when I started cranking on some >>> code and writing a bunch of imports: >>> >>> > import Control.Monad.Trans.Class (MonadTrans) >>> > import Data.Map (Map) >>> >>> I would try to build first without updating the cabal file >>> build-depends, and I would get something like the following error messages: >>> >>> > /path/to/Module.hs:48:1: error: >>> > Failed to load interface for ‘Data.Map’ >>> > It is a member of the hidden package ‘containers-0.5.7.1’. >>> > Perhaps you need to add ‘containers’ to the build-depends in >>> your .cabal file. >>> > Use -v to see a list of the files searched for. >>> > >>> > /path/to/Module.hs:21:1: error: >>> > Failed to load interface for ‘Control.Monad.Trans.Class’ >>> > It is a member of the hidden package ‘transformers-0.5.2.0’. >>> > Perhaps you need to add ‘transformers’ to the build-depends in >>> your .cabal file. >>> > Use -v to see a list of the files searched for. >>> >>> >>> This was good because the error contained a suggested solution which >>> contained the missing package, and I could sort of lazily add the >>> build-depends I needed without having to memorize a (Module -> Package) >>> mapping. I even had developer tooling to do it automatically. >>> >>> With lts-10.*, however, the analogous error message looks like this: >>> >>> > /path/to/Module.hs:9:1: error: >>> > Could not find module ‘Data.DoubleWord’ >>> > Use -v to see a list of the files searched for. >>> > | >>> > 9 | import Data.DoubleWord (Word256(Word256), Word128(Word128)) >>> > | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ >>> >>> I am wondering, is there a way to bring back the solution suggestion? >>> Not having access to it has made me realize how heavily I was using that >>> feature. What do others think about this missing bit of supplemental error >>> information? >>> >>> Thanks, >>> >>> -Rick Owens >>> >>> >>> >>> >>> _______________________________________________ >>> 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. >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From yotam2206 at gmail.com Thu Jan 25 09:50:18 2018 From: yotam2206 at gmail.com (Yotam Ohad) Date: Thu, 25 Jan 2018 09:50:18 +0000 Subject: [Haskell-cafe] Caching Actions Message-ID: Hi, I've been digging around the source code of reactive-banana and I found this code : data Cached m a = Cached (m a) runCached :: Cached m a -> m a runCached (Cached x) = x -- | An action whose result will be cached. -- Executing the action the first time in the monad will -- execute the side effects. From then on, -- only the generated value will be returned. {-# NOINLINE cache #-} cache :: (MonadFix m, MonadIO m) => m a -> Cached m a cache m = unsafePerformIO $ do key <- liftIO $ newIORef Nothing return $ Cached $ do ma <- liftIO $ readIORef key -- read the cached result case ma of Just a -> return a -- return the cached result. Nothing -> mdo liftIO $ -- write the result already writeIORef key (Just a) a <- m -- evaluate return a I'm trying to understand the reasom behind the use of mdo. Can't it be like this: do a <- m liftIO $ writeIORef key (Just a) return a Removing the need for a recursive definition? Yotam -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at snoyman.com Thu Jan 25 09:51:29 2018 From: michael at snoyman.com (Michael Snoyman) Date: Thu, 25 Jan 2018 11:51:29 +0200 Subject: [Haskell-cafe] LTS-10.* missing build-depends suggestion In-Reply-To: References: Message-ID: Nice repro Dan! I hope you don't mind, I took your repro and opened a GHC Trac ticket about this: https://ghc.haskell.org/trac/ghc/ticket/14717#ticket On Thu, Jan 25, 2018 at 9:29 AM, Dan Burton wrote: > Hm, you're right. Seems like a GHC thing. I've tested a simple file with > "import Data.Map" on both a stack project and a cabal project -- with > containers installed in ghc's main package-db, as verified via stack/cabal > exec ghc-pkg list containers -- and it doesn't give the hint in either case. > > Taking it a step further and removing cabal/stack out of the equation... > > $ cat Main.hs > module Main where > import Data.Map > main = putStrLn "It compiles" > > $ ghc-pkg list containers > /usr/local/Cellar/ghc/8.2.2/lib/ghc-8.2.2/package.conf.d > containers-0.5.10.2 > > $ ghc --make -hide-all-packages -package base Main.hs > [1 of 1] Compiling Main ( Main.hs, Main.o ) > > Main.hs:2:1: error: > Could not find module ‘Data.Map’ > Use -v to see a list of the files searched for. > | > 2 | import Data.Map > | ^^^^^^^^^^^^^^^ > > $ ghc --make -hide-all-packages -package base -package containers Main.hs > [1 of 1] Compiling Main ( Main.hs, Main.o ) > Linking Main ... > > -- Dan Burton > > On Wed, Jan 24, 2018 at 8:38 PM, Michael Snoyman > wrote: > >> FWIW, I've also noticed that with LTS 10/GHC 8.2.2 I no longer get the >> package name suggestions, even when I know I have the package installed. I >> don't know if it's an issue with Stack or GHC, I haven't investigated. But >> I can't think of something on the Stack side which would make the behavior >> different between GHC 8.0.2 and GHC 8.2.2. >> >> On Thu, Jan 25, 2018 at 4:02 AM, Dan Burton >> wrote: >> >>> I believe the particular feature you are talking about is a feature of >>> GHC. Whether a suggestion is show or not merely depends on whether GHC sees >>> the package in question in its package database(s). >>> >>> If you are using stack, then you can look at one of your LTS 9 projects, >>> and run >>> >>> stack exec -- ghc-pkg list >>> >>> In order to see the list of installed packages. (I think something like >>> `cabal exec ghc-pkg list` should do the same for a cabal project.) >>> >>> Identify the packages you tend to use, go into one of your LTS 10 >>> projects, and `stack install pkg1 pkg2 ...` >>> >>> Note that with stack, each minor version of LTS has its own package >>> database, so packages locally installed into lts-10.1 will not necessarily >>> be available in your local instance of lts-10.2. Repeat stack install to >>> taste. >>> >>> tl;dr the trick is to set up your package database so that GHC knows >>> what to suggest for you >>> >>> -- Dan Burton >>> >>> On Wed, Jan 24, 2018 at 5:12 PM, Rick Owens >>> wrote: >>> >>>> Dear Haskell Café, >>>> >>>> I am a long-time Haskell developer with a proliferation of private >>>> projects. I typically make very heavy use of stack and LTS. Today, I tried >>>> to bootstrap my first project using LTS-10.* (with GHC-8.2.2) and I ran >>>> into an interesting problem (for me). >>>> >>>> In the past, with lts-9.* and below, when I started cranking on some >>>> code and writing a bunch of imports: >>>> >>>> > import Control.Monad.Trans.Class (MonadTrans) >>>> > import Data.Map (Map) >>>> >>>> I would try to build first without updating the cabal file >>>> build-depends, and I would get something like the following error messages: >>>> >>>> > /path/to/Module.hs:48:1: error: >>>> > Failed to load interface for ‘Data.Map’ >>>> > It is a member of the hidden package ‘containers-0.5.7.1’. >>>> > Perhaps you need to add ‘containers’ to the build-depends in >>>> your .cabal file. >>>> > Use -v to see a list of the files searched for. >>>> > >>>> > /path/to/Module.hs:21:1: error: >>>> > Failed to load interface for ‘Control.Monad.Trans.Class’ >>>> > It is a member of the hidden package ‘transformers-0.5.2.0’. >>>> > Perhaps you need to add ‘transformers’ to the build-depends in >>>> your .cabal file. >>>> > Use -v to see a list of the files searched for. >>>> >>>> >>>> This was good because the error contained a suggested solution which >>>> contained the missing package, and I could sort of lazily add the >>>> build-depends I needed without having to memorize a (Module -> Package) >>>> mapping. I even had developer tooling to do it automatically. >>>> >>>> With lts-10.*, however, the analogous error message looks like this: >>>> >>>> > /path/to/Module.hs:9:1: error: >>>> > Could not find module ‘Data.DoubleWord’ >>>> > Use -v to see a list of the files searched for. >>>> > | >>>> > 9 | import Data.DoubleWord (Word256(Word256), Word128(Word128)) >>>> > | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ >>>> >>>> I am wondering, is there a way to bring back the solution suggestion? >>>> Not having access to it has made me realize how heavily I was using that >>>> feature. What do others think about this missing bit of supplemental error >>>> information? >>>> >>>> Thanks, >>>> >>>> -Rick Owens >>>> >>>> >>>> >>>> >>>> _______________________________________________ >>>> 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. >>> >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at snoyman.com Thu Jan 25 10:03:46 2018 From: michael at snoyman.com (Michael Snoyman) Date: Thu, 25 Jan 2018 12:03:46 +0200 Subject: [Haskell-cafe] Caching Actions In-Reply-To: References: Message-ID: I believe the intention is to ensure that two threads do not perform the action at the same time. If you look at the implementation of mfix for IO[1], it's using an MVar. I'm not 100% certain, but I think the `cache` function above could be rewritten to use MVars explicitly and avoid both monadic do and unsafe IO functions. [1] The fixIO function, https://www.stackage.org/haddock/lts-10.3/base-4.10.1.0/src/System-IO.html#fixIO On Thu, Jan 25, 2018 at 11:50 AM, Yotam Ohad wrote: > Hi, > > I've been digging around the source code of reactive-banana and I found > this code > : > > > data Cached m a = Cached (m a) > > runCached :: Cached m a -> m a > runCached (Cached x) = x > > -- | An action whose result will be cached. > -- Executing the action the first time in the monad will > -- execute the side effects. From then on, > -- only the generated value will be returned. > {-# NOINLINE cache #-} > cache :: (MonadFix m, MonadIO m) => m a -> Cached m a > cache m = unsafePerformIO $ do > key <- liftIO $ newIORef Nothing > return $ Cached $ do > ma <- liftIO $ readIORef key -- read the cached result > case ma of > Just a -> return a -- return the cached result. > Nothing -> mdo > liftIO $ -- write the result already > writeIORef key (Just a) > a <- m -- evaluate > return a > > I'm trying to understand the reasom behind the use of mdo. Can't it be like this: > > do > a <- m > liftIO $ writeIORef key (Just a) > return a > > Removing the need for a recursive definition? > > Yotam > > > _______________________________________________ > 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 chneukirchen at gmail.com Thu Jan 25 11:51:14 2018 From: chneukirchen at gmail.com (Christian Neukirchen) Date: Thu, 25 Jan 2018 12:51:14 +0100 Subject: [Haskell-cafe] Munich Haskell Meeting, 2018-01-29 @ 19:30 Message-ID: <87d11yf971.fsf@gmail.com> Dear all, Next week, our monthly Munich Haskell Meeting will take place again on Monday, January 29 at **Cafe Puck** at 19h30. For details see here: http://muenchen.haskell.bayern/dates.html If you plan to join, please add yourself to this dudle so we can reserve enough seats! It is OK to add yourself to the dudle anonymously or pseudonymously. https://dudle.inf.tu-dresden.de/haskell-munich-jan-2018/ [Please note: I'll likely arrive 8-9pm this time since I need to wait for my water meter to get changed. I'll book for Neukirchen as usual.] Everybody is welcome! cu, -- Christian Neukirchen http://chneukirchen.org From arjenvanweelden at gmail.com Thu Jan 25 12:31:04 2018 From: arjenvanweelden at gmail.com (Arjen) Date: Thu, 25 Jan 2018 13:31:04 +0100 Subject: [Haskell-cafe] Caching Actions In-Reply-To: References: Message-ID: <1516883464.2002.15.camel@gmail.com> On Thu, 2018-01-25 at 09:50 +0000, Yotam Ohad wrote: > Hi, > I've been digging around the source code of reactive-banana and I > found this code: > data Cached m a = Cached (m a) > > runCached :: Cached m a -> m a > runCached (Cached x) = x > > -- | An action whose result will be cached. > -- Executing the action the first time in the monad will > -- execute the side effects. From then on, > -- only the generated value will be returned. > {-# NOINLINE cache #-} > cache :: (MonadFix m, MonadIO m) => m a -> Cached m a > cache m = unsafePerformIO $ do > key <- liftIO $ newIORef Nothing > return $ Cached $ do > ma <- liftIO $ readIORef key -- read the cached result > case ma of > Just a -> return a -- return the cached result. > Nothing -> mdo > liftIO $ -- write the result already > writeIORef key (Just a) > a <- m -- evaluate > return a > > I'm trying to understand the reasom behind the use of mdo. Can't it > be like this: > do > a <- m > liftIO $ writeIORef key (Just a) > return a > Removing the need for a recursive definition? > > Yotam > > > > > _______________________________________________ I ran into a need for something similar for FRP myself. I agree that one probably has to be careful about duplicate/concurrent evaluation. My solution at the time was an action, which returns an action that is performed only once: lazyIO :: IO a -> IO (IO a) lazyIO action = do box <- newMVar Nothing return $ modifyMVar box storeResultOnce where storeResultOnce m@(Just result) = return (m, result) storeResultOnce _ = action >>= \r -> return (Just r, r) {-# RULES "optimize lazyIO" lazyIO = unsafeInterleaveIO . (pure <$>) #-} I think you need to change the type of the cache function if you want to avoid unsafe IO functions at all: cache :: (MonadFix m, MonadIO m) => m a -> m (Cached m a) unsafePerformIO [1] already prevents duplicate/concurrent evaluation of its argument. And if you're using unsafe IO already, why not simplify it to just using unsafeInterleaveIO? It has the same guarantees about no duplication according to its Haskell source. [1] https://hackage.haskell.org/package/base-4.10.1.0/docs/System-IO-Un safe.html -------------- next part -------------- An HTML attachment was scrubbed... URL: From leepike at gmail.com Thu Jan 25 15:52:13 2018 From: leepike at gmail.com (Lee Pike) Date: Thu, 25 Jan 2018 15:52:13 +0000 Subject: [Haskell-cafe] Multiple positions open Message-ID: We have multiple positions open doing work at the intersection of Haskell, compilers, and machine learning, as well as Haskell-based infrastructure (CI, builds, etc.) Preferably Portland, Oregon or Palo Alto, California. Email me for details! Lee -------------- next part -------------- An HTML attachment was scrubbed... URL: From rick at owensmurray.com Thu Jan 25 17:32:15 2018 From: rick at owensmurray.com (Rick Owens) Date: Thu, 25 Jan 2018 11:32:15 -0600 Subject: [Haskell-cafe] LTS-10.* missing build-depends suggestion In-Reply-To: References: Message-ID: Thanks for the help/info guys! On Thu, Jan 25, 2018 at 3:51 AM, Michael Snoyman wrote: > Nice repro Dan! I hope you don't mind, I took your repro and opened a GHC > Trac ticket about this: > > https://ghc.haskell.org/trac/ghc/ticket/14717#ticket > > On Thu, Jan 25, 2018 at 9:29 AM, Dan Burton > wrote: > >> Hm, you're right. Seems like a GHC thing. I've tested a simple file with >> "import Data.Map" on both a stack project and a cabal project -- with >> containers installed in ghc's main package-db, as verified via stack/cabal >> exec ghc-pkg list containers -- and it doesn't give the hint in either case. >> >> Taking it a step further and removing cabal/stack out of the equation... >> >> $ cat Main.hs >> module Main where >> import Data.Map >> main = putStrLn "It compiles" >> >> $ ghc-pkg list containers >> /usr/local/Cellar/ghc/8.2.2/lib/ghc-8.2.2/package.conf.d >> containers-0.5.10.2 >> >> $ ghc --make -hide-all-packages -package base Main.hs >> [1 of 1] Compiling Main ( Main.hs, Main.o ) >> >> Main.hs:2:1: error: >> Could not find module ‘Data.Map’ >> Use -v to see a list of the files searched for. >> | >> 2 | import Data.Map >> | ^^^^^^^^^^^^^^^ >> >> $ ghc --make -hide-all-packages -package base -package containers Main.hs >> [1 of 1] Compiling Main ( Main.hs, Main.o ) >> Linking Main ... >> >> -- Dan Burton >> >> On Wed, Jan 24, 2018 at 8:38 PM, Michael Snoyman >> wrote: >> >>> FWIW, I've also noticed that with LTS 10/GHC 8.2.2 I no longer get the >>> package name suggestions, even when I know I have the package installed. I >>> don't know if it's an issue with Stack or GHC, I haven't investigated. But >>> I can't think of something on the Stack side which would make the behavior >>> different between GHC 8.0.2 and GHC 8.2.2. >>> >>> On Thu, Jan 25, 2018 at 4:02 AM, Dan Burton >>> wrote: >>> >>>> I believe the particular feature you are talking about is a feature of >>>> GHC. Whether a suggestion is show or not merely depends on whether GHC sees >>>> the package in question in its package database(s). >>>> >>>> If you are using stack, then you can look at one of your LTS 9 >>>> projects, and run >>>> >>>> stack exec -- ghc-pkg list >>>> >>>> In order to see the list of installed packages. (I think something like >>>> `cabal exec ghc-pkg list` should do the same for a cabal project.) >>>> >>>> Identify the packages you tend to use, go into one of your LTS 10 >>>> projects, and `stack install pkg1 pkg2 ...` >>>> >>>> Note that with stack, each minor version of LTS has its own package >>>> database, so packages locally installed into lts-10.1 will not necessarily >>>> be available in your local instance of lts-10.2. Repeat stack install to >>>> taste. >>>> >>>> tl;dr the trick is to set up your package database so that GHC knows >>>> what to suggest for you >>>> >>>> -- Dan Burton >>>> >>>> On Wed, Jan 24, 2018 at 5:12 PM, Rick Owens >>>> wrote: >>>> >>>>> Dear Haskell Café, >>>>> >>>>> I am a long-time Haskell developer with a proliferation of private >>>>> projects. I typically make very heavy use of stack and LTS. Today, I tried >>>>> to bootstrap my first project using LTS-10.* (with GHC-8.2.2) and I ran >>>>> into an interesting problem (for me). >>>>> >>>>> In the past, with lts-9.* and below, when I started cranking on some >>>>> code and writing a bunch of imports: >>>>> >>>>> > import Control.Monad.Trans.Class (MonadTrans) >>>>> > import Data.Map (Map) >>>>> >>>>> I would try to build first without updating the cabal file >>>>> build-depends, and I would get something like the following error messages: >>>>> >>>>> > /path/to/Module.hs:48:1: error: >>>>> > Failed to load interface for ‘Data.Map’ >>>>> > It is a member of the hidden package ‘containers-0.5.7.1’. >>>>> > Perhaps you need to add ‘containers’ to the build-depends in >>>>> your .cabal file. >>>>> > Use -v to see a list of the files searched for. >>>>> > >>>>> > /path/to/Module.hs:21:1: error: >>>>> > Failed to load interface for ‘Control.Monad.Trans.Class’ >>>>> > It is a member of the hidden package ‘transformers-0.5.2.0’. >>>>> > Perhaps you need to add ‘transformers’ to the build-depends in >>>>> your .cabal file. >>>>> > Use -v to see a list of the files searched for. >>>>> >>>>> >>>>> This was good because the error contained a suggested solution which >>>>> contained the missing package, and I could sort of lazily add the >>>>> build-depends I needed without having to memorize a (Module -> Package) >>>>> mapping. I even had developer tooling to do it automatically. >>>>> >>>>> With lts-10.*, however, the analogous error message looks like this: >>>>> >>>>> > /path/to/Module.hs:9:1: error: >>>>> > Could not find module ‘Data.DoubleWord’ >>>>> > Use -v to see a list of the files searched for. >>>>> > | >>>>> > 9 | import Data.DoubleWord (Word256(Word256), Word128(Word128)) >>>>> > | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ >>>>> >>>>> I am wondering, is there a way to bring back the solution suggestion? >>>>> Not having access to it has made me realize how heavily I was using that >>>>> feature. What do others think about this missing bit of supplemental error >>>>> information? >>>>> >>>>> Thanks, >>>>> >>>>> -Rick Owens >>>>> >>>>> >>>>> >>>>> >>>>> _______________________________________________ >>>>> 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. >>>> >>> >>> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From rick at owensmurray.com Thu Jan 25 20:21:37 2018 From: rick at owensmurray.com (Rick Owens) Date: Thu, 25 Jan 2018 14:21:37 -0600 Subject: [Haskell-cafe] LTS-10.* missing build-depends suggestion In-Reply-To: References: Message-ID: FWIW, I discovered how to easily find the missing package using ghc-pkg: $ stack exec ghc-pkg -- find-module Data.DoubleWord /home/rowens/.stack/programs/x86_64-linux/ghc-8.2.2/lib/ghc-8.2.2/package.conf.d (no packages) /home/rowens/.stack/snapshots/x86_64-linux/lts-10.3/8.2.2/pkgdb data-dword-0.3.1.1 /home/rowens/projects/om-legion-objects/.stack-work/install/x86_64-linux/lts-10.3/8.2.2/pkgdb (no packages) Thanks to Dan for bringing up ghc-pkg, which I had not previously had occasion to learn much about. -Rick On Thu, Jan 25, 2018 at 11:32 AM, Rick Owens wrote: > Thanks for the help/info guys! > > On Thu, Jan 25, 2018 at 3:51 AM, Michael Snoyman > wrote: > >> Nice repro Dan! I hope you don't mind, I took your repro and opened a GHC >> Trac ticket about this: >> >> https://ghc.haskell.org/trac/ghc/ticket/14717#ticket >> >> On Thu, Jan 25, 2018 at 9:29 AM, Dan Burton >> wrote: >> >>> Hm, you're right. Seems like a GHC thing. I've tested a simple file with >>> "import Data.Map" on both a stack project and a cabal project -- with >>> containers installed in ghc's main package-db, as verified via stack/cabal >>> exec ghc-pkg list containers -- and it doesn't give the hint in either case. >>> >>> Taking it a step further and removing cabal/stack out of the equation... >>> >>> $ cat Main.hs >>> module Main where >>> import Data.Map >>> main = putStrLn "It compiles" >>> >>> $ ghc-pkg list containers >>> /usr/local/Cellar/ghc/8.2.2/lib/ghc-8.2.2/package.conf.d >>> containers-0.5.10.2 >>> >>> $ ghc --make -hide-all-packages -package base Main.hs >>> [1 of 1] Compiling Main ( Main.hs, Main.o ) >>> >>> Main.hs:2:1: error: >>> Could not find module ‘Data.Map’ >>> Use -v to see a list of the files searched for. >>> | >>> 2 | import Data.Map >>> | ^^^^^^^^^^^^^^^ >>> >>> $ ghc --make -hide-all-packages -package base -package containers Main.hs >>> [1 of 1] Compiling Main ( Main.hs, Main.o ) >>> Linking Main ... >>> >>> -- Dan Burton >>> >>> On Wed, Jan 24, 2018 at 8:38 PM, Michael Snoyman >>> wrote: >>> >>>> FWIW, I've also noticed that with LTS 10/GHC 8.2.2 I no longer get the >>>> package name suggestions, even when I know I have the package installed. I >>>> don't know if it's an issue with Stack or GHC, I haven't investigated. But >>>> I can't think of something on the Stack side which would make the behavior >>>> different between GHC 8.0.2 and GHC 8.2.2. >>>> >>>> On Thu, Jan 25, 2018 at 4:02 AM, Dan Burton >>>> wrote: >>>> >>>>> I believe the particular feature you are talking about is a feature of >>>>> GHC. Whether a suggestion is show or not merely depends on whether GHC sees >>>>> the package in question in its package database(s). >>>>> >>>>> If you are using stack, then you can look at one of your LTS 9 >>>>> projects, and run >>>>> >>>>> stack exec -- ghc-pkg list >>>>> >>>>> In order to see the list of installed packages. (I think something >>>>> like `cabal exec ghc-pkg list` should do the same for a cabal project.) >>>>> >>>>> Identify the packages you tend to use, go into one of your LTS 10 >>>>> projects, and `stack install pkg1 pkg2 ...` >>>>> >>>>> Note that with stack, each minor version of LTS has its own package >>>>> database, so packages locally installed into lts-10.1 will not necessarily >>>>> be available in your local instance of lts-10.2. Repeat stack install to >>>>> taste. >>>>> >>>>> tl;dr the trick is to set up your package database so that GHC knows >>>>> what to suggest for you >>>>> >>>>> -- Dan Burton >>>>> >>>>> On Wed, Jan 24, 2018 at 5:12 PM, Rick Owens >>>>> wrote: >>>>> >>>>>> Dear Haskell Café, >>>>>> >>>>>> I am a long-time Haskell developer with a proliferation of private >>>>>> projects. I typically make very heavy use of stack and LTS. Today, I tried >>>>>> to bootstrap my first project using LTS-10.* (with GHC-8.2.2) and I ran >>>>>> into an interesting problem (for me). >>>>>> >>>>>> In the past, with lts-9.* and below, when I started cranking on some >>>>>> code and writing a bunch of imports: >>>>>> >>>>>> > import Control.Monad.Trans.Class (MonadTrans) >>>>>> > import Data.Map (Map) >>>>>> >>>>>> I would try to build first without updating the cabal file >>>>>> build-depends, and I would get something like the following error messages: >>>>>> >>>>>> > /path/to/Module.hs:48:1: error: >>>>>> > Failed to load interface for ‘Data.Map’ >>>>>> > It is a member of the hidden package ‘containers-0.5.7.1’. >>>>>> > Perhaps you need to add ‘containers’ to the build-depends in >>>>>> your .cabal file. >>>>>> > Use -v to see a list of the files searched for. >>>>>> > >>>>>> > /path/to/Module.hs:21:1: error: >>>>>> > Failed to load interface for ‘Control.Monad.Trans.Class’ >>>>>> > It is a member of the hidden package ‘transformers-0.5.2.0’. >>>>>> > Perhaps you need to add ‘transformers’ to the build-depends >>>>>> in your .cabal file. >>>>>> > Use -v to see a list of the files searched for. >>>>>> >>>>>> >>>>>> This was good because the error contained a suggested solution which >>>>>> contained the missing package, and I could sort of lazily add the >>>>>> build-depends I needed without having to memorize a (Module -> Package) >>>>>> mapping. I even had developer tooling to do it automatically. >>>>>> >>>>>> With lts-10.*, however, the analogous error message looks like this: >>>>>> >>>>>> > /path/to/Module.hs:9:1: error: >>>>>> > Could not find module ‘Data.DoubleWord’ >>>>>> > Use -v to see a list of the files searched for. >>>>>> > | >>>>>> > 9 | import Data.DoubleWord (Word256(Word256), Word128(Word128)) >>>>>> > | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ >>>>>> >>>>>> I am wondering, is there a way to bring back the solution suggestion? >>>>>> Not having access to it has made me realize how heavily I was using that >>>>>> feature. What do others think about this missing bit of supplemental error >>>>>> information? >>>>>> >>>>>> Thanks, >>>>>> >>>>>> -Rick Owens >>>>>> >>>>>> >>>>>> >>>>>> >>>>>> _______________________________________________ >>>>>> 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. >>>>> >>>> >>>> >>> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From takenobu.hs at gmail.com Fri Jan 26 13:09:03 2018 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Fri, 26 Jan 2018 22:09:03 +0900 Subject: [Haskell-cafe] Haskell to Ethereum VM ? Message-ID: Hi cafe, Does anyone know about the code generator from Haskell's syntax to Ethereum VM language (bytecode)? That is, what corresponds to Solidity in Haskell. Although Solidity is interesting, it's difficult for me to achieve quality and safety. Does such a project already exist? Regards, Takenobu -------------- next part -------------- An HTML attachment was scrubbed... URL: From carter.schonwald at gmail.com Fri Jan 26 16:43:02 2018 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Fri, 26 Jan 2018 11:43:02 -0500 Subject: [Haskell-cafe] Haskell to Ethereum VM ? In-Reply-To: References: Message-ID: Hello Takenobu, while theres definitely a lot of haskell code out there that deals with ethereum (or implementing it!), i'm not aware of anything targeting the evm isa from haskell or any other mature functional programming language On Fri, Jan 26, 2018 at 8:09 AM, Takenobu Tani wrote: > Hi cafe, > > Does anyone know about the code generator from Haskell's syntax to > Ethereum VM language (bytecode)? > That is, what corresponds to Solidity in Haskell. > > Although Solidity is interesting, it's difficult for me to achieve quality > and safety. > Does such a project already exist? > > Regards, > Takenobu > > > > _______________________________________________ > 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 haskell at patrickmn.com Fri Jan 26 17:55:46 2018 From: haskell at patrickmn.com (Patrick Mylund Nielsen) Date: Fri, 26 Jan 2018 12:55:46 -0500 Subject: [Haskell-cafe] Haskell to Ethereum VM ? In-Reply-To: References: Message-ID: <4669e0ee-3f9e-63b4-256b-9d8cfc7178ab@patrickmn.com> The Quorum[1] team has been dreaming about such a Haskell-beginner-friendly bytecode-generating DSL for a very long time. The user experience of writing applications in a language where pitfalls are so non-obvious is one of the biggest pain points of Ethereum in general. We would warmly welcome something like this, and would definitely look to use it in Quorum. (Our EVM is the same as public Ethereum.) [1]: A permissioned/non-PoW version of Ethereum with high throughput and privacy - https://github.com/jpmorganchase/quorum/ On 1/26/2018 11:43 AM, Carter Schonwald wrote: > Hello Takenobu,  > while theres definitely a lot of haskell code out there that deals with > ethereum (or implementing it!), i'm not aware of anything targeting the > evm isa from haskell or any other mature functional programming language > > On Fri, Jan 26, 2018 at 8:09 AM, Takenobu Tani > wrote: > > Hi cafe, > > Does anyone know about the code generator from Haskell's syntax to > Ethereum VM language (bytecode)? > That is, what corresponds to Solidity in Haskell. > > Although Solidity is interesting, it's difficult for me to achieve > quality and safety. > Does such a project already exist? > > Regards, > Takenobu > > > > _______________________________________________ > 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 takenobu.hs at gmail.com Sat Jan 27 01:05:26 2018 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Sat, 27 Jan 2018 10:05:26 +0900 Subject: [Haskell-cafe] Haskell to Ethereum VM ? In-Reply-To: <4669e0ee-3f9e-63b4-256b-9d8cfc7178ab@patrickmn.com> References: <4669e0ee-3f9e-63b4-256b-9d8cfc7178ab@patrickmn.com> Message-ID: Hi Carter, Patrick, Thank you for reply. Quorum is interesting! It would be very nice to be able to describe Ethereum's contract with Haskell DSL. The characteristics about immutable and type will fit DApps. Thank you very much, Takenobu 2018-01-27 2:55 GMT+09:00 Patrick Mylund Nielsen : > The Quorum[1] team has been dreaming about such a > Haskell-beginner-friendly bytecode-generating DSL for a very long time. > The user experience of writing applications in a language where pitfalls > are so non-obvious is one of the biggest pain points of Ethereum in > general. > > We would warmly welcome something like this, and would definitely look > to use it in Quorum. (Our EVM is the same as public Ethereum.) > > [1]: A permissioned/non-PoW version of Ethereum with high throughput and > privacy - https://github.com/jpmorganchase/quorum/ > > On 1/26/2018 11:43 AM, Carter Schonwald wrote: > > Hello Takenobu, > > while theres definitely a lot of haskell code out there that deals with > > ethereum (or implementing it!), i'm not aware of anything targeting the > > evm isa from haskell or any other mature functional programming language > > > > On Fri, Jan 26, 2018 at 8:09 AM, Takenobu Tani > > wrote: > > > > Hi cafe, > > > > Does anyone know about the code generator from Haskell's syntax to > > Ethereum VM language (bytecode)? > > That is, what corresponds to Solidity in Haskell. > > > > Although Solidity is interesting, it's difficult for me to achieve > > quality and safety. > > Does such a project already exist? > > > > Regards, > > Takenobu > > > > > > > > _______________________________________________ > > 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. > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From greg7mdp at gmail.com Sat Jan 27 01:22:19 2018 From: greg7mdp at gmail.com (Gregory Popovitch) Date: Fri, 26 Jan 2018 20:22:19 -0500 Subject: [Haskell-cafe] Haskell to Ethereum VM ? In-Reply-To: References: <4669e0ee-3f9e-63b4-256b-9d8cfc7178ab@patrickmn.com> Message-ID: <86E95F90581544F3AD24460B5E1B2D1B@gregava> Probably you are aware of Cardano (https://www.cardanohub.org/en/home/), a new generation blockchain platform which uses languages inspired from Haskell. From the whitepaper at https://whycardano.com/: "Systems such as Bitcoin provide an extremely inflexible and draconian scripting language that is difficult to program bespoke transactions in, and to read and understand. Yet the general programmability of languages such as Solidity introduce an extraordinary amount of complexity into the system and are useful to only a much smaller set of actors. Therefore, we have chosen to design a new language called Simon6 in honor of its creator Simon Thompson and the creator of the concepts that inspired it, Simon Peyton Jones. Simon is a domain-specific language that is based upon Composing contracts: an adventure in financial engineering. The principal idea is that financial transactions are generally composed from a collection of foundational elements7 . If one assembles a financial periodic table of elements, then one can provide support for an arbitrarily large set of compound transactions that will cover most, if not all, common transaction types without requiring general programmability. The primary advantage is that security and execution can be extremely well understood. Proofs can be written to show correctness of templates and exhaust the execution space of problematic transaction events, such as the creation of new money out of thin air or transaction malleability. Second, one can leave in extensions to add more elements by way of soft forks if new functionality is required. That said, there will always be a need to connect CSL to overlay protocols, legacy financial systems, and special purpose servers. Thus we have developed Plutus as both a general purpose smart contract language and also a special purpose DSL for interoperability. Plutus is a typed functional language based on concepts from Haskell, which can be used to write custom transaction scripts. For CSL, it will be used for complex transactions required to add support for other layers we need to connect, such as our sidechains scheme." _____ From: Haskell-Cafe [mailto:haskell-cafe-bounces at haskell.org] On Behalf Of Takenobu Tani Sent: Friday, January 26, 2018 8:05 PM To: Patrick Mylund Nielsen Cc: haskell-cafe Subject: Re: [Haskell-cafe] Haskell to Ethereum VM ? Hi Carter, Patrick, Thank you for reply. Quorum is interesting! It would be very nice to be able to describe Ethereum's contract with Haskell DSL. The characteristics about immutable and type will fit DApps. Thank you very much, Takenobu 2018-01-27 2:55 GMT+09:00 Patrick Mylund Nielsen : The Quorum[1] team has been dreaming about such a Haskell-beginner-friendly bytecode-generating DSL for a very long time. The user experience of writing applications in a language where pitfalls are so non-obvious is one of the biggest pain points of Ethereum in general. We would warmly welcome something like this, and would definitely look to use it in Quorum. (Our EVM is the same as public Ethereum.) [1]: A permissioned/non-PoW version of Ethereum with high throughput and privacy - https://github.com/ jpmorganchase/quorum/ On 1/26/2018 11:43 AM, Carter Schonwald wrote: > Hello Takenobu, > while theres definitely a lot of haskell code out there that deals with > ethereum (or implementing it!), i'm not aware of anything targeting the > evm isa from haskell or any other mature functional programming language > > On Fri, Jan 26, 2018 at 8:09 AM, Takenobu Tani > wrote: > > Hi cafe, > > Does anyone know about the code generator from Haskell's syntax to > Ethereum VM language (bytecode)? > That is, what corresponds to Solidity in Haskell. > > Although Solidity is interesting, it's difficult for me to achieve > quality and safety. > Does such a project already exist? > > Regards, > Takenobu > > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi- bin/mailman/listinfo/haskell-cafe > 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. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From takenobu.hs at gmail.com Sat Jan 27 02:27:56 2018 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Sat, 27 Jan 2018 11:27:56 +0900 Subject: [Haskell-cafe] Haskell to Ethereum VM ? In-Reply-To: <86E95F90581544F3AD24460B5E1B2D1B@gregava> References: <4669e0ee-3f9e-63b4-256b-9d8cfc7178ab@patrickmn.com> <86E95F90581544F3AD24460B5E1B2D1B@gregava> Message-ID: Hi Gregory, Thank you for much information. I have heard Cardano, but I did not know the details. It's amazing! Although Ethereum VM is stack based virtual machine, Cardano's IELE(VM) is register based VM!, it's powerfull and beautiful! In addition, it is protected by semantics. Umm, High-level safety abstructed language (Haskell based) + register based VM (IELE) ! It's amazing. Thank you for telling me details. I will explore this. Thank you very much, Takenobu 2018-01-27 10:22 GMT+09:00 Gregory Popovitch : > Probably you are aware of Cardano (https://www.cardanohub.org/en/home/), > a new generation blockchain platform which uses languages inspired from > Haskell. From the whitepaper at https://whycardano.com/: > > "Systems such as Bitcoin provide an extremely inflexible and draconian > scripting language that is difficult to program bespoke transactions in, > and to read and understand. Yet the general programmability of languages > such as Solidity introduce an extraordinary amount of complexity into the > system and are useful to only a much smaller set of actors. > > Therefore, we have chosen to design a new language called Simon6 > in honor of its creator Simon > Thompson and the creator of the concepts that inspired it, Simon Peyton > Jones. Simon is a domain-specific language that is based upon *Composing > contracts: an adventure in financial engineering > *. > > The principal idea is that financial transactions are generally composed > from a collection of foundational elements7 > . If one assembles a financial > periodic table of elements, then one can provide support for an arbitrarily > large set of compound transactions that will cover most, if not all, common > transaction types without requiring general programmability. > > The primary advantage is that security and execution can be extremely well > understood. Proofs can be written to show correctness of templates and > exhaust the execution space of problematic transaction events, such as the > creation of new money out of thin air > or transaction > malleability . > Second, one can leave in extensions to add more elements by way of soft > forks if new functionality is required. > > That said, there will always be a need to connect CSL to overlay > protocols, legacy financial systems, and special purpose servers. Thus we > have developed Plutus > as both a general > purpose smart contract language and also a special purpose DSL for > interoperability. > > Plutus is a typed functional language based on concepts from Haskell, > which can be used to write custom transaction scripts. For CSL, it will be > used for complex transactions required to add support for other layers we > need to connect, such as our sidechains scheme." > > ------------------------------ > *From:* Haskell-Cafe [mailto:haskell-cafe-bounces at haskell.org] *On Behalf > Of *Takenobu Tani > *Sent:* Friday, January 26, 2018 8:05 PM > *To:* Patrick Mylund Nielsen > *Cc:* haskell-cafe > *Subject:* Re: [Haskell-cafe] Haskell to Ethereum VM ? > > Hi Carter, Patrick, > > Thank you for reply. > Quorum is interesting! > It would be very nice to be able to describe Ethereum's contract with > Haskell DSL. > The characteristics about immutable and type will fit DApps. > > Thank you very much, > Takenobu > > > > 2018-01-27 2:55 GMT+09:00 Patrick Mylund Nielsen : > >> The Quorum[1] team has been dreaming about such a >> Haskell-beginner-friendly bytecode-generating DSL for a very long time. >> The user experience of writing applications in a language where pitfalls >> are so non-obvious is one of the biggest pain points of Ethereum in >> general. >> >> We would warmly welcome something like this, and would definitely look >> to use it in Quorum. (Our EVM is the same as public Ethereum.) >> >> [1]: A permissioned/non-PoW version of Ethereum with high throughput and >> privacy - https://github.com/jpmorganchase/quorum/ >> >> On 1/26/2018 11:43 AM, Carter Schonwald wrote: >> > Hello Takenobu, >> > while theres definitely a lot of haskell code out there that deals with >> > ethereum (or implementing it!), i'm not aware of anything targeting the >> > evm isa from haskell or any other mature functional programming language >> > >> > On Fri, Jan 26, 2018 at 8:09 AM, Takenobu Tani > > > wrote: >> > >> > Hi cafe, >> > >> > Does anyone know about the code generator from Haskell's syntax to >> > Ethereum VM language (bytecode)? >> > That is, what corresponds to Solidity in Haskell. >> > >> > Although Solidity is interesting, it's difficult for me to achieve >> > quality and safety. >> > Does such a project already exist? >> > >> > Regards, >> > Takenobu >> > >> > >> > >> > _______________________________________________ >> > 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. >> > >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From greg7mdp at gmail.com Sat Jan 27 02:48:08 2018 From: greg7mdp at gmail.com (Gregory Popovitch) Date: Fri, 26 Jan 2018 21:48:08 -0500 Subject: [Haskell-cafe] Haskell to Ethereum VM ? In-Reply-To: References: <4669e0ee-3f9e-63b4-256b-9d8cfc7178ab@patrickmn.com> <86E95F90581544F3AD24460B5E1B2D1B@gregava> Message-ID: Hi Takenobu, You are very welcome. Indeed I think that Cardano made all the right technical choices, and looks extremely promising. I am not the only one feeling that way, and Cardono, even before being released, has now the 5th highest market cap of all crypto currencies. The repeated issues with Solidity, which was designed for ease of use instead of correctness, make a lot of people feel that Cardano and its Haskell inspired scripting languages would be a much better choice for writing reliable and correct smart contracts. Good luck in your exploration. I'd like to learn more about it as well. Thanks, gregory _____ From: Takenobu Tani [mailto:takenobu.hs at gmail.com] Sent: Friday, January 26, 2018 9:28 PM To: Gregory Popovitch Cc: haskell-cafe Subject: Re: [Haskell-cafe] Haskell to Ethereum VM ? Hi Gregory, Thank you for much information. I have heard Cardano, but I did not know the details. It's amazing! Although Ethereum VM is stack based virtual machine, Cardano's IELE(VM) is register based VM!, it's powerfull and beautiful! In addition, it is protected by semantics. Umm, High-level safety abstructed language (Haskell based) + register based VM (IELE) ! It's amazing. Thank you for telling me details. I will explore this. Thank you very much, Takenobu 2018-01-27 10:22 GMT+09:00 Gregory Popovitch : Probably you are aware of Cardano (https://www.cardanohub.org/ en/home/), a new generation blockchain platform which uses languages inspired from Haskell. From the whitepaper at https://whycardano.com/: "Systems such as Bitcoin provide an extremely inflexible and draconian scripting language that is difficult to program bespoke transactions in, and to read and understand. Yet the general programmability of languages such as Solidity introduce an extraordinary amount of complexity into the system and are useful to only a much smaller set of actors. Therefore, we have chosen to design a new language called Simon6 in honor of its creator Simon Thompson and the creator of the concepts that inspired it, Simon Peyton Jones. Simon is a domain-specific language that is based upon Composing contracts: an adventure in financial engineering. The principal idea is that financial transactions are generally composed from a collection of foundational elements7 . If one assembles a financial periodic table of elements, then one can provide support for an arbitrarily large set of compound transactions that will cover most, if not all, common transaction types without requiring general programmability. The primary advantage is that security and execution can be extremely well understood. Proofs can be written to show correctness of templates and exhaust the execution space of problematic transaction events, such as the creation of new money out of thin air or transaction malleability . Second, one can leave in extensions to add more elements by way of soft forks if new functionality is required. That said, there will always be a need to connect CSL to overlay protocols, legacy financial systems, and special purpose servers. Thus we have developed Plutus as both a general purpose smart contract language and also a special purpose DSL for interoperability. Plutus is a typed functional language based on concepts from Haskell, which can be used to write custom transaction scripts. For CSL, it will be used for complex transactions required to add support for other layers we need to connect, such as our sidechains scheme." _____ From: Haskell-Cafe [mailto:haskell-cafe-bounces@ haskell.org] On Behalf Of Takenobu Tani Sent: Friday, January 26, 2018 8:05 PM To: Patrick Mylund Nielsen Cc: haskell-cafe Subject: Re: [Haskell-cafe] Haskell to Ethereum VM ? Hi Carter, Patrick, Thank you for reply. Quorum is interesting! It would be very nice to be able to describe Ethereum's contract with Haskell DSL. The characteristics about immutable and type will fit DApps. Thank you very much, Takenobu 2018-01-27 2:55 GMT+09:00 Patrick Mylund Nielsen : The Quorum[1] team has been dreaming about such a Haskell-beginner-friendly bytecode-generating DSL for a very long time. The user experience of writing applications in a language where pitfalls are so non-obvious is one of the biggest pain points of Ethereum in general. We would warmly welcome something like this, and would definitely look to use it in Quorum. (Our EVM is the same as public Ethereum.) [1]: A permissioned/non-PoW version of Ethereum with high throughput and privacy - https://github.com/jpmorgancha se/quorum/ On 1/26/2018 11:43 AM, Carter Schonwald wrote: > Hello Takenobu, > while theres definitely a lot of haskell code out there that deals with > ethereum (or implementing it!), i'm not aware of anything targeting the > evm isa from haskell or any other mature functional programming language > > On Fri, Jan 26, 2018 at 8:09 AM, Takenobu Tani > wrote: > > Hi cafe, > > Does anyone know about the code generator from Haskell's syntax to > Ethereum VM language (bytecode)? > That is, what corresponds to Solidity in Haskell. > > Although Solidity is interesting, it's difficult for me to achieve > quality and safety. > Does such a project already exist? > > Regards, > Takenobu > > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-b in/mailman/listinfo/haskell-cafe > 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-bi n/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From andrew.lelechenko at gmail.com Sat Jan 27 21:30:47 2018 From: andrew.lelechenko at gmail.com (andrew.lelechenko at gmail.com) Date: Sat, 27 Jan 2018 21:30:47 +0000 Subject: [Haskell-cafe] Taking over maintainership of exact-pi In-Reply-To: References: <2A8272FA-F807-4C4E-84C8-E6139A41DBDF@gmail.com> Message-ID: Hi Douglas, How is it going? Since you are really busy (a new baby is a big deal, congratulations) to do these changes, I’d be glad to apply them, if you are happy to add me (username Bodigrim) as a maintainer at http://hackage.haskell.org/package/exact-pi/maintainers Feel free to kick me out afterwards. Best regards, Andrew > 20 янв. 2018 г., в 19:18, Douglas McClean написал(а): > > Sorry everyone, new baby. Will review PR by end of weekend. > >> On Jan 20, 2018 1:45 PM, "Andrew Lelechenko" wrote: >> I would like to take over `exact-pi` package (https://hackage.haskell.org/package/exact-pi). >> Unfortunately, the package became incompatible with upcoming GHC 8.4 and needs an upgrade. The relevant pull request (https://github.com/dmcclean/exact-pi/pull/5), prepared by @konn, has been open for a month without response. I also tried to reach its maintainer Douglas McClean (cced) by email, but have not heard back. >> >> I am so interested in upgrading `exact-pi`, because it is a dependency of my package `arithmoi`. >> >> — >> Best regards, >> Andrew >> -------------- next part -------------- An HTML attachment was scrubbed... URL: From kindaro at gmail.com Mon Jan 29 16:21:10 2018 From: kindaro at gmail.com (sonne) Date: Mon, 29 Jan 2018 23:21:10 +0700 Subject: [Haskell-cafe] What's the story behind "applicative" in "Constant Applicative Form"? Message-ID: Hi cafe. I've been trying to make the concept of CAFs get through to me, but the very name is cryptic enough to stupefy me. What does it mean for a thing to be "applicative"? Is it related to the concept of applicative functor (likely not)? What would a constant non-applicative form look like? A non-constant applicative form? An applicative non-form, in the end? I put a question on Stack Overflow about this, only to discover no one's really sure. I would appreciate either an answer put there right away or a permission to re-post or rephrase an answer there myself, but, if you do mind, I will of course keep the answer private to this mailing list. This is the link to the question: stackoverflow.com/questions/48489778 Thank you! P.S. I guess this is my first e-mail to this list, so please kindly let me know if it's unfit or in any way out of line. From stephen.tetley at gmail.com Mon Jan 29 22:18:49 2018 From: stephen.tetley at gmail.com (Stephen Tetley) Date: Mon, 29 Jan 2018 22:18:49 +0000 Subject: [Haskell-cafe] What's the story behind "applicative" in "Constant Applicative Form"? In-Reply-To: References: Message-ID: Hi Sonne Circa the 1970s and 80s "applicative" was often used in the UK as a synonym for functional, and its coinage dates back to at least Landin's "The Next 700 Programming Languages" paper (1966). I wouldn't bet against "applicative form" being the same thing as "applicative expressions" in Landin's paper, though I have to confess this section goes over my head. I thought I'd read that researchers in the 70s and 80s preferred the term "applicative" over "functional" because "functional" can also be a synonym for "working" (rather than "not-working"), but I'm not sure how how much currency "functional" actually had in those days. I suspect "constant non-applicative form" is a misnomer - I would guess the opposite of "CAF" would be "non-constant applicative form". Best wishes Stephen On 29 January 2018 at 16:21, sonne wrote: > Hi cafe. > > I've been trying to make the concept of CAFs get through to me, but > the very name is cryptic enough to stupefy me. What does it mean for a > thing to be "applicative"? Is it related to the concept of applicative > functor (likely not)? What would a constant non-applicative form look > like? A non-constant applicative form? An applicative non-form, in the > end? > > I put a question on Stack Overflow about this, only to discover no > one's really sure. I would appreciate either an answer put there right > away or a permission to re-post or rephrase an answer there myself, > but, if you do mind, I will of course keep the answer private to this > mailing list. This is the link to the question: > stackoverflow.com/questions/48489778 > > Thank you! > > P.S. I guess this is my first e-mail to this list, so please kindly > let me know if it's unfit or in any way out of line. > _______________________________________________ > 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 kazu at iij.ad.jp Tue Jan 30 03:25:43 2018 From: kazu at iij.ad.jp (Kazu Yamamoto (=?iso-2022-jp?B?GyRCOzNLXE9CSScbKEI=?=)) Date: Tue, 30 Jan 2018 12:25:43 +0900 (JST) Subject: [Haskell-cafe] addFinalizer in GHC 7.10 Message-ID: <20180130.122543.1221412261213143075.kazu@iij.ad.jp> Hello cafe, We, the network library maintainers, have questions about System.Mem.Weak.addFinalizer in GHC 7.10. We are trying to make the library extensible especially for the socket type and the socket address type. For this purpose, a proposed definition for Socket in version 3.0.0.0 is a just CInt: newtype Socket = Socket CInt deriving (Eq, Show) One problem is that unreachable Socket cannot be GCed if CInt (a file descriptor) is not closed. To let GC work, we are trying to add a finalizer via addFinalizer: socket family stype protocol = do fd <- c_socket ... ... let s = Socket fd addFinalizer s $ close s ruturn s This works well for many cases. Unfortunately, we *sometime* got the following error with GHC 7.10: tests/SimpleSpec.hs:56: 1) Simple.sendMany works well uncaught exception: IOException of type InvalidArgument (threadWait: invalid argument (Bad file descriptor)) It seems to us that Socket is GCed too early in GHC 7.10. We don't see this behavior in other versions of GHC. So, here are our questions: Q1) Do we use addFinalizer correctly? Q2) Is this a bug of GHC 7.10? Q3) If this is a bug of GHC 7.10, are there any workarounds? --Kazu From ietf-dane at dukhovni.org Tue Jan 30 04:50:06 2018 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Mon, 29 Jan 2018 23:50:06 -0500 Subject: [Haskell-cafe] addFinalizer in GHC 7.10 In-Reply-To: <20180130.122543.1221412261213143075.kazu@iij.ad.jp> References: <20180130.122543.1221412261213143075.kazu@iij.ad.jp> Message-ID: > On Jan 29, 2018, at 10:25 PM, Kazu Yamamoto (山本和彦) wrote: > > socket family stype protocol = do > fd <- c_socket ... > ... > let s = Socket fd > addFinalizer s $ close s > ruturn s For the record, I think I've convinced Kazu Yamamoto that this is an anti-pattern. Such a finalizer would easily end up closing already closed sockets, whose file-descriptors may already be associated with other open files or sockets. That way lie all sorts of difficult to isolate race-condition bugs. To make this safe, the close function would need to mutate the socket, invalidating the enclosed file-descriptor, and would then need to be a NOP or just raise an exception if the socket is closed again (the finalizer should invoke a close variant that just returns without raising exceptions if the socket is already closed). There is, AFAIK still an unresolved bug along these lines somewhere in http-client and its dependencies. So far no reproducing cases have been provided. No very recent reports either, perhaps it went away, or people have just been more lucky lately: https://github.com/snoyberg/http-client/issues/252 https://github.com/vincenthz/hs-tls/issues/179 All that said, the original question about addFinalizer vs. GHC 7.10 may still be worth exploring, even if its use-case for Sockets goes away. So, please don't take this poset to mean that the original question should be ignored. -- Viktor. From kazu at iij.ad.jp Tue Jan 30 05:18:56 2018 From: kazu at iij.ad.jp (Kazu Yamamoto (=?iso-2022-jp?B?GyRCOzNLXE9CSScbKEI=?=)) Date: Tue, 30 Jan 2018 14:18:56 +0900 (JST) Subject: [Haskell-cafe] addFinalizer in GHC 7.10 In-Reply-To: References: <20180130.122543.1221412261213143075.kazu@iij.ad.jp> Message-ID: <20180130.141856.2722967654701867.kazu@iij.ad.jp> Hi, I registered this issue to network: https://github.com/haskell/network/issues/302 Viktor, thank you! --Kazu >> On Jan 29, 2018, at 10:25 PM, Kazu Yamamoto (山本和彦) wrote: >> >> socket family stype protocol = do >> fd <- c_socket ... >> ... >> let s = Socket fd >> addFinalizer s $ close s >> ruturn s > > For the record, I think I've convinced Kazu Yamamoto that this is > an anti-pattern. Such a finalizer would easily end up closing > already closed sockets, whose file-descriptors may already be > associated with other open files or sockets. That way lie all > sorts of difficult to isolate race-condition bugs. To make this > safe, the close function would need to mutate the socket, > invalidating the enclosed file-descriptor, and would then need to > be a NOP or just raise an exception if the socket is closed again > (the finalizer should invoke a close variant that just returns > without raising exceptions if the socket is already closed). > > There is, AFAIK still an unresolved bug along these lines somewhere > in http-client and its dependencies. So far no reproducing cases have > been provided. No very recent reports either, perhaps it went away, > or people have just been more lucky lately: > > https://github.com/snoyberg/http-client/issues/252 > https://github.com/vincenthz/hs-tls/issues/179 > > All that said, the original question about addFinalizer vs. GHC 7.10 > may still be worth exploring, even if its use-case for Sockets goes > away. So, please don't take this poset to mean that the original > question should be ignored. > > -- > Viktor. > > _______________________________________________ > 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 danburton.email at gmail.com Tue Jan 30 17:29:17 2018 From: danburton.email at gmail.com (Dan Burton) Date: Tue, 30 Jan 2018 09:29:17 -0800 Subject: [Haskell-cafe] BayHac 2018 announcement Message-ID: I am pleased to announce that BayHac 2018 will be held at the Takt office in San Francisco on the weekend of Friday, April 27 thru Sunday, April 29. BayHac is a Haskell hackathon weekend event for the San Francisco Bay Area and Silicon Valley. It will be a weekend of learning, hacking, and connecting with fellow Haskell enthusiasts. See the page for BayHac 2018 on the haskell.org wiki for details: https://wiki.haskell.org/BayHac2018 -- Dan Burton -------------- next part -------------- An HTML attachment was scrubbed... URL: From ekmett at gmail.com Tue Jan 30 21:50:36 2018 From: ekmett at gmail.com (Edward Kmett) Date: Tue, 30 Jan 2018 16:50:36 -0500 Subject: [Haskell-cafe] addFinalizer in GHC 7.10 In-Reply-To: <20180130.141856.2722967654701867.kazu@iij.ad.jp> References: <20180130.122543.1221412261213143075.kazu@iij.ad.jp> <20180130.141856.2722967654701867.kazu@iij.ad.jp> Message-ID: Attaching a finalizer to a regular data type like that is a bit of a hazard prone process. If GHC unpack your Socket in another data constructor it will get "freed" and then your socket can get finalized while you still have access to the CInt! data MySockets = MySockets {-# unpack #-} !Socket {-# unpack #-} !Socket will happily 'eat' your data constructor wrapper and if there are no references remaining to a copy of it on the heap, their finalizers will fire. Worker-wrapper transforms can do this even without any "containing" data type if you just increase your optimization level! It would be much, much safer to attach the finalizer to something that has a "presence" all its own, like Weak# () as is done in ForeignPtr. This would result in something like: data Socket = Socket !CInt (Weak# ()) Then when it gets unpacked into another data constructor, then the Weak# () still exists. This isn't free, it comes at the cost that your sockets take a couple of words each (plus finalizer space), but the approach you are taking now isn't free either as it isn't really sound. ;) *tl;dr* don't attach finalizers to regular Haskell data types if you can help it -Edward On Tue, Jan 30, 2018 at 12:18 AM, Kazu Yamamoto wrote: > Hi, > > I registered this issue to network: > > https://github.com/haskell/network/issues/302 > > Viktor, thank you! > > --Kazu > > >> On Jan 29, 2018, at 10:25 PM, Kazu Yamamoto (山本和彦) > wrote: > >> > >> socket family stype protocol = do > >> fd <- c_socket ... > >> ... > >> let s = Socket fd > >> addFinalizer s $ close s > >> ruturn s > > > > For the record, I think I've convinced Kazu Yamamoto that this is > > an anti-pattern. Such a finalizer would easily end up closing > > already closed sockets, whose file-descriptors may already be > > associated with other open files or sockets. That way lie all > > sorts of difficult to isolate race-condition bugs. To make this > > safe, the close function would need to mutate the socket, > > invalidating the enclosed file-descriptor, and would then need to > > be a NOP or just raise an exception if the socket is closed again > > (the finalizer should invoke a close variant that just returns > > without raising exceptions if the socket is already closed). > > > > There is, AFAIK still an unresolved bug along these lines somewhere > > in http-client and its dependencies. So far no reproducing cases have > > been provided. No very recent reports either, perhaps it went away, > > or people have just been more lucky lately: > > > > https://github.com/snoyberg/http-client/issues/252 > > https://github.com/vincenthz/hs-tls/issues/179 > > > > All that said, the original question about addFinalizer vs. GHC 7.10 > > may still be worth exploring, even if its use-case for Sockets goes > > away. So, please don't take this poset to mean that the original > > question should be ignored. > > > > -- > > Viktor. > > > > _______________________________________________ > > 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. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ietf-dane at dukhovni.org Tue Jan 30 22:09:45 2018 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Tue, 30 Jan 2018 17:09:45 -0500 Subject: [Haskell-cafe] addFinalizer in GHC 7.10 In-Reply-To: References: <20180130.122543.1221412261213143075.kazu@iij.ad.jp> <20180130.141856.2722967654701867.kazu@iij.ad.jp> Message-ID: <0DD25D3C-7A19-4D29-9B4E-D42D947AC3CC@dukhovni.org> > On Jan 30, 2018, at 4:50 PM, Edward Kmett wrote: > > It would be much, much safer to attach the finalizer to something that has a "presence" all its own, like Weak# () as is done in ForeignPtr. This would result in something like: > > data Socket = Socket !CInt (Weak# ()) > > Then when it gets unpacked into another data constructor, then the Weak# () still exists. This isn't free, it comes at the cost that your sockets take a couple of words each (plus finalizer space), but the approach you are taking now isn't free either as it isn't really sound. ;) > > tl;dr don't attach finalizers to regular Haskell data types if you can help it THanks, good to know. I gather the unpacking can/will happen even if Socket internals are [made] opaque to other modules? And of course in this case, in addition to avoiding running the finalizer too early, it is critical that each socket be closed at most once. Therefore, to support finalization, and make the API safe for multiple close (as seems to be the case with System.IO Handle's for example) there's a need for additional mutable state in the Socket, to keep track of whether it has or has not yet been closed. I am curious as to what your suggestion would be as to how to best keep track of such state. 1. Employ a separate MVar to keep track of socket state, and update it on close to ensure at most once close. 2. Wrap the file descriptor in an IORef, and set it to an invalid value (-1 on Unix, INVALID_SOCKET on Windows) on close. This avoids misuse not only with close, but also with attempts at read/write/... I/O after close. However it does not avoid (far less likely I think) races to close the socket from multiple threads. 3. Move the state to a wrapper structure managed in FFI code so that all socket operations are via a foreign pointer to a C-structure in which the file descriptor is invalidated on close. 4. Other suggestions... -- Viktor. From ekmett at gmail.com Tue Jan 30 22:25:17 2018 From: ekmett at gmail.com (Edward Kmett) Date: Tue, 30 Jan 2018 17:25:17 -0500 Subject: [Haskell-cafe] addFinalizer in GHC 7.10 In-Reply-To: <0DD25D3C-7A19-4D29-9B4E-D42D947AC3CC@dukhovni.org> References: <20180130.122543.1221412261213143075.kazu@iij.ad.jp> <20180130.141856.2722967654701867.kazu@iij.ad.jp> <0DD25D3C-7A19-4D29-9B4E-D42D947AC3CC@dukhovni.org> Message-ID: Yes, this can happen even if you're opaque and don't export stuff. You could attach the finalizer to an (unpacked) IORef that holds the Bool that says whether you've been finalized. An IORef holds onto a MutVar# under the hood, and so it also maintains the same sort of stable presence Weak# offered above. Similarly you _could_ just stuff the info in an MVar or ForeignPtr. Each of those has support for attaching a finalizer directly to the heap allocated part that lives in # and therefore isn't vulnerable to being inlined or unpacked. There probably should be able to be similar options for attaching the finalizer to a MutableByteArray#, even if the combinators don't exist right now, etc. I'd personally go with an IORef and then atomicModifyIORef during the "close" and "finalize" operations to extract and set the flag in one operation. That way there isn't any communication overhead, but IORef, ForeignPtr, MVar, etc. could all work. -Edward On Tue, Jan 30, 2018 at 5:09 PM, Viktor Dukhovni wrote: > > > > On Jan 30, 2018, at 4:50 PM, Edward Kmett wrote: > > > > It would be much, much safer to attach the finalizer to something that > has a "presence" all its own, like Weak# () as is done in ForeignPtr. This > would result in something like: > > > > data Socket = Socket !CInt (Weak# ()) > > > > Then when it gets unpacked into another data constructor, then the Weak# > () still exists. This isn't free, it comes at the cost that your sockets > take a couple of words each (plus finalizer space), but the approach you > are taking now isn't free either as it isn't really sound. ;) > > > > tl;dr don't attach finalizers to regular Haskell data types if you can > help it > > THanks, good to know. I gather the unpacking can/will happen even if > Socket internals are [made] opaque to other modules? > > And of course in this case, in addition to avoiding > running the finalizer too early, it is critical that each socket be closed > at most once. Therefore, to support finalization, and make the API safe > for multiple close (as seems to be the case with System.IO Handle's for > example) there's a need for additional mutable state in the Socket, to > keep track of whether it has or has not yet been closed. > > I am curious as to what your suggestion would be as to how to best keep > track of such state. > > 1. Employ a separate MVar to keep track of socket state, and update > it on close to ensure at most once close. > > 2. Wrap the file descriptor in an IORef, and set it to an invalid > value (-1 on Unix, INVALID_SOCKET on Windows) on close. This > avoids misuse not only with close, but also with attempts at > read/write/... I/O after close. However it does not avoid > (far less likely I think) races to close the socket from > multiple threads. > > 3. Move the state to a wrapper structure managed in FFI code > so that all socket operations are via a foreign pointer to > a C-structure in which the file descriptor is invalidated on > close. > > 4. Other suggestions... > > -- > Viktor. > > _______________________________________________ > 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 kazu at iij.ad.jp Wed Jan 31 00:51:20 2018 From: kazu at iij.ad.jp (Kazu Yamamoto (=?iso-2022-jp?B?GyRCOzNLXE9CSScbKEI=?=)) Date: Wed, 31 Jan 2018 09:51:20 +0900 (JST) Subject: [Haskell-cafe] addFinalizer in GHC 7.10 In-Reply-To: References: <0DD25D3C-7A19-4D29-9B4E-D42D947AC3CC@dukhovni.org> Message-ID: <20180131.095120.598442848629665459.kazu@iij.ad.jp> Hi Edward, Thank you for your excellent explanation! I'm now being convinced by the IORef approach. I should write PoC for that. --Kazu > Yes, this can happen even if you're opaque and don't export stuff. > > You could attach the finalizer to an (unpacked) IORef that holds the Bool > that says whether you've been finalized. An IORef holds onto a MutVar# > under the hood, and so it also maintains the same sort of stable presence > Weak# offered above. Similarly you _could_ just stuff the info in an MVar > or ForeignPtr. Each of those has support for attaching a finalizer directly > to the heap allocated part that lives in # and therefore isn't vulnerable > to being inlined or unpacked. > > There probably should be able to be similar options for attaching the > finalizer to a MutableByteArray#, even if the combinators don't exist right > now, etc. > > I'd personally go with an IORef and then atomicModifyIORef during the > "close" and "finalize" operations to extract and set the flag in one > operation. That way there isn't any communication overhead, but IORef, > ForeignPtr, MVar, etc. could all work. > > -Edward > > On Tue, Jan 30, 2018 at 5:09 PM, Viktor Dukhovni > wrote: > >> >> >> > On Jan 30, 2018, at 4:50 PM, Edward Kmett wrote: >> > >> > It would be much, much safer to attach the finalizer to something that >> has a "presence" all its own, like Weak# () as is done in ForeignPtr. This >> would result in something like: >> > >> > data Socket = Socket !CInt (Weak# ()) >> > >> > Then when it gets unpacked into another data constructor, then the Weak# >> () still exists. This isn't free, it comes at the cost that your sockets >> take a couple of words each (plus finalizer space), but the approach you >> are taking now isn't free either as it isn't really sound. ;) >> > >> > tl;dr don't attach finalizers to regular Haskell data types if you can >> help it >> >> THanks, good to know. I gather the unpacking can/will happen even if >> Socket internals are [made] opaque to other modules? >> >> And of course in this case, in addition to avoiding >> running the finalizer too early, it is critical that each socket be closed >> at most once. Therefore, to support finalization, and make the API safe >> for multiple close (as seems to be the case with System.IO Handle's for >> example) there's a need for additional mutable state in the Socket, to >> keep track of whether it has or has not yet been closed. >> >> I am curious as to what your suggestion would be as to how to best keep >> track of such state. >> >> 1. Employ a separate MVar to keep track of socket state, and update >> it on close to ensure at most once close. >> >> 2. Wrap the file descriptor in an IORef, and set it to an invalid >> value (-1 on Unix, INVALID_SOCKET on Windows) on close. This >> avoids misuse not only with close, but also with attempts at >> read/write/... I/O after close. However it does not avoid >> (far less likely I think) races to close the socket from >> multiple threads. >> >> 3. Move the state to a wrapper structure managed in FFI code >> so that all socket operations are via a foreign pointer to >> a C-structure in which the file descriptor is invalidated on >> close. >> >> 4. Other suggestions... >> >> -- >> Viktor. >> >> _______________________________________________ >> 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 id at joeyh.name Wed Jan 31 18:11:14 2018 From: id at joeyh.name (Joey Hess) Date: Wed, 31 Jan 2018 14:11:14 -0400 Subject: [Haskell-cafe] Spectre mitigations for Haskell Message-ID: <20180131181114.GA27384@kitenet.net> Has anyone thought about the impact of the Spectre attack (https://spectreattack.com/spectre.pdf) on Haskell programs, and mitigations? Here's my initial thoughts, bearing in mind that low level stuff is not my forte.. There are likely to be many gadgets in the ghc RTS that could be used by a Spectre variant 2 attack, using indirect branch poisoning. Since the RTS is mostly C code, C compiler mitigations such as retpoline can avoid the indirect branch prediction problems. There's also assembly in the RTS. For example, StgCRun.c contains a "jmp eax" indirect branch which might be vulnerable. FFI code can also contain vulnerable indirect branches both C and assembly. It would be good if at least securemem wasn't vulnerable to Spectre variant 2, so that Haskell programs operating on very private data could use it to avoid the attack. But, even if securemem itself doesn't contain any vulnerable gadgets (its constant time Eq shouldn't branch, which helps..), other vulnerable gadgets in the RTS and elsewhere can still be pointed at the securemem buffer. I do have Haskell programs that I would like to harden against Spectre variant 2, since they're sometimes used in a multi-user environment and operate on private data. As for Spectre variant 1, it would need something like a haskell implementation of a javascript interpreter running untrusted code, or something like lambdabot running safe haskell code. That would then be vulnerable to conditional branch misprediction to expose whatever private data the process has access to. Perhaps a sufficiently smart compiler could do something about Spectre variant 1, but there are probably not too many vulnetable programs and it can be prevented in the program by eg avoiding exposure of high-resolution timers, the same way web browsers have been dealing with this attack. -- see shy jo -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 833 bytes Desc: not available URL: