From jwlato at gmail.com Mon Feb 1 02:24:30 2016 From: jwlato at gmail.com (John Lato) Date: Mon, 01 Feb 2016 02:24:30 +0000 Subject: [Haskell-cafe] A Sliding TChan? In-Reply-To: References: Message-ID: Control.Concurrent.MVar has an example implementation of a SkipChan, which is pretty close to what you want: https://hackage.haskell.org/package/base-4.8.2.0/docs/Control-Concurrent-MVar.html . I also have a package called KickChan that implements something similar; if a consumer gets too far behind the channel becomes stale and the consumer will need to reconnect. This can be useful if e.g. the consumer gets an initial state and the channel only communicates updates. On 14:17, Thu, Jan 28, 2016 Noon Silk wrote: > I think you should be able to do this with the `pipes` and > `pipes-concurrency` libraries, in particular have a look at: > http://haddock.stackage.org/lts-5.0/pipes-concurrency-2.0.5/Pipes-Concurrent.html#v:newest > > -- > Noon > > > On Fri, Jan 29, 2016 at 7:30 AM, Mark Fine wrote: > >> We're currently using a TMChan to broadcast from a single producer thread >> to many consumer threads. This works well! However, we're seeing issues >> with a fast producer and/or a slow consumer, with the channel growing >> unbounded. Fortunately, our producer-consumer communication is >> time-sensitive and tolerant of loss: we're ok with the producer always >> writing at the expense of dropping communication to a slow consumer. >> >> A TMBChan provides a bounded channel (but no means to dupe/broadcast) >> where a writer will block once the channel fills up. In our use case, we'd >> like to continue writing to the channel but dropping off the end of the >> channel. Clojure's core-async module has some related concepts, in >> particular the notion of a sliding buffer >> >> that drops the oldest elements once full. Has anyone encountered something >> similar in working with channels and/or have any solutions? Thanks! >> >> Mark >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> > > > -- > Noon Silk, ? > > https://silky.github.io/ > > "Every morning when I wake up, I experience an exquisite joy ? the joy > of being this signature." > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From jeffbrown.the at gmail.com Mon Feb 1 07:10:16 2016 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Sun, 31 Jan 2016 23:10:16 -0800 Subject: [Haskell-cafe] Share a variable across GHCI sessions: Possible? Message-ID: Suppose v is a view onto some data in a graph[1]. You ask GHCI to (show $ nodes v). You would like to ask GHCI in another window to (show $ disambiguations v), referring to the same v. Is it possible? My motivation is to show disambiguations that are about the nodes. Examples of disambiguations would be "a ! character adjacent to the left of a word means it requires money", or "CAP stands for Coastal Alliance of Pharoahs", or "a(/n)b means a needs b". [1] Using the Functional Graph Library, I am writing a graph database editor, Digraphs With Text: https://github.com/JeffreyBenjaminBrown/digraphs-with-text DWT is exceptionally flexible. Relationships can be of any arity, and can involve other relationships. For instance, in DWT the relationship "_ needs _ in order to _" has a natural representation; I am unaware of any other system in which it does. I would *love* help! And I take job offers seriously! -- Jeffrey Benjamin Brown -------------- next part -------------- An HTML attachment was scrubbed... URL: From capn.freako at gmail.com Mon Feb 1 13:28:31 2016 From: capn.freako at gmail.com (David Banas) Date: Mon, 1 Feb 2016 05:28:31 -0800 Subject: [Haskell-cafe] Question, re: failed attempt at constraining a Traversable instance. Message-ID: <7DAD2F54-7B7A-41D7-8413-32191BD69802@gmail.com> Hi all, I?m trying to do this: data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) instance Functor Tree where fmap g Empty = Empty fmap g (Leaf x) = Leaf (g x) fmap g (Node t1 x t2) = Node (fmap g t1) (g x) (fmap g t2) instance Foldable Tree where foldMap f Empty = mempty foldMap f (Leaf x) = f x foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r instance (Monoid (f (Tree a))) => Traversable (Tree (f a)) where sequenceA Empty = pure Empty sequenceA (Leaf f) = Leaf <$> f sequenceA (Node t1 f t2) = (sequenceA t1) `mappend` (Leaf <$> f) `mappend` (sequenceA t2) And I?m being told this: The first argument of ?Traversable? should have kind ?* -> *?, but ?Tree (f a)? has kind ?*? In the instance declaration for ?Traversable (Tree (f a))? And I don?t quite understand what I?m asking for that?s forbidden. Is it that I?m trying to declare that only a certain subset of Trees are Traversable, and that?s not okay? It?s got to be all Trees or no Trees are Traversable? Thanks, -db -------------- next part -------------- An HTML attachment was scrubbed... URL: From heraldhoi at gmail.com Mon Feb 1 17:26:23 2016 From: heraldhoi at gmail.com (Geraldus) Date: Mon, 01 Feb 2016 17:26:23 +0000 Subject: [Haskell-cafe] Hackage Docs Message-ID: Hi friends! Apologize, a lot of Hackage docs issues discussed here already, but I'll decided to bring this question one more time. I'm facing missing docs during last few weeks, both Hoogle and Hayoo links to Hackage and usual response I see is "Not found". Stackage helps a lot, but most of the time I have to manually search same term on Stackage again. Can we improve this sad situation finally? -------------- next part -------------- An HTML attachment was scrubbed... URL: From adam at well-typed.com Mon Feb 1 17:53:50 2016 From: adam at well-typed.com (Adam Gundry) Date: Mon, 1 Feb 2016 17:53:50 +0000 Subject: [Haskell-cafe] Question, re: failed attempt at constraining a Traversable instance. In-Reply-To: <7DAD2F54-7B7A-41D7-8413-32191BD69802@gmail.com> References: <7DAD2F54-7B7A-41D7-8413-32191BD69802@gmail.com> Message-ID: <56AF9BAE.4050100@well-typed.com> Hi, On 01/02/16 13:28, David Banas wrote: > I?m trying to do this: > > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) > > [...] > > instance (Monoid (f (Tree a))) => Traversable (Tree (f a)) where > sequenceA Empty = pure Empty > sequenceA (Leaf f) = Leaf <$> f > sequenceA (Node t1 f t2) = (sequenceA t1) `mappend` (Leaf <$> f) > `mappend` (sequenceA t2) > > > And I?m being told this: > > The first argument of ?Traversable? should have kind ?* -> *?, but > ?Tree (f a)? has kind ?*? > In the instance declaration for ?Traversable (Tree (f a))? > > > And I don?t quite understand what I?m asking for that?s forbidden. > Is it that I?m trying to declare that only a certain subset > of /Trees/ are Traversable, and that?s not okay? It?s got to be all > Trees or no Trees are Traversable? Being Traversable (or indeed a Functor) is a property of type constructors (of kind * -> *), not of types (of kind *). In much the same way, the list type constructor [] is Traversable, but not the particular list type [Int]. The explicitly quantified type of `traverse` for a particular `Traversable t` is this: forall f a b . Applicative f => (a -> f b) -> t a -> f (t b) Notice that this involves `t a` and `t b` where `a` and `b` are polymorphic type variables, chosen by the caller of `traverse`. There's no way to constrain the particular types that might be used to instantiate those type variables. What are you really trying to do? If you'd like to write an instance for `Traversable Tree`, the haddocks for Traversable might help. :-) Or perhaps you'd like to use something like `Traversable (Compose Tree f)`? Hope this helps, Adam -- Adam Gundry, Haskell Consultant Well-Typed LLP, http://www.well-typed.com/ From wojtek at power.com.pl Mon Feb 1 18:53:32 2016 From: wojtek at power.com.pl (=?UTF-8?Q?Wojtek_Narczy=c5=84ski?=) Date: Mon, 1 Feb 2016 19:53:32 +0100 Subject: [Haskell-cafe] Instance match surprise Message-ID: <56AFA9AC.1020209@power.com.pl> Dear List, Why does the first instance match? ANY is neither Eq nor Typeable. I thought I had some basic understanding of type classes, and now this... wojtek at biuro:~/src/he$ cat minimatch.hs {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} module MiniMatch where import Data.Typeable data A130 = A130 deriving (Eq) data ANY = ANY class AtmAcct a class Against q class (AtmAcct a, Against q) => Match a q where match :: a -> q -> Bool instance AtmAcct A130 instance Against ANY instance (Eq a, Eq q, Typeable a, Typeable q, AtmAcct a, Against q) => Match a q where match _ _ = False instance (AtmAcct a) => Match a ANY where match _ _ = True m1 = match A130 ANY -- offending line wojtek at biuro:~/src/he$ ghc minimatch.hs [1 of 1] Compiling MiniMatch ( minimatch.hs, minimatch.o ) minimatch.hs:21:6: error: ? Overlapping instances for Match A130 ANY arising from a use of ?match? Matching instances: instance (Eq a, Eq q, Typeable a, Typeable q, AtmAcct a, Against q) => Match a q -- Defined at minimatch.hs:18:10 instance AtmAcct a => Match a ANY -- Defined at minimatch.hs:19:10 ? In the expression: match A130 ANY In an equation for ?m1?: m1 = match A130 ANY -- Thanks, Wojtek Narczy?ski From imantc at gmail.com Mon Feb 1 19:19:57 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 1 Feb 2016 20:19:57 +0100 Subject: [Haskell-cafe] Instance match surprise In-Reply-To: <56AFA9AC.1020209@power.com.pl> References: <56AFA9AC.1020209@power.com.pl> Message-ID: Cze?? Wojtek, in instance (Eq a, Eq q, Typeable a, Typeable q, AtmAcct a, Against q) => Match a q where ANY is q because instance Against ANY A130 is a because of instance AtmAcct A130 in instance (AtmAcct a) => Match a ANY where match _ _ = True ANY is specified A130 is a because of instance AtmAcct A130 ;) From wojtek at power.com.pl Mon Feb 1 20:22:31 2016 From: wojtek at power.com.pl (=?UTF-8?Q?Wojtek_Narczy=c5=84ski?=) Date: Mon, 1 Feb 2016 21:22:31 +0100 Subject: [Haskell-cafe] Instance match surprise In-Reply-To: References: <56AFA9AC.1020209@power.com.pl> Message-ID: <56AFBE87.2060509@power.com.pl> On 01.02.2016 20:19, Imants Cekusins wrote: > in > instance (Eq a, Eq q, Typeable a, Typeable q, AtmAcct a, Against q) => > Match a q where > > ANY is q > because > instance Against ANY > > But I require q to be Eq and Typeable, and ANY is none of those two? -- Wojtek From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Mon Feb 1 20:29:51 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Mon, 1 Feb 2016 20:29:51 +0000 Subject: [Haskell-cafe] Instance match surprise In-Reply-To: <56AFA9AC.1020209@power.com.pl> References: <56AFA9AC.1020209@power.com.pl> Message-ID: <20160201202951.GE16950@weber> On Mon, Feb 01, 2016 at 07:53:32PM +0100, Wojtek Narczy?ski wrote: > Why does the first instance match? ANY is neither Eq nor Typeable. I > thought I had some basic understanding of type classes, and now > this... > minimatch.hs:21:6: error: > ? Overlapping instances for Match A130 ANY > arising from a use of ?match? > Matching instances: > instance (Eq a, Eq q, Typeable a, Typeable q, AtmAcct a, > Against q) => > Match a q > -- Defined at minimatch.hs:18:10 > instance AtmAcct a => Match a ANY -- Defined at minimatch.hs:19:10 > ? In the expression: match A130 ANY > In an equation for ?m1?: m1 = match A130 ANY The way instance resolution works is somewhat counterintuitive, and it took me a long time to get my head around it. The upshot is that the instance context is *absolutely irrelevant* when looking for a matching instance. The type is Match A130 ANY The instances in scope are (Eq a, Eq q, Typeable a, Typeable q, AtmAcct a, Against q) => Match a q and AtmAcct a => Match a ANY But because the instance contexts are irrelevant, these are just ... => Match a q and ... => Match a ANY Both of these match 'Match A123 ANY', and thus you have overlap. If you want to know *why* the instance contexts are ignored then you'll have to ask someone who knows more about Prolog :) Tom From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Mon Feb 1 20:30:42 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Mon, 1 Feb 2016 20:30:42 +0000 Subject: [Haskell-cafe] Instance match surprise In-Reply-To: <56AFBE87.2060509@power.com.pl> References: <56AFA9AC.1020209@power.com.pl> <56AFBE87.2060509@power.com.pl> Message-ID: <20160201203041.GF16950@weber> On Mon, Feb 01, 2016 at 09:22:31PM +0100, Wojtek Narczy?ski wrote: > On 01.02.2016 20:19, Imants Cekusins wrote: > >in > >instance (Eq a, Eq q, Typeable a, Typeable q, AtmAcct a, Against q) => > > Match a q where > > > >ANY is q > >because > >instance Against ANY > > But I require q to be Eq and Typeable, and ANY is none of those two? Correct. The actual reason is more subtle. See my sibling post. Tom From K.Bleijenberg at lijbrandt.nl Mon Feb 1 20:31:59 2016 From: K.Bleijenberg at lijbrandt.nl (Kees Bleijenberg) Date: Mon, 1 Feb 2016 21:31:59 +0100 Subject: [Haskell-cafe] why is rpar/rpar always faster (book Simon Marlow)? Message-ID: <000001d15d2f$99f3c1b0$cddb4510$@lijbrandt.nl> I'am reading the book Parallel and Concurrent Programming in Haskell. The book has an explanation of the Eval monad. It compares rpar/rpar (example 2-1), rpar/rseq (example 2-2), rpar/rseq/rpar (example 2-3) and rpar/rpar/rseq/rseq in rpar.hs The examples run all in the total time 0.82 s. When I run rpar/rpar (example2-1) on my computer total time is 1.34 s. All other examples have total time 2.22 s. I'am running the examples exactly as written in the book. I tried the examples in opposite order, but the rpar/rpar example remains a lot faster. I wonder why the other examples are so much slower and why is it so different from the book? I run the examples on a computer with 4 cores. I'am using ghc version 7.10.1 on Win64. The Haskell version is 32 bits. If I run the examples with +RTS -N1 all examples use the same time (2.20 sec). Kees -------------- next part -------------- An HTML attachment was scrubbed... URL: From hyarion at iinet.net.au Mon Feb 1 20:34:42 2016 From: hyarion at iinet.net.au (Ben) Date: Tue, 02 Feb 2016 07:34:42 +1100 Subject: [Haskell-cafe] Instance match surprise In-Reply-To: <56AFBE87.2060509@power.com.pl> References: <56AFA9AC.1020209@power.com.pl> <56AFBE87.2060509@power.com.pl> Message-ID: <4DE461D1-CF6B-4E99-8B80-AD114D69343F@iinet.net.au> On 2 February 2016 7:22:31 AM AEDT, "Wojtek Narczy?ski" wrote: >On 01.02.2016 20:19, Imants Cekusins wrote: >> in >> instance (Eq a, Eq q, Typeable a, Typeable q, AtmAcct a, Against q) >=> >> Match a q where >> >> ANY is q >> because >> instance Against ANY >> >> >But I require q to be Eq and Typeable, and ANY is none of those two? > >-- >Wojtek >_______________________________________________ >Haskell-Cafe mailing list >Haskell-Cafe at haskell.org >http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe But there *could* be other instances the compiler just can't see at the moment (because it's in another module that's not imported). Someone else could then import this module and that other module and observe inconsistent instances. To avoid that problem, the type class system *never* commits to "negative" information; if an instance choice is only valid because there *isn't* a possible instance in scope then that instance choice is not valid after all. A consequence is that constraints on an instance have to be ignored when choosing an instance (they still might make the choice be an error after it is chosen, but they don't affect which instance is selected). And so an instance like: ... => Match a q is the *only* possible instance you can write, since it will match everything regardless of the ... (unless you use overlapping instances). -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Mon Feb 1 20:39:04 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 1 Feb 2016 21:39:04 +0100 Subject: [Haskell-cafe] Instance match surprise In-Reply-To: <20160201203041.GF16950@weber> References: <56AFA9AC.1020209@power.com.pl> <56AFBE87.2060509@power.com.pl> <20160201203041.GF16950@weber> Message-ID: .. could we say: main purpose of instance contexts is to allow use of 'open' (e.g. a) types when defining instance methods (i.e. we can use (==) a inside instance method if the context says Eq a) , rather than for looking up an applicable instance? From wojtek at power.com.pl Mon Feb 1 22:33:46 2016 From: wojtek at power.com.pl (=?UTF-8?Q?Wojtek_Narczy=c5=84ski?=) Date: Mon, 1 Feb 2016 23:33:46 +0100 Subject: [Haskell-cafe] Instance match surprise In-Reply-To: <4DE461D1-CF6B-4E99-8B80-AD114D69343F@iinet.net.au> References: <56AFA9AC.1020209@power.com.pl> <56AFBE87.2060509@power.com.pl> <4DE461D1-CF6B-4E99-8B80-AD114D69343F@iinet.net.au> Message-ID: <56AFDD4A.3070605@power.com.pl> On 01.02.2016 21:34, Ben wrote: > But there *could* be other instances the compiler just can't see at > the moment (because it's in another module that's not imported). > Someone else could then import this module and that other module and > observe inconsistent instances. > Okay, I get it. In another module there might be instances Eq and Typeable for ANY, and then the instances would indeed overlap. It makes sense. > To avoid that problem, the type class system *never* commits to > "negative" information; if an instance choice is only valid because > there *isn't* a possible instance in scope then that instance choice > is not valid after all. > I will have to produce many instances by hand. Couldn't the compiler just postpone the its overlap checking until linking? Or might I forbid creation of Eq and Typeable instances of ANY? -- Wojtek From hyarion at iinet.net.au Mon Feb 1 22:49:00 2016 From: hyarion at iinet.net.au (Ben) Date: Tue, 02 Feb 2016 09:49:00 +1100 Subject: [Haskell-cafe] Instance match surprise In-Reply-To: <56AFDD4A.3070605@power.com.pl> References: <56AFA9AC.1020209@power.com.pl> <56AFBE87.2060509@power.com.pl> <4DE461D1-CF6B-4E99-8B80-AD114D69343F@iinet.net.au> <56AFDD4A.3070605@power.com.pl> Message-ID: <0530EFC0-8CFD-4C61-A80B-339583065BC5@iinet.net.au> On 2 February 2016 9:33:46 AM AEDT, "Wojtek Narczy?ski" wrote: >On 01.02.2016 21:34, Ben wrote: >> But there *could* be other instances the compiler just can't see at >> the moment (because it's in another module that's not imported). >> Someone else could then import this module and that other module and >> observe inconsistent instances. >> > >Okay, I get it. In another module there might be instances Eq and >Typeable for ANY, and then the instances would indeed overlap. It makes > >sense. > >> To avoid that problem, the type class system *never* commits to >> "negative" information; if an instance choice is only valid because >> there *isn't* a possible instance in scope then that instance choice >> is not valid after all. >> > >I will have to produce many instances by hand. > >Couldn't the compiler just postpone the its overlap checking until >linking? Or might I forbid creation of Eq and Typeable instances of >ANY? > >-- >Wojtek >_______________________________________________ >Haskell-Cafe mailing list >Haskell-Cafe at haskell.org >http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe It potentially could, but it didn't (the design isn't without tradeoffs). What you can do is look into overlapping instances; you can make the compiler allow those two instances to overlap and pick the most specific one that applies at each use site. It still wouldn't be actually using the constraints to choose the instance, but in code that statically knows its talking about Any it can use that instance, and if it's an unknown type variable you presumably *won't* be able to prove Typeable or Eq if it could possibly be Any, so the code still wouldn't compile. I have very rarely actually used this, because it can be a little "dangerous" (you can get those inconsistent instances the ignore-the-instance-constraints rule is designed to avoid), but with a little discipline it can work fine. Read up on the GHC documentation on the OverlappingInstances extension. -------------- next part -------------- An HTML attachment was scrubbed... URL: From wojtek at power.com.pl Mon Feb 1 22:56:58 2016 From: wojtek at power.com.pl (=?UTF-8?Q?Wojtek_Narczy=c5=84ski?=) Date: Mon, 1 Feb 2016 23:56:58 +0100 Subject: [Haskell-cafe] Instance match surprise In-Reply-To: <20160201202951.GE16950@weber> References: <56AFA9AC.1020209@power.com.pl> <20160201202951.GE16950@weber> Message-ID: <56AFE2BA.5020405@power.com.pl> On 01.02.2016 21:29, Tom Ellis wrote: > If you want to know*why* the instance contexts are ignored then you'll have > to ask someone who knows more about Prolog:) I think I know. There is really no way of knowing that there is no vicious little instance Eq ANY lurking deep down some obscure useless module. It is called: open world assumption. -- Wojtek -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Feb 2 06:38:25 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 2 Feb 2016 06:38:25 +0000 Subject: [Haskell-cafe] Instance match surprise In-Reply-To: <56AFE2BA.5020405@power.com.pl> References: <56AFA9AC.1020209@power.com.pl> <20160201202951.GE16950@weber> <56AFE2BA.5020405@power.com.pl> Message-ID: <20160202063825.GG16950@weber> On Mon, Feb 01, 2016 at 11:56:58PM +0100, Wojtek Narczy?ski wrote: > On 01.02.2016 21:29, Tom Ellis wrote: > >If you want to know*why* the instance contexts are ignored then you'll have > >to ask someone who knows more about Prolog:) > I think I know. There is really no way of knowing that there is no > vicious little instance Eq ANY lurking deep down some obscure > useless module. It is called: open world assumption. Yes, Ben's explanation was a good one. From P.Achten at cs.ru.nl Tue Feb 2 09:33:48 2016 From: P.Achten at cs.ru.nl (Peter Achten) Date: Tue, 2 Feb 2016 10:33:48 +0100 Subject: [Haskell-cafe] [TFP 2016] 1st call for papers Message-ID: <56B077FC.1090002@cs.ru.nl> ----------------------------- C A L L F O R P A P E R S ----------------------------- ======== TFP 2016 =========== 17th Symposium on Trends in Functional Programming June 8-10, 2016 University of Maryland, College Park Near Washington, DC http://tfp2016.org/ The symposium on Trends in Functional Programming (TFP) is an international forum for researchers with interests in all aspects of functional programming, taking a broad view of current and future trends in the area. It aspires to be a lively environment for presenting the latest research results, and other contributions (see below). Authors of draft papers will be invited to submit revised papers based on the feedback receive at the symposium. A post-symposium refereeing process will then select a subset of these articles for formal publication. TFP 2016 will be the main event of a pair of functional programming events. TFP 2016 will be accompanied by the International Workshop on Trends in Functional Programming in Education (TFPIE), which will take place on June 7nd. The TFP symposium is the heir of the successful series of Scottish Functional Programming Workshops. Previous TFP symposia were held in * Edinburgh (Scotland) in 2003; * Munich (Germany) in 2004; * Tallinn (Estonia) in 2005; * Nottingham (UK) in 2006; * New York (USA) in 2007; * Nijmegen (The Netherlands) in 2008; * Komarno (Slovakia) in 2009; * Oklahoma (USA) in 2010; * Madrid (Spain) in 2011; * St. Andrews (UK) in 2012; * Provo (Utah, USA) in 2013; * Soesterberg (The Netherlands) in 2014; * and Inria Sophia-Antipolis (France) in 2015. For further general information about TFP please see the TFP homepage. (http://www.tifp.org/). == SCOPE == The symposium recognizes that new trends may arise through various routes. As part of the Symposium's focus on trends we therefore identify the following five article categories. High-quality articles are solicited in any of these categories: Research Articles: leading-edge, previously unpublished research work Position Articles: on what new trends should or should not be Project Articles: descriptions of recently started new projects Evaluation Articles: what lessons can be drawn from a finished project Overview Articles: summarizing work with respect to a trendy subject Articles must be original and not simultaneously submitted for publication to any other forum. They may consider any aspect of functional programming: theoretical, implementation-oriented, or experience-oriented. Applications of functional programming techniques to other languages are also within the scope of the symposium. Topics suitable for the symposium include, but are not limited to: Functional programming and multicore/manycore computing Functional programming in the cloud High performance functional computing Extra-functional (behavioural) properties of functional programs Dependently typed functional programming Validation and verification of functional programs Debugging and profiling for functional languages Functional programming in different application areas: security, mobility, telecommunications applications, embedded systems, global computing, grids, etc. Interoperability with imperative programming languages Novel memory management techniques Program analysis and transformation techniques Empirical performance studies Abstract/virtual machines and compilers for functional languages (Embedded) domain specific languages New implementation strategies Any new emerging trend in the functional programming area If you are in doubt on whether your article is within the scope of TFP, please contact the TFP 2016 program chair, David Van Horn. == BEST PAPER AWARDS == To reward excellent contributions, TFP awards a prize for the best paper accepted for the formal proceedings. TFP traditionally pays special attention to research students, acknowledging that students are almost by definition part of new subject trends. A student paper is one for which the authors state that the paper is mainly the work of students, the students are listed as first authors, and a student would present the paper. A prize for the best student paper is awarded each year. In both cases, it is the PC of TFP that awards the prize. In case the best paper happens to be a student paper, that paper will then receive both prizes. == SPONSORS == TFP is financially supported by CyberPoint, Galois, Trail of Bits, and the University of Maryland Computer Science Department. == PAPER SUBMISSIONS == Acceptance of articles for presentation at the symposium is based on a lightweight peer review process of extended abstracts (4 to 10 pages in length) or full papers (20 pages). The submission must clearly indicate which category it belongs to: research, position, project, evaluation, or overview paper. It should also indicate which authors are research students, and whether the main author(s) are students. A draft paper for which ALL authors are students will receive additional feedback by one of the PC members shortly after the symposium has taken place. We use EasyChair for the refereeing process. Papers must be submitted at: https://easychair.org/conferences/?conf=tfp2016 Papers must be written in English, and written using the LNCS style. For more information about formatting please consult the Springer LNCS web site: http://www.springer.com/computer/lncs?SGWID=0-164-6-793341-0 == IMPORTANT DATES == Submission of draft papers: April 8, 2016 Notification: April 15, 2016 Registration: May 13, 2016 TFP Symposium: June 8-10, 2016 Student papers feedback: June 14, 2016 Submission for formal review: July 14, 2016 Notification of acceptance: September 14, 2016 Camera ready paper: October 14, 2016 == PROGRAM COMMITTEE == Amal Ahmed Northeastern University (US) Nada Amin ?cole Polytechnique F?d?rale de Lausanne (CH) Kenichi Asai Ochanomizu University (JP) Ma?gorzata Biernacka University of Wroclaw (PL) Laura Castro University of A Coru?a (ES) Ravi Chugh University of Chicago (US) Silvia Ghilezan University of Novi Sad (SR) Clemens Grelck University of Amsterdam (NL) John Hughes Chalmers University of Technology (SE) Suresh Jagannathan Purdue University (US) Pieter Koopman Radboud University Nijmegen (NL) Geoffrey Mainland Drexel University (US) Chris Martens University of California, Santa Cruz (US) Jay McCarthy University of Massachusetts, Lowell (US) Heather Miller ?cole Polytechnique F?d?rale de Lausanne (CH) Manuel Serrano INRIA, Sophia-Antipolis (FR) Scott Smith Johns Hopkins University (US) ?ric Tanter University of Chile (CL) David Van Horn (Chair) University of Maryland (US) Niki Vazou University of California, San Diego (US) From david.feuer at gmail.com Tue Feb 2 17:41:34 2016 From: david.feuer at gmail.com (David Feuer) Date: Tue, 2 Feb 2016 12:41:34 -0500 Subject: [Haskell-cafe] Is there a type class for boring types? Message-ID: Or, alternatively, some common class that lets me express that a type is boring (i.e., inhabited by precisely one fully-defined value)? lens has Settable, whose law ensures the type involved has a boring representation (in the sense of representable functor), but is there a more fundamental way? class Boring x where inhabitant :: x instance Boring () where inhabitant = () instance Boring (Proxy a) where inhabitant = Proxy instance Boring y => Boring (x -> y) where inhabitant = const inhabitant instance (Boring x, Boring y) => Boring (x, y) where inhabitant = (inhabitant, inhabitant) instance Boring x => Boring (Const x y) where inhabitant = Const inhabitant instance Boring x => Boring (Identity x) where inhabitant = Identity inhabitant ... -------------- next part -------------- An HTML attachment was scrubbed... URL: From ollie at ocharles.org.uk Tue Feb 2 18:05:46 2016 From: ollie at ocharles.org.uk (Oliver Charles) Date: Tue, 02 Feb 2016 18:05:46 +0000 Subject: [Haskell-cafe] Is there a type class for boring types? In-Reply-To: References: Message-ID: Seems a bit of an ad hoc class, but maybe class (Bounded a, Eq a) => Singular a where singular :: a With the constraint that singular = maxBound = minBound. Not going to let you write an instance for (->) though, but maybe there are other ways to get that with a different property. On Tue, Feb 2, 2016 at 5:42 PM David Feuer wrote: > Or, alternatively, some common class that lets me express that a type is > boring (i.e., inhabited by precisely one fully-defined value)? lens has > Settable, whose law ensures the type involved has a boring representation > (in the sense of representable functor), but is there a more fundamental > way? > > class Boring x where > inhabitant :: x > instance Boring () where > inhabitant = () > instance Boring (Proxy a) where > inhabitant = Proxy > instance Boring y => Boring (x -> y) where > inhabitant = const inhabitant > instance (Boring x, Boring y) => Boring (x, y) where > inhabitant = (inhabitant, inhabitant) > instance Boring x => Boring (Const x y) where > inhabitant = Const inhabitant > instance Boring x => Boring (Identity x) where > inhabitant = Identity inhabitant > ... > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From monkleyon at googlemail.com Tue Feb 2 19:16:39 2016 From: monkleyon at googlemail.com (insanemole .) Date: Tue, 2 Feb 2016 20:16:39 +0100 Subject: [Haskell-cafe] Is there a type class for boring types? In-Reply-To: References: Message-ID: I suspect there are a lot of classes that are almost right - and they might even be better suited to a particular application than the more generic solutions. The most striking for me is Monoid. 'inhabitant' looks like 'mempty', while 'mappend' would simply be (\_ _ -> inhabitant). What's more, almost all instances you mention are already instances of Monoid, so less work for you. Also note that there is no way to ensure that only "truly boring" classes will be made instances of your class, so maybe relying on Monoid is enough? Another class that comes to mind is class Unit m where unit :: m () which is one of the fundamental classes of the functor hierarchy. (Note that pure x == fmap (const x) unit). Granted, it's of a different kind, but... Just this weekend I have been working on a polykinded class: class Reducible target r where reduce :: Proxy r -> target which can be seen as a generalization of Boring, Unit, Typeable, and heaps of other stuff. So there is probably no end to how fundamental you can be. Am 02.02.2016 18:41 schrieb "David Feuer" : > Or, alternatively, some common class that lets me express that a type is > boring (i.e., inhabited by precisely one fully-defined value)? lens has > Settable, whose law ensures the type involved has a boring representation > (in the sense of representable functor), but is there a more fundamental > way? > > class Boring x where > inhabitant :: x > instance Boring () where > inhabitant = () > instance Boring (Proxy a) where > inhabitant = Proxy > instance Boring y => Boring (x -> y) where > inhabitant = const inhabitant > instance (Boring x, Boring y) => Boring (x, y) where > inhabitant = (inhabitant, inhabitant) > instance Boring x => Boring (Const x y) where > inhabitant = Const inhabitant > instance Boring x => Boring (Identity x) where > inhabitant = Identity inhabitant > ... > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Tue Feb 2 20:28:57 2016 From: david.feuer at gmail.com (David Feuer) Date: Tue, 2 Feb 2016 15:28:57 -0500 Subject: [Haskell-cafe] Is there a type class for boring types? In-Reply-To: References: Message-ID: Because Monoid has the unfortunate instance instance Monoid m => Monoid (a -> m) this would work (without, of course, giving me the law I want). But the uniqueness of the inhabitant is the real point, and there doesn't seem to be any way to enforce that except by a stated law. On Feb 2, 2016 2:16 PM, "insanemole ." wrote: > I suspect there are a lot of classes that are almost right - and they > might even be better suited to a particular application than the more > generic solutions. > > The most striking for me is Monoid. 'inhabitant' looks like 'mempty', > while 'mappend' would simply be (\_ _ -> inhabitant). What's more, almost > all instances you mention are already instances of Monoid, so less work for > you. Also note that there is no way to ensure that only "truly boring" > classes will be made instances of your class, so maybe relying on Monoid is > enough? > > Another class that comes to mind is > class Unit m where unit :: m () > which is one of the fundamental classes of the functor hierarchy. (Note > that pure x == fmap (const x) unit). Granted, it's of a different kind, > but... > Just this weekend I have been working on a polykinded class: > class Reducible target r where reduce :: Proxy r -> target > which can be seen as a generalization of Boring, Unit, Typeable, and heaps > of other stuff. So there is probably no end to how fundamental you can be. > Am 02.02.2016 18:41 schrieb "David Feuer" : > >> Or, alternatively, some common class that lets me express that a type is >> boring (i.e., inhabited by precisely one fully-defined value)? lens has >> Settable, whose law ensures the type involved has a boring representation >> (in the sense of representable functor), but is there a more fundamental >> way? >> >> class Boring x where >> inhabitant :: x >> instance Boring () where >> inhabitant = () >> instance Boring (Proxy a) where >> inhabitant = Proxy >> instance Boring y => Boring (x -> y) where >> inhabitant = const inhabitant >> instance (Boring x, Boring y) => Boring (x, y) where >> inhabitant = (inhabitant, inhabitant) >> instance Boring x => Boring (Const x y) where >> inhabitant = Const inhabitant >> instance Boring x => Boring (Identity x) where >> inhabitant = Identity inhabitant >> ... >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Feb 2 21:34:18 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 2 Feb 2016 21:34:18 +0000 Subject: [Haskell-cafe] Is there a type class for boring types? In-Reply-To: References: Message-ID: <20160202213418.GH16950@weber> On Tue, Feb 02, 2016 at 12:41:34PM -0500, David Feuer wrote: > Or, alternatively, some common class that lets me express that a type is > boring (i.e., inhabited by precisely one fully-defined value)? FWIW it's the dual of Empty: https://hackage.haskell.org/package/total-1.0.4/docs/Lens-Family-Total.html From david.feuer at gmail.com Tue Feb 2 21:59:39 2016 From: david.feuer at gmail.com (David Feuer) Date: Tue, 2 Feb 2016 16:59:39 -0500 Subject: [Haskell-cafe] Is there a type class for boring types? In-Reply-To: <20160202213418.GH16950@weber> References: <20160202213418.GH16950@weber> Message-ID: Indeed! Empty is lucky. The existence, for a type x, of a function impossible :: forall y . x -> y is sufficient--parametricity guarantees uniqueness. For Boring/Singular, this is certainly not the case. Non-boring types y typically have multiple functions possible :: forall x . x -> y We'd really want sole :: Pi (y :: a) -> inhabitant = y For some horrifyingly vague notion of equality. That obviously isn't going to cut it for real Haskell. On Feb 2, 2016 4:34 PM, "Tom Ellis" < tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > On Tue, Feb 02, 2016 at 12:41:34PM -0500, David Feuer wrote: > > Or, alternatively, some common class that lets me express that a type is > > boring (i.e., inhabited by precisely one fully-defined value)? > > FWIW it's the dual of Empty: > > > https://hackage.haskell.org/package/total-1.0.4/docs/Lens-Family-Total.html > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From muranushi at gmail.com Wed Feb 3 01:37:57 2016 From: muranushi at gmail.com (Takayuki Muranushi) Date: Wed, 3 Feb 2016 10:37:57 +0900 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? Message-ID: Show instance for non-ascii characters prints their character codes. This is sad for Haskell users that speaks language other than English. > 'A' 'A' > '?' '\196' > '?' '\28450' > print $ [(++"'s dad"), (++"'s mom")] <*> ["Simon", "John"] ["Simon's dad","John's dad","Simon's mom","John's mom"] > print $ [(++"??"), (++"??")] <*> ["??", "??"] ["\30000\20013\12398\29238","\23665\30000\12398\29238","\30000\20013\12398\27597","\23665\30000\12398\27597"] The function that needs improvement is showLitChar in GHC.Show, which currently prints any character larger than ASCII code 127 by its character code: http://haddock.stackage.org/lts-5.1/base-4.8.2.0/src/GHC-Show.html showLitChar :: Char -> ShowS showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDec (shows (ord c)) s) On the other hand, there is GHC.Unicode.isPrint, the predicate for printable Unicode characters, that is calling on a foreign function u_iswprint for the knowledge. https://hackage.haskell.org/package/base-4.8.2.0/docs/src/GHC.Unicode.html#isPrint I think one of the solution is to import and call u_iswprint from GHC.Show, too, but I don't know it's against any design choices. Yesterday, I had a chance to teach Haskell (in Japanese,) and I had to use English in some of the most exciting examples, like the Applicative List example above. I would heartedly like to see GHC improve in these directions, so that we can make more happy learning materials on Haskell. Let me ask your opinions on what is the best way to do this (or is better not to do this), before I submit something to GHC Trac. Best, -------------------------------- -- Takayuki MURANUSHI -- RIKEN Advanced Institute for Computational Science -- http://nushio3.github.io/ -- http://www.geocities.jp/takascience/ -------------------------------- From david.feuer at gmail.com Wed Feb 3 02:05:17 2016 From: david.feuer at gmail.com (David Feuer) Date: Tue, 2 Feb 2016 21:05:17 -0500 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: Message-ID: Unfortunately, I don't think there is any way to do exactly this without breaking the assumptions of a lot of existing code. But I suspect you can work around the problem in a few different ways, one of which strikes me as reasonable, if not quite perfectly accurate in all cases: Write a function ushow that applies show to the given element, then digs through the resulting string converting escape sequences corresponding to valid Unicode codepoints into those codepoints. On Tue, Feb 2, 2016 at 8:37 PM, Takayuki Muranushi wrote: > Show instance for non-ascii characters prints their character codes. > This is sad for Haskell users that speaks language other than English. > >> 'A' > 'A' >> '?' > '\196' >> '?' > '\28450' >> print $ [(++"'s dad"), (++"'s mom")] <*> ["Simon", "John"] > ["Simon's dad","John's dad","Simon's mom","John's mom"] >> print $ [(++"??"), (++"??")] <*> ["??", "??"] > ["\30000\20013\12398\29238","\23665\30000\12398\29238","\30000\20013\12398\27597","\23665\30000\12398\27597"] > > The function that needs improvement is showLitChar in GHC.Show, which > currently prints any character larger than ASCII code 127 by its > character code: > > http://haddock.stackage.org/lts-5.1/base-4.8.2.0/src/GHC-Show.html > > showLitChar :: Char -> ShowS > showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDec (shows > (ord c)) s) > > On the other hand, there is GHC.Unicode.isPrint, the predicate for > printable Unicode characters, that is calling on a foreign function > u_iswprint for the knowledge. > > https://hackage.haskell.org/package/base-4.8.2.0/docs/src/GHC.Unicode.html#isPrint > > I think one of the solution is to import and call u_iswprint from > GHC.Show, too, > but I don't know it's against any design choices. > > > > Yesterday, I had a chance to teach Haskell (in Japanese,) and I had to > use English in some of the most exciting examples, like the > Applicative List example above. I would heartedly like to see GHC > improve in these directions, so that we can make more happy learning > materials on Haskell. > > Let me ask your opinions on what is the best way to do this (or is > better not to do this), before I submit something to GHC Trac. > > > Best, > > -------------------------------- > -- Takayuki MURANUSHI > -- RIKEN Advanced Institute for Computational Science > -- http://nushio3.github.io/ > -- http://www.geocities.jp/takascience/ > -------------------------------- > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From muranushi at gmail.com Wed Feb 3 02:20:42 2016 From: muranushi at gmail.com (Takayuki Muranushi) Date: Wed, 3 Feb 2016 11:20:42 +0900 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: Message-ID: Dear David Kraeutmann, thank you for your advice. Now I know that the best thing to do before I submit something to GHC Trac was nothing but actually to submit it :) https://ghc.haskell.org/trac/ghc/ticket/11529#ticket Dear David Feuer, thank you for your suggestion. I also think `ushow` is a good idea. Then we'd like to have a ghci flag, that switches the `show` in the REPL to `ushow` . Shall we continue the discussion to the ticket #11529, and could you please help me list up the cases where the change will break the assumptions of existing codes? Takayuki MURANUSHI RIKEN Advanced Institute for Computational Science http://nushio3.github.io/ http://www.geocities.jp/takascience/ 2016-02-03 11:05 GMT+09:00 David Feuer : > Unfortunately, I don't think there is any way to do exactly this > without breaking the assumptions of a lot of existing code. But I > suspect you can work around the problem in a few different ways, one > of which strikes me as reasonable, if not quite perfectly accurate in > all cases: > > Write a function ushow that applies show to the given element, then > digs through the resulting string converting escape sequences > corresponding to valid Unicode codepoints into those codepoints. > > On Tue, Feb 2, 2016 at 8:37 PM, Takayuki Muranushi wrote: >> Show instance for non-ascii characters prints their character codes. >> This is sad for Haskell users that speaks language other than English. >> >>> 'A' >> 'A' >>> '?' >> '\196' >>> '?' >> '\28450' >>> print $ [(++"'s dad"), (++"'s mom")] <*> ["Simon", "John"] >> ["Simon's dad","John's dad","Simon's mom","John's mom"] >>> print $ [(++"??"), (++"??")] <*> ["??", "??"] >> ["\30000\20013\12398\29238","\23665\30000\12398\29238","\30000\20013\12398\27597","\23665\30000\12398\27597"] >> >> The function that needs improvement is showLitChar in GHC.Show, which >> currently prints any character larger than ASCII code 127 by its >> character code: >> >> http://haddock.stackage.org/lts-5.1/base-4.8.2.0/src/GHC-Show.html >> >> showLitChar :: Char -> ShowS >> showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDec (shows >> (ord c)) s) >> >> On the other hand, there is GHC.Unicode.isPrint, the predicate for >> printable Unicode characters, that is calling on a foreign function >> u_iswprint for the knowledge. >> >> https://hackage.haskell.org/package/base-4.8.2.0/docs/src/GHC.Unicode.html#isPrint >> >> I think one of the solution is to import and call u_iswprint from >> GHC.Show, too, >> but I don't know it's against any design choices. >> >> >> >> Yesterday, I had a chance to teach Haskell (in Japanese,) and I had to >> use English in some of the most exciting examples, like the >> Applicative List example above. I would heartedly like to see GHC >> improve in these directions, so that we can make more happy learning >> materials on Haskell. >> >> Let me ask your opinions on what is the best way to do this (or is >> better not to do this), before I submit something to GHC Trac. >> >> >> Best, >> >> -------------------------------- >> -- Takayuki MURANUSHI >> -- RIKEN Advanced Institute for Computational Science >> -- http://nushio3.github.io/ >> -- http://www.geocities.jp/takascience/ >> -------------------------------- >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From chmdko at gmail.com Wed Feb 3 06:30:06 2016 From: chmdko at gmail.com (Michael Christensen) Date: Tue, 2 Feb 2016 22:30:06 -0800 Subject: [Haskell-cafe] Accessing and Inspecting StgBindings in Ghci Message-ID: <56B19E6E.6060401@gmail.com> Hi all, I'm currently trying to understand how STG works, and my goal right now is to be able to inspect StgBinding values. I've written a short program, based on the wiki article GHC/As a library , like below: -- Code.hs -- module Lib (printSTG, dumpSTG) where import Control.Monad.Ghc (lift, runGhcT) import CorePrep (corePrepPgm) import CoreToStg (coreToStg) import DynFlags (defaultFatalMessager, defaultFlushOut) import GHC hiding (runGhcT) import GHC.Paths (libdir) import HscMain (newHscEnv) import HscTypes (hsc_dflags, typeEnvTyCons) import Outputable (interppSP, showSDoc) import System.Environment (getArgs) import StgSyn (StgBinding) dumpSTG :: String -> IO [StgBinding] dumpSTG fileName = defaultErrorHandler defaultFatalMessager defaultFlushOut $ runGhcT (Just libdir) $ do sess <- getSession let dflags = hsc_dflags sess setSessionDynFlags dflags cm <- compileToCoreModule fileName let md = cm_module cm ml <- fmap ms_location $ getModSummary $ moduleName md lift $ do cp <- corePrepPgm sess ml <$> cm_binds <*> (typeEnvTyCons . cm_types) $ cm coreToStg dflags md cp printSTG = getArgs >>= \x -> case x of [] -> putStrLn "usage: Main " (fileName:_) -> do bindings <- dumpSTG fileName str <- runGhcT (Just libdir) $ do dflags <- getSessionDynFlags return $ showSDoc dflags $ interppSP bindings putStrLn str This works when I compile it to print out a Haskell file in STG format. However, *my question is*, is there a way so that I can call dumpSTG to get back that list of StgBindings, *from within Ghci*? Whenever I do so within Ghci, i.e. ghci> :l code.hs ghci> bindings <- dumpSTG "fileToTest.hs" : panic! (the 'impossible' happened) (GHC version 7.10.3 for x86_64-unknown-linux): no package state yet: call GHC.setSessionDynFlags I know that it's saying I need to set the session dyn flags, but I'm not sure how that can get done from within Ghci, especially because that needs to get done within the GhcMonad. Part of my problem may stem from having a inadequate understanding of monads. Any help or pointers would be greatly appreciated! Thank you very much, Mike -------------- next part -------------- An HTML attachment was scrubbed... URL: From chmdko at gmail.com Wed Feb 3 06:58:46 2016 From: chmdko at gmail.com (Michael Christensen) Date: Tue, 2 Feb 2016 22:58:46 -0800 Subject: [Haskell-cafe] Accessing and Inspecting StgBindings in Ghci In-Reply-To: <56B19E6E.6060401@gmail.com> References: <56B19E6E.6060401@gmail.com> Message-ID: <56B1A526.2070605@gmail.com> Hi all, I discovered that the issue of trying to use the "dumpSTG" function from with ghci was occuring whenever I tried to run it on one particular Haskell input file. When I used it on a different file, it allowed me to get the list of STG bindings in ghci as desired. I'll be investigating why that first file is causing the ghci panic, but other than that, my question has been answered/resolved. Thanks, Michael On 02/02/2016 10:30 PM, Michael Christensen wrote: > Hi all, > > I'm currently trying to understand how STG works, and my goal right > now is to be able to inspect StgBinding values. I've written a short > program, based on the wiki article GHC/As a library > , like below: > > -- Code.hs -- > module Lib (printSTG, dumpSTG) where > > import Control.Monad.Ghc (lift, runGhcT) > import CorePrep (corePrepPgm) > import CoreToStg (coreToStg) > import DynFlags (defaultFatalMessager, > defaultFlushOut) > import GHC hiding (runGhcT) > import GHC.Paths (libdir) > import HscMain (newHscEnv) > import HscTypes (hsc_dflags, typeEnvTyCons) > import Outputable (interppSP, showSDoc) > import System.Environment (getArgs) > import StgSyn (StgBinding) > > dumpSTG :: String -> IO [StgBinding] > dumpSTG fileName = defaultErrorHandler defaultFatalMessager > defaultFlushOut $ > runGhcT (Just libdir) $ do > sess <- getSession > let dflags = hsc_dflags sess > setSessionDynFlags dflags > cm <- compileToCoreModule fileName > let md = cm_module cm > ml <- fmap ms_location $ getModSummary $ moduleName md > lift $ do > cp <- corePrepPgm sess ml <$> cm_binds <*> (typeEnvTyCons . > cm_types) $ cm > coreToStg dflags md cp > > printSTG = > getArgs >>= \x -> case x of > [] -> putStrLn "usage: Main " > (fileName:_) -> do > bindings <- dumpSTG fileName > str <- runGhcT (Just libdir) $ do > dflags <- getSessionDynFlags > return $ showSDoc dflags $ interppSP bindings > putStrLn str > > This works when I compile it to print out a Haskell file in STG format. > > However, *my question is*, is there a way so that I can call dumpSTG > to get back that list of StgBindings, *from within Ghci*? Whenever I > do so within Ghci, i.e. > > ghci> :l code.hs > ghci> bindings <- dumpSTG "fileToTest.hs" > : panic! (the 'impossible' happened) > (GHC version 7.10.3 for x86_64-unknown-linux): > no package state yet: call GHC.setSessionDynFlags > > I know that it's saying I need to set the session dyn flags, but I'm > not sure how that can get done from within Ghci, especially because > that needs to get done within the GhcMonad. Part of my problem may > stem from having a inadequate understanding of monads. Any help or > pointers would be greatly appreciated! > > Thank you very much, > Mike > -------------- next part -------------- An HTML attachment was scrubbed... URL: From hjgtuyl at chello.nl Wed Feb 3 10:47:06 2016 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Wed, 03 Feb 2016 11:47:06 +0100 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: Message-ID: On Wed, 03 Feb 2016 02:37:57 +0100, Takayuki Muranushi wrote: > Show instance for non-ascii characters prints their character codes. > This is sad for Haskell users that speaks language other than English. > >> 'A' > 'A' >> '?' > '\196' >> '?' > '\28450' You could use wxHaskell to display the output of your program, as the attached image shows. Regards, Henk-Jan van Tuyl -- 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://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- -------------- next part -------------- A non-text attachment was scrubbed... Name: HelloWorld.png Type: image/png Size: 3593 bytes Desc: not available URL: From dct25-561bs at mythic-beasts.com Wed Feb 3 12:13:22 2016 From: dct25-561bs at mythic-beasts.com (David Turner) Date: Wed, 3 Feb 2016 12:13:22 +0000 Subject: [Haskell-cafe] Problems with cabal and stackage Message-ID: Hi, Overnight there seems to have been a change to stackage where it's now issuing redirects from http to https URLs: ~$ cabal update Downloading the latest package list from stackage-lts-2.22 Warning: http error: Unable to handle redirect, unsupported scheme: https://www.stackage.org/snapshot/lts-2.22/00-index.tar.gz cabal: Failed to download http://www.stackage.org/snapshot/lts-2.22/00-index.tar.gz : ErrorMisc "Error HTTP code: 301" My cabal doesn't seem to like https and I think it's a recentish version: $ cabal --version cabal-install version 1.22.0.0 using version 1.22.0.0 of the Cabal library I'm probably using a bit of an old workflow (and I know that LTS-2 is pretty old too) but is there any simple way of getting this working again? Cheers, -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at snoyman.com Wed Feb 3 12:49:37 2016 From: michael at snoyman.com (Michael Snoyman) Date: Wed, 3 Feb 2016 14:49:37 +0200 Subject: [Haskell-cafe] Problems with cabal and stackage In-Reply-To: References: Message-ID: Sorry about that, I brought it up in issue #150[1] and had thought that cabal-install was no longer a limiting factor on forcing SSL connections. I've just added a workaround that disables the redirect for tarballs, so that it should still work with cabal-install, while granting most users the security guarantees of using SSL. I believe this will be a sufficient workaround, but I'd appreciate if you could test and confirm that this fixes the problem for you. [1] https://github.com/fpco/stackage-server/issues/150 On Wed, Feb 3, 2016 at 2:13 PM, David Turner wrote: > Hi, > > Overnight there seems to have been a change to stackage where it's now > issuing redirects from http to https URLs: > > ~$ cabal update > Downloading the latest package list from stackage-lts-2.22 > Warning: http error: Unable to handle redirect, unsupported scheme: > https://www.stackage.org/snapshot/lts-2.22/00-index.tar.gz > cabal: Failed to download > http://www.stackage.org/snapshot/lts-2.22/00-index.tar.gz : ErrorMisc > "Error > HTTP code: 301" > > > My cabal doesn't seem to like https and I think it's a recentish version: > > $ cabal --version > cabal-install version 1.22.0.0 > using version 1.22.0.0 of the Cabal library > > I'm probably using a bit of an old workflow (and I know that LTS-2 is > pretty old too) but is there any simple way of getting this working again? > > Cheers, > -------------- next part -------------- An HTML attachment was scrubbed... URL: From travis.cardwell at extellisys.com Wed Feb 3 13:07:26 2016 From: travis.cardwell at extellisys.com (Travis Cardwell) Date: Wed, 3 Feb 2016 22:07:26 +0900 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: Message-ID: <56B1FB8E.3020906@extellisys.com> On 02/03/2016 10:37 AM, Takayuki Muranushi wrote: > I think one of the solution is to import and call u_iswprint from > GHC.Show, too, > but I don't know it's against any design choices. +1 for only escaping non-printable characters. > Yesterday, I had a chance to teach Haskell (in Japanese,) and I had to > use English in some of the most exciting examples, like the > Applicative List example above. I would heartedly like to see GHC > improve in these directions, so that we can make more happy learning > materials on Haskell. As a workaround, perhaps you can avoid using print/show with core data structures. Using your applicative example: > mapM_ putStrLn $ [(++"??"), (++"??")] <*> ["??", "??"] ???? ???? ???? ???? For other data structures, you can write your own Show instance: data Name = Name String String instance Show Name where show (Name family given) = family ++ given > print $ Person "??" "??" ???? Travis From dct25-561bs at mythic-beasts.com Wed Feb 3 13:16:00 2016 From: dct25-561bs at mythic-beasts.com (David Turner) Date: Wed, 3 Feb 2016 13:16:00 +0000 Subject: [Haskell-cafe] Problems with cabal and stackage In-Reply-To: References: Message-ID: Thanks Michael, all seems well with the world again. Cheers, David On 3 February 2016 at 12:49, Michael Snoyman wrote: > Sorry about that, I brought it up in issue #150[1] and had thought that > cabal-install was no longer a limiting factor on forcing SSL connections. > I've just added a workaround that disables the redirect for tarballs, so > that it should still work with cabal-install, while granting most users the > security guarantees of using SSL. I believe this will be a sufficient > workaround, but I'd appreciate if you could test and confirm that this > fixes the problem for you. > > [1] https://github.com/fpco/stackage-server/issues/150 > > On Wed, Feb 3, 2016 at 2:13 PM, David Turner < > dct25-561bs at mythic-beasts.com> wrote: > >> Hi, >> >> Overnight there seems to have been a change to stackage where it's now >> issuing redirects from http to https URLs: >> >> ~$ cabal update >> Downloading the latest package list from stackage-lts-2.22 >> Warning: http error: Unable to handle redirect, unsupported scheme: >> https://www.stackage.org/snapshot/lts-2.22/00-index.tar.gz >> cabal: Failed to download >> http://www.stackage.org/snapshot/lts-2.22/00-index.tar.gz : ErrorMisc >> "Error >> HTTP code: 301" >> >> >> My cabal doesn't seem to like https and I think it's a recentish version: >> >> $ cabal --version >> cabal-install version 1.22.0.0 >> using version 1.22.0.0 of the Cabal library >> >> I'm probably using a bit of an old workflow (and I know that LTS-2 is >> pretty old too) but is there any simple way of getting this working again? >> >> Cheers, >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From nawi at nawi.is Wed Feb 3 13:31:22 2016 From: nawi at nawi.is (Christoph R. Murauer) Date: Wed, 3 Feb 2016 14:31:22 +0100 Subject: [Haskell-cafe] Building / cross compile GHC for OpenBSD/macppc. Message-ID: Hello ! I am new here - sorry, if I ask something what was asked before. OpenBSD provides for amd64 and other platforms GHC and, also the haskell-platform which works very good. I try to get one of the old PowerMac's with a G5 CPU and saw, that there is no GHC (yes, there is a very old version - something like 3.x) for OpenBSD/macppc. I got some informations about to cross compile and saw also the wiki at https://ghc.haskell.org/trac/ghc/wiki/Building/CrossCompiling now my main question is, are there more informations about it ? Available for cross compile is GHC and haskell-platform 7.10.3, gcc 4.2.1 20070719, llvm 3.5.20140228 all on amd64. The planned target platforms are Mac's / PowerMac's with G3, G4 and G5 CPU's. All versions of OpenBSD/macppc are 32 bit only (including the G5). A cross compile from Mac OS X is no option because the OpenBSD project should be able to cross build on their machines (security reasons). Thanks for informations and tips. Regards, Christoph From gracjanpolak at gmail.com Wed Feb 3 21:02:32 2016 From: gracjanpolak at gmail.com (Gracjan Polak) Date: Wed, 3 Feb 2016 22:02:32 +0100 Subject: [Haskell-cafe] Month in Haskell Mode January 2016 Message-ID: Welcome Haskell Mode users, Haskell Mode progress report for January 2016. For previous issue see December 2015 . Reddit discussion . What is Haskell Mode? Haskell Mode is an umbrella project for multiple Emacs tools for efficient Haskell development. Haskell Mode is an open source project developed by a group of volunteers constantly looking for contributions. For more information how to help see https://github.com/haskell/haskell-mode. Important developments Haskell Mode 2015 retrospective was published. Emacs 23 support was dropped. Last stable haskell-mode release that supports Emacs 23 is haskell-mode version 13.18 . We have added code coverage reporting and it already helped to nail down some missing cases in our test suite for indentation and font locking. We are currently at 30% coverage. Request Haskell Mode web presence is none at this point. I'd like to ask a volunteer to create a static web page deployed on github pages that will serve as Haskell Mode home page. Any takers? Current project focus Current project focus is to lower entry barrier for newcomers by defining bite-sized tasks. Get 50 'well-defined-tasks' done as by the metric: https://github.com/haskell/haskell-mode/issues?q=is%3Aissue+label%3Awell-defined-task+is%3Aclosed A 'well-defined-task' is a category of tasks that have the field cleared for them, questions already sorted out and detailed information how to get them done. So you can just sit, search for 'well-defined-task' label and enjoy the coding! The point is to lower the entry barrier for new users, new issue reporters and advanced programmers but Emacs lisp beginners to contribute to the project. Current status: 14 well-defined-tasks closed plus 13 more open . If only you can help with reaching our targets please do so! Issues closed in January - [Discussion] Character class for apostrophe #549 - Debugger triggered on "match c of", a typo for "case c of" #599 - Interactive mode recognizes some lines as compiler errors incorrectly #635 - make check should recompile files properly #709 - haskell-process-suggest-pragma hangs emacs #754 - ghc-mod / stack / dist dir #801 - [Discussion] REPL vs IDE #809 - haskell-mode becomes unresponsive when adding a language pragma #820 - Drop Emacs 23 support #847 - Can't press enter in haskell interactive mode #876 - Mac OS X El Capitan: no such file or directory, ghci #908 - Emacs hangs when typing behind whitespace #980 - haskell-process-load-file error (wrong-type-argument number-or-marker-p nil) when code has an error #1004 - Regression quasi-quotes are not highlighted anymore #1041 - Custom Haskell variables don't retain their customization #1043 - Indentation point missing for record data declarations #1044 - Font lock Role annotations #1057 - Use undercover.el and https://coveralls.io/ #1062 - haskell-cabal-strip-list and haskell-cabal-listify #1076 - Indentation of guards does not work sensibly with haskell-indentation #1079 - Indentation of first data constructor does not work with haskell-indent #1080 - Annoying indentation behaviour when declaring data types #1081 - Can't indent, gets error. #1082 - [Discussion] Make haskell-indentation external, editor agnostic project #1086 - haskell-cabal-subsection-arrange-lines inserts superfluous commas #1094 - haskell-indentation misbehaves for comments #1101 - haskell-process-path-* now allowed to be lists #1112 - Wrong completion-at-point in Haskell interpreter with helm #1113 Pull requests merged in January - Record indentation should follow tibell style #1047 - Defcustoms should not be autoloaded #1048 - Define url and some keywords/tags for haskell-mode #1049 - Make quasi quote more visible #1051 - Lexeme parsing improvements #1052 - Skip an indentation test for Emacs 25 #1053 - Require at least Emacs 24.1 #1055 - Add font lock type/data family declarations #1056 - User manual updates #1058 - Add literate font lock tests, remove unused parts #1059 - Fix typos in documentation strings #1060 - Use plain string face for quasi quotes #1061 - Add code coverage #1063 - Add keybinding for haskell-cabal-visit-file #1064 - Add type role to font lock #1066 - Add test for SQL font-lock #1067 - Add test for 'type role' font-lock #1068 - Remove turn-on/off-haskell-font-lock #1069 - More font lock tests #1070 - Add tests and fix for classify by first char #1071 - Disallow leading spaces in error regexp in interactive mode #1072 - Add some tests for indentation #1073 - Inline haskell-mode-jump-to-loc #1075 - Increase haskell-cabal.el coverage #1077 - Define haskell-package struct's slots #1083 - Utils coverage #1089 - Utils coverage #1090 - Improve haskell-utils-reduce-string. Add tests #1092 - Add post-command-hook related tests #1093 - Test utils #1095 - Add string tests #1096 - Follow comma style when arranging a Cabal section #1098 - Detect comma style #1099 - Implement haskell-goto-first-error #1100 - Bump version to 16.1-git #1102 - Honor equals on its own line in data decl #1105 - Honor equals on separate line after guards #1106 - Remove a stray parenthesis #1108 - Tidy up haskell-load.el: untabify, reindent. Fix some warnings. #1111 - Allow haskell-process-path-* to be lists. #1114 - Add haskell-indent tests #1115 - Prevent haskell-doc-mode to hang Emacs during user input waiting #1116 - Remove haskell-interactive-mode-completion-cache #1119 Contributors active in January Arthur Fayzrakhmanov (????? ????????????), Bozhidar Batsov, Dan Aloni, Daniel Bergey, Fice-T, Gracjan Polak, Herbert Valerio Riedel, Kirill Ignatiev, Mike Sperber, Thomas Winant, U-Yuriy-PCYuriy, issue-dispenser, mrBliss Contributing Haskell Mode needs volunteers like any other open source project. For more information see: https://github.com/haskell/haskell-mode/wiki Also drop by our IRC channel: #haskell-emacs at irc.freenode.net. Thanks! -------------- next part -------------- An HTML attachment was scrubbed... URL: From atzeus at gmail.com Wed Feb 3 21:11:56 2016 From: atzeus at gmail.com (Atze van der Ploeg) Date: Wed, 3 Feb 2016 22:11:56 +0100 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: <56B1FB8E.3020906@extellisys.com> References: <56B1FB8E.3020906@extellisys.com> Message-ID: I think we can all agree these characters should be shown. Maybe a GHC bug report is a good idea? On 02/03/2016 10:37 AM, Takayuki Muranushi wrote: > I think one of the solution is to import and call u_iswprint from > GHC.Show, too, > but I don't know it's against any design choices. +1 for only escaping non-printable characters. > Yesterday, I had a chance to teach Haskell (in Japanese,) and I had to > use English in some of the most exciting examples, like the > Applicative List example above. I would heartedly like to see GHC > improve in these directions, so that we can make more happy learning > materials on Haskell. As a workaround, perhaps you can avoid using print/show with core data structures. Using your applicative example: > mapM_ putStrLn $ [(++"??"), (++"??")] <*> ["??", "??"] ???? ???? ???? ???? For other data structures, you can write your own Show instance: data Name = Name String String instance Show Name where show (Name family given) = family ++ given > print $ Person "??" "??" ???? Travis _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe at haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: From kane at kane.cx Wed Feb 3 22:02:31 2016 From: kane at kane.cx (David Kraeutmann) Date: Wed, 3 Feb 2016 23:02:31 +0100 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: <56B1FB8E.3020906@extellisys.com> Message-ID: <56B278F7.30503@kane.cx> You could also use an approach similar to what 'lens' does and write a bit of Template Haskell to generate Unicode-aware Show instances. On 2/3/2016 10:11 PM, Atze van der Ploeg wrote: > I think we can all agree these characters should be shown. Maybe a GHC bug > report is a good idea? > On 02/03/2016 10:37 AM, Takayuki Muranushi wrote: > > I think one of the solution is to import and call u_iswprint from > > GHC.Show, too, > > but I don't know it's against any design choices. > > +1 for only escaping non-printable characters. > > > Yesterday, I had a chance to teach Haskell (in Japanese,) and I had to > > use English in some of the most exciting examples, like the > > Applicative List example above. I would heartedly like to see GHC > > improve in these directions, so that we can make more happy learning > > materials on Haskell. > > As a workaround, perhaps you can avoid using print/show with core data > structures. Using your applicative example: > > > mapM_ putStrLn $ [(++"??"), (++"??")] <*> ["??", "??"] > ???? > ???? > ???? > ???? > > For other data structures, you can write your own Show instance: > > data Name = Name String String > > instance Show Name where > show (Name family given) = family ++ given > > > print $ Person "??" "??" > ???? > > Travis > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- A non-text attachment was scrubbed... Name: smime.p7s Type: application/pkcs7-signature Size: 4291 bytes Desc: S/MIME Cryptographic Signature URL: From david.feuer at gmail.com Wed Feb 3 22:03:51 2016 From: david.feuer at gmail.com (David Feuer) Date: Wed, 3 Feb 2016 17:03:51 -0500 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: <56B1FB8E.3020906@extellisys.com> Message-ID: There's one open now. thomie commented ( https://ghc.haskell.org/trac/ghc/ticket/11529#comment:4 ) that it's possible to hook up your choice of showing function as the one GHCi should use to display values. This strikes me as the best available approach preserving backwards compatibility. Adding a GHCi flag for this might be reasonable. On Wed, Feb 3, 2016 at 4:11 PM, Atze van der Ploeg wrote: > I think we can all agree these characters should be shown. Maybe a GHC bug > report is a good idea? > On 02/03/2016 10:37 AM, Takayuki Muranushi wrote: > > I think one of the solution is to import and call u_iswprint from > > GHC.Show, too, > > but I don't know it's against any design choices. > > +1 for only escaping non-printable characters. > > > Yesterday, I had a chance to teach Haskell (in Japanese,) and I had to > > use English in some of the most exciting examples, like the > > Applicative List example above. I would heartedly like to see GHC > > improve in these directions, so that we can make more happy learning > > materials on Haskell. > > As a workaround, perhaps you can avoid using print/show with core data > structures. Using your applicative example: > > > mapM_ putStrLn $ [(++"??"), (++"??")] <*> ["??", "??"] > ???? > ???? > ???? > ???? > > For other data structures, you can write your own Show instance: > > data Name = Name String String > > instance Show Name where > show (Name family given) = family ++ given > > > print $ Person "??" "??" > ???? > > Travis > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From noonslists at gmail.com Wed Feb 3 22:33:18 2016 From: noonslists at gmail.com (Noon Silk) Date: Thu, 4 Feb 2016 09:33:18 +1100 Subject: [Haskell-cafe] Hackage Docs In-Reply-To: References: Message-ID: Yeah. I'm a bit mystified about this issue myself. I've created a GitHub issue: https://github.com/haskell/hackage-server/issues/478 inspired by this and the other recent threads. Hopefully some of the maintainers of the hackage library will respond and we can get a plan together and make some progress here. -- Noon On Tue, Feb 2, 2016 at 4:26 AM, Geraldus wrote: > Hi friends! > > Apologize, a lot of Hackage docs issues discussed here already, but I'll > decided to bring this question one more time. > > I'm facing missing docs during last few weeks, both Hoogle and Hayoo links > to Hackage and usual response I see is "Not found". Stackage helps a lot, > but most of the time I have to manually search same term on Stackage again. > > Can we improve this sad situation finally? > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -- 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 horstmey at Mathematik.Uni-Marburg.de Thu Feb 4 01:42:14 2016 From: horstmey at Mathematik.Uni-Marburg.de (Thomas Horstmeyer) Date: Thu, 4 Feb 2016 01:42:14 +0000 Subject: [Haskell-cafe] A Sliding TChan? In-Reply-To: References: Message-ID: <56B2AC76.1070903@informatik.uni-marburg.de> Hi Mark, your question made me take a look at the TChan implementation, which I always had wanted to do (but never had the time). To test my understanding, I sketched a TChan variation that should solve the problem. (A test with one sender and two receivers showed expected output but I did not measure memory usage.) The sender replaces older messages with a marker. This should make the content available to the garbage collector (if it is not referenced by a receiver who has read it). On reading a marker, a receiver skips directly to the next valid message. On the downside, the sender keeps a reference to the last n messages, so they will not be garbage collected even if every receiver has read them. Thomas {-# LANGUAGE CPP, DeriveDataTypeable #-} module Control.Concurrent.STM.TBBroadcast( #ifdef __GLASGOW_HASKELL__ TSender, TReceiver, newSender, newSenderIO, writeBC, newReceiver, readBC #endif ) where #ifdef __GLASGOW_HASKELL__ import GHC.Conc import Data.Typeable (Typeable) data TSender a = Sender {-# UNPACK #-} !(TVar Int) {-# UNPACK #-} !(TVar (TVarList a)) {-# UNPACK #-} !(TVar (TVarList a)) deriving (Eq, Typeable) type TVarList a = TVar (TList a) data TList a = TNil | TCons a {-# UNPACK #-} !(TVarList a) | Outdated {-# UNPACK #-} !(TVar (TVarList a)) newSender :: Int -> STM (TSender a) newSender n | n <= 0 = error "windows size must be >=0" | otherwise = do hole <- newTVar TNil first <- newTVar hole end <- newTVar hole count <- newTVar n return (Sender count first end) newSenderIO :: Int -> IO (TSender a) newSenderIO n | n <= 0 = error "windows size must be >=0" | otherwise = do hole <- newTVarIO TNil first <- newTVarIO hole end <- newTVarIO hole count <- newTVarIO n return (Sender count first end) writeBC :: TSender a -> a -> STM () writeBC (Sender count first end) a = do listend <- readTVar end new_listend <- newTVar TNil writeTVar listend (TCons a new_listend) writeTVar end new_listend n <- readTVar count case n of 0 -> do listhead <- readTVar first head <- readTVar listhead case head of TCons _ tl -> writeTVar first tl writeTVar listhead (Outdated first) _ -> writeTVar count $! (n-1) data TReceiver a = Receiver {-# UNPACK #-} !(TVar (TVarList a)) newReceiver :: TSender a -> STM (TReceiver a) newReceiver (Sender _ _ end) = do hole <- readTVar end first <-newTVar hole return (Receiver first) readBC :: TReceiver a -> STM a readBC (Receiver first) = do listhead <- readTVar first head <- readTVar listhead case head of TNil -> retry TCons a tl -> do writeTVar first tl return a Outdated next -> do next' <- readTVar next writeTVar first next' readBC (Receiver first) #endif Am 28.01.2016 um 20:30 schrieb Mark Fine: > We're currently using a TMChan to broadcast from a single producer > thread to many consumer threads. This works well! However, we're seeing > issues with a fast producer and/or a slow consumer, with the channel > growing unbounded. Fortunately, our producer-consumer communication is > time-sensitive and tolerant of loss: we're ok with the producer always > writing at the expense of dropping communication to a slow consumer. > > A TMBChan provides a bounded channel (but no means to dupe/broadcast) > where a writer will block once the channel fills up. In our use case, > we'd like to continue writing to the channel but dropping off the end of > the channel. Clojure's core-async module has some related concepts, in > particular the notion of a sliding buffer > that > drops the oldest elements once full. Has anyone encountered something > similar in working with channels and/or have any solutions? Thanks! > > Mark > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > From gershomb at gmail.com Thu Feb 4 04:39:02 2016 From: gershomb at gmail.com (Gershom B) Date: Wed, 3 Feb 2016 23:39:02 -0500 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: <56B1FB8E.3020906@extellisys.com> Message-ID: Backwards compatibility is important, but not an absolute. I?d be curious if anyone can point to instances where software might _rely_ on the show instance for strings not displaying unicode characters? ?Gershom On February 3, 2016 at 5:03:58 PM, David Feuer (david.feuer at gmail.com) wrote: > There's one open now. thomie commented ( > https://ghc.haskell.org/trac/ghc/ticket/11529#comment:4 ) that it's > possible to hook up your choice of showing function as the one GHCi should > use to display values. This strikes me as the best available approach > preserving backwards compatibility. Adding a GHCi flag for this might be > reasonable. > > On Wed, Feb 3, 2016 at 4:11 PM, Atze van der Ploeg wrote: > > > I think we can all agree these characters should be shown. Maybe a GHC bug > > report is a good idea? > > On 02/03/2016 10:37 AM, Takayuki Muranushi wrote: > > > I think one of the solution is to import and call u_iswprint from > > > GHC.Show, too, > > > but I don't know it's against any design choices. > > > > +1 for only escaping non-printable characters. > > > > > Yesterday, I had a chance to teach Haskell (in Japanese,) and I had to > > > use English in some of the most exciting examples, like the > > > Applicative List example above. I would heartedly like to see GHC > > > improve in these directions, so that we can make more happy learning > > > materials on Haskell. > > > > As a workaround, perhaps you can avoid using print/show with core data > > structures. Using your applicative example: > > > > > mapM_ putStrLn $ [(++"??"), (++"??")] <*> ["??", "??"] > > ???? > > ???? > > ???? > > ???? > > > > For other data structures, you can write your own Show instance: > > > > data Name = Name String String > > > > instance Show Name where > > show (Name family given) = family ++ given > > > > > print $ Person "??" "??" > > ???? > > > > Travis > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > From cma at bitemyapp.com Thu Feb 4 04:45:53 2016 From: cma at bitemyapp.com (Christopher Allen) Date: Wed, 3 Feb 2016 22:45:53 -0600 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: <56B1FB8E.3020906@extellisys.com> Message-ID: Can be useful in debugging, such as when dealing with visually identical characters with different byte values. Having principally western characters be rendered is a bit chauvinistic. This use case could be addressed with a function that takes a list of byte ranges to be rendered literally, others being the byte version. That would at least dispose if one reason for opposing changing this. On Wed, Feb 3, 2016 at 10:39 PM, Gershom B wrote: > Backwards compatibility is important, but not an absolute. I?d be curious > if anyone can point to instances where software might _rely_ on the show > instance for strings not displaying unicode characters? > > ?Gershom > > > On February 3, 2016 at 5:03:58 PM, David Feuer (david.feuer at gmail.com) > wrote: > > There's one open now. thomie commented ( > > https://ghc.haskell.org/trac/ghc/ticket/11529#comment:4 ) that it's > > possible to hook up your choice of showing function as the one GHCi > should > > use to display values. This strikes me as the best available approach > > preserving backwards compatibility. Adding a GHCi flag for this might be > > reasonable. > > > > On Wed, Feb 3, 2016 at 4:11 PM, Atze van der Ploeg wrote: > > > > > I think we can all agree these characters should be shown. Maybe a GHC > bug > > > report is a good idea? > > > On 02/03/2016 10:37 AM, Takayuki Muranushi wrote: > > > > I think one of the solution is to import and call u_iswprint from > > > > GHC.Show, too, > > > > but I don't know it's against any design choices. > > > > > > +1 for only escaping non-printable characters. > > > > > > > Yesterday, I had a chance to teach Haskell (in Japanese,) and I had > to > > > > use English in some of the most exciting examples, like the > > > > Applicative List example above. I would heartedly like to see GHC > > > > improve in these directions, so that we can make more happy learning > > > > materials on Haskell. > > > > > > As a workaround, perhaps you can avoid using print/show with core data > > > structures. Using your applicative example: > > > > > > > mapM_ putStrLn $ [(++"??"), (++"??")] <*> ["??", "??"] > > > ???? > > > ???? > > > ???? > > > ???? > > > > > > For other data structures, you can write your own Show instance: > > > > > > data Name = Name String String > > > > > > instance Show Name where > > > show (Name family given) = family ++ given > > > > > > > print $ Person "??" "??" > > > ???? > > > > > > Travis > > > _______________________________________________ > > > Haskell-Cafe mailing list > > > Haskell-Cafe at haskell.org > > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > > > > _______________________________________________ > > > Haskell-Cafe mailing list > > > Haskell-Cafe at haskell.org > > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > > > > > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From will.yager at gmail.com Thu Feb 4 04:51:35 2016 From: will.yager at gmail.com (William Yager) Date: Wed, 3 Feb 2016 22:51:35 -0600 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: <56B1FB8E.3020906@extellisys.com> Message-ID: If someone wants to view the byte values, why are they printing the string? Printing a string should display the string, not its underlying representation. To view the byte values, one can map over the string with fromEnum or something similar. On Wed, Feb 3, 2016 at 10:45 PM, Christopher Allen wrote: > Can be useful in debugging, such as when dealing with visually identical > characters with different byte values. Having principally western > characters be rendered is a bit chauvinistic. This use case could be > addressed with a function that takes a list of byte ranges to be rendered > literally, others being the byte version. That would at least dispose if > one reason for opposing changing this. > > On Wed, Feb 3, 2016 at 10:39 PM, Gershom B wrote: > >> Backwards compatibility is important, but not an absolute. I?d be curious >> if anyone can point to instances where software might _rely_ on the show >> instance for strings not displaying unicode characters? >> >> ?Gershom >> >> >> On February 3, 2016 at 5:03:58 PM, David Feuer (david.feuer at gmail.com) >> wrote: >> > There's one open now. thomie commented ( >> > https://ghc.haskell.org/trac/ghc/ticket/11529#comment:4 ) that it's >> > possible to hook up your choice of showing function as the one GHCi >> should >> > use to display values. This strikes me as the best available approach >> > preserving backwards compatibility. Adding a GHCi flag for this might be >> > reasonable. >> > >> > On Wed, Feb 3, 2016 at 4:11 PM, Atze van der Ploeg wrote: >> > >> > > I think we can all agree these characters should be shown. Maybe a >> GHC bug >> > > report is a good idea? >> > > On 02/03/2016 10:37 AM, Takayuki Muranushi wrote: >> > > > I think one of the solution is to import and call u_iswprint from >> > > > GHC.Show, too, >> > > > but I don't know it's against any design choices. >> > > >> > > +1 for only escaping non-printable characters. >> > > >> > > > Yesterday, I had a chance to teach Haskell (in Japanese,) and I had >> to >> > > > use English in some of the most exciting examples, like the >> > > > Applicative List example above. I would heartedly like to see GHC >> > > > improve in these directions, so that we can make more happy learning >> > > > materials on Haskell. >> > > >> > > As a workaround, perhaps you can avoid using print/show with core data >> > > structures. Using your applicative example: >> > > >> > > > mapM_ putStrLn $ [(++"??"), (++"??")] <*> ["??", "??"] >> > > ???? >> > > ???? >> > > ???? >> > > ???? >> > > >> > > For other data structures, you can write your own Show instance: >> > > >> > > data Name = Name String String >> > > >> > > instance Show Name where >> > > show (Name family given) = family ++ given >> > > >> > > > print $ Person "??" "??" >> > > ???? >> > > >> > > Travis >> > > _______________________________________________ >> > > Haskell-Cafe mailing list >> > > Haskell-Cafe at haskell.org >> > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> > > >> > > _______________________________________________ >> > > Haskell-Cafe mailing list >> > > Haskell-Cafe at haskell.org >> > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> > > >> > > >> > _______________________________________________ >> > Haskell-Cafe mailing list >> > Haskell-Cafe at haskell.org >> > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> > >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> > > > > -- > Chris Allen > Currently working on http://haskellbook.com > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From b at chreekat.net Thu Feb 4 04:55:28 2016 From: b at chreekat.net (Bryan Richter) Date: Wed, 3 Feb 2016 20:55:28 -0800 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: <56B1FB8E.3020906@extellisys.com> Message-ID: Gershom speaks my mind. I do not doubt that changing the Show instance for String will create bugs in some code, but how many bugs will it also fix? What is the ratio? On Feb 3, 2016 8:40 PM, "Gershom B" wrote: > Backwards compatibility is important, but not an absolute. I?d be curious > if anyone can point to instances where software might _rely_ on the show > instance for strings not displaying unicode characters? > > ?Gershom > > > On February 3, 2016 at 5:03:58 PM, David Feuer (david.feuer at gmail.com) > wrote: > > There's one open now. thomie commented ( > > https://ghc.haskell.org/trac/ghc/ticket/11529#comment:4 ) that it's > > possible to hook up your choice of showing function as the one GHCi > should > > use to display values. This strikes me as the best available approach > > preserving backwards compatibility. Adding a GHCi flag for this might be > > reasonable. > > > > On Wed, Feb 3, 2016 at 4:11 PM, Atze van der Ploeg wrote: > > > > > I think we can all agree these characters should be shown. Maybe a GHC > bug > > > report is a good idea? > > > On 02/03/2016 10:37 AM, Takayuki Muranushi wrote: > > > > I think one of the solution is to import and call u_iswprint from > > > > GHC.Show, too, > > > > but I don't know it's against any design choices. > > > > > > +1 for only escaping non-printable characters. > > > > > > > Yesterday, I had a chance to teach Haskell (in Japanese,) and I had > to > > > > use English in some of the most exciting examples, like the > > > > Applicative List example above. I would heartedly like to see GHC > > > > improve in these directions, so that we can make more happy learning > > > > materials on Haskell. > > > > > > As a workaround, perhaps you can avoid using print/show with core data > > > structures. Using your applicative example: > > > > > > > mapM_ putStrLn $ [(++"??"), (++"??")] <*> ["??", "??"] > > > ???? > > > ???? > > > ???? > > > ???? > > > > > > For other data structures, you can write your own Show instance: > > > > > > data Name = Name String String > > > > > > instance Show Name where > > > show (Name family given) = family ++ given > > > > > > > print $ Person "??" "??" > > > ???? > > > > > > Travis > > > _______________________________________________ > > > Haskell-Cafe mailing list > > > Haskell-Cafe at haskell.org > > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > > > > _______________________________________________ > > > Haskell-Cafe mailing list > > > Haskell-Cafe at haskell.org > > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > > > > > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Thu Feb 4 06:45:43 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 4 Feb 2016 07:45:43 +0100 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: <56B1FB8E.3020906@extellisys.com> Message-ID: What if (some) show instances where alternative representations are possible, were moved out of Prelude? A selection of modules with alternative show instances would be available from stand alone modules. To be imported as needed. For example, bytestring may be 'show'ed in different ways. Less convenient than now, backward incompatible yet simple enough. -------------- next part -------------- An HTML attachment was scrubbed... URL: From miguelimo38 at yandex.ru Thu Feb 4 07:13:22 2016 From: miguelimo38 at yandex.ru (MigMit) Date: Thu, 4 Feb 2016 08:13:22 +0100 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: <56B1FB8E.3020906@extellisys.com> Message-ID: That would lead to incompatibilities, with different packages using different instances. ?????????? ? iPhone > 4 ????. 2016 ?., ? 7:45, Imants Cekusins ???????(?): > > What if (some) show instances where alternative representations are possible, were moved out of Prelude? > > A selection of modules with alternative show instances would be available from stand alone modules. To be imported as needed. > > For example, bytestring may be 'show'ed in different ways. > > Less convenient than now, backward incompatible yet simple enough. > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Thu Feb 4 07:20:25 2016 From: david.feuer at gmail.com (David Feuer) Date: Thu, 4 Feb 2016 02:20:25 -0500 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: <56B1FB8E.3020906@extellisys.com> Message-ID: This is by far the worst possible option. Incoherent instances lead to nightmarishly unpredictable behavior. On Thu, Feb 4, 2016 at 1:45 AM, Imants Cekusins wrote: > What if (some) show instances where alternative representations are > possible, were moved out of Prelude? > > A selection of modules with alternative show instances would be available > from stand alone modules. To be imported as needed. > > For example, bytestring may be 'show'ed in different ways. > > Less convenient than now, backward incompatible yet simple enough. > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Thu Feb 4 07:38:04 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 4 Feb 2016 08:38:04 +0100 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: <56B1FB8E.3020906@extellisys.com> Message-ID: is the purpose of the show : a) serialization to string? or b) text representation? if a) then why is unexpected display - a concern? if b) then why is inconsistency - a concern? if more than one way to display c is possible, then should we expect both a) and b) from Show? From dct25-561bs at mythic-beasts.com Thu Feb 4 07:57:17 2016 From: dct25-561bs at mythic-beasts.com (David Turner) Date: Thu, 4 Feb 2016 07:57:17 +0000 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: <56B1FB8E.3020906@extellisys.com> Message-ID: One of the most visible uses of Show is that it's how values are shown in GHCi. As mentioned earlier in this thread, if you're teaching in a non-ASCII language then the user experience is pretty poor. On the other hand, I see Show (like .ToString() in C# etc.) as a debugging tool: not for seriously robust serialisation but useful if you need to dump a value into a log message or email or similar. And in that situation it's very useful if it sticks to ASCII: non-ASCII content just isn't resilient enough to being passed around the network, truncated and generally mutilated on the way through. These are definitely two different concerns and they pull in opposite directions in this discussion. It's a matter of opinion which you think is more important. Me, I think the latter, but then I do a lot of logging and speak a language that fits into ASCII. YMMV! On 4 Feb 2016 07:38, "Imants Cekusins" wrote: > is the purpose of the show : > > a) serialization to string? > or > b) text representation? > > if a) then why is unexpected display - a concern? > if b) then why is inconsistency - a concern? > > if more than one way to display c is possible, then should we expect > both a) and b) from Show? > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From grrwlf at gmail.com Thu Feb 4 08:28:31 2016 From: grrwlf at gmail.com (Sergey Mironov) Date: Thu, 4 Feb 2016 11:28:31 +0300 Subject: [Haskell-cafe] Haskell game to translate Message-ID: Hi, Cafe. My friend wants to improve her collaboration skills in the area of game development. She is a Translator and the plan is to learn Git by contributing some Russian/English/French (and maybe simple Korean) translations to a GitHub project. Could you recommend me (and my friend) some game project wich needs translation? Note, that It should support multylang features in some form, understandable for non-programmer. I'll help with required workplace setup. Haskell, Linux, etc. is OK. Regards, Sergey From imantc at gmail.com Thu Feb 4 09:47:47 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 4 Feb 2016 10:47:47 +0100 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: <56B1FB8E.3020906@extellisys.com> Message-ID: if Show is the opposite of Read, then serialization is probably the purpose, consistency is more important. re: formatting GHCi output: what if GHCi used another class (not Show) for formatting output? what if it were possible to pass a cmd flag to ghci to specify formatting instance to use in this session? From claude at mathr.co.uk Thu Feb 4 09:56:29 2016 From: claude at mathr.co.uk (Claude Heiland-Allen) Date: Thu, 4 Feb 2016 09:56:29 +0000 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: <56B1FB8E.3020906@extellisys.com> Message-ID: <56B3204D.4000509@mathr.co.uk> On 04/02/16 09:47, Imants Cekusins wrote: > re: formatting GHCi output: > > what if GHCi used another class (not Show) for formatting output? > > what if it were possible to pass a cmd flag to ghci to specify > formatting instance to use in this session? It is possible: https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/interactive-evaluation.html#ghci-interactive-print -- http://mathr.co.uk From imantc at gmail.com Thu Feb 4 10:07:21 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 4 Feb 2016 11:07:21 +0100 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: <56B3204D.4000509@mathr.co.uk> References: <56B1FB8E.3020906@extellisys.com> <56B3204D.4000509@mathr.co.uk> Message-ID: > It is possible: Cheers Claude! :) this is new for me. Would this help Takayuki? From miguelimo38 at yandex.ru Thu Feb 4 10:07:36 2016 From: miguelimo38 at yandex.ru (Miguel Mitrofanov) Date: Thu, 04 Feb 2016 13:07:36 +0300 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: 2580000000209825433 References: <56B1FB8E.3020906@extellisys.com> Message-ID: <4249431454580456@web27m.yandex.ru> An HTML attachment was scrubbed... URL: From imantc at gmail.com Thu Feb 4 10:25:11 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 4 Feb 2016 11:25:11 +0100 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: <4249431454580456@web27m.yandex.ru> References: <56B1FB8E.3020906@extellisys.com> <4249431454580456@web27m.yandex.ru> Message-ID: > Two modules defining different instances for the same class and type can't be used together. it is possible to define conflicting instances for the same class/type in modules that don't import one another - without strange results, isn't it? or conflicting instances must not exist within the same app, including libs? From mail at joachim-breitner.de Thu Feb 4 10:26:58 2016 From: mail at joachim-breitner.de (Joachim Breitner) Date: Thu, 04 Feb 2016 11:26:58 +0100 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: <56B1FB8E.3020906@extellisys.com> Message-ID: <1454581618.9855.20.camel@joachim-breitner.de> Hi, Am Mittwoch, den 03.02.2016, 23:39 -0500 schrieb Gershom B: > Backwards compatibility is important, but not an absolute. I?d be > curious if anyone can point to instances where software might _rely_ > on the show instance for strings not displaying unicode characters? some people do use Show and Read as a quick-and-easy serialization/deserialization method, and some of them might assume that only ASCII characters are in use, so they maybe did not bother taking encodings in account when writing them out or in. There are many disencouraged practices mentioned in the above paragraph, but unfortunately, it?s our users that do disencouraged practices that most likely would not pay attention to breaking code changes in the standard libraries, are least likely to update their code and thus be hit the worst. It?s a pitty, and it should be added to the list of things to do better with the next larger language revision (if such a thing ever happens). Greetings, Joachim -- Joachim ?nomeata? Breitner mail at joachim-breitner.de ? http://www.joachim-breitner.de/ Jabber: nomeata at joachim-breitner.de ? GPG-Key: 0xF0FBF51F Debian Developer: nomeata at debian.org -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 819 bytes Desc: This is a digitally signed message part URL: From miguelimo38 at yandex.ru Thu Feb 4 10:33:00 2016 From: miguelimo38 at yandex.ru (Miguel Mitrofanov) Date: Thu, 04 Feb 2016 13:33:00 +0300 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: 2580000000209924300 References: <56B1FB8E.3020906@extellisys.com> <4249431454580456@web27m.yandex.ru> Message-ID: <4644981454581980@web28j.yandex.ru> An HTML attachment was scrubbed... URL: From lambda.fairy at gmail.com Thu Feb 4 11:18:45 2016 From: lambda.fairy at gmail.com (Chris Wong) Date: Thu, 4 Feb 2016 22:18:45 +1100 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: Message-ID: Have you considered using IHaskell instead? https://github.com/gibiansky/IHaskell It supports images and interactive widgets. It shouldn't be too hard to make it display Unicode text. On Wed, Feb 3, 2016 at 12:37 PM, Takayuki Muranushi wrote: > Show instance for non-ascii characters prints their character codes. > This is sad for Haskell users that speaks language other than English. > >> 'A' > 'A' >> '?' > '\196' >> '?' > '\28450' >> print $ [(++"'s dad"), (++"'s mom")] <*> ["Simon", "John"] > ["Simon's dad","John's dad","Simon's mom","John's mom"] >> print $ [(++"??"), (++"??")] <*> ["??", "??"] > ["\30000\20013\12398\29238","\23665\30000\12398\29238","\30000\20013\12398\27597","\23665\30000\12398\27597"] > > The function that needs improvement is showLitChar in GHC.Show, which > currently prints any character larger than ASCII code 127 by its > character code: > > http://haddock.stackage.org/lts-5.1/base-4.8.2.0/src/GHC-Show.html > > showLitChar :: Char -> ShowS > showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDec (shows > (ord c)) s) > > On the other hand, there is GHC.Unicode.isPrint, the predicate for > printable Unicode characters, that is calling on a foreign function > u_iswprint for the knowledge. > > https://hackage.haskell.org/package/base-4.8.2.0/docs/src/GHC.Unicode.html#isPrint > > I think one of the solution is to import and call u_iswprint from > GHC.Show, too, > but I don't know it's against any design choices. > > > > Yesterday, I had a chance to teach Haskell (in Japanese,) and I had to > use English in some of the most exciting examples, like the > Applicative List example above. I would heartedly like to see GHC > improve in these directions, so that we can make more happy learning > materials on Haskell. > > Let me ask your opinions on what is the best way to do this (or is > better not to do this), before I submit something to GHC Trac. > > > Best, > > -------------------------------- > -- Takayuki MURANUSHI > -- RIKEN Advanced Institute for Computational Science > -- http://nushio3.github.io/ > -- http://www.geocities.jp/takascience/ > -------------------------------- > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe -- Chris Wong (https://lambda.xyz) "I had not the vaguest idea what this meant and when I could not remember the words, my tutor threw the book at my head, which did not stimulate my intellect in any way." -- Bertrand Russell From chrisdone at gmail.com Thu Feb 4 14:56:53 2016 From: chrisdone at gmail.com (Christopher Done) Date: Thu, 4 Feb 2016 14:56:53 +0000 Subject: [Haskell-cafe] Is there a way to generate instances from the GHCi REPL? Message-ID: Good evening, Is there a way with TH to generate instances for a class in GHCi? I want to generate instances for a serialization class. I tried to write some TH to do it, but $(foo) in GHCi?s REPL says that it can only be Q Exp, not Q [Dec]. Sadness. I found qAddTopDecls. I tried to add the class declarations via $(foo >>= qAddTopDecls; stringE "OK!") and it says ?Only function, value, and foreign import declarations may be added with addTopDecl". Woe. I could create a file and then load in that file, but loading modules loses all GHCi's state, which would defeat the purpose of using a REPL in the first place. Any hope? Ciao! ? -------------- next part -------------- An HTML attachment was scrubbed... URL: From yom at artyom.me Thu Feb 4 22:09:19 2016 From: yom at artyom.me (Artyom) Date: Fri, 5 Feb 2016 01:09:19 +0300 Subject: [Haskell-cafe] Is there a way to generate instances from the GHCi REPL? In-Reply-To: References: Message-ID: <56B3CC0F.7060407@artyom.me> If your instance-generating function is defined in an external module, you can use it in GHCi like this: |-- Enable TH > :set -XTemplateHaskell -- Import modules (e.g. Aeson) > import Data.Aeson.TH > import Data.Aeson -- Define the type for which I'm going to generate instances > data X = X {x :: Int} -- Derive the instance Prelude Data.Aeson.TH> data Dummy; deriveJSON defaultOptions ''X -- Check that it works > toJSON (X 1) Object (fromList [("x",Number 1.0)]) | (More about the |data Dummy| trick here: https://www.reddit.com/r/haskelltil/comments/3ghacj/you_can_use_template_haskell_functions_like/.) ? -------------- next part -------------- An HTML attachment was scrubbed... URL: From mgsloan at gmail.com Fri Feb 5 01:29:05 2016 From: mgsloan at gmail.com (Michael Sloan) Date: Thu, 4 Feb 2016 17:29:05 -0800 Subject: [Haskell-cafe] Is there a way to generate instances from the GHCi REPL? In-Reply-To: References: Message-ID: One thing to note is that the qAddTopDecls issue isn't a fundamental issue, just a matter of implementation: https://ghc.haskell.org/trac/ghc/ticket/10853 On Thu, Feb 4, 2016 at 6:56 AM, Christopher Done wrote: > Good evening, > > Is there a way with TH to generate instances for a class in GHCi? I want > to generate instances for a serialization class. > > I tried to write some TH to do it, but $(foo) in GHCi?s REPL says that it > can only be Q Exp, not Q [Dec]. Sadness. > > I found qAddTopDecls. I tried to add the class declarations via $(foo >>= > qAddTopDecls; stringE "OK!") and it says ?Only function, value, and > foreign import declarations may be added with addTopDecl". Woe. > > I could create a file and then load in that file, but loading modules > loses all GHCi's state, which would defeat the purpose of using a REPL in > the first place. > > Any hope? > > Ciao! > ? > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From muranushi at gmail.com Fri Feb 5 05:06:35 2016 From: muranushi at gmail.com (Takayuki Muranushi) Date: Fri, 5 Feb 2016 14:06:35 +0900 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: Message-ID: Hi all, I wrote a small package for showing values in Unicode, to be used together with `-interactive-print`. I wish this is useful to you. https://github.com/nushio3/unicode-show#readme With print : $ ghci ... > ["????7.6.1"] ["\21704\26031\20811\23572\&7.6.1"] > With uprint : $ ghci -interactive-print=Text.Show.Unicode.uprint Text.Show.Unicode ... Ok, modules loaded: Text.Show.Unicode. > ("??????!",["????7.6.1???","???"]) ("??????!",["????7.6.1???","???"]) > "?\n?" "?\n?" There were several corner-cases, such as "\"" (a string with double quotation), "\23572\&7" (\& separates the Unicode literal from the digit character) and "3 :?\& 5" (where :?\& is a name of an infix value constructor.) If you find more corner cases, please let me know! Best, -------------------------------- -- Takayuki MURANUSHI -- RIKEN Advanced Institute for Computational Science -- http://nushio3.github.io/ -- http://www.geocities.jp/takascience/ -------------------------------- 2016-02-04 20:18 GMT+09:00 Chris Wong : > Have you considered using IHaskell instead? > > https://github.com/gibiansky/IHaskell > > It supports images and interactive widgets. It shouldn't be too hard > to make it display Unicode text. > > On Wed, Feb 3, 2016 at 12:37 PM, Takayuki Muranushi wrote: >> Show instance for non-ascii characters prints their character codes. >> This is sad for Haskell users that speaks language other than English. >> >>> 'A' >> 'A' >>> '?' >> '\196' >>> '?' >> '\28450' >>> print $ [(++"'s dad"), (++"'s mom")] <*> ["Simon", "John"] >> ["Simon's dad","John's dad","Simon's mom","John's mom"] >>> print $ [(++"??"), (++"??")] <*> ["??", "??"] >> ["\30000\20013\12398\29238","\23665\30000\12398\29238","\30000\20013\12398\27597","\23665\30000\12398\27597"] >> >> The function that needs improvement is showLitChar in GHC.Show, which >> currently prints any character larger than ASCII code 127 by its >> character code: >> >> http://haddock.stackage.org/lts-5.1/base-4.8.2.0/src/GHC-Show.html >> >> showLitChar :: Char -> ShowS >> showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDec (shows >> (ord c)) s) >> >> On the other hand, there is GHC.Unicode.isPrint, the predicate for >> printable Unicode characters, that is calling on a foreign function >> u_iswprint for the knowledge. >> >> https://hackage.haskell.org/package/base-4.8.2.0/docs/src/GHC.Unicode.html#isPrint >> >> I think one of the solution is to import and call u_iswprint from >> GHC.Show, too, >> but I don't know it's against any design choices. >> >> >> >> Yesterday, I had a chance to teach Haskell (in Japanese,) and I had to >> use English in some of the most exciting examples, like the >> Applicative List example above. I would heartedly like to see GHC >> improve in these directions, so that we can make more happy learning >> materials on Haskell. >> >> Let me ask your opinions on what is the best way to do this (or is >> better not to do this), before I submit something to GHC Trac. >> >> >> Best, >> >> -------------------------------- >> -- Takayuki MURANUSHI >> -- RIKEN Advanced Institute for Computational Science >> -- http://nushio3.github.io/ >> -- http://www.geocities.jp/takascience/ >> -------------------------------- >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > > -- > Chris Wong (https://lambda.xyz) > > "I had not the vaguest idea what this meant and when I could not > remember the words, my tutor threw the book at my head, which did not > stimulate my intellect in any way." -- Bertrand Russell From michael at orlitzky.com Fri Feb 5 15:58:18 2016 From: michael at orlitzky.com (Michael Orlitzky) Date: Fri, 5 Feb 2016 10:58:18 -0500 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: References: <56B1FB8E.3020906@extellisys.com> Message-ID: <56B4C69A.30009@orlitzky.com> On 02/03/2016 11:39 PM, Gershom B wrote: > Backwards compatibility is important, but not an absolute. I?d be > curious if anyone can point to instances where software might _rely_ > on the show instance for strings not displaying unicode characters? > This will break a bunch of my doctests, but I can just update them. I would be more concerned about what happens in a terminal/font that doesn't have unicode support. For the font at least, my xfce4-terminal does something intelligent and falls back to another font that does have the fortune cookie symbols. But for the terminal? Try Ctrl-Alt-F1 to drop out of X and into a Linux/BSD terminal, and runghc on a file containing, main = mapM_ putStrLn $ [(++"??"), (++"??")] <*> ["??", "??"] I get a bunch of grey question marks. From johannes.waldmann at htwk-leipzig.de Fri Feb 5 16:14:16 2016 From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann) Date: Fri, 5 Feb 2016 17:14:16 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic Message-ID: <56B4CA58.4050101@htwk-leipzig.de> As Manuel wrote: > I expect that every single person teaching Haskell > is going to be unhappy about it. Indeed I am. (Will be teaching beginners next term.) - J.W. From colinpauladams at gmail.com Fri Feb 5 16:22:26 2016 From: colinpauladams at gmail.com (Colin Adams) Date: Fri, 5 Feb 2016 16:22:26 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56B4CA58.4050101@htwk-leipzig.de> References: <56B4CA58.4050101@htwk-leipzig.de> Message-ID: What's changed? On 5 February 2016 at 16:14, Johannes Waldmann < johannes.waldmann at htwk-leipzig.de> wrote: > As Manuel wrote: > > > I expect that every single person teaching Haskell > > is going to be unhappy about it. > > Indeed I am. (Will be teaching beginners next term.) > > - J.W. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From johannes.waldmann at htwk-leipzig.de Fri Feb 5 16:25:15 2016 From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann) Date: Fri, 5 Feb 2016 17:25:15 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> Message-ID: <56B4CCEB.5060406@htwk-leipzig.de> > What's changed? I was referring to a discussion on ghc-devs, see https://mail.haskell.org/pipermail/ghc-devs/2016-February/011268.html and mixed up addresses when replying. - J. From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Fri Feb 5 16:26:51 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Fri, 5 Feb 2016 16:26:51 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56B4CCEB.5060406@htwk-leipzig.de> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> Message-ID: <20160205162651.GA28854@weber> On Fri, Feb 05, 2016 at 05:25:15PM +0100, Johannes Waldmann wrote: > > What's changed? > > I was referring to a discussion on ghc-devs, see > https://mail.haskell.org/pipermail/ghc-devs/2016-February/011268.html > and mixed up addresses when replying. I'm glad you did, because this is the first I've heard of it! From alan.zimm at gmail.com Fri Feb 5 17:47:28 2016 From: alan.zimm at gmail.com (Alan & Kim Zimmerman) Date: Fri, 5 Feb 2016 19:47:28 +0200 Subject: [Haskell-cafe] Month in haskell-ide-engine January 2016 Message-ID: Welcome Haskell IDE Engine users, Haskell IDE Engine progress report for January 2016 [1] What is Haskell IDE Engine? Not an IDE. It is a common point for people in the Haskell community to pool their efforts with respect to tooling. For tool writers, provide tools as a HIE plugin, so it can be available on supported IDEs For IDE developers, integrate to HIE, and all the Haskell tools supported as plugins become available For users, it means the overall Haskell experience should improve. Important developments A new ghc-dump-tree plugin based on https://github.com/edsko/ghc-dump-tree Current project focus The current focus is to get the initial version working well enough for an alpha release. To this end, there are some hardy developers using it in their daily work in emacs. Issues closed in January Querying a graph database instead of using GHC-API? #10 Decide how haskell-ide project is run #13 Rework the Console #20 Use an error handler in the dispatcher #50 Protocol definition #66 (emacs) "Selecting deleted buffer" after hie buffer killed #121 emacs : process HieDiff result #132 Create a doc entry describing how to run hie with leksah #142 Create --one-shot flag to run one cmd and exit #154 Update to ghc-mod 5.5 #156 Fix warnings #159 HIE and current working directory #161 Improve error message for badly-formatted json #166 ghc-mod not properly detecting project #175 thread blocked indefinitely in an STM transaction -- Running tests #178 Create Report-2015-12.md #151 [POC] Move plugin and command names to the typelevel #152 Pull requests merged in January Just some textual improvements #153 Starting to bring in async streaming command #155 One shot invocation #158 leksah instructions #160 Bump deps and adapt to new apis #162 Improve error messages in JSON parsing #167 Add ide-backend plugin #168 Refactor ExtensibleState #169 Ghc-dump-tree plugin #170 Fix warnings #171 Emacs: log parse error even if there is no handler #172 Add an error handler in the dispatcher (fixes #50) #173 Recreate buffers if they have been killed #174 ghc-mod 5.5 #176 Remove ide-backend #179 Move emacs tests to buttercup #180 Increase timeout for cash upload #181 Update stack.yaml for ghc-mod-5.5 and HaRe-0.8.2.3 #182 Support multiple sessions in emacs #183 Fix warnings #165 Harmonise nightly versions, install ide-backend-server #177 Contributors active in January Alan Zimmerman, Alexey Shmalko, Cies Breijs, Griffin Smith, JP Moresmau, Justin Wood, Moritz Kiefer Contributing Haskell IDE Engine needs volunteers like any other open source project. For more information see: https://github.com/haskell/haskell-ide-engine Also drop by our IRC channel: #haskell-ide-engine at irc.freenode.net. Thanks! Alan [1] https://github.com/haskell/haskell-ide-engine/blob/master/docs/Report-2016-01.md From me at khanson.io Fri Feb 5 17:55:08 2016 From: me at khanson.io (Kyle Hanson) Date: Fri, 5 Feb 2016 09:55:08 -0800 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <20160205162651.GA28854@weber> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> Message-ID: I am also happy the discussion was posted here. Although I don't teach Haskell professionally, one of the things I loved to do was show people how simple Haskell really was by inspecting types and slowly putting the puzzle pieces together. Summary of the problem for others: >From *Takenobu Tani* Before ghc7.8: Prelude> :t foldr foldr :: (a -> b -> b) -> b -> [a] -> b Prelude> :t ($) ($) :: (a -> b) -> a -> b Beginners should only understand about following: * type variable (polymorphism) After ghc8.0: Prelude> :t foldr foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b Prelude> :t ($) ($) :: forall (w :: GHC.Types.Levity) a (b :: TYPE w). (a -> b) -> a -> b With this change it looks like I will no longer be able to keep `$` in my toolbox since telling a beginner its "magic" goes against what I believe Haskell is good at, being well defined and easy to understand (Not well defined in terms of Types but well defined in terms of ability to precisely and concisely explain and define whats going on). It looks like where the discussion is going is to have these types show by default but eventually have an Alternative prelude for beginners. >From *Richard Eisenberg:* - It's interesting that the solution to the two problems Takenobu pulls out below (but others have hinted at in this thread) is by having an alternate Prelude for beginners. I believe that having an alternate beginners' Prelude is becoming essential. I know I'm not the first one to suggest this, but a great many issues that teachers of Haskell have raised with me and posts on this and other lists would be solved by an alternate Prelude for beginners. I don't like the idea of fragmenting Haskell into "beginners" and "advanced" versions. Its hard enough to get people to believe Haskell is easy. If they see that they aren't using the "real" prelude, Haskell will still be this magic black box that is too abstract and difficult to understand. If they have to use a "dumbed down" version of Haskell to learn, its not as compelling. There is something powerful about using the same idiomatic tools as the "big boys" and have the tools still be able to be easy to understand.... by default. Adding complexity to the default Haskell runs the risk of further alienating newcomers to the language who have a misconception that its too hard. Admittedly, I am not well informed of the state of GHC 8.0 development and haven't had time to fully look into the situation. I am very interested to see where this conversation and the default complexity of Haskell goes. -- Kyle On Fri, Feb 5, 2016 at 8:26 AM, Tom Ellis < tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > On Fri, Feb 05, 2016 at 05:25:15PM +0100, Johannes Waldmann wrote: > > > What's changed? > > > > I was referring to a discussion on ghc-devs, see > > https://mail.haskell.org/pipermail/ghc-devs/2016-February/011268.html > > and mixed up addresses when replying. > > I'm glad you did, because this is the first I've heard of it! > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From cma at bitemyapp.com Fri Feb 5 17:59:18 2016 From: cma at bitemyapp.com (Christopher Allen) Date: Fri, 5 Feb 2016 11:59:18 -0600 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> Message-ID: I don't want, nor do I think it's a good idea, to have a beginners' Prelude. My point about ($) was not expressly about beginners, it was about intermediate practitioners too. On Fri, Feb 5, 2016 at 11:55 AM, Kyle Hanson wrote: > I am also happy the discussion was posted here. Although I don't teach > Haskell professionally, one of the things I loved to do was show people how > simple Haskell really was by inspecting types and slowly putting the puzzle > pieces together. > > Summary of the problem for others: > > From *Takenobu Tani* > > Before ghc7.8: > > Prelude> :t foldr > foldr :: (a -> b -> b) -> b -> [a] -> b > > Prelude> :t ($) > ($) :: (a -> b) -> a -> b > > Beginners should only understand about following: > > * type variable (polymorphism) > > > After ghc8.0: > > Prelude> :t foldr > foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b > > Prelude> :t ($) > ($) > :: forall (w :: GHC.Types.Levity) a (b :: TYPE w). > (a -> b) -> a -> b > > > > With this change it looks like I will no longer be able to keep `$` in my > toolbox since telling a beginner its "magic" goes against what I believe > Haskell is good at, being well defined and easy to understand (Not well > defined in terms of Types but well defined in terms of ability to precisely > and concisely explain and define whats going on). > > It looks like where the discussion is going is to have these types show by > default but eventually have an Alternative prelude for beginners. > > From *Richard Eisenberg:* > > - It's interesting that the solution to the two problems Takenobu pulls out below (but others have hinted at in this thread) is by having an alternate Prelude for beginners. I believe that having an alternate beginners' Prelude is becoming essential. I know I'm not the first one to suggest this, but a great many issues that teachers of Haskell have raised with me and posts on this and other lists would be solved by an alternate Prelude for beginners. > > I don't like the idea of fragmenting Haskell into "beginners" and > "advanced" versions. Its hard enough to get people to believe Haskell is > easy. If they see that they aren't using the "real" prelude, Haskell will > still be this magic black box that is too abstract and difficult to > understand. If they have to use a "dumbed down" version of Haskell to > learn, its not as compelling. > > There is something powerful about using the same idiomatic tools as the > "big boys" and have the tools still be able to be easy to understand.... by > default. Adding complexity to the default Haskell runs the risk of further > alienating newcomers to the language who have a misconception that its too > hard. > > Admittedly, I am not well informed of the state of GHC 8.0 development and > haven't had time to fully look into the situation. I am very interested to > see where this conversation and the default complexity of Haskell goes. > > -- > Kyle > > > On Fri, Feb 5, 2016 at 8:26 AM, Tom Ellis < > tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > >> On Fri, Feb 05, 2016 at 05:25:15PM +0100, Johannes Waldmann wrote: >> > > What's changed? >> > >> > I was referring to a discussion on ghc-devs, see >> > https://mail.haskell.org/pipermail/ghc-devs/2016-February/011268.html >> > and mixed up addresses when replying. >> >> I'm glad you did, because this is the first I've heard of it! >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From eir at cis.upenn.edu Fri Feb 5 18:13:23 2016 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Fri, 5 Feb 2016 13:13:23 -0500 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> Message-ID: <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Perhaps it will aid the discussion to see that the type of ($) will, for better or worse, be changing again before 8.0. The problem is described in GHC ticket #11471. The details of "why" aren't all that important for this discussion, but the resolution might be. The new (hopefully final!) type of ($) will be: > ($) :: forall (r :: RuntimeRep) (a :: *) (b :: TYPE r). (a -> b) -> a -> b Once again, it's easy enough to tweak the pretty-printer to hide the complexity. But perhaps it's not necessary. The difference as far as this conversation is concerned is that Levity has been renamed to RuntimeRep. I think this is an improvement, because now it's not terribly hard to explain: --- 1. Types of kind * have values represented by pointers. This is the vast majority of data in Haskell, because almost everything in Haskell is boxed. 2. But sometimes, we don't care how a value is represented. In this case, we can be polymorphic in the choice of representation, just like `length` is polymorphic in the choice of list element type. 3. ($) works with functions whose result can have any representation, as succinctly stated in the type. Note that the argument to the function must be boxed, however, because the implementation of ($) must store and pass the argument. It doesn't care at all about the result, though, allowing for representation-polymorphism. In aid of this explanation, we can relate this all to Java. The reference types in Java (e.g., Object, int[], Boolean) are all like types of kind *. The primitive types in Java (int, boolean, char) do not have kind *. Java allows type abstraction (that is, generics) only over the types of kind *. Haskell is more general, allowing abstraction over primitive types via representation polymorphism. --- Could this all be explained to a novice programmer? That would be a struggle. But it could indeed be explained to an intermediate programmer in another language just learning Haskell. For point of comparison, Java is widely used as a teaching language. And yet one of the simplest programs is public class HelloWorld { public static void main(String[] args) { System.out.println("Hello, world!"); } } When I taught Java (I taught high-school full time for 8 years), I would start with something similar to this and have to tell everyone to ignore 90% of what was written. My course never even got to arrays and `static`! That was painful, but everyone survived. This is just to point out that Haskell isn't the only language with this problem. Not to say we shouldn't try to improve! We're in a bit of a bind in all this. We really need the fancy type for ($) so that it can be used in all situations where it is used currently. The old type for ($) was just a plain old lie. Now, at least, we're not lying. So, do we 1) lie, 2) allow the language to grow, or 3) avoid certain growth because it affects how easy the language is to learn? I don't really think anyone is advocating for (3) exactly, but it's hard to have (2) and not make things more complicated -- unless we have a beginners' mode or other features in, say, GHCi that aid learning. As I've said, I'm in full favor of adding these features. Richard On Feb 5, 2016, at 12:55 PM, Kyle Hanson wrote: > I am also happy the discussion was posted here. Although I don't teach Haskell professionally, one of the things I loved to do was show people how simple Haskell really was by inspecting types and slowly putting the puzzle pieces together. > > Summary of the problem for others: > From Takenobu Tani > Before ghc7.8: > > Prelude> :t foldr > foldr :: (a -> b -> b) -> b -> [a] -> b > > Prelude> :t ($) > ($) :: (a -> b) -> a -> b > > Beginners should only understand about following: > > * type variable (polymorphism) > > > After ghc8.0: > > Prelude> :t foldr > foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b > > Prelude> :t ($) > ($) > :: forall (w :: GHC.Types.Levity) a (b :: TYPE w). > (a -> b) -> a -> b > > > With this change it looks like I will no longer be able to keep `$` in my toolbox since telling a beginner its "magic" goes against what I believe Haskell is good at, being well defined and easy to understand (Not well defined in terms of Types but well defined in terms of ability to precisely and concisely explain and define whats going on). > > It looks like where the discussion is going is to have these types show by default but eventually have an Alternative prelude for beginners. > > From Richard Eisenberg: > - It's interesting that the solution to the two problems Takenobu pulls out below (but others have hinted at in this thread) is by having an alternate Prelude for beginners. I believe that having an alternate beginners' Prelude is becoming essential. I know I'm not the first one to suggest this, but a great many issues that teachers of Haskell have raised with me and posts on this and other lists would be solved by an alternate Prelude for beginners. > I don't like the idea of fragmenting Haskell into "beginners" and "advanced" versions. Its hard enough to get people to believe Haskell is easy. If they see that they aren't using the "real" prelude, Haskell will still be this magic black box that is too abstract and difficult to understand. If they have to use a "dumbed down" version of Haskell to learn, its not as compelling. > > There is something powerful about using the same idiomatic tools as the "big boys" and have the tools still be able to be easy to understand.... by default. Adding complexity to the default Haskell runs the risk of further alienating newcomers to the language who have a misconception that its too hard. > > Admittedly, I am not well informed of the state of GHC 8.0 development and haven't had time to fully look into the situation. I am very interested to see where this conversation and the default complexity of Haskell goes. > > -- > Kyle > > > On Fri, Feb 5, 2016 at 8:26 AM, Tom Ellis wrote: > On Fri, Feb 05, 2016 at 05:25:15PM +0100, Johannes Waldmann wrote: > > > What's changed? > > > > I was referring to a discussion on ghc-devs, see > > https://mail.haskell.org/pipermail/ghc-devs/2016-February/011268.html > > and mixed up addresses when replying. > > I'm glad you did, because this is the first I've heard of it! > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: From capn.freako at gmail.com Fri Feb 5 18:45:10 2016 From: capn.freako at gmail.com (David Banas) Date: Fri, 5 Feb 2016 10:45:10 -0800 Subject: [Haskell-cafe] Foldable/Traversable and Applicative/Monoid? Message-ID: Hi all, I don't understand why Foldable is a necessary super-class of Traversable, and I suspect that the Applicative/Monoid duality, which I've just begun discovering in the literature, has something to do with why that is so. Can anyone give me a hint, without giving me the answer? Thanks! -db -------------- next part -------------- An HTML attachment was scrubbed... URL: From cma at bitemyapp.com Fri Feb 5 19:05:30 2016 From: cma at bitemyapp.com (Christopher Allen) Date: Fri, 5 Feb 2016 13:05:30 -0600 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: Changing the name doesn't fix the issue. The issue is the noise and the referent, not the referrer. There's a habit of over-focusing on names in programming communities. I think it'd be a mistake to do that here and risk missing the point. You can make all of the keywords in the Java example salient early on, but you cannot make the implementation details you're exposing in the type of ($) relevant unless they already have a year or two of Haskell under their belts. Listing out the keywords: 1. public 2. class 3. (class name) 4. static 5. void 6. (method name) 7. (method arguments) Explaining public, class, static, and void usually happens pretty soon after the basics in a Java course. Importantly, they're things you _need_ to know to get things done properly in Java. The same is not true of what is mentioned in the type of ($). The implicit prenex form and forall are irrelevant for learners until they get to Rank2/RankN which is very much beyond, "I am learning Haskell" and into, "I am designing an API in Haskell for other people to use". * vs. # is something many working and hobbyist Haskellers I've known will scarcely know anything about. There is a big difference, to my mind, between what is being exposed here in Java versus what is being exposed in the type ($). Consider that the boxed/unboxed distinction exists in Java but needn't come up in any beginner tutorials. >Types of kind * have values represented by pointers. This is the vast majority of data in Haskell, because almost everything in Haskell is boxed. We can't assume Haskell learners know what pointers are. This, again, creates unnecessary noise for learners by forcing exposure to things that are irrelevant for a very long time. On Fri, Feb 5, 2016 at 12:13 PM, Richard Eisenberg wrote: > Perhaps it will aid the discussion to see that the type of ($) will, for > better or worse, be changing again before 8.0. > > The problem is described in GHC ticket #11471. The details of "why" aren't > all that important for this discussion, but the resolution might be. The > new (hopefully final!) type of ($) will be: > > > ($) :: forall (r :: RuntimeRep) (a :: *) (b :: TYPE r). (a -> b) -> a -> > b > > Once again, it's easy enough to tweak the pretty-printer to hide the > complexity. But perhaps it's not necessary. The difference as far as this > conversation is concerned is that Levity has been renamed to RuntimeRep. I > think this is an improvement, because now it's not terribly hard to explain: > > --- > 1. Types of kind * have values represented by pointers. This is the vast > majority of data in Haskell, because almost everything in Haskell is boxed. > 2. But sometimes, we don't care how a value is represented. In this case, > we can be polymorphic in the choice of representation, just like `length` > is polymorphic in the choice of list element type. > 3. ($) works with functions whose result can have any representation, as > succinctly stated in the type. Note that the argument to the function must > be boxed, however, because the implementation of ($) must store and pass > the argument. It doesn't care at all about the result, though, allowing for > representation-polymorphism. > > In aid of this explanation, we can relate this all to Java. The reference > types in Java (e.g., Object, int[], Boolean) are all like types of kind *. > The primitive types in Java (int, boolean, char) do not have kind *. Java > allows type abstraction (that is, generics) only over the types of kind *. > Haskell is more general, allowing abstraction over primitive types via > representation polymorphism. > --- > > Could this all be explained to a novice programmer? That would be a > struggle. But it could indeed be explained to an intermediate programmer in > another language just learning Haskell. > > For point of comparison, Java is widely used as a teaching language. And > yet one of the simplest programs is > > public class HelloWorld > { > public static void main(String[] args) > { > System.out.println("Hello, world!"); > } > } > > When I taught Java (I taught high-school full time for 8 years), I would > start with something similar to this and have to tell everyone to ignore > 90% of what was written. My course never even got to arrays and `static`! > That was painful, but everyone survived. This is just to point out that > Haskell isn't the only language with this problem. Not to say we shouldn't > try to improve! > > We're in a bit of a bind in all this. We really need the fancy type for > ($) so that it can be used in all situations where it is used currently. > The old type for ($) was just a plain old lie. Now, at least, we're not > lying. So, do we 1) lie, 2) allow the language to grow, or 3) avoid certain > growth because it affects how easy the language is to learn? I don't really > think anyone is advocating for (3) exactly, but it's hard to have (2) and > not make things more complicated -- unless we have a beginners' mode or > other features in, say, GHCi that aid learning. As I've said, I'm in full > favor of adding these features. > > Richard > > On Feb 5, 2016, at 12:55 PM, Kyle Hanson wrote: > > I am also happy the discussion was posted here. Although I don't teach > Haskell professionally, one of the things I loved to do was show people how > simple Haskell really was by inspecting types and slowly putting the puzzle > pieces together. > > Summary of the problem for others: > > From *Takenobu Tani* > > Before ghc7.8: > > Prelude> :t foldr > foldr :: (a -> b -> b) -> b -> [a] -> b > > Prelude> :t ($) > ($) :: (a -> b) -> a -> b > > Beginners should only understand about following: > > * type variable (polymorphism) > > > After ghc8.0: > > Prelude> :t foldr > foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b > > Prelude> :t ($) > ($) > :: forall (w :: GHC.Types.Levity) a (b :: TYPE w). > (a -> b) -> a -> b > > > > With this change it looks like I will no longer be able to keep `$` in my > toolbox since telling a beginner its "magic" goes against what I believe > Haskell is good at, being well defined and easy to understand (Not well > defined in terms of Types but well defined in terms of ability to precisely > and concisely explain and define whats going on). > > It looks like where the discussion is going is to have these types show by > default but eventually have an Alternative prelude for beginners. > > From *Richard Eisenberg:* > > - It's interesting that the solution to the two problems Takenobu pulls out below (but others have hinted at in this thread) is by having an alternate Prelude for beginners. I believe that having an alternate beginners' Prelude is becoming essential. I know I'm not the first one to suggest this, but a great many issues that teachers of Haskell have raised with me and posts on this and other lists would be solved by an alternate Prelude for beginners. > > I don't like the idea of fragmenting Haskell into "beginners" and > "advanced" versions. Its hard enough to get people to believe Haskell is > easy. If they see that they aren't using the "real" prelude, Haskell will > still be this magic black box that is too abstract and difficult to > understand. If they have to use a "dumbed down" version of Haskell to > learn, its not as compelling. > > There is something powerful about using the same idiomatic tools as the > "big boys" and have the tools still be able to be easy to understand.... by > default. Adding complexity to the default Haskell runs the risk of further > alienating newcomers to the language who have a misconception that its too > hard. > > Admittedly, I am not well informed of the state of GHC 8.0 development and > haven't had time to fully look into the situation. I am very interested to > see where this conversation and the default complexity of Haskell goes. > > -- > Kyle > > > On Fri, Feb 5, 2016 at 8:26 AM, Tom Ellis < > tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > >> On Fri, Feb 05, 2016 at 05:25:15PM +0100, Johannes Waldmann wrote: >> > > What's changed? >> > >> > I was referring to a discussion on ghc-devs, see >> > https://mail.haskell.org/pipermail/ghc-devs/2016-February/011268.html >> > and mixed up addresses when replying. >> >> I'm glad you did, because this is the first I've heard of it! >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From spam at scientician.net Fri Feb 5 19:12:25 2016 From: spam at scientician.net (Bardur Arantsson) Date: Fri, 5 Feb 2016 20:12:25 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: On 02/05/2016 08:05 PM, Christopher Allen wrote: > Changing the name doesn't fix the issue. The issue is the noise and the > referent, not the referrer. There's a habit of over-focusing on names in > programming communities. I think it'd be a mistake to do that here and risk > missing the point. > I think you're being a bit harsh, but I *do* think you're essentially right. Beginners will have no idea what most the that means, so... *yes* the type *will* need to be simplified for display purposes. (Unless, of course, you opt-in to full signatures.) Regards, From cma at bitemyapp.com Fri Feb 5 19:16:56 2016 From: cma at bitemyapp.com (Christopher Allen) Date: Fri, 5 Feb 2016 13:16:56 -0600 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: I just showed the type of ($) to my boss in our company chat who has been using Haskell for 14 years. He'd played with Haskell prior to that, but 14 years ago is when he started postgrad and teaching Haskell. Here's what he said: >...what? >what does that do? He's been using Haskell in production for the last 5 years as well, I think. Please simplify the type unless a pragma specific to levity is turned on. As it happens, I like the name levity better than runtimerep, but neither solve any pedagogical issues. YMMV. On Fri, Feb 5, 2016 at 1:12 PM, Bardur Arantsson wrote: > On 02/05/2016 08:05 PM, Christopher Allen wrote: > > Changing the name doesn't fix the issue. The issue is the noise and the > > referent, not the referrer. There's a habit of over-focusing on names in > > programming communities. I think it'd be a mistake to do that here and > risk > > missing the point. > > > > I think you're being a bit harsh, but I *do* think you're essentially > right. Beginners will have no idea what most the that means, so... *yes* > the type *will* need to be simplified for display purposes. (Unless, of > course, you opt-in to full signatures.) > > Regards, > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Fri Feb 5 19:19:25 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Fri, 5 Feb 2016 19:19:25 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: <20160205191925.GC28854@weber> On Fri, Feb 05, 2016 at 01:13:23PM -0500, Richard Eisenberg wrote: > We're in a bit of a bind in all this. We really need the fancy type for > ($) so that it can be used in all situations where it is used currently. Is there a list of situations where ($) is used currently that give rise to this need? From will.yager at gmail.com Fri Feb 5 19:20:25 2016 From: will.yager at gmail.com (Will Yager) Date: Fri, 5 Feb 2016 13:20:25 -0600 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: Why must ($) be kind-polymorphic? It seems as though there is a small enough base of unboxed code that having e.g. ($#) would be fine. If that won't work, would it be possible to have something like ($) :: forall k a (b :: k) . (a -> b) -> a -> b I don't know if this is possible in Haskell now, but I believe the currently popular dependently typed languages allow this sort of thing. >> >> > ($) :: forall (r :: RuntimeRep) (a :: *) (b :: TYPE r). (a -> b) -> a -> b >> -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Fri Feb 5 19:20:43 2016 From: david.feuer at gmail.com (David Feuer) Date: Fri, 5 Feb 2016 14:20:43 -0500 Subject: [Haskell-cafe] Foldable/Traversable and Applicative/Monoid? In-Reply-To: References: Message-ID: It's not so much that it's *necessary* as that it's *possible*. The existence of two functions in Data.Traversable explains both of the superclasses of Traversable: fmapDefault :: Traversable t => (a -> b) -> t a -> t b foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m Each of these is written using only traverse, and they can be used to define fmap and foldMap for types when you've written traverse. Hint: Consider traversing using the following applicative functors: newtype Const a b = Const a instance Monoid a => Applicative (Const a) newtype Identity a = Identity a instance Applicative Identity On Feb 5, 2016 1:45 PM, "David Banas" wrote: > Hi all, > > I don't understand why Foldable is a necessary super-class of Traversable, > and I suspect that the Applicative/Monoid duality, which I've just begun > discovering in the literature, has something to do with why that is so. > > Can anyone give me a hint, without giving me the answer? > > Thanks! > -db > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From me at khanson.io Fri Feb 5 19:46:17 2016 From: me at khanson.io (Kyle Hanson) Date: Fri, 5 Feb 2016 11:46:17 -0800 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: Richard, I appreciate your response and have some genuine questions about how you see the Language growing in the future. As much as I am a principled developer in terms of adhering closely to the truth as possible, I also view code as a product that needs to "customers" to be successful. In order for that to happen, it needs to easily accessible and easy to understand. I learned Haskell almost entirely by looking at existing projects and exploring the very awesome Hackage documentation. What would be the hackage definition for ($)? Would it be `($) :: forall (r :: RuntimeRep) (a :: *) (b :: TYPE r). (a -> b) -> a -> b` with an asterisk that says "*For beginners: ($) :: (a -> b) -> a -> b" Would there be a "Simple Hackage"? It would be interesting for me to see how the skill levels of Haskell are distributed. In most languages it would look like a pyramid with a small group advanced developers on top and a mountain of people underneath. Haskell seems to be pushing towards the inverse, in which to code and understand standard, non beginners mode haskell you have to be "advanced". The barrier to entry looks to be increasing. I agree with Christopher Allen and also do not agree with your assessment and comparison to the unnecessary syntax in Java. You can explain that program using simple english. That is why it was used for so many years as an introductory language. How do you explain `forall (r :: RuntimeRep) (a :: *) (b :: TYPE r).` using simple english? I think its important to identify who you want your "customers" to be. If you only want the most advanced type theorists to use the language, that is perfectly fine, but what you lose are thousands of developers that can benefit the Haskell community without having to know advanced Typing. Needing a "Beginners" mode in a language is *not* a feature, its a fundamental design flaw. It shows that the language was not sufficiently thought out and designed for everyone. Its extremely important to not lose touch with the people that make the community; the newcomers. Sacrificing the 99% of beginner and intermediate haskellers for the 1%, I believe is a step in the wrong direction. -- Kyle On Fri, Feb 5, 2016 at 10:13 AM, Richard Eisenberg wrote: > Perhaps it will aid the discussion to see that the type of ($) will, for > better or worse, be changing again before 8.0. > > The problem is described in GHC ticket #11471. The details of "why" aren't > all that important for this discussion, but the resolution might be. The > new (hopefully final!) type of ($) will be: > > > ($) :: forall (r :: RuntimeRep) (a :: *) (b :: TYPE r). (a -> b) -> a -> > b > > Once again, it's easy enough to tweak the pretty-printer to hide the > complexity. But perhaps it's not necessary. The difference as far as this > conversation is concerned is that Levity has been renamed to RuntimeRep. I > think this is an improvement, because now it's not terribly hard to explain: > > --- > 1. Types of kind * have values represented by pointers. This is the vast > majority of data in Haskell, because almost everything in Haskell is boxed. > 2. But sometimes, we don't care how a value is represented. In this case, > we can be polymorphic in the choice of representation, just like `length` > is polymorphic in the choice of list element type. > 3. ($) works with functions whose result can have any representation, as > succinctly stated in the type. Note that the argument to the function must > be boxed, however, because the implementation of ($) must store and pass > the argument. It doesn't care at all about the result, though, allowing for > representation-polymorphism. > > In aid of this explanation, we can relate this all to Java. The reference > types in Java (e.g., Object, int[], Boolean) are all like types of kind *. > The primitive types in Java (int, boolean, char) do not have kind *. Java > allows type abstraction (that is, generics) only over the types of kind *. > Haskell is more general, allowing abstraction over primitive types via > representation polymorphism. > --- > > Could this all be explained to a novice programmer? That would be a > struggle. But it could indeed be explained to an intermediate programmer in > another language just learning Haskell. > > For point of comparison, Java is widely used as a teaching language. And > yet one of the simplest programs is > > public class HelloWorld > { > public static void main(String[] args) > { > System.out.println("Hello, world!"); > } > } > > When I taught Java (I taught high-school full time for 8 years), I would > start with something similar to this and have to tell everyone to ignore > 90% of what was written. My course never even got to arrays and `static`! > That was painful, but everyone survived. This is just to point out that > Haskell isn't the only language with this problem. Not to say we shouldn't > try to improve! > > We're in a bit of a bind in all this. We really need the fancy type for > ($) so that it can be used in all situations where it is used currently. > The old type for ($) was just a plain old lie. Now, at least, we're not > lying. So, do we 1) lie, 2) allow the language to grow, or 3) avoid certain > growth because it affects how easy the language is to learn? I don't really > think anyone is advocating for (3) exactly, but it's hard to have (2) and > not make things more complicated -- unless we have a beginners' mode or > other features in, say, GHCi that aid learning. As I've said, I'm in full > favor of adding these features. > > Richard > > On Feb 5, 2016, at 12:55 PM, Kyle Hanson wrote: > > I am also happy the discussion was posted here. Although I don't teach > Haskell professionally, one of the things I loved to do was show people how > simple Haskell really was by inspecting types and slowly putting the puzzle > pieces together. > > Summary of the problem for others: > > From *Takenobu Tani* > > Before ghc7.8: > > Prelude> :t foldr > foldr :: (a -> b -> b) -> b -> [a] -> b > > Prelude> :t ($) > ($) :: (a -> b) -> a -> b > > Beginners should only understand about following: > > * type variable (polymorphism) > > > After ghc8.0: > > Prelude> :t foldr > foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b > > Prelude> :t ($) > ($) > :: forall (w :: GHC.Types.Levity) a (b :: TYPE w). > (a -> b) -> a -> b > > > > With this change it looks like I will no longer be able to keep `$` in my > toolbox since telling a beginner its "magic" goes against what I believe > Haskell is good at, being well defined and easy to understand (Not well > defined in terms of Types but well defined in terms of ability to precisely > and concisely explain and define whats going on). > > It looks like where the discussion is going is to have these types show by > default but eventually have an Alternative prelude for beginners. > > From *Richard Eisenberg:* > > - It's interesting that the solution to the two problems Takenobu pulls out below (but others have hinted at in this thread) is by having an alternate Prelude for beginners. I believe that having an alternate beginners' Prelude is becoming essential. I know I'm not the first one to suggest this, but a great many issues that teachers of Haskell have raised with me and posts on this and other lists would be solved by an alternate Prelude for beginners. > > I don't like the idea of fragmenting Haskell into "beginners" and > "advanced" versions. Its hard enough to get people to believe Haskell is > easy. If they see that they aren't using the "real" prelude, Haskell will > still be this magic black box that is too abstract and difficult to > understand. If they have to use a "dumbed down" version of Haskell to > learn, its not as compelling. > > There is something powerful about using the same idiomatic tools as the > "big boys" and have the tools still be able to be easy to understand.... by > default. Adding complexity to the default Haskell runs the risk of further > alienating newcomers to the language who have a misconception that its too > hard. > > Admittedly, I am not well informed of the state of GHC 8.0 development and > haven't had time to fully look into the situation. I am very interested to > see where this conversation and the default complexity of Haskell goes. > > -- > Kyle > > > On Fri, Feb 5, 2016 at 8:26 AM, Tom Ellis < > tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > >> On Fri, Feb 05, 2016 at 05:25:15PM +0100, Johannes Waldmann wrote: >> > > What's changed? >> > >> > I was referring to a discussion on ghc-devs, see >> > https://mail.haskell.org/pipermail/ghc-devs/2016-February/011268.html >> > and mixed up addresses when replying. >> >> I'm glad you did, because this is the first I've heard of it! >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcin.jan.mrotek at gmail.com Fri Feb 5 20:54:14 2016 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Fri, 5 Feb 2016 21:54:14 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: > > How do you explain `forall (r :: RuntimeRep) (a :: *) (b :: TYPE r).` > using simple english? > "for all 'a's that are lifted types and 'b's that are types of any runtime representation 'r'..." I don't really want to argue what is "simple english". I'd agree that Haskell's syntax is becoming more and more inadequate for expressing ideas that are being introduced to the language, though. Best regards, Marcin Mrotek -------------- next part -------------- An HTML attachment was scrubbed... URL: From omari at smileystation.com Fri Feb 5 20:58:35 2016 From: omari at smileystation.com (Omari Norman) Date: Fri, 5 Feb 2016 15:58:35 -0500 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: On Fri, Feb 5, 2016 at 2:46 PM, Kyle Hanson wrote: > I think its important to identify who you want your "customers" to be. If > you only want the most advanced type theorists to use the language, that is > perfectly fine, but what you lose are thousands of developers that can > benefit the Haskell community without having to know advanced Typing. > > Needing a "Beginners" mode in a language is *not* a feature, its a > fundamental design flaw. It shows that the language was not sufficiently > thought out and designed for everyone. > > Its extremely important to not lose touch with the people that make the > community; the newcomers. Sacrificing the 99% of beginner and intermediate > haskellers for the 1%, I believe is a step in the wrong direction. > > I'm sympathetic, but the same arguments were made against the Foldable-Traversable Proposal. See for instance http://neilmitchell.blogspot.com/2014/10/why-traversablefoldable-should-not-be.html Since that wound up going in, I think this ship has sailed. Types are going to become increasingly polymorphic in the Prelude. Though I wish this weren't so I've come to accept it, and I doubt attacking it head on is going to get anywhere. -------------- next part -------------- An HTML attachment was scrubbed... URL: From tanuki at gmail.com Fri Feb 5 23:14:34 2016 From: tanuki at gmail.com (Theodore Lief Gannon) Date: Fri, 5 Feb 2016 15:14:34 -0800 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic Message-ID: (Sorry you got this twice, Kyle!) I agree wholeheartedly with this: > Its extremely important to not lose touch with the people that make the community; the newcomers. Sacrificing the 99% of beginner and intermediate haskellers for the 1%, I believe is a step in the wrong direction. But also with this: > There's a real drawback to flags like -fdefault-levity: they hide things from unsuspecting users. We already get a steady trickle of bug reports stemming from confusion around hidden kinds. Users diligently try to make a minimal test case and then someone has to point out that the user is wrong. It's a waste of time and, I'm sure, is frustrating for users. I'm worried about this problem getting worse. I've been learning Haskell for about a year and a half, and using it in production for roughly a third of that. More than once I've run into a language construct which struck me as odd, asked about it, and was told it was that way for pedagogical reasons. I consider this a poor state of affairs on all sides, including pedagogy! I had a correct intuition that something was amiss, but here's the language itself sewing unjustified doubt about my understanding. It was discouraging. Lowering the garden wall is good, but not at the expense of hiding a hedge maze just inside the gate. The advantage of an alternate prelude is that the hedge maze is no longer hidden, and maps are handed out on entry; the disadvantage is that from the outside it just looks like a second, higher wall. This is a very hard problem and I have no idea how to solve it in the long term. For now though, why not cause -fdefault-levity to produce prominent warnings that it's simplifying types? Possibly even annotate simplified output, e.g.: ($) ::# (a -> b) -> a -> b On Fri, Feb 5, 2016 at 11:46 AM, Kyle Hanson wrote: > Richard, > > I appreciate your response and have some genuine questions about how you > see the Language growing in the future. As much as I am a principled > developer in terms of adhering closely to the truth as possible, I also > view code as a product that needs to "customers" to be successful. In order > for that to happen, it needs to easily accessible and easy to understand. > > I learned Haskell almost entirely by looking at existing projects and > exploring the very awesome Hackage documentation. What would be the hackage > definition for ($)? Would it be `($) :: forall (r :: RuntimeRep) (a :: *) > (b :: TYPE r). (a -> b) -> a -> b` with an asterisk that says "*For > beginners: ($) :: (a -> b) -> a -> b" > > Would there be a "Simple Hackage"? > > It would be interesting for me to see how the skill levels of Haskell are > distributed. In most languages it would look like a pyramid with a small > group advanced developers on top and a mountain of people underneath. > Haskell seems to be pushing towards the inverse, in which to code and > understand standard, non beginners mode haskell you have to be "advanced". > The barrier to entry looks to be increasing. > > I agree with Christopher Allen and also do not agree with your assessment > and comparison to the unnecessary syntax in Java. You can explain that > program using simple english. That is why it was used for so many years as > an introductory language. > How do you explain `forall (r :: RuntimeRep) (a :: *) (b :: TYPE r).` > using simple english? > > I think its important to identify who you want your "customers" to be. If > you only want the most advanced type theorists to use the language, that is > perfectly fine, but what you lose are thousands of developers that can > benefit the Haskell community without having to know advanced Typing. > > Needing a "Beginners" mode in a language is *not* a feature, its a > fundamental design flaw. It shows that the language was not sufficiently > thought out and designed for everyone. > > Its extremely important to not lose touch with the people that make the > community; the newcomers. Sacrificing the 99% of beginner and intermediate > haskellers for the 1%, I believe is a step in the wrong direction. > > -- > Kyle > > On Fri, Feb 5, 2016 at 10:13 AM, Richard Eisenberg > wrote: > >> Perhaps it will aid the discussion to see that the type of ($) will, for >> better or worse, be changing again before 8.0. >> >> The problem is described in GHC ticket #11471. The details of "why" >> aren't all that important for this discussion, but the resolution might be. >> The new (hopefully final!) type of ($) will be: >> >> > ($) :: forall (r :: RuntimeRep) (a :: *) (b :: TYPE r). (a -> b) -> a >> -> b >> >> Once again, it's easy enough to tweak the pretty-printer to hide the >> complexity. But perhaps it's not necessary. The difference as far as this >> conversation is concerned is that Levity has been renamed to RuntimeRep. I >> think this is an improvement, because now it's not terribly hard to explain: >> >> --- >> 1. Types of kind * have values represented by pointers. This is the vast >> majority of data in Haskell, because almost everything in Haskell is boxed. >> 2. But sometimes, we don't care how a value is represented. In this case, >> we can be polymorphic in the choice of representation, just like `length` >> is polymorphic in the choice of list element type. >> 3. ($) works with functions whose result can have any representation, as >> succinctly stated in the type. Note that the argument to the function must >> be boxed, however, because the implementation of ($) must store and pass >> the argument. It doesn't care at all about the result, though, allowing for >> representation-polymorphism. >> >> In aid of this explanation, we can relate this all to Java. The reference >> types in Java (e.g., Object, int[], Boolean) are all like types of kind *. >> The primitive types in Java (int, boolean, char) do not have kind *. Java >> allows type abstraction (that is, generics) only over the types of kind *. >> Haskell is more general, allowing abstraction over primitive types via >> representation polymorphism. >> --- >> >> Could this all be explained to a novice programmer? That would be a >> struggle. But it could indeed be explained to an intermediate programmer in >> another language just learning Haskell. >> >> For point of comparison, Java is widely used as a teaching language. And >> yet one of the simplest programs is >> >> public class HelloWorld >> { >> public static void main(String[] args) >> { >> System.out.println("Hello, world!"); >> } >> } >> >> When I taught Java (I taught high-school full time for 8 years), I would >> start with something similar to this and have to tell everyone to ignore >> 90% of what was written. My course never even got to arrays and `static`! >> That was painful, but everyone survived. This is just to point out that >> Haskell isn't the only language with this problem. Not to say we shouldn't >> try to improve! >> >> We're in a bit of a bind in all this. We really need the fancy type for >> ($) so that it can be used in all situations where it is used currently. >> The old type for ($) was just a plain old lie. Now, at least, we're not >> lying. So, do we 1) lie, 2) allow the language to grow, or 3) avoid certain >> growth because it affects how easy the language is to learn? I don't really >> think anyone is advocating for (3) exactly, but it's hard to have (2) and >> not make things more complicated -- unless we have a beginners' mode or >> other features in, say, GHCi that aid learning. As I've said, I'm in full >> favor of adding these features. >> >> Richard >> >> On Feb 5, 2016, at 12:55 PM, Kyle Hanson wrote: >> >> I am also happy the discussion was posted here. Although I don't teach >> Haskell professionally, one of the things I loved to do was show people how >> simple Haskell really was by inspecting types and slowly putting the puzzle >> pieces together. >> >> Summary of the problem for others: >> >> From *Takenobu Tani* >> >> Before ghc7.8: >> >> Prelude> :t foldr >> foldr :: (a -> b -> b) -> b -> [a] -> b >> >> Prelude> :t ($) >> ($) :: (a -> b) -> a -> b >> >> Beginners should only understand about following: >> >> * type variable (polymorphism) >> >> >> After ghc8.0: >> >> Prelude> :t foldr >> foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b >> >> Prelude> :t ($) >> ($) >> :: forall (w :: GHC.Types.Levity) a (b :: TYPE w). >> (a -> b) -> a -> b >> >> >> >> With this change it looks like I will no longer be able to keep `$` in my >> toolbox since telling a beginner its "magic" goes against what I believe >> Haskell is good at, being well defined and easy to understand (Not well >> defined in terms of Types but well defined in terms of ability to precisely >> and concisely explain and define whats going on). >> >> It looks like where the discussion is going is to have these types show >> by default but eventually have an Alternative prelude for beginners. >> >> From *Richard Eisenberg:* >> >> - It's interesting that the solution to the two problems Takenobu pulls out below (but others have hinted at in this thread) is by having an alternate Prelude for beginners. I believe that having an alternate beginners' Prelude is becoming essential. I know I'm not the first one to suggest this, but a great many issues that teachers of Haskell have raised with me and posts on this and other lists would be solved by an alternate Prelude for beginners. >> >> I don't like the idea of fragmenting Haskell into "beginners" and >> "advanced" versions. Its hard enough to get people to believe Haskell is >> easy. If they see that they aren't using the "real" prelude, Haskell will >> still be this magic black box that is too abstract and difficult to >> understand. If they have to use a "dumbed down" version of Haskell to >> learn, its not as compelling. >> >> There is something powerful about using the same idiomatic tools as the >> "big boys" and have the tools still be able to be easy to understand.... by >> default. Adding complexity to the default Haskell runs the risk of further >> alienating newcomers to the language who have a misconception that its too >> hard. >> >> Admittedly, I am not well informed of the state of GHC 8.0 development >> and haven't had time to fully look into the situation. I am very interested >> to see where this conversation and the default complexity of Haskell goes. >> >> -- >> Kyle >> >> >> On Fri, Feb 5, 2016 at 8:26 AM, Tom Ellis < >> tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: >> >>> On Fri, Feb 05, 2016 at 05:25:15PM +0100, Johannes Waldmann wrote: >>> > > What's changed? >>> > >>> > I was referring to a discussion on ghc-devs, see >>> > https://mail.haskell.org/pipermail/ghc-devs/2016-February/011268.html >>> > and mixed up addresses when replying. >>> >>> I'm glad you did, because this is the first I've heard of it! >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> Haskell-Cafe at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> >> > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mike at izbicki.me Fri Feb 5 23:21:00 2016 From: mike at izbicki.me (Mike Izbicki) Date: Fri, 5 Feb 2016 15:21:00 -0800 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: > We're in a bit of a bind in all this. We really need the fancy type for ($) > so that it can be used in all situations where it is used currently. The old > type for ($) was just a plain old lie. Now, at least, we're not lying. So, > do we 1) lie, 2) allow the language to grow, or 3) avoid certain growth > because it affects how easy the language is to learn? I don't really think > anyone is advocating for (3) exactly, but it's hard to have (2) and not make > things more complicated -- unless we have a beginners' mode or other > features in, say, GHCi that aid learning. As I've said, I'm in full favor of > adding these features. The old type for ($) is only a lie when the MagicHash extension is turned on. Otherwise, it is not a lie. I think the best solution is to pretty print the type depending on what language pragmas are in use. In GHCI, this would be trivial. The much harder case is haddock documentation. I think a good way around this would be an eventual patch to haddock that allows the user to select which extensions they want to use when browsing documentation. There's a lot of usability issues that would need to be resolved with this still, but it reduces this technical discussion we're having down to a design discussion. It also nicely lets the user specify the level of difficulty they want their prelude to be without causing incompatibilty with users who want a different level of prelude. From yom at artyom.me Fri Feb 5 23:22:06 2016 From: yom at artyom.me (Artyom) Date: Sat, 6 Feb 2016 02:22:06 +0300 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: Message-ID: <56B52E9E.50303@artyom.me> Why not just make GHCi output a comment whenever the type involves levity? | > :t ($) -- Note: the actual type is more generic: -- -- ($) :: forall (w :: GHC.Types.Levity) a (b :: TYPE w). (a -> b) -> a -> b -- -- For the absolute majority of purposes the simpler type is correct. -- See GHC Guide chapter X point Y to learn more about this. ($) :: (a -> b) -> a -> b | ? -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Fri Feb 5 23:40:31 2016 From: imantc at gmail.com (Imants Cekusins) Date: Sat, 6 Feb 2016 00:40:31 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: off-topic but still may be relevant. my apologies if it isn't: isn't a good programming language - simple and unambiguous? isn't programming language as much about communicating with other programmers as about instructing compiler? look at the game of chess: limited number of clear rules allow for many complex and rich games. clarity, convenience + library coverage would draw users and keep them, I think. Good shiny tools attract interest. However it's what you could make with these tools matters. From mihai.maruseac at gmail.com Sat Feb 6 00:06:25 2016 From: mihai.maruseac at gmail.com (Mihai Maruseac) Date: Fri, 5 Feb 2016 19:06:25 -0500 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56B52E9E.50303@artyom.me> References: <56B52E9E.50303@artyom.me> Message-ID: On Fri, Feb 5, 2016 at 6:22 PM, Artyom wrote: > Why not just make GHCi output a comment whenever the type involves levity? > >> :t ($) > > -- Note: the actual type is more generic: > -- > -- ($) :: forall (w :: GHC.Types.Levity) a (b :: TYPE w). (a -> b) -> a > -> b > -- > -- For the absolute majority of purposes the simpler type is correct. > -- See GHC Guide chapter X point Y to learn more about this. > > ($) :: (a -> b) -> a -> b > Wouldn't this look like a scary error to some users? Though, users can get accustomed to this and this solution seems to be the best of both worlds. -- Mihai Maruseac (MM) "If you can't solve a problem, then there's an easier problem you can solve: find it." -- George Polya From eir at cis.upenn.edu Sat Feb 6 00:09:44 2016 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Fri, 5 Feb 2016 19:09:44 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: It may come as a surprise to many of you that I, too, am very worried about Haskell becoming inaccessible to newcomers. If we can't induct new people into our ranks, we will die. It is for this reason that I have always been unhappy with the FTP. But that ship has sailed. I fully agree with George's suggestion below that the default Prelude should be the beginner's Prelude. I believe I have argued this stance in the past, but louder voices prevailed. Perhaps I was wrong in branding: we should have a proper Prelude as the default, and make available a super whiz-bang advanced Prelude as well. I'm never very good about branding. I'd lend strong support to someone who articulates a concrete move in this direction, but I don't have the bandwidth to spearhead it myself. Despite the various arguments saying that the bits in Java are easier to understand than the bits in ($), I'm quite unconvinced. (Particularly about `static`. Even `class` is hard for true beginners.) And the boxed/unboxed distinction does come up early in Java: just try to write an ArrayList and now you need to know about boxed types and unboxed ones. Chris's point that "it's not about the name" is valid. The Levity --> RuntimeRep change is not about the name, but about the functionality. Levity distinguished only between lifted and unlifted; RuntimeRep distinguishes between boxed/lifted, boxed/unlifted, and all the unboxed types with their different widths. I'm just clarifying that it's not simply a cosmetic name-change. The old type of ($) was always a lie. -XMagicHash just changes the parser, allowing the # suffix. It is only by convention that most (all?) unlifted things end in #. The old type of ($) was perhaps a harmless lie, but a lie nonetheless. Are we comfortable with lying? (Believe me, I'm not trying to impose some moral dimension to simplifying output!) In my mind, lying about types like this is in the same space as having a beginner's Prelude. And people will constantly discover that we're lying and get very confused. Having a whole host of flags that tell GHC to lie less is somewhat like having two versions of the language... only the differences manifest only in output instead of input. If we are comfortable with lying in this way: as I've offered, I can hide the type of ($) (and other representation-polymorphic things) behind a flag. Easy to do. Another great question that has come up is about Haddock output (Hackage). I think Haddock needs to add a facility where library authors can include specializations of an overly general type. This can be done in commentary, but it's not as prominent. Such a new feature would address the ($) problem, as ($) :: forall (a :: *) (b :: *). (a -> b) -> a -> b is a specialization of its real type. It would also help a great deal with FTP-related generalizations. I also want to respond directly to Kyle's comments: > I think its important to identify who you want your "customers" to be. If you only want the most advanced type theorists to use the language, that is perfectly fine, but what you lose are thousands of developers that can benefit the Haskell community without having to know advanced Typing. Rest assured, I want my "customers" to be everyone who wants to program. I've volunteered to teach a bit of Haskell to high schoolers, and I'd love a shot at a course where I teach it to people who have never programmed. > > Needing a "Beginners" mode in a language is *not* a feature, its a fundamental design flaw. It shows that the language was not sufficiently thought out and designed for everyone. On an intuitive level, this rings true for me. But when I think about the details, I'm less convinced. For example, take Scratch (scratch.mit.edu), which is wonderfully easy to learn and gives kids (and adults!) a great deal of fun. Yet it's painful to use when you know more. And the Racket folks have invested a lot of time in coming up with a curriculum to go with their language, and they explicitly have expertise levels. Needing these levels may just be part of the game. So, rest assured, I remain very receptive to these concerns. And I'd love concrete help in putting them to rest. Richard On Feb 5, 2016, at 6:30 PM, George Colpitts wrote: > +1 for Christopher's email > Richard, I disagree with "But it could indeed be explained to an intermediate programmer in another language just learning Haskell." Your explanation is good but it assumes you have already explained "types of kind *" and the boxed vs unboxed distinction. Admittedly the latter should be understood by most Java programmers but I doubt that intermediate programmers in other languages do. If I did have to explain "$" I would say, for now think of it in terms of it's pre 8.0 type. Alternatively avoid mentioning "$" to beginners. I don't believe it is in Hutton's book or any of Bird's although I might be wrong. > > Most intermediate programmers in another language struggle a lot with learning monads, witness all the monad tutorials. Absorbing monads is central, there is a lot that has to be explained before that. Minimizing that material would be a good thing. > > I have mixed feelings about a beginner's prelude best summarized by saying the proposed beginner's prelude should be the standard prelude and the current one should be an advanced prelude. If we have a beginner's prelude I feel we are saying that this is a hard to understand research language and we hope that someday you have enough education, energy and tenacity to get to the point where you understand it. If we do it the other way we are saying you have what you need but if you want more there is lots! > > On Fri, Feb 5, 2016 at 3:05 PM, Christopher Allen wrote: > Changing the name doesn't fix the issue. The issue is the noise and the referent, not the referrer. There's a habit of over-focusing on names in programming communities. I think it'd be a mistake to do that here and risk missing the point. > > You can make all of the keywords in the Java example salient early on, but you cannot make the implementation details you're exposing in the type of ($) relevant unless they already have a year or two of Haskell under their belts. Listing out the keywords: > > 1. public > > 2. class > > 3. (class name) > > 4. static > > 5. void > > 6. (method name) > > 7. (method arguments) > > Explaining public, class, static, and void usually happens pretty soon after the basics in a Java course. Importantly, they're things you _need_ to know to get things done properly in Java. The same is not true of what is mentioned in the type of ($). > > The implicit prenex form and forall are irrelevant for learners until they get to Rank2/RankN which is very much beyond, "I am learning Haskell" and into, "I am designing an API in Haskell for other people to use". * vs. # is something many working and hobbyist Haskellers I've known will scarcely know anything about. > > There is a big difference, to my mind, between what is being exposed here in Java versus what is being exposed in the type ($). Consider that the boxed/unboxed distinction exists in Java but needn't come up in any beginner tutorials. > > >Types of kind * have values represented by pointers. This is the vast majority of data in Haskell, because almost everything in Haskell is boxed. > > We can't assume Haskell learners know what pointers are. This, again, creates unnecessary noise for learners by forcing exposure to things that are irrelevant for a very long time. > > > On Fri, Feb 5, 2016 at 12:13 PM, Richard Eisenberg wrote: > Perhaps it will aid the discussion to see that the type of ($) will, for better or worse, be changing again before 8.0. > > The problem is described in GHC ticket #11471. The details of "why" aren't all that important for this discussion, but the resolution might be. The new (hopefully final!) type of ($) will be: > > > ($) :: forall (r :: RuntimeRep) (a :: *) (b :: TYPE r). (a -> b) -> a -> b > > Once again, it's easy enough to tweak the pretty-printer to hide the complexity. But perhaps it's not necessary. The difference as far as this conversation is concerned is that Levity has been renamed to RuntimeRep. I think this is an improvement, because now it's not terribly hard to explain: > > --- > 1. Types of kind * have values represented by pointers. This is the vast majority of data in Haskell, because almost everything in Haskell is boxed. > 2. But sometimes, we don't care how a value is represented. In this case, we can be polymorphic in the choice of representation, just like `length` is polymorphic in the choice of list element type. > 3. ($) works with functions whose result can have any representation, as succinctly stated in the type. Note that the argument to the function must be boxed, however, because the implementation of ($) must store and pass the argument. It doesn't care at all about the result, though, allowing for representation-polymorphism. > > In aid of this explanation, we can relate this all to Java. The reference types in Java (e.g., Object, int[], Boolean) are all like types of kind *. The primitive types in Java (int, boolean, char) do not have kind *. Java allows type abstraction (that is, generics) only over the types of kind *. Haskell is more general, allowing abstraction over primitive types via representation polymorphism. > --- > > Could this all be explained to a novice programmer? That would be a struggle. But it could indeed be explained to an intermediate programmer in another language just learning Haskell. > > For point of comparison, Java is widely used as a teaching language. And yet one of the simplest programs is > > public class HelloWorld > { > public static void main(String[] args) > { > System.out.println("Hello, world!"); > } > } > > When I taught Java (I taught high-school full time for 8 years), I would start with something similar to this and have to tell everyone to ignore 90% of what was written. My course never even got to arrays and `static`! That was painful, but everyone survived. This is just to point out that Haskell isn't the only language with this problem. Not to say we shouldn't try to improve! > > We're in a bit of a bind in all this. We really need the fancy type for ($) so that it can be used in all situations where it is used currently. The old type for ($) was just a plain old lie. Now, at least, we're not lying. So, do we 1) lie, 2) allow the language to grow, or 3) avoid certain growth because it affects how easy the language is to learn? I don't really think anyone is advocating for (3) exactly, but it's hard to have (2) and not make things more complicated -- unless we have a beginners' mode or other features in, say, GHCi that aid learning. As I've said, I'm in full favor of adding these features. > > Richard > > On Feb 5, 2016, at 12:55 PM, Kyle Hanson wrote: > >> I am also happy the discussion was posted here. Although I don't teach Haskell professionally, one of the things I loved to do was show people how simple Haskell really was by inspecting types and slowly putting the puzzle pieces together. >> >> Summary of the problem for others: >> From Takenobu Tani >> Before ghc7.8: >> >> Prelude> :t foldr >> foldr :: (a -> b -> b) -> b -> [a] -> b >> >> Prelude> :t ($) >> ($) :: (a -> b) -> a -> b >> >> Beginners should only understand about following: >> >> * type variable (polymorphism) >> >> >> After ghc8.0: >> >> Prelude> :t foldr >> foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b >> >> Prelude> :t ($) >> ($) >> :: forall (w :: GHC.Types.Levity) a (b :: TYPE w). >> (a -> b) -> a -> b >> >> >> With this change it looks like I will no longer be able to keep `$` in my toolbox since telling a beginner its "magic" goes against what I believe Haskell is good at, being well defined and easy to understand (Not well defined in terms of Types but well defined in terms of ability to precisely and concisely explain and define whats going on). >> >> It looks like where the discussion is going is to have these types show by default but eventually have an Alternative prelude for beginners. >> >> From Richard Eisenberg: >> - It's interesting that the solution to the two problems Takenobu pulls out below (but others have hinted at in this thread) is by having an alternate Prelude for beginners. I believe that having an alternate beginners' Prelude is becoming essential. I know I'm not the first one to suggest this, but a great many issues that teachers of Haskell have raised with me and posts on this and other lists would be solved by an alternate Prelude for beginners. >> I don't like the idea of fragmenting Haskell into "beginners" and "advanced" versions. Its hard enough to get people to believe Haskell is easy. If they see that they aren't using the "real" prelude, Haskell will still be this magic black box that is too abstract and difficult to understand. If they have to use a "dumbed down" version of Haskell to learn, its not as compelling. >> >> There is something powerful about using the same idiomatic tools as the "big boys" and have the tools still be able to be easy to understand.... by default. Adding complexity to the default Haskell runs the risk of further alienating newcomers to the language who have a misconception that its too hard. >> >> Admittedly, I am not well informed of the state of GHC 8.0 development and haven't had time to fully look into the situation. I am very interested to see where this conversation and the default complexity of Haskell goes. >> >> -- >> Kyle >> >> >> On Fri, Feb 5, 2016 at 8:26 AM, Tom Ellis wrote: >> On Fri, Feb 05, 2016 at 05:25:15PM +0100, Johannes Waldmann wrote: >> > > What's changed? >> > >> > I was referring to a discussion on ghc-devs, see >> > https://mail.haskell.org/pipermail/ghc-devs/2016-February/011268.html >> > and mixed up addresses when replying. >> >> I'm glad you did, because this is the first I've heard of it! >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > > > > > -- > Chris Allen > Currently working on http://haskellbook.com > > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From yom at artyom.me Sat Feb 6 00:15:56 2016 From: yom at artyom.me (Artyom) Date: Sat, 6 Feb 2016 03:15:56 +0300 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B52E9E.50303@artyom.me> Message-ID: <56B53B3C.4020100@artyom.me> I agree, it?s a bit too heavy. In fact, since most users probably won?t ever ever ever need that type, let?s only impose it on those who explicitly agree to see it: | > :t ($) -- Note: the actual type is slightly more generic; set -fshow-levity -- or use :t# instead of :t to see the fully generic form. ($) :: (a -> b) -> a -> b | On 02/06/2016 03:06 AM, Mihai Maruseac wrote: > On Fri, Feb 5, 2016 at 6:22 PM, Artyom wrote: >> Why not just make GHCi output a comment whenever the type involves levity? >> >>> :t ($) >> -- Note: the actual type is more generic: >> -- >> -- ($) :: forall (w :: GHC.Types.Levity) a (b :: TYPE w). (a -> b) -> a >> -> b >> -- >> -- For the absolute majority of purposes the simpler type is correct. >> -- See GHC Guide chapter X point Y to learn more about this. >> >> ($) :: (a -> b) -> a -> b >> > Wouldn't this look like a scary error to some users? Though, users can > get accustomed to this and this solution seems to be the best of both > worlds. > > > ? -------------- next part -------------- An HTML attachment was scrubbed... URL: From mihai.maruseac at gmail.com Sat Feb 6 00:27:42 2016 From: mihai.maruseac at gmail.com (Mihai Maruseac) Date: Fri, 5 Feb 2016 19:27:42 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: On Fri, Feb 5, 2016 at 7:09 PM, Richard Eisenberg wrote: > > Another great question that has come up is about Haddock output (Hackage). I > think Haddock needs to add a facility where library authors can include > specializations of an overly general type. This can be done in commentary, > but it's not as prominent. Such a new feature would address the ($) problem, > as ($) :: forall (a :: *) (b :: *). (a -> b) -> a -> b is a specialization > of its real type. It would also help a great deal with FTP-related > generalizations. This goes hand in hand with Artyom's suggestion of a warning in GHCi after showing the simpler type. I'm thinking of a flag which enables/disables printing the simplest type with warning (in GHCi) or footnote (or otherwise, in Haddock). We can have the default behavior of the flag be either printing the simpler type + extra (warning/footnote) or printing the longer type and include a reference in our learning materials that beginners and people confused by the long, complex and real type, can use --use-simpler-types flag. -- Mihai Maruseac (MM) "If you can't solve a problem, then there's an easier problem you can solve: find it." -- George Polya From takenobu.hs at gmail.com Sat Feb 6 00:28:58 2016 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Sat, 6 Feb 2016 09:28:58 +0900 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: Hi, I tried to draw informal illustrations about Foldable signatures for beginners [1]. I'll also try to draw simple illustrations about new ($). Of course I like Haskell's beautiful abstraction :) Thank you for your great efforts. [1] http://takenobu-hs.github.io/downloads/type_introduction_illustrated.pdf Regards, Takenobu 2016-02-06 9:09 GMT+09:00 Richard Eisenberg : > It may come as a surprise to many of you that I, too, am very worried > about Haskell becoming inaccessible to newcomers. If we can't induct new > people into our ranks, we will die. It is for this reason that I have > always been unhappy with the FTP. But that ship has sailed. > > I fully agree with George's suggestion below that the default Prelude > should be the beginner's Prelude. I believe I have argued this stance in > the past, but louder voices prevailed. Perhaps I was wrong in branding: we > should have a proper Prelude as the default, and make available a super > whiz-bang advanced Prelude as well. I'm never very good about branding. I'd > lend strong support to someone who articulates a concrete move in this > direction, but I don't have the bandwidth to spearhead it myself. > > Despite the various arguments saying that the bits in Java are easier to > understand than the bits in ($), I'm quite unconvinced. (Particularly about > `static`. Even `class` is hard for true beginners.) And the boxed/unboxed > distinction does come up early in Java: just try to write an ArrayList > and now you need to know about boxed types and unboxed ones. > > Chris's point that "it's not about the name" is valid. The Levity --> > RuntimeRep change is not about the name, but about the functionality. > Levity distinguished only between lifted and unlifted; RuntimeRep > distinguishes between boxed/lifted, boxed/unlifted, and all the unboxed > types with their different widths. I'm just clarifying that it's not simply > a cosmetic name-change. > > The old type of ($) was always a lie. -XMagicHash just changes the parser, > allowing the # suffix. It is only by convention that most (all?) unlifted > things end in #. The old type of ($) was perhaps a harmless lie, but a lie > nonetheless. > > Are we comfortable with lying? (Believe me, I'm not trying to impose some > moral dimension to simplifying output!) In my mind, lying about types like > this is in the same space as having a beginner's Prelude. And people will > constantly discover that we're lying and get very confused. Having a whole > host of flags that tell GHC to lie less is somewhat like having two > versions of the language... only the differences manifest only in output > instead of input. > > If we are comfortable with lying in this way: as I've offered, I can hide > the type of ($) (and other representation-polymorphic things) behind a > flag. Easy to do. > > Another great question that has come up is about Haddock output (Hackage). > I think Haddock needs to add a facility where library authors can include > specializations of an overly general type. This can be done in commentary, > but it's not as prominent. Such a new feature would address the ($) > problem, as ($) :: forall (a :: *) (b :: *). (a -> b) -> a -> b is a > specialization of its real type. It would also help a great deal with > FTP-related generalizations. > > I also want to respond directly to Kyle's comments: > > I think its important to identify who you want your "customers" to be. If > you only want the most advanced type theorists to use the language, that is > perfectly fine, but what you lose are thousands of developers that can > benefit the Haskell community without having to know advanced Typing. > > > Rest assured, I want my "customers" to be everyone who wants to program. > I've volunteered to teach a bit of Haskell to high schoolers, and I'd love > a shot at a course where I teach it to people who have never programmed. > > > Needing a "Beginners" mode in a language is *not* a feature, its a > fundamental design flaw. It shows that the language was not sufficiently > thought out and designed for everyone. > > > On an intuitive level, this rings true for me. But when I think about the > details, I'm less convinced. For example, take Scratch (scratch.mit.edu), > which is wonderfully easy to learn and gives kids (and adults!) a great > deal of fun. Yet it's painful to use when you know more. And the Racket > folks have invested a lot of time in coming up with a curriculum to go with > their language, and they explicitly have expertise levels. Needing these > levels may just be part of the game. > > So, rest assured, I remain very receptive to these concerns. And I'd love > concrete help in putting them to rest. > > Richard > > > On Feb 5, 2016, at 6:30 PM, George Colpitts > wrote: > > +1 for Christopher's email > Richard, I disagree with "But it could indeed be explained to an > intermediate programmer in another language just learning Haskell." Your > explanation is good but it assumes you have already explained "types of > kind *" and the boxed vs unboxed distinction. Admittedly the latter should > be understood by most Java programmers but I doubt that intermediate > programmers in other languages do. If I did have to explain "$" I would > say, for now think of it in terms of it's pre 8.0 type. Alternatively avoid > mentioning "$" to beginners. I don't believe it is in Hutton's book or any > of Bird's although I might be wrong. > > Most intermediate programmers in another language struggle a lot with > learning monads, witness all the monad tutorials. Absorbing monads is > central, there is a lot that has to be explained before that. Minimizing > that material would be a good thing. > > I have mixed feelings about a beginner's prelude best summarized by saying > the proposed beginner's prelude should be the standard prelude and the > current one should be an advanced prelude. If we have a beginner's prelude > I feel we are saying that this is a hard to understand research language > and we hope that someday you have enough education, energy and tenacity to > get to the point where you understand it. If we do it the other way we are > saying you have what you need but if you want more there is lots! > > On Fri, Feb 5, 2016 at 3:05 PM, Christopher Allen > wrote: > >> Changing the name doesn't fix the issue. The issue is the noise and the >> referent, not the referrer. There's a habit of over-focusing on names in >> programming communities. I think it'd be a mistake to do that here and risk >> missing the point. >> >> You can make all of the keywords in the Java example salient early on, >> but you cannot make the implementation details you're exposing in the type >> of ($) relevant unless they already have a year or two of Haskell under >> their belts. Listing out the keywords: >> >> 1. public >> >> 2. class >> >> 3. (class name) >> >> 4. static >> >> 5. void >> >> 6. (method name) >> >> 7. (method arguments) >> >> Explaining public, class, static, and void usually happens pretty soon >> after the basics in a Java course. Importantly, they're things you _need_ >> to know to get things done properly in Java. The same is not true of what >> is mentioned in the type of ($). >> >> The implicit prenex form and forall are irrelevant for learners until >> they get to Rank2/RankN which is very much beyond, "I am learning Haskell" >> and into, "I am designing an API in Haskell for other people to use". * vs. >> # is something many working and hobbyist Haskellers I've known will >> scarcely know anything about. >> >> There is a big difference, to my mind, between what is being exposed here >> in Java versus what is being exposed in the type ($). Consider that the >> boxed/unboxed distinction exists in Java but needn't come up in any >> beginner tutorials. >> >> >Types of kind * have values represented by pointers. This is the vast >> majority of data in Haskell, because almost everything in Haskell is boxed. >> >> We can't assume Haskell learners know what pointers are. This, again, >> creates unnecessary noise for learners by forcing exposure to things that >> are irrelevant for a very long time. >> >> >> On Fri, Feb 5, 2016 at 12:13 PM, Richard Eisenberg >> wrote: >> >>> Perhaps it will aid the discussion to see that the type of ($) will, for >>> better or worse, be changing again before 8.0. >>> >>> The problem is described in GHC ticket #11471. The details of "why" >>> aren't all that important for this discussion, but the resolution might be. >>> The new (hopefully final!) type of ($) will be: >>> >>> > ($) :: forall (r :: RuntimeRep) (a :: *) (b :: TYPE r). (a -> b) -> a >>> -> b >>> >>> Once again, it's easy enough to tweak the pretty-printer to hide the >>> complexity. But perhaps it's not necessary. The difference as far as this >>> conversation is concerned is that Levity has been renamed to RuntimeRep. I >>> think this is an improvement, because now it's not terribly hard to explain: >>> >>> --- >>> 1. Types of kind * have values represented by pointers. This is the vast >>> majority of data in Haskell, because almost everything in Haskell is boxed. >>> 2. But sometimes, we don't care how a value is represented. In this >>> case, we can be polymorphic in the choice of representation, just like >>> `length` is polymorphic in the choice of list element type. >>> 3. ($) works with functions whose result can have any representation, as >>> succinctly stated in the type. Note that the argument to the function must >>> be boxed, however, because the implementation of ($) must store and pass >>> the argument. It doesn't care at all about the result, though, allowing for >>> representation-polymorphism. >>> >>> In aid of this explanation, we can relate this all to Java. The >>> reference types in Java (e.g., Object, int[], Boolean) are all like types >>> of kind *. The primitive types in Java (int, boolean, char) do not have >>> kind *. Java allows type abstraction (that is, generics) only over the >>> types of kind *. Haskell is more general, allowing abstraction over >>> primitive types via representation polymorphism. >>> --- >>> >>> Could this all be explained to a novice programmer? That would be a >>> struggle. But it could indeed be explained to an intermediate programmer in >>> another language just learning Haskell. >>> >>> For point of comparison, Java is widely used as a teaching language. And >>> yet one of the simplest programs is >>> >>> public class HelloWorld >>> { >>> public static void main(String[] args) >>> { >>> System.out.println("Hello, world!"); >>> } >>> } >>> >>> When I taught Java (I taught high-school full time for 8 years), I would >>> start with something similar to this and have to tell everyone to ignore >>> 90% of what was written. My course never even got to arrays and `static`! >>> That was painful, but everyone survived. This is just to point out that >>> Haskell isn't the only language with this problem. Not to say we shouldn't >>> try to improve! >>> >>> We're in a bit of a bind in all this. We really need the fancy type for >>> ($) so that it can be used in all situations where it is used currently. >>> The old type for ($) was just a plain old lie. Now, at least, we're not >>> lying. So, do we 1) lie, 2) allow the language to grow, or 3) avoid certain >>> growth because it affects how easy the language is to learn? I don't really >>> think anyone is advocating for (3) exactly, but it's hard to have (2) and >>> not make things more complicated -- unless we have a beginners' mode or >>> other features in, say, GHCi that aid learning. As I've said, I'm in full >>> favor of adding these features. >>> >>> Richard >>> >>> On Feb 5, 2016, at 12:55 PM, Kyle Hanson wrote: >>> >>> I am also happy the discussion was posted here. Although I don't teach >>> Haskell professionally, one of the things I loved to do was show people how >>> simple Haskell really was by inspecting types and slowly putting the puzzle >>> pieces together. >>> >>> Summary of the problem for others: >>> >>> From *Takenobu Tani* >>> >>> Before ghc7.8: >>> >>> Prelude> :t foldr >>> foldr :: (a -> b -> b) -> b -> [a] -> b >>> >>> Prelude> :t ($) >>> ($) :: (a -> b) -> a -> b >>> >>> Beginners should only understand about following: >>> >>> * type variable (polymorphism) >>> >>> >>> After ghc8.0: >>> >>> Prelude> :t foldr >>> foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b >>> >>> Prelude> :t ($) >>> ($) >>> :: forall (w :: GHC.Types.Levity) a (b :: TYPE w). >>> (a -> b) -> a -> b >>> >>> >>> >>> With this change it looks like I will no longer be able to keep `$` in >>> my toolbox since telling a beginner its "magic" goes against what I believe >>> Haskell is good at, being well defined and easy to understand (Not well >>> defined in terms of Types but well defined in terms of ability to precisely >>> and concisely explain and define whats going on). >>> >>> It looks like where the discussion is going is to have these types show >>> by default but eventually have an Alternative prelude for beginners. >>> >>> From *Richard Eisenberg:* >>> >>> - It's interesting that the solution to the two problems Takenobu pulls out below (but others have hinted at in this thread) is by having an alternate Prelude for beginners. I believe that having an alternate beginners' Prelude is becoming essential. I know I'm not the first one to suggest this, but a great many issues that teachers of Haskell have raised with me and posts on this and other lists would be solved by an alternate Prelude for beginners. >>> >>> I don't like the idea of fragmenting Haskell into "beginners" and >>> "advanced" versions. Its hard enough to get people to believe Haskell is >>> easy. If they see that they aren't using the "real" prelude, Haskell will >>> still be this magic black box that is too abstract and difficult to >>> understand. If they have to use a "dumbed down" version of Haskell to >>> learn, its not as compelling. >>> >>> There is something powerful about using the same idiomatic tools as the >>> "big boys" and have the tools still be able to be easy to understand.... by >>> default. Adding complexity to the default Haskell runs the risk of further >>> alienating newcomers to the language who have a misconception that its too >>> hard. >>> >>> Admittedly, I am not well informed of the state of GHC 8.0 development >>> and haven't had time to fully look into the situation. I am very interested >>> to see where this conversation and the default complexity of Haskell goes. >>> >>> -- >>> Kyle >>> >>> >>> On Fri, Feb 5, 2016 at 8:26 AM, Tom Ellis < >>> tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: >>> >>>> On Fri, Feb 05, 2016 at 05:25:15PM +0100, Johannes Waldmann wrote: >>>> > > What's changed? >>>> > >>>> > I was referring to a discussion on ghc-devs, see >>>> > https://mail.haskell.org/pipermail/ghc-devs/2016-February/011268.html >>>> > and mixed up addresses when replying. >>>> >>>> I'm glad you did, because this is the first I've heard of it! >>>> _______________________________________________ >>>> Haskell-Cafe mailing list >>>> Haskell-Cafe at haskell.org >>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>>> >>> >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> Haskell-Cafe at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> >>> >>> >>> _______________________________________________ >>> ghc-devs mailing list >>> ghc-devs at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs >>> >>> >> >> >> -- >> Chris Allen >> Currently working on http://haskellbook.com >> >> _______________________________________________ >> ghc-devs mailing list >> ghc-devs at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs >> >> > > > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From yom at artyom.me Sat Feb 6 00:47:43 2016 From: yom at artyom.me (Artyom) Date: Sat, 6 Feb 2016 03:47:43 +0300 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: <56B542AF.4070106@artyom.me> I?ve amended my suggestion to say basically ?this type is a slight lie, here?s a flag/command to see the true type? ? this way we aren?t scaring people with implementation guts, merely letting them see the guts for themselves and then think ?I don?t care about this? (which is, I think, exactly what should happen; the worst scenario here is that the beginner falls into the ?I?m an advanced user, I need all features, I need to know everything, so I?ll enable the flag? trap ? which is why it?s important not to call it ?an advanced type? or mention ?if you know what you?re doing? or anything else like that). I don?t agree that levity can be compared to Java?s ?class? or ?static? ? not because it?s harder to understand, but because it?s much less widely used; I don?t feel that you need to know about levity in order to be a good Haskeller. Also, unboxed types don?t imply knowledge of levity ? for instance, I?ve been successfully using unboxed types for a while, but I only found out about the true type of |($)| by complete accident (I think I queried the kind of |->| and then got curious about question marks). Of On 02/06/2016 03:27 AM, Mihai Maruseac wrote: > On Fri, Feb 5, 2016 at 7:09 PM, Richard Eisenberg wrote: >> Another great question that has come up is about Haddock output (Hackage). I >> think Haddock needs to add a facility where library authors can include >> specializations of an overly general type. This can be done in commentary, >> but it's not as prominent. Such a new feature would address the ($) problem, >> as ($) :: forall (a :: *) (b :: *). (a -> b) -> a -> b is a specialization >> of its real type. It would also help a great deal with FTP-related >> generalizations. > This goes hand in hand with Artyom's suggestion of a warning in GHCi > after showing the simpler type. > > I'm thinking of a flag which enables/disables printing the simplest > type with warning (in GHCi) or footnote (or otherwise, in Haddock). We > can have the default behavior of the flag be either printing the > simpler type + extra (warning/footnote) or printing the longer type > and include a reference in our learning materials that beginners and > people confused by the long, complex and real type, can use > --use-simpler-types flag. > ? -------------- next part -------------- An HTML attachment was scrubbed... URL: From eir at cis.upenn.edu Sat Feb 6 01:51:13 2016 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Fri, 5 Feb 2016 20:51:13 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <56B542AF.4070106@artyom.me> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> Message-ID: <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> A bit of time away from my keyboard has revealed a natural way to solve this problem and others: be more like Idris. Normally, of course, I'm thinking about how Haskell's type system can be more like Idris's. But that's not what I mean here. I want Haskell's interface to be more like Idris's. Imagine this interchange: ?> :t ($) ($) :: (a -> b) -> a -> b -- click on the type ($) :: forall a b. (a -> b) -> a -> b -- click on the a ($) :: forall (a :: *) b. (a -> b) -> a -> b -- click on the b ($) :: forall (a :: *) (b :: *). (a -> b) -> a -> b -- where b's kind has a different color than usual -- click on b's kind ($) :: forall {r :: RuntimeRep} (a :: *) (b :: TYPE r). (a -> b) -> a -> b -- mouseover RuntimeRep or TYPE reveals a tooltip "($) is representation-polymorphic, meaning that `b` can have an arbitrary runtime representation. Please see http://.... for more details." Similarly, classes would render in a special color, allowing you to click on them and choose to instantiate the type at a few in-scope instances of the class at hand, changing Foldable f => f a -> Int to the much simpler [a] -> Int. This is not a minor engineering project, but it would reap wonderful rewards, addressing the problems in this thread and more. No more lying (because all lies are clickable), no more fragmented language, no more brakes on development. Evidently, Chris already agrees with this proposal: #10073 (https://ghc.haskell.org/trac/ghc/ticket/10073) Also see #8809 (https://ghc.haskell.org/trac/ghc/ticket/8809) Any volunteers to implement this? :) Richard On Feb 5, 2016, at 7:47 PM, Artyom wrote: > I?ve amended my suggestion to say basically ?this type is a slight lie, here?s a flag/command to see the true type? ? this way we aren?t scaring people with implementation guts, merely letting them see the guts for themselves and then think ?I don?t care about this? (which is, I think, exactly what should happen; the worst scenario here is that the beginner falls into the ?I?m an advanced user, I need all features, I need to know everything, so I?ll enable the flag? trap ? which is why it?s important not to call it ?an advanced type? or mention ?if you know what you?re doing? or anything else like that). > > I don?t agree that levity can be compared to Java?s ?class? or ?static? ? not because it?s harder to understand, but because it?s much less widely used; I don?t feel that you need to know about levity in order to be a good Haskeller. Also, unboxed types don?t imply knowledge of levity ? for instance, I?ve been successfully using unboxed types for a while, but I only found out about the true type of ($) by complete accident (I think I queried the kind of -> and then got curious about question marks). Of > > On 02/06/2016 03:27 AM, Mihai Maruseac wrote: > > > >> On Fri, Feb 5, 2016 at 7:09 PM, Richard Eisenberg wrote: >>> Another great question that has come up is about Haddock output (Hackage). I >>> think Haddock needs to add a facility where library authors can include >>> specializations of an overly general type. This can be done in commentary, >>> but it's not as prominent. Such a new feature would address the ($) problem, >>> as ($) :: forall (a :: *) (b :: *). (a -> b) -> a -> b is a specialization >>> of its real type. It would also help a great deal with FTP-related >>> generalizations. >> This goes hand in hand with Artyom's suggestion of a warning in GHCi >> after showing the simpler type. >> >> I'm thinking of a flag which enables/disables printing the simplest >> type with warning (in GHCi) or footnote (or otherwise, in Haddock). We >> can have the default behavior of the flag be either printing the >> simpler type + extra (warning/footnote) or printing the longer type >> and include a reference in our learning materials that beginners and >> people confused by the long, complex and real type, can use >> --use-simpler-types flag. >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From travis.cardwell at extellisys.com Sat Feb 6 02:08:41 2016 From: travis.cardwell at extellisys.com (Travis Cardwell) Date: Sat, 6 Feb 2016 11:08:41 +0900 Subject: [Haskell-cafe] Can we improve Show instance for non-ascii charcters? In-Reply-To: <56B4C69A.30009@orlitzky.com> References: <56B1FB8E.3020906@extellisys.com> <56B4C69A.30009@orlitzky.com> Message-ID: <56B555A9.5020104@extellisys.com> On 02/06/2016 12:58 AM, Michael Orlitzky wrote: > But for the terminal? Try Ctrl-Alt-F1 to drop out of X and into a > Linux/BSD terminal, and runghc on a file containing, > > main = mapM_ putStrLn $ [(++"??"), (++"??")] <*> ["??", "??"] > > I get a bunch of grey question marks. By default, Ctrl+Alt+F1 takes you to a "virtual console," which uses a framebuffer with very limited memory. Console fonts are limited to 256 glyphs, or 512 glyphs with fewer colors, which is too few glyphs for a proper CJK Unicode font. (**tangent below**) This issue applies to all Unicode software; it is not specific to Haskell. Cheers, Travis **tangent** It is possible to use Unicode outside of X with other software. For example, fbterm is a terminal emulator that selects fonts with fontconfig and renders them using freetype2, making the usual X fonts available for use. Here are some (Japanese) instructions for installation: Debian8 ????????????fbterm? http://qiita.com/mtomoaki_96kg/items/e5a946fd38f7318d3758 From m.farkasdyck at gmail.com Sat Feb 6 02:24:47 2016 From: m.farkasdyck at gmail.com (M Farkas-Dyck) Date: Fri, 5 Feb 2016 18:24:47 -0800 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> Message-ID: On 05/02/2016, Richard Eisenberg wrote: > -- click on the type The question so remains: what would we write to a purely textual terminal? From mihai.maruseac at gmail.com Sat Feb 6 02:29:07 2016 From: mihai.maruseac at gmail.com (Mihai Maruseac) Date: Fri, 5 Feb 2016 21:29:07 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> Message-ID: On Fri, Feb 5, 2016 at 9:24 PM, M Farkas-Dyck wrote: >> -- click on the type > > The question so remains: what would we write to a purely textual terminal? We could write the simplest type with a "type :expand / :ex (or similar) to expand signature", eventually underlining the part that will be expanded first. -- Mihai Maruseac (MM) "If you can't solve a problem, then there's an easier problem you can solve: find it." -- George Polya From hon.lianhung at gmail.com Sat Feb 6 02:58:18 2016 From: hon.lianhung at gmail.com (Lian Hung Hon) Date: Sat, 6 Feb 2016 10:58:18 +0800 Subject: [Haskell-cafe] How to handle recoverable errors in multi-step computation? Message-ID: Dear haskellers, I have a multi-step computation. The steps are predefined, but users can choose which steps to execute (something like a recipe). Here is an example recipe: Step 1 - Get data from network (multiple HTTP calls) and put into a list Step 2 - Process the data (e.g. average, sum, median, etc.) Step 3 - Persist result to database Sometimes, Step 1 can fail for some of the HTTP calls. When this happens, Step 2 should continue as much as possible using whatever data that has been retrieved, but somehow indicate that an error has occurred and the result is partial. Q1: What is the idiomatic way of achieving this? Using throwError in Control.Monad.Except aborts the computation, which isn't what I want. Q2: (General software design) Furthermore, where should the error be logged? Logging it in both Step 1 and 2 preserves modularity for each of the steps, unfortunately it would result in duplicate error messages. What is the best practice for this? Regards, Hon -------------- next part -------------- An HTML attachment was scrubbed... URL: From alex323 at gmail.com Sat Feb 6 07:17:50 2016 From: alex323 at gmail.com (Alex) Date: Sat, 6 Feb 2016 00:17:50 -0700 Subject: [Haskell-cafe] Combining Pipes with Callbacks Message-ID: <20160206001750.6d667253@gmail.com> Is it possible to shoehorn a function which uses send/receive callbacks in to the definition of a Pipe?: http://lpaste.net/3654837866896293888#line23 If so, how would I define `cb' here? -- Alex From imantc at gmail.com Sat Feb 6 08:23:42 2016 From: imantc at gmail.com (Imants Cekusins) Date: Sat, 6 Feb 2016 09:23:42 +0100 Subject: [Haskell-cafe] How to handle recoverable errors in multi-step computation? In-Reply-To: References: Message-ID: hello Hon, you could: Q1) return Either Partial Result from each step that may partially fail Q2) Partial type may include (tag, level) where tag is generated by the function where it first happened, level is incremented in each caller function (where the "error" bubbled up/propagated). Log fails in every steps. Tags would let you link errors, levels would hint at the order in which the error bubbled up. this may not be the best practice. Just a possibility. From marcin.jan.mrotek at gmail.com Sat Feb 6 08:37:42 2016 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Sat, 6 Feb 2016 09:37:42 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> Message-ID: I have a bad feeling this would complicate the parser and pretty printer a lot, and thus isn't feasible, but what about allowing wildcards in kind signatures? I mean, in forall (w :: Levity) a (b :: TYPE w). (a -> b) -> a -> b the `w` variable seems superfluous, as it's only there to give it a kind signature. I think there's enough information in `TYPE w` to infer the kind (`TYPE` can only be parametrized with `Levity`?) so maybe something like this would work: forall a (b :: TYPE _). (a -> b) -> a -> b This could be "some" compromise between "lying" about the type and being scary to beginners, as at the very least all the type variables introduced are actually used in the type signature. Best regards, Marcin Mrotek -------------- next part -------------- An HTML attachment was scrubbed... URL: From roma at ro-che.info Sat Feb 6 08:58:27 2016 From: roma at ro-che.info (Roman Cheplyaka) Date: Sat, 6 Feb 2016 10:58:27 +0200 Subject: [Haskell-cafe] How to handle recoverable errors in multi-step computation? In-Reply-To: References: Message-ID: <56B5B5B3.8080003@ro-che.info> It sounds like you want the Validation applicative functor. See e.g. https://ro-che.info/articles/2015-05-02-smarter-validation On 02/06/2016 04:58 AM, Lian Hung Hon wrote: > Dear haskellers, > > I have a multi-step computation. The steps are predefined, but users can > choose which steps to execute (something like a recipe). Here is an > example recipe: > > Step 1 - Get data from network (multiple HTTP calls) and put into a list > Step 2 - Process the data (e.g. average, sum, median, etc.) > Step 3 - Persist result to database > > Sometimes, Step 1 can fail for some of the HTTP calls. When this > happens, Step 2 should continue as much as possible using whatever data > that has been retrieved, but somehow indicate that an error has occurred > and the result is partial. > > Q1: What is the idiomatic way of achieving this? Using throwError in > Control.Monad.Except aborts the computation, which isn't what I want. > > Q2: (General software design) Furthermore, where should the error be > logged? Logging it in both Step 1 and 2 preserves modularity for each of > the steps, unfortunately it would result in duplicate error messages. > What is the best practice for this? > > Regards, > Hon > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 819 bytes Desc: OpenPGP digital signature URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sat Feb 6 11:59:20 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sat, 6 Feb 2016 11:59:20 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <20160205191925.GC28854@weber> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> Message-ID: <20160206115920.GA30442@weber> On Fri, Feb 05, 2016 at 07:19:25PM +0000, Tom Ellis wrote: > On Fri, Feb 05, 2016 at 01:13:23PM -0500, Richard Eisenberg wrote: > > We're in a bit of a bind in all this. We really need the fancy type for > > ($) so that it can be used in all situations where it is used currently. > > Is there a list of situations where ($) is used currently that give rise to > this need? Does anyone have any idea about this? What is it about ($) that means it needs a new funky type whereas (apparently) nothing else does? From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sat Feb 6 12:20:49 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sat, 6 Feb 2016 12:20:49 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <20160206115920.GA30442@weber> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> Message-ID: <20160206122049.GB30442@weber> On Sat, Feb 06, 2016 at 11:59:20AM +0000, Tom Ellis wrote: > On Fri, Feb 05, 2016 at 07:19:25PM +0000, Tom Ellis wrote: > > On Fri, Feb 05, 2016 at 01:13:23PM -0500, Richard Eisenberg wrote: > > > We're in a bit of a bind in all this. We really need the fancy type for > > > ($) so that it can be used in all situations where it is used currently. > > > > Is there a list of situations where ($) is used currently that give rise to > > this need? > > Does anyone have any idea about this? What is it about ($) that means it > needs a new funky type whereas (apparently) nothing else does? For example, why should maybe not be extended from maybe :: b -> (a -> b) -> Maybe a -> b to maybe :: forall (r :: RuntimeRep) (a :: *) (b :: TYPE r). b -> (a -> b) -> Maybe a -> b That's strictly more general, is it not? Tom From ben at smart-cactus.org Sat Feb 6 12:27:00 2016 From: ben at smart-cactus.org (Ben Gamari) Date: Sat, 06 Feb 2016 13:27:00 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <20160206115920.GA30442@weber> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> Message-ID: <87r3gq9g8b.fsf@smart-cactus.org> Tom Ellis writes: > On Fri, Feb 05, 2016 at 07:19:25PM +0000, Tom Ellis wrote: >> On Fri, Feb 05, 2016 at 01:13:23PM -0500, Richard Eisenberg wrote: >> > We're in a bit of a bind in all this. We really need the fancy type for >> > ($) so that it can be used in all situations where it is used currently. >> >> Is there a list of situations where ($) is used currently that give rise to >> this need? > > Does anyone have any idea about this? What is it about ($) that means it > needs a new funky type whereas (apparently) nothing else does? The first (albeit rather unconvincing) example I can think of is be something like, getI# :: Int -> Int# getI# (I# n#) = n# n# :: Int# n# = getI# $ 5 + 8 Richard likely has something a bit less contrived though. This does raise the question of why ($) is generalized, yet (.) is not, (.) :: forall (l :: Levity) a b (c :: TYPE l). (b -> c) -> (a -> b) -> (a -> c) (.) f g x = f (g x) Cheers, - Ben -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 472 bytes Desc: not available URL: From marcin.jan.mrotek at gmail.com Sat Feb 6 12:31:14 2016 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Sat, 6 Feb 2016 13:31:14 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <20160206122049.GB30442@weber> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <20160206122049.GB30442@weber> Message-ID: > > maybe :: forall (r :: RuntimeRep) (a :: *) (b :: TYPE r). b -> (a -> b) -> > Maybe a -> b > `b` also is a type of an argument in that function, so I think being levity polymorphic on it in is excluded by "GC going haywire chasing values as if they were pointers" as described here: https://mail.haskell.org/pipermail/ghc-devs/2016-February/011269.html Best regards, Marcin Mrotek -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sat Feb 6 12:31:57 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sat, 6 Feb 2016 12:31:57 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <87r3gq9g8b.fsf@smart-cactus.org> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <87r3gq9g8b.fsf@smart-cactus.org> Message-ID: <20160206123157.GC30442@weber> On Sat, Feb 06, 2016 at 01:27:00PM +0100, Ben Gamari wrote: > Tom Ellis writes: > > On Fri, Feb 05, 2016 at 07:19:25PM +0000, Tom Ellis wrote: > >> On Fri, Feb 05, 2016 at 01:13:23PM -0500, Richard Eisenberg wrote: > >> > We're in a bit of a bind in all this. We really need the fancy type for > >> > ($) so that it can be used in all situations where it is used currently. > >> > >> Is there a list of situations where ($) is used currently that give rise to > >> this need? > > > > Does anyone have any idea about this? What is it about ($) that means it > > needs a new funky type whereas (apparently) nothing else does? > > The first (albeit rather unconvincing) example I can think of is be > something like, > > getI# :: Int -> Int# > getI# (I# n#) = n# > > n# :: Int# > n# = getI# $ 5 + 8 > > Richard likely has something a bit less contrived though. I hope there's something less contrived, because if the benefit is "you get to use $ to apply functions whose return type is not of kind *" then the power to weight ratio of this is extremely low. Is it also something to do with the special treatment that $ gets in the compiler, to allow 'runST $ do'? https://www.mail-archive.com/glasgow-haskell-users at haskell.org/msg18923.html > This does raise the question of why ($) is generalized, yet (.) is not, > > (.) :: forall (l :: Levity) a b (c :: TYPE l). > (b -> c) -> (a -> b) -> (a -> c) > (.) f g x = f (g x) Quite. From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sat Feb 6 12:33:09 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sat, 6 Feb 2016 12:33:09 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <20160206122049.GB30442@weber> Message-ID: <20160206123309.GD30442@weber> On Sat, Feb 06, 2016 at 01:31:14PM +0100, Marcin Mrotek wrote: > > > > maybe :: forall (r :: RuntimeRep) (a :: *) (b :: TYPE r). b -> (a -> b) -> > > Maybe a -> b > > > > `b` also is a type of an argument in that function, so I think being levity > polymorphic on it in is excluded by "GC going haywire chasing values as if > they were pointers" as described here: > https://mail.haskell.org/pipermail/ghc-devs/2016-February/011269.html Ah, "The levity polymorphic type never appears directly to the left of an arrow.". Thanks. From imantc at gmail.com Sat Feb 6 12:40:06 2016 From: imantc at gmail.com (Imants Cekusins) Date: Sat, 6 Feb 2016 13:40:06 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <20160206123309.GD30442@weber> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <20160206122049.GB30442@weber> <20160206123309.GD30442@weber> Message-ID: out of curiosity, what are * and #? I tried to search but did not find. Thank you From imantc at gmail.com Sat Feb 6 12:48:23 2016 From: imantc at gmail.com (Imants Cekusins) Date: Sat, 6 Feb 2016 13:48:23 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <20160206122049.GB30442@weber> <20160206123309.GD30442@weber> Message-ID: actually "#" worked on Hoogle: https://wiki.haskell.org/Keywords#.23 From takenobu.hs at gmail.com Sat Feb 6 12:59:01 2016 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Sat, 6 Feb 2016 21:59:01 +0900 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <20160206122049.GB30442@weber> <20160206123309.GD30442@weber> Message-ID: Hi, The '*' means kind "lifted". The '#' means kind "unlifted". Futhermore, "TYPE 'Lifted" is alias to '*' "TYPE 'Unlifted" is alias to '#' Are these also useful? [1] https://wiki.haskell.org/Kind [2] https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/TypeType [3] https://ghc.haskell.org/trac/ghc/wiki/UnliftedDataTypes [4] https://takenobu-hs.github.io/downloads/haskell_lazy_evaluation.pdf#page=192 Regards, Takenobu 2016-02-06 21:48 GMT+09:00 Imants Cekusins : > actually "#" worked on Hoogle: > > https://wiki.haskell.org/Keywords#.23 > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Sat Feb 6 13:15:34 2016 From: imantc at gmail.com (Imants Cekusins) Date: Sat, 6 Feb 2016 14:15:34 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <20160206122049.GB30442@weber> <20160206123309.GD30442@weber> Message-ID: Thank you Takenobu the links are useful, yes. Is knowledge of these terms necessary to program or are these terms of most interest to compiler developers? From ben at smart-cactus.org Sat Feb 6 13:30:03 2016 From: ben at smart-cactus.org (Ben Gamari) Date: Sat, 06 Feb 2016 14:30:03 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <20160206123157.GC30442@weber> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <87r3gq9g8b.fsf@smart-cactus.org> <20160206123157.GC30442@weber> Message-ID: <87k2mi9db8.fsf@smart-cactus.org> Tom Ellis writes: > On Sat, Feb 06, 2016 at 01:27:00PM +0100, Ben Gamari wrote: >> >> The first (albeit rather unconvincing) example I can think of is be >> something like, >> >> getI# :: Int -> Int# >> getI# (I# n#) = n# >> >> n# :: Int# >> n# = getI# $ 5 + 8 >> >> Richard likely has something a bit less contrived though. > > I hope there's something less contrived, because if the benefit is "you get > to use $ to apply functions whose return type is not of kind *" then the > power to weight ratio of this is extremely low. > > Is it also something to do with the special treatment that $ gets in the > compiler, to allow 'runST $ do'? > > https://www.mail-archive.com/glasgow-haskell-users at haskell.org/msg18923.html > To this the best of my knowledge, no. This would require impredicative polymorphism which Richard's work does not provide. There is (was?), however, active work on this front as well [1]. Cheers, - Ben [1] https://ghc.haskell.org/trac/ghc/wiki/ImpredicativePolymorphism/Impredicative-2015 -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 472 bytes Desc: not available URL: From nickolay.kudasov at gmail.com Sat Feb 6 13:59:06 2016 From: nickolay.kudasov at gmail.com (Nickolay Kudasov) Date: Sat, 06 Feb 2016 13:59:06 +0000 Subject: [Haskell-cafe] How to handle recoverable errors in multi-step computation? In-Reply-To: <56B5B5B3.8080003@ro-che.info> References: <56B5B5B3.8080003@ro-che.info> Message-ID: You might also want to check out Chronicle monad in these package: https://hackage.haskell.org/package/these-0.6.2.1/docs/Control-Monad-Chronicle.html Kind regards, Nick On Sat, 6 Feb 2016 at 11:58, Roman Cheplyaka wrote: > It sounds like you want the Validation applicative functor. > See e.g. https://ro-che.info/articles/2015-05-02-smarter-validation > > On 02/06/2016 04:58 AM, Lian Hung Hon wrote: > > Dear haskellers, > > > > I have a multi-step computation. The steps are predefined, but users can > > choose which steps to execute (something like a recipe). Here is an > > example recipe: > > > > Step 1 - Get data from network (multiple HTTP calls) and put into a list > > Step 2 - Process the data (e.g. average, sum, median, etc.) > > Step 3 - Persist result to database > > > > Sometimes, Step 1 can fail for some of the HTTP calls. When this > > happens, Step 2 should continue as much as possible using whatever data > > that has been retrieved, but somehow indicate that an error has occurred > > and the result is partial. > > > > Q1: What is the idiomatic way of achieving this? Using throwError in > > Control.Monad.Except aborts the computation, which isn't what I want. > > > > Q2: (General software design) Furthermore, where should the error be > > logged? Logging it in both Step 1 and 2 preserves modularity for each of > > the steps, unfortunately it would result in duplicate error messages. > > What is the best practice for this? > > > > Regards, > > Hon > > > > > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From takenobu.hs at gmail.com Sat Feb 6 14:13:11 2016 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Sat, 6 Feb 2016 23:13:11 +0900 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <20160206122049.GB30442@weber> <20160206123309.GD30442@weber> Message-ID: Hi Imants and cafe, > Is knowledge of these terms necessary to program or are these terms of > most interest to compiler developers? Ah, I think not necessary, but useful for abstraction and optimization of program :) I share something about Kind, here : [1] Learn You a Haskell for Great Good!, Kinds and some type-foo http://learnyouahaskell.com/making-our-own-types-and-typeclasses#kinds-and-some-type-foo [2] Haskell 2010 Language Report, 4.1.1 Kinds https://www.haskell.org/definition/haskell2010.pdf [3] http://takenobu-hs.github.io/downloads/type_introduction_illustrated.pdf#page=69 Regards, Takenobu 2016-02-06 22:15 GMT+09:00 Imants Cekusins : > Thank you Takenobu > > the links are useful, yes. > > Is knowledge of these terms necessary to program or are these terms of > most interest to compiler developers? > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From nickolay.kudasov at gmail.com Sat Feb 6 14:59:57 2016 From: nickolay.kudasov at gmail.com (Nickolay Kudasov) Date: Sat, 06 Feb 2016 14:59:57 +0000 Subject: [Haskell-cafe] ANN: servant-swagger and swagger2 Message-ID: Dear Cafe, I am pleased to announce servant-swagger [1] and swagger2 [2] packages! Swagger [3] is a project used to describe and document RESTful APIs. Here's a servant blog post, introducing both packages: https://haskell-servant.github.io/posts/2016-02-06-servant-swagger.html servant-swagger allows you to generate a Swagger specification from your Servant API. swagger2 is a standalone package for Swagger 2.0. This package introduces lenses and generic-based derivation to minimize the effort of constructing a Swagger specification for your API. Both packages are supposed to be easy to use and have great documentation! So if you have any troubles using/understanding them ? feel free to report an issue or contact me directly! Kind regards, Nick [1] http://hackage.haskell.org/package/servant-swagger [2] http://hackage.haskell.org/package/swagger2 [3] http://swagger.io -------------- next part -------------- An HTML attachment was scrubbed... URL: From capn.freako at gmail.com Sat Feb 6 15:10:16 2016 From: capn.freako at gmail.com (David Banas) Date: Sat, 6 Feb 2016 07:10:16 -0800 Subject: [Haskell-cafe] Foldable/Traversable and Applicative/Monoid? In-Reply-To: References: Message-ID: Hi David, Thanks for your reply! That?s really interesting; I never would have thought to try and implement super-class member functions, in terms of sub-class member functions. I was trying to go the other way: implement sequenceA, in terms of foldMap, which seemed to require a completely generic way of turning an Applicative (guaranteed by the type signature of sequenceA) into a Monoid (required by foldMap). I came up with this: {-# LANGUAGE Rank2Types FlexibleContexts UndecidableInstances AllowAmbiguousTypes #-} newtype MonApp = MonApp {getApp :: (Applicative f, Monoid a) => f a} instance Monoid MonApp where mempty = MonApp $ pure mempty mappend ma1 ma2 = MonApp $ mappend <$> (getApp ma1) <*> (getApp ma2) instance (Monoid a) => Monoid (Tree a) where mempty = Empty mappend Empty t = t mappend t Empty = t mappend (Leaf x) (Leaf y) = Leaf (x `mappend` y) mappend (Leaf x) (Node t1 y t2) = Node t1 (x `mappend` y) t2 mappend (Node t1 y t2) (Leaf x) = Node t1 (y `mappend` x) t2 mappend (Node t1 x t2) (Node t3 y t4) = Node (t1 `mappend` t3) (x `mappend` y) (t2 `mappend` t4) instance Monoid (Tree a) => Traversable Tree where sequenceA = getApp . foldMap (MonApp . (fmap Leaf)) to which the compiler responded: Couldn't match type ?f (Tree a1)? with ?forall (f1 :: * -> *) a2. (Applicative f1, Monoid a2) => f1 a2? Expected type: f (Tree a1) -> interactive:IHaskell161.MonApp Actual type: (forall (f :: * -> *) a. (Applicative f, Monoid a) => f a) -> interactive:IHaskell161.MonApp Relevant bindings include sequenceA :: Tree (f a1) -> f (Tree a1) (bound at :14:3) In the first argument of ?(.)?, namely ?IHaskell161.MonApp? In the first argument of ?foldMap?, namely ?(interactive:IHaskell161.MonApp . (fmap Leaf))? -db On Feb 5, 2016, at 11:20 AM, David Feuer wrote: > It's not so much that it's *necessary* as that it's *possible*. The existence of two functions in Data.Traversable explains both of the superclasses of Traversable: > > fmapDefault :: Traversable t => (a -> b) -> t a -> t b > > foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m > > Each of these is written using only traverse, and they can be used to define fmap and foldMap for types when you've written traverse. > > Hint: Consider traversing using the following applicative functors: > > newtype Const a b = Const a > instance Monoid a => Applicative (Const a) > > newtype Identity a = Identity a > instance Applicative Identity > > On Feb 5, 2016 1:45 PM, "David Banas" wrote: > Hi all, > > I don't understand why Foldable is a necessary super-class of Traversable, and I suspect that the Applicative/Monoid duality, which I've just begun discovering in the literature, has something to do with why that is so. > > Can anyone give me a hint, without giving me the answer? > > Thanks! > -db > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From eir at cis.upenn.edu Sat Feb 6 15:17:36 2016 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Sat, 6 Feb 2016 10:17:36 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <56B6097C.1010500@ro-che.info> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B6097C.1010500@ro-che.info> Message-ID: I have made a ticket #11549 (https://ghc.haskell.org/trac/ghc/ticket/11549) requesting a -fshow-runtime-rep flag (recalling that the name levity will soon be outdated) as described in this thread. I will make sure this gets in for the release of 8.0. Other points: - You're quite right that (.) could be generalized. But I'll wait for someone to really want this. - I don't have a non-contrived example of the use of ($) with unlifted types. It's quite possible that when adding the dirty runST hack, it was observed that an unlifted type would be OK. At that point, the type of ($) didn't need to become so elaborate. And now we're just trying not to change old (but perhaps unrequested) behavior. - For the record, this debate is entirely unrelated to the runST impredicativity hack. (Except, as noted above, perhaps in history.) That hack remains, basically unchanged. - On Feb 6, 2016, at 9:55 AM, Roman Cheplyaka wrote: > > I would call this a simplification rather than a lie. This is a very convincing argument. - Thanks, also, for the voice of support. What I love about the Haskell community is that we can have an impassioned debate full of strong opinions, and it all very rarely devolves into a proper flame war. All the posts I've seen in this thread have been constructive and helpful. Thanks. Richard From theedge456 at free.fr Sat Feb 6 15:19:43 2016 From: theedge456 at free.fr (Fabien R) Date: Sat, 6 Feb 2016 16:19:43 +0100 Subject: [Haskell-cafe] generating object file for ARM Message-ID: <56B60F0F.1070101@free.fr> Hello, I would like to link my Haskell module with existing object files for armv7-m. I use ghc 7.4.1 on debian/amd64. This command seems incorrect or incomplete: ghc -pgmcarm-none-eabi-gcc -pgmParm-none-eabi-cpp -pgmaarm-none-eabi-as -pgmlarm-none-eabi-ld -keep-tmp-files HaskellModule.hs A lot of errors appeared: [1 of 1] Compiling HaskellModule ( HaskellModule.hs, HaskellModule.o ) /tmp/ghc13654_0/ghc13654_0.s: Assembler messages: /tmp/ghc13654_0/ghc13654_0.s:5:0: Error: unrecognized symbol type "" /tmp/ghc13654_0/ghc13654_0.s:17:0: Error: unrecognized symbol type "" /tmp/ghc13654_0/ghc13654_0.s:29:0: Error: bad instruction `leaq -40(%rbp),%rax' /tmp/ghc13654_0/ghc13654_0.s:30:0: Error: bad instruction `cmpq %r15,%rax' Any hints ? -- Fabien ______________________________ From mantkiew at gsd.uwaterloo.ca Sat Feb 6 15:32:52 2016 From: mantkiew at gsd.uwaterloo.ca (=?UTF-8?Q?Micha=C5=82_Antkiewicz?=) Date: Sat, 6 Feb 2016 10:32:52 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> Message-ID: Richard, That is by far the best idea I've read in this entire thread!!! There should be no more lies, no "beginner-only" preludes, etc. All information should be available on request, effortlessly, as in your example interaction with GHCi. I don't like having to set special flags to see/hide certain info, as it was proposed. Having to use the flags can easily mislead people who are not aware of them and also it is too much work. There was an issue raised with Haddocks. It's 2016 and we can easily make the haddocks more interactive by embedding some JavaScript to exactly recreate your interaction with GHCi or even, as a poor mans substitute, simply show more details on mouse hoover or have similar design like for showing instances, etc. Every programmer should understand the difference between boxed and unboxed values. Period. The fact that Haskell allows for levity polimorphism is something we should be proud of and leverage in teaching, not hide it or lie about it. Finally, I wanted to highlight explicit type application as a great didactic tool. We can now nicely provide types the same way as values to the function and I find it a great way to explain type parameters. Best, Micha? On Fri, Feb 5, 2016 at 8:51 PM, Richard Eisenberg wrote: > A bit of time away from my keyboard has revealed a natural way to solve this > problem and others: be more like Idris. > > Normally, of course, I'm thinking about how Haskell's type system can be > more like Idris's. But that's not what I mean here. I want Haskell's > interface to be more like Idris's. Imagine this interchange: > > ?> :t ($) > ($) :: (a -> b) -> a -> b > -- click on the type > ($) :: forall a b. (a -> b) -> a -> b > -- click on the a > ($) :: forall (a :: *) b. (a -> b) -> a -> b > -- click on the b > ($) :: forall (a :: *) (b :: *). (a -> b) -> a -> b -- where b's kind has > a different color than usual > -- click on b's kind > ($) :: forall {r :: RuntimeRep} (a :: *) (b :: TYPE r). (a -> b) -> a -> b > -- mouseover RuntimeRep or TYPE reveals a tooltip > "($) is representation-polymorphic, meaning that `b` can have an arbitrary > runtime representation. Please see http://.... for more details." > > Similarly, classes would render in a special color, allowing you to click on > them and choose to instantiate the type at a few in-scope instances of the > class at hand, changing Foldable f => f a -> Int to the much simpler [a] -> > Int. > > This is not a minor engineering project, but it would reap wonderful > rewards, addressing the problems in this thread and more. No more lying > (because all lies are clickable), no more fragmented language, no more > brakes on development. > > Evidently, Chris already agrees with this proposal: #10073 > (https://ghc.haskell.org/trac/ghc/ticket/10073) > > Also see #8809 (https://ghc.haskell.org/trac/ghc/ticket/8809) > > Any volunteers to implement this? :) > > Richard > > On Feb 5, 2016, at 7:47 PM, Artyom wrote: > > I?ve amended my suggestion to say basically ?this type is a slight lie, > here?s a flag/command to see the true type? ? this way we aren?t scaring > people with implementation guts, merely letting them see the guts for > themselves and then think ?I don?t care about this? (which is, I think, > exactly what should happen; the worst scenario here is that the beginner > falls into the ?I?m an advanced user, I need all features, I need to know > everything, so I?ll enable the flag? trap ? which is why it?s important not > to call it ?an advanced type? or mention ?if you know what you?re doing? or > anything else like that). > > I don?t agree that levity can be compared to Java?s ?class? or ?static? ? > not because it?s harder to understand, but because it?s much less widely > used; I don?t feel that you need to know about levity in order to be a good > Haskeller. Also, unboxed types don?t imply knowledge of levity ? for > instance, I?ve been successfully using unboxed types for a while, but I only > found out about the true type of ($) by complete accident (I think I queried > the kind of -> and then got curious about question marks). Of > > On 02/06/2016 03:27 AM, Mihai Maruseac wrote: > > > > On Fri, Feb 5, 2016 at 7:09 PM, Richard Eisenberg wrote: > > Another great question that has come up is about Haddock output (Hackage). I > think Haddock needs to add a facility where library authors can include > specializations of an overly general type. This can be done in commentary, > but it's not as prominent. Such a new feature would address the ($) problem, > as ($) :: forall (a :: *) (b :: *). (a -> b) -> a -> b is a specialization > of its real type. It would also help a great deal with FTP-related > generalizations. > > This goes hand in hand with Artyom's suggestion of a warning in GHCi > after showing the simpler type. > > I'm thinking of a flag which enables/disables printing the simplest > type with warning (in GHCi) or footnote (or otherwise, in Haddock). We > can have the default behavior of the flag be either printing the > simpler type + extra (warning/footnote) or printing the longer type > and include a reference in our learning materials that beginners and > people confused by the long, complex and real type, can use > --use-simpler-types flag. > > > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > From karel.gardas at centrum.cz Sat Feb 6 15:34:00 2016 From: karel.gardas at centrum.cz (Karel Gardas) Date: Sat, 06 Feb 2016 16:34:00 +0100 Subject: [Haskell-cafe] generating object file for ARM In-Reply-To: <56B60F0F.1070101@free.fr> References: <56B60F0F.1070101@free.fr> Message-ID: <56B61268.8020509@centrum.cz> Your ghc is your native (amd64) compiler (provided by debian as a package)? If so, then this is not supported. You need to compile ghc from source and configure it as a cross-compiler. Another problem is that armv7-m supports only thumb-2 isns while GHC HEAD IIRC switched to arm isns solely. The last problem may be lack of support for armv7-m in GHC's RTS (runtime) or for your (probably?) RTOS which you run on armv7-m? Karel On 02/ 6/16 04:19 PM, Fabien R wrote: > Hello, > > I would like to link my Haskell module with existing object files for > armv7-m. I use ghc 7.4.1 on debian/amd64. > > This command seems incorrect or incomplete: > ghc -pgmcarm-none-eabi-gcc -pgmParm-none-eabi-cpp -pgmaarm-none-eabi-as > -pgmlarm-none-eabi-ld -keep-tmp-files HaskellModule.hs > > A lot of errors appeared: > [1 of 1] Compiling HaskellModule ( HaskellModule.hs, HaskellModule.o ) > /tmp/ghc13654_0/ghc13654_0.s: Assembler messages: > > /tmp/ghc13654_0/ghc13654_0.s:5:0: > Error: unrecognized symbol type "" > > /tmp/ghc13654_0/ghc13654_0.s:17:0: > Error: unrecognized symbol type "" > > /tmp/ghc13654_0/ghc13654_0.s:29:0: > Error: bad instruction `leaq -40(%rbp),%rax' > > /tmp/ghc13654_0/ghc13654_0.s:30:0: > Error: bad instruction `cmpq %r15,%rax' > > Any hints ? > From imantc at gmail.com Sat Feb 6 15:54:44 2016 From: imantc at gmail.com (Imants Cekusins) Date: Sat, 6 Feb 2016 16:54:44 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> Message-ID: in addition to Takenobu's links, Real World Haskell explains unboxing and lifting on p.583 just to clarify, for practical use, is it safe to say that "boxed" and "lifted" are synonyms? you see, term "boxed" is used in other languages. I assumed "lifting" related to monads. Hence the confusion. From vagarenko at gmail.com Sat Feb 6 16:33:01 2016 From: vagarenko at gmail.com (Alexey Vagarenko) Date: Sat, 6 Feb 2016 08:33:01 -0800 (PST) Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> Message-ID: <21990971-3511-4849-bda5-66b03c596029@googlegroups.com> > > is it safe to say that "boxed" and > "lifted" are synonyms? > No. Lifted means may contain bottom. Boxed means represented by a pointer. `ByteArray#` is boxed but unlifted See https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/TypeType#Classifyingtypes On Saturday, February 6, 2016 at 8:54:50 PM UTC+5, Imants Cekusins wrote: > > in addition to Takenobu's links, Real World Haskell explains unboxing > and lifting on p.583 > > just to clarify, for practical use, is it safe to say that "boxed" and > "lifted" are synonyms? you see, term "boxed" is used in other > languages. I assumed "lifting" related to monads. Hence the confusion. > _______________________________________________ > Haskell-Cafe mailing list > Haskel... at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ekmett at gmail.com Sat Feb 6 17:09:22 2016 From: ekmett at gmail.com (Edward Kmett) Date: Sat, 6 Feb 2016 12:09:22 -0500 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: On Fri, Feb 5, 2016 at 6:21 PM, Mike Izbicki wrote: > > We're in a bit of a bind in all this. We really need the fancy type for > ($) > > so that it can be used in all situations where it is used currently. The > old > > type for ($) was just a plain old lie. Now, at least, we're not lying. > So, > > do we 1) lie, 2) allow the language to grow, or 3) avoid certain growth > > because it affects how easy the language is to learn? I don't really > think > > anyone is advocating for (3) exactly, but it's hard to have (2) and not > make > > things more complicated -- unless we have a beginners' mode or other > > features in, say, GHCi that aid learning. As I've said, I'm in full > favor of > > adding these features. > > The old type for ($) is only a lie when the MagicHash extension is > turned on. Otherwise, it is not a lie. I think the best solution is > to pretty print the type depending on what language pragmas are in > use. In GHCI, this would be trivial. The much harder case is haddock > documentation. > Note: The old type of ($) has always been a lie, even without MagicHash, a much stronger lie because the true type of ($) can't even be written in the language today. You can instantiate both the source and target types of ($) to polytypes, not just monotypes. This lets us use ($) in situations like runST $ do ... Having it infer a RankNType through its magical type inference rule there doesn't require an extension on the behalf of the user, even if runST required them at the definition site. -Edward > I think a good way around this would be an eventual patch to haddock > that allows the user to select which extensions they want to use when > browsing documentation. There's a lot of usability issues that would > need to be resolved with this still, but it reduces this technical > discussion we're having down to a design discussion. It also nicely > lets the user specify the level of difficulty they want their prelude > to be without causing incompatibilty with users who want a different > level of prelude. > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ekmett at gmail.com Sat Feb 6 17:12:47 2016 From: ekmett at gmail.com (Edward Kmett) Date: Sat, 6 Feb 2016 12:12:47 -0500 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <20160206122049.GB30442@weber> <20160206123309.GD30442@weber> Message-ID: As you dig deeper into Haskell you'll eventually need to understand what these mean to reason about anything beyond first order code. The primitives that GHC uses to implement arrays, references and the like live in #. We then wrap them in something in * before exposing them to the user, but you can shave a level of indirection by knowing what lives in # and what doesn't. But even if you never care about #, Int, Double, etc. are of kind *, Functors are of kind * -> *, etc. so to talk about the type of types at all you need to be able to talk about these concepts at all with any rigor, and to understand why Maybe Maybe isn't a thing. On Sat, Feb 6, 2016 at 8:15 AM, Imants Cekusins wrote: > Thank you Takenobu > > the links are useful, yes. > > Is knowledge of these terms necessary to program or are these terms of > most interest to compiler developers? > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sat Feb 6 17:19:39 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sat, 6 Feb 2016 17:19:39 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <20160206122049.GB30442@weber> <20160206123309.GD30442@weber> Message-ID: <20160206171939.GK30442@weber> On Sat, Feb 06, 2016 at 12:12:47PM -0500, Edward Kmett wrote: > As you dig deeper into Haskell you'll eventually need to understand what > these mean to reason about anything beyond first order code. > > The primitives that GHC uses to implement arrays, references and the like > live in #. We then wrap them in something in * before exposing them to the > user, but you can shave a level of indirection by knowing what lives in # > and what doesn't. > > But even if you never care about #, Int, Double, etc. are of kind *, > Functors are of kind * -> *, etc. so to talk about the type of types at all > you need to be able to talk about these concepts at all with any rigor, and > to understand why Maybe Maybe isn't a thing. I think this is a bit pessimistic. I've been a professional Haskell developer for some years without ever needing to know what # is. I'm pretty sure that a professional Haskeller could be comfortable only know about * on a vague, intuitive level. Tom From targen at gmail.com Sat Feb 6 18:14:56 2016 From: targen at gmail.com (=?UTF-8?Q?Manuel_G=C3=B3mez?=) Date: Sat, 6 Feb 2016 13:44:56 -0430 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <20160206122049.GB30442@weber> <20160206123309.GD30442@weber> Message-ID: On Sat, Feb 6, 2016 at 12:42 PM, Edward Kmett wrote: > The primitives that GHC uses to implement arrays, references and the like > live in #. We then wrap them in something in * before exposing them to the > user, but you can shave a level of indirection by knowing what lives in # > and what doesn't. Yes! Let?s not forget, of course, that these (or similar) have been in GHC for many, many years, right in the Prelude: ``` > :i Int Char Float Double IO Integer data Int = GHC.Types.I# GHC.Prim.Int# data Char = GHC.Types.C# GHC.Prim.Char# data Float = GHC.Types.F# GHC.Prim.Float# data Double = GHC.Types.D# GHC.Prim.Double# newtype IO a = GHC.Types.IO (GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #)) data Integer = integer-gmp-1.0.0.0:GHC.Integer.Type.S# !GHC.Prim.Int# | integer-gmp-1.0.0.0:GHC.Integer.Type.Jp# {-# UNPACK #-}integer-gmp-1.0.0.0:GHC.Integer.Type.BigNat | integer-gmp-1.0.0.0:GHC.Integer.Type.Jn# {-# UNPACK #-}integer-gmp-1.0.0.0:GHC.Integer.Type.BigNat ``` Stepping outside the Prelude, yet well within beginner territory, brings even more fun: ``` > :i Map Set data Map k a = containers-0.5.6.2:Data.Map.Base.Bin {-# UNPACK #-}containers-0.5.6.2:Data.Map.Base.Size !k a !(Map k a) !(Map k a) | containers-0.5.6.2:Data.Map.Base.Tip data Set a = containers-0.5.6.2:Data.Set.Base.Bin {-# UNPACK #-}containers-0.5.6.2:Data.Set.Base.Size !a !(Set a) !(Set a) | containers-0.5.6.2:Data.Set.Base.Tip ``` Unboxed types, the UNPACK pragma, references to GHC.Prim (which easily lead to confusing exploration), unboxed tuples, an unboxed State monad, RealWorld, bang patterns, unexported constructors, implementation details for abstract types? all of them available right from the prompt of the Prelude using the main tool for exploratory learning that beginners rely on. I?m not saying this is a good thing and I?m not saying this should be fixed. I?m not even saying this is comparable to the situation with $ and I?m likewise not saying presenting these concepts to beginners should be thought of as comparable to presenting levity polymorphism to beginners. It is nonetheless relevant context to this discussion; the Prelude has always had concepts unfriendly to beginners readily available, and Haskell beginner teachers have always had to work around these issues. Students have always asked about these things. > But even if you never care about #, Int, Double, etc. are of kind *, > Functors are of kind * -> *, etc. so to talk about the type of types at all > you need to be able to talk about these concepts at all with any rigor, and > to understand why Maybe Maybe isn't a thing. In my personal teaching experience, it is extremely helpful to discuss kinds in the first introduction of type constructors, after covering types with no parameters. This is especially helpful in discussing how the hierarchy leading to Monad works, and why things like ?instance Functor (Tree Int) where ?? don?t make sense and why ?instance Functor Tree where ?? must be parametric in the type of the thing in the tree, which in turn motivates a lot more discussion. Teaching kinds is teaching Haskell basics. It is not an advanced topic. It ought to be covered near the very first lessons on Haskell for absolute beginners. From dct25-561bs at mythic-beasts.com Sat Feb 6 19:33:53 2016 From: dct25-561bs at mythic-beasts.com (David Turner) Date: Sat, 6 Feb 2016 19:33:53 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <20160206122049.GB30442@weber> <20160206123309.GD30442@weber> Message-ID: By way of a counterpoint to the "showing complicated things alienates beginners" argument, remember that to a beginner there are already very many things on the screen that they won't (and needn't immediately) understand. For instance, this is what a simple `stack ghci` in my home directory says to me: $ stack ghci Run from outside a project, using implicit global project config Using resolver: lts-2.22 from implicit global project's config file: /home/linuxadmin/.stack/global/stack.yaml Error parsing targets: The specified targets matched no packages. Perhaps you need to run 'stack init'? Warning: build failed, but optimistically launching GHCi anyway Configuring GHCi with the following packages: GHCi, version 7.8.4: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. Ok, modules loaded: none. Prelude> There's a lot of stuff there you don't need as a beginner. The line beginning 'Error' is a bit scary, as is the 'Warning'. The advice to run 'stack init' is not good advice. The advice to use :? for help is probably the most beginner-useful thing in all that and it looks like line noise rather than a thing you might want to actually type! My point is that beginners have to start out ignoring things they don't understand anyway - part of the process of learning a new language is coming to terms with what's important and what's not in any given context. I'm not saying I'm a big fan of the addition to the type sig of ($), and would definitely appreciate a flag to switch it off, but I don't think this'll make it significantly harder to teach my next victims. Cheers, David On 6 February 2016 at 18:14, Manuel G?mez wrote: > On Sat, Feb 6, 2016 at 12:42 PM, Edward Kmett wrote: > > The primitives that GHC uses to implement arrays, references and the like > > live in #. We then wrap them in something in * before exposing them to > the > > user, but you can shave a level of indirection by knowing what lives in # > > and what doesn't. > > Yes! Let?s not forget, of course, that these (or similar) have been > in GHC for many, many years, right in the Prelude: > > ``` > > :i Int Char Float Double IO Integer > data Int = GHC.Types.I# GHC.Prim.Int# > data Char = GHC.Types.C# GHC.Prim.Char# > data Float = GHC.Types.F# GHC.Prim.Float# > data Double = GHC.Types.D# GHC.Prim.Double# > newtype IO a > = GHC.Types.IO (GHC.Prim.State# GHC.Prim.RealWorld > -> (# GHC.Prim.State# GHC.Prim.RealWorld, a #)) > data Integer > = integer-gmp-1.0.0.0:GHC.Integer.Type.S# !GHC.Prim.Int# > | integer-gmp-1.0.0.0:GHC.Integer.Type.Jp# {-# UNPACK > #-}integer-gmp-1.0.0.0:GHC.Integer.Type.BigNat > | integer-gmp-1.0.0.0:GHC.Integer.Type.Jn# {-# UNPACK > #-}integer-gmp-1.0.0.0:GHC.Integer.Type.BigNat > ``` > > Stepping outside the Prelude, yet well within beginner territory, > brings even more fun: > > ``` > > :i Map Set > data Map k a > = containers-0.5.6.2:Data.Map.Base.Bin {-# UNPACK > #-}containers-0.5.6.2:Data.Map.Base.Size > !k > a > !(Map k a) > !(Map k a) > | containers-0.5.6.2:Data.Map.Base.Tip > data Set a > = containers-0.5.6.2:Data.Set.Base.Bin {-# UNPACK > #-}containers-0.5.6.2:Data.Set.Base.Size > !a > !(Set a) > !(Set a) > | containers-0.5.6.2:Data.Set.Base.Tip > ``` > > Unboxed types, the UNPACK pragma, references to GHC.Prim (which easily > lead to confusing exploration), unboxed tuples, an unboxed State > monad, RealWorld, bang patterns, unexported constructors, > implementation details for abstract types? all of them available right > from the prompt of the Prelude using the main tool for exploratory > learning that beginners rely on. > > I?m not saying this is a good thing and I?m not saying this should be > fixed. I?m not even saying this is comparable to the situation with $ > and I?m likewise not saying presenting these concepts to beginners > should be thought of as comparable to presenting levity polymorphism > to beginners. It is nonetheless relevant context to this discussion; > the Prelude has always had concepts unfriendly to beginners readily > available, and Haskell beginner teachers have always had to work > around these issues. Students have always asked about these things. > > > But even if you never care about #, Int, Double, etc. are of kind *, > > Functors are of kind * -> *, etc. so to talk about the type of types at > all > > you need to be able to talk about these concepts at all with any rigor, > and > > to understand why Maybe Maybe isn't a thing. > > In my personal teaching experience, it is extremely helpful to discuss > kinds in the first introduction of type constructors, after covering > types with no parameters. This is especially helpful in discussing > how the hierarchy leading to Monad works, and why things like > ?instance Functor (Tree Int) where ?? don?t make sense and why > ?instance Functor Tree where ?? must be parametric in the type of the > thing in the tree, which in turn motivates a lot more discussion. > > Teaching kinds is teaching Haskell basics. It is not an advanced > topic. It ought to be covered near the very first lessons on Haskell > for absolute beginners. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From johnw at newartisans.com Sat Feb 6 21:04:34 2016 From: johnw at newartisans.com (John Wiegley) Date: Sat, 06 Feb 2016 16:04:34 -0500 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: (Kyle Hanson's message of "Fri, 5 Feb 2016 09:55:08 -0800") References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> Message-ID: >>>>> Kyle Hanson writes: Prelude> :t ($) > ($) :: (a -> b) -> a -> b Prelude> :t ($) > ($) > :: forall (w :: GHC.Types.Levity) a (b :: TYPE w). > (a -> b) -> a -> b I wonder if it could elide that information when -fprint-explicit-foralls is not enabled? The (a :: *) is not enough to warrant a forall in the former case, so 'b :: TYPE w' where 'w :: GHC.Types.Levity' perhaps shouldn't be enough to warrant it in the latter. -- John Wiegley GPG fingerprint = 4710 CF98 AF9B 327B B80F http://newartisans.com 60E1 46C4 BD1A 7AC1 4BA2 From marcin.jan.mrotek at gmail.com Sun Feb 7 00:55:25 2016 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Sun, 7 Feb 2016 01:55:25 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <20160206122049.GB30442@weber> <20160206123309.GD30442@weber> Message-ID: > > There's a lot of stuff there you don't need as a beginner. The line > beginning 'Error' is a bit scary, as is the 'Warning'. The advice to run > 'stack init' is not good advice. > I understand your point about 'Error', but I still think most people are more likely to dismiss everything before `Prelude>` as line noise than to ignore stuff that is printed after they type `:t ($)`, especially if they've already used `:t` to check the types of other things. Don't get me wrong, I'm generally all in for unlifted/unboxed types, data kinds, levity polymorphism, etc, it's just that I remember the time when the tipe signature of `>>=` looked scary and the `Foldable` and `Traversable` type classes seemed like black magic to me. I hesitate to suggest this, as someone who didn't write any Haskell for a couple of months now, but maybe the already mentioned suggestion of having a ($) that only works for lifted types and (#$) that is levity polymorphic would be a good choice? Best regards, Marcin Mrotek -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Sun Feb 7 04:26:00 2016 From: david.feuer at gmail.com (David Feuer) Date: Sat, 6 Feb 2016 23:26:00 -0500 Subject: [Haskell-cafe] Foldable/Traversable and Applicative/Monoid? In-Reply-To: References: Message-ID: It's not terribly unusual. Functor can be a superclass of Applicative because fmap f xs = pure f <*> xs Applicative can be a superclass of Monad because pure = return (<*>) = ap Distributive can be a superclass of Representable because distribute wf = tabulate (\k -> fmap (`index` k) wf) Obviously, it often *doesn't* work like this. The class structure may be arranged as it is because the subclass conceptually or practically represents a refinement of the superclass. But when the methods of a given class can be implemented using the methods of another, that suggests that it *might* make sense for it to be a superclass. On Feb 6, 2016 10:10 AM, "David Banas" wrote: > Hi David, > > Thanks for your reply! > > That?s really interesting; I never would have thought to try and implement > super-class member functions, in terms of sub-class member functions. > I was trying to go the other way: implement sequenceA, in terms of > foldMap, which seemed to require a completely generic way of turning an > Applicative (guaranteed by the type signature of sequenceA) into a Monoid > (required by foldMap). I came up with this: > > > {-# LANGUAGE Rank2Types > FlexibleContexts > UndecidableInstances > AllowAmbiguousTypes > #-} > > newtype MonApp = MonApp {getApp :: (Applicative f, Monoid a) => f a} > > instance Monoid MonApp where > mempty = MonApp $ pure mempty > mappend ma1 ma2 = MonApp $ mappend <$> (getApp ma1) <*> (getApp ma2) > > instance (Monoid a) => Monoid (Tree a) where > mempty = Empty > mappend Empty t = t > mappend t Empty = t > mappend (Leaf x) (Leaf y) = Leaf (x `mappend` y) > mappend (Leaf x) (Node t1 y t2) = Node t1 (x `mappend` y) t2 > mappend (Node t1 y t2) (Leaf x) = Node t1 (y `mappend` x) t2 > mappend (Node t1 x t2) (Node t3 y t4) = Node (t1 `mappend` t3) (x > `mappend` y) (t2 `mappend` t4) > > instance Monoid (Tree a) => Traversable Tree where > sequenceA = getApp . foldMap (MonApp . (fmap Leaf)) > > > to which the compiler responded: > > > Couldn't match type ?f (Tree a1)? with ?forall (f1 :: * -> *) a2. > (Applicative f1, Monoid a2) => f1 a2? > Expected type: f (Tree a1) -> interactive:IHaskell161.MonApp > Actual type: (forall (f :: * -> *) a. (Applicative f, Monoid a) => f a) -> > interactive:IHaskell161.MonApp > Relevant bindings include sequenceA :: Tree (f a1) -> f (Tree a1) (bound > at :14:3) > In the first argument of ?(.)?, namely ?IHaskell161.MonApp? > In the first argument of ?foldMap?, namely > ?(interactive:IHaskell161.MonApp . (fmap Leaf))? > > > -db > > > On Feb 5, 2016, at 11:20 AM, David Feuer wrote: > > It's not so much that it's *necessary* as that it's *possible*. The > existence of two functions in Data.Traversable explains both of the > superclasses of Traversable: > > fmapDefault :: Traversable t => (a -> b) -> t a -> t b > > foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m > > Each of these is written using only traverse, and they can be used to > define fmap and foldMap for types when you've written traverse. > > Hint: Consider traversing using the following applicative functors: > > newtype Const a b = Const a > instance Monoid a => Applicative (Const a) > > newtype Identity a = Identity a > instance Applicative Identity > On Feb 5, 2016 1:45 PM, "David Banas" wrote: > >> Hi all, >> >> I don't understand why Foldable is a necessary super-class of >> Traversable, and I suspect that the Applicative/Monoid duality, which I've >> just begun discovering in the literature, has something to do with why that >> is so. >> >> Can anyone give me a hint, without giving me the answer? >> >> Thanks! >> -db >> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From twhitehead at gmail.com Sun Feb 7 07:25:41 2016 From: twhitehead at gmail.com (Tyson Whitehead) Date: Sun, 07 Feb 2016 02:25:41 -0500 Subject: [Haskell-cafe] Pulling an applicative/apply out of a record Message-ID: <56B6F175.1000203@gmail.com> Quick question for the experts out there. I need to process some records. The records come in in an unordered stream of record fields. From each stream of fields I want to produce a Record entry containing the fields I need to do my calculation. > data Record = { field1 :: Type1, field2 :: Type2, ... } I was thinking this setup might work nice with something like > data RecordF d = RecordF { field1 :: f Type1, field2 :: f Type2, ... } as I could then have (1) a monoid version I could accumulate use as an accumulator over the stream > type RecordM = RecordF [] and (2) a final version. > type Record = RecordF Identity This final version seems like it should easily come from the later by pulling the [] (or anything else that has the Apply/Applicative structure) to the outside and then taking the head of the resulting list. While I could write the boilerplate to do this, it seems like something I should be able to do more elegantly. The best I have come up with so far is to use the lens package to give me an isomorphism to a tuple. Then I need a uncurried zip for arbitrarily large tuples. Follow this by an isomorphism back. RecordF (f Type1) (f Type2) ... -> (f Type1, f Type2, ....) -> f (Type1, Type2, ...) -> f (Record Type1 Type2 ...) I can't seem to find any uncurried zip implementations for arbitrarily large tuples (or any other way to do this without writing the boilerplate). Am I missing something? Is there a better way to do this? Thanks! -Tyson PS: It seems the Data.Vinyl package has something along these lines with the rtraverse function https://hackage.haskell.org/package/vinyl-0.5.1/docs/Data-Vinyl-Core.html From benl at ouroborus.net Sun Feb 7 08:26:26 2016 From: benl at ouroborus.net (Ben Lippmeier) Date: Sun, 7 Feb 2016 19:26:26 +1100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> Message-ID: <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> > On 7 Feb 2016, at 2:32 am, Micha? Antkiewicz wrote: > > Every programmer should understand the difference between boxed and > unboxed values. Period. The fact that Haskell allows for levity > polimorphism is something we should be proud of and leverage in > teaching, not hide it or lie about it. When I first read the ?Unboxed values as first class citizens..? paper I felt smart, like learning the difference between Int and Int# was helping me understand how compilers worked under the hood. Now, ~15 years later, I already know all these details and having to constantly worry about the difference between Int and Int# when writing application code makes me feel dumb. When I then read people praising the advanced Haskell type system and the fact that we can now use advanced Haskell type system features to write polymorphic functions that work with both Int and Int# I feel even dumber. This isn?t a criticism of the work on levity polymorphism, more that it feels to me like a solution to a problem that should not exist in the first place. In my own mind, the boxed/unboxed problem is in the same bucket as the problem that ownership typing tries to address in the OO world. Every OO programmer can recite the great engineering benefits of splitting the fields and methods of an object into public and private. However, in most OO languages, if a public method returns a reference to mutable private state, then the caller can then update the internal state of the object. Ownership typing is an advanced type system extension for OO languages to prevent this from happening. It also feels like the same class of problem as what the segmentation registers in the x86 architecture try to address. Does anyone here know how the 8086 processor addresses more than 64k of memory with only 16-bit address registers? I sure wish I didn?t. As a budding young programmer, reading about these details was a way to learn how computers operate, but it?s not information I would inflict on any of my current students. With Int/Int#, public/private and x86 segmentation, the abstraction never really worked in the first place. However, because there weren?t any other obvious solutions at the time, these ?features? were grandfathered into the culture of the technology. For the disciples of a particular technology, the recognition of problems in the fundamental design of that technology tends to result in extensions to what they already have -- rather than backing up and reconsidering WTF they were thinking in the first place. These days when I read papers about advanced type system extensions I typically feel smart for a few days, but then after reflecting on it a few weeks or months later I often feel dumb again. I?m not sure if that?s something to be proud of... Ben. -------------- next part -------------- An HTML attachment was scrubbed... URL: From qdunkan at gmail.com Sun Feb 7 09:22:29 2016 From: qdunkan at gmail.com (Evan Laforge) Date: Sun, 7 Feb 2016 14:52:29 +0530 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> Message-ID: 1, Just to clarify, there are no actual known uses for a TypeRep-polymorphic ($), right? I thought I saw someone say that. 2, ($) has had a fib in its type for a very long time, but did it ever hurt anyone? The closest I saw was a generalized concern about it being bad when people report a bug and then hear that things are more general than they thought and I guess this makes their bug not a bug or something? Results in some confusing back-and-forth? It would be nice to get more specific about how much trouble the ($) lie has caused. 3, Is anything other than ($) TypeRep-polymorphic? If 2 is "not very much", an obvious solution is to keep lying and not worry about it. But clearly someone had a reason strong enough to make this change... what was it? If 1 is "maybe not" then an obvious solution is to just make ($) not TypeRep-polymorphic. I can't imagine that not being able to use ($) is a serious problem if you're working with # types, given that there are already tons of other restrictions. I hesitate to get distracted from the specifics, but I agree with Ben Lippemeier in that I like how haskell doesn't make me worry about boxed vs. unboxed. I'm not saying one little type annotation on one operator is suddenly making me worry since I've never even thought to run :t ($). But I'm happy that # is mostly off in its own little corner and you don't even have to know it exists until you need to get into low level optimization. From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sun Feb 7 09:26:04 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sun, 7 Feb 2016 09:26:04 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <20160206123309.GD30442@weber> Message-ID: <20160207092604.GA803@weber> On Sun, Feb 07, 2016 at 01:55:25AM +0100, Marcin Mrotek wrote: > I hesitate to suggest this, as someone who didn't write any Haskell for a > couple of months now, but maybe the already mentioned suggestion of having > a ($) that only works for lifted types and (#$) that is levity polymorphic > would be a good choice? If we're going to introduce levity polymorphism then I think separate operators are a good place to start. Unifying them can happen once everyone has had a chance to get used to the idea. From theedge456 at free.fr Sun Feb 7 10:14:58 2016 From: theedge456 at free.fr (Fabien R) Date: Sun, 7 Feb 2016 11:14:58 +0100 Subject: [Haskell-cafe] generating object file for ARM In-Reply-To: <56B61268.8020509@centrum.cz> References: <56B60F0F.1070101@free.fr> <56B61268.8020509@centrum.cz> Message-ID: <56B71922.8050307@free.fr> On 06/02/2016 16:34, Karel Gardas wrote: > > Your ghc is your native (amd64) compiler (provided by debian as a > package)? If so, then this is not supported. You need to compile ghc That's what I suspected. I thought that ghc would generate kinds of interim c files that I could compile with gcc-arm... I will try to cross-compile ghc. -- Fabien From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sun Feb 7 10:17:46 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sun, 7 Feb 2016 10:17:46 +0000 Subject: [Haskell-cafe] Pulling an applicative/apply out of a record In-Reply-To: <56B6F175.1000203@gmail.com> References: <56B6F175.1000203@gmail.com> Message-ID: <20160207101746.GC803@weber> On Sun, Feb 07, 2016 at 02:25:41AM -0500, Tyson Whitehead wrote: > RecordF (f Type1) (f Type2) ... -> (f Type1, f Type2, ....) > -> f (Type1, Type2, ...) -> f (Record Type1 Type2 ...) > > I can't seem to find any uncurried zip implementations for arbitrarily > large tuples (or any other way to do this without writing the > boilerplate). Am I missing something? Is there a better way to do this? I would call this a multi-typed 'Data.Traversable.sequence'. Data.Profunctor.Product.TH generates this (in fact something slightly more general that works for ProductProfunctors, not just Applicatives). Currently it only works for fully polymorphic record types, but we could tweak it so it so it's a bit more general. Tom From jo at durchholz.org Sun Feb 7 10:50:40 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Sun, 7 Feb 2016 11:50:40 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> Message-ID: <56B72180.6040900@durchholz.org> Am 07.02.2016 um 09:26 schrieb Ben Lippmeier: > > It also feels like the same class of problem as what the segmentation > registers in the x86 architecture try to address. Does anyone here > know how the 8086 processor addresses more than 64k of memory with > only 16-bit address registers? I sure wish I didn?t. Yes I do, and yes I wish I didn't either. For the Int/Int# concept, the approaches I have seen either ignore the efficiency and let the machine figure out what to do (Smalltalk, Python, pre-Int# Haskell), or they complicate the type system at the expense of polymorphism (Java, Eiffel), or they complicate the type system even more to regain some form of polymorphism (C++, today's Haskell). I guess the world is still waiting for an approach that does not force this choice on language designers. Aside note: My own choice would be to have an annotation that tells the compiler to keep something unboxed if it can, and if it cannot, have it print a warning why not. Not seeing this choice in the wild means that either language designers didn't find the right way to do this, or the idea as such is dumb; I don't know which. > With Int/Int#, public/private and x86 segmentation, the abstraction > never really worked in the first place. However, because there > weren?t any other obvious solutions at the time, these ?features? > were grandfathered into the culture of the technology. As much as I agree that design misdecisions can perpetuate by becoming part of the technology culture (see PHP's view on security, or C's insistence on microoptimization), this did not happen for x86 16-bit segment/offset addressing. Even Microsoft switched as fast as they could, and that was in the old days when features were far more important than security or even stability. > For the > disciples of a particular technology, the recognition of problems in > the fundamental design of that technology tends to result in > extensions to what they already have -- rather than backing up and > reconsidering WTF they were thinking in the first place. Word. Problem is that it is possible to add features to existing language, but almost impossible to remove them. Those working on practically useful type systems want to solve an existing problem in an existing language, so they don't have a motive to reconsider; even if they did, they'd quickly drop the thought because whatever the change they'd want, it would get rejected because it would break existing code left and right. This seems to be a universal problem. Every language that I know has it, including Haskell (which I don't really know well enough but the discussion and options are just as with any other language). Regards, Jo From heraldhoi at gmail.com Sun Feb 7 11:08:41 2016 From: heraldhoi at gmail.com (Geraldus) Date: Sun, 07 Feb 2016 11:08:41 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <20160207092604.GA803@weber> References: <20160206123309.GD30442@weber> <20160207092604.GA803@weber> Message-ID: Hi, friends! I want to share my own feelings about type signatures. It is always hard for me to read type signatures with class constraints, because first I need to spot that there is =>, then I have to split type signature in my mind to constraint part and actual signature part. I think having constraints before signature when defining things is something that eases source parsing and etc., but wouldn't type signatures become a bit more readable if we put constraints after actual signature when printing it in GHCi (and maybe in Haddock), e.g.: ($) :: (a -> b) -> a -> b forall r :: RuntimeRep a :: * b :: TYPE r -------------- next part -------------- An HTML attachment was scrubbed... URL: From ivan.miljenovic at gmail.com Sun Feb 7 11:46:16 2016 From: ivan.miljenovic at gmail.com (Ivan Lazar Miljenovic) Date: Sun, 7 Feb 2016 22:46:16 +1100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <20160206123309.GD30442@weber> <20160207092604.GA803@weber> Message-ID: On 7 February 2016 at 22:08, Geraldus wrote: > > Hi, friends! I want to share my own feelings about type signatures. It is > always hard for me to read type signatures with class constraints, because > first I need to spot that there is =>, then I have to split type signature > in my mind to constraint part and actual signature part. I think having > constraints before signature when defining things is something that eases > source parsing and etc., but wouldn't type signatures become a bit more > readable if we put constraints after actual signature when printing it in > GHCi (and maybe in Haddock), e.g.: > > ($) :: (a -> b) -> a -> b > forall r :: RuntimeRep > a :: * > b :: TYPE r If this is only how ghci types/prints it, then it makes it much more difficult (if not impossible) to just copy/paste the resulting type into your code. This also makes it much more verbose: it might be useful for longer type signatures (especially with large constraints) but not for the majority of them. I also like being able to see the constraints first so that I know what they are before reading the actual type. -- Ivan Lazar Miljenovic Ivan.Miljenovic at gmail.com http://IvanMiljenovic.wordpress.com From benl at ouroborus.net Sun Feb 7 12:17:13 2016 From: benl at ouroborus.net (Ben Lippmeier) Date: Sun, 7 Feb 2016 23:17:13 +1100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <56B72180.6040900@durchholz.org> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <56B72180.6040900@durchholz.org> Message-ID: <619CFC50-DD2A-402F-A5D6-D986C9F4C4DE@ouroborus.net> > On 7 Feb 2016, at 9:50 pm, Joachim Durchholz wrote: > For the Int/Int# concept, the approaches I have seen either ignore the efficiency and let the machine figure out what to do (Smalltalk, Python, pre-Int# Haskell), or they complicate the type system at the expense of polymorphism (Java, Eiffel), or they complicate the type system even more to regain some form of polymorphism (C++, today's Haskell). Although I haven?t implemented it, I suspect another approach is to just specialise every polymorphic function at its unboxed type arguments. Boxed and unboxed value types would share the same kind. Of course, full specialisation of polymorphic code assumes that code is available in the interface files, but we?ve almost got that already. Dealing with mutual recursion could be a pain, though. I don?t think specialisation was an option back when unboxed types were originally implemented. I believe GHC?s support for cross module inlining came some time after the unboxed types, if the publication dates of the relative papers are to be a guide. Ben. From nickolay.kudasov at gmail.com Sun Feb 7 13:37:17 2016 From: nickolay.kudasov at gmail.com (Nickolay Kudasov) Date: Sun, 07 Feb 2016 13:37:17 +0000 Subject: [Haskell-cafe] Incredibly slow type-level Nub Message-ID: Dear Cafe, I have faced a type-level performance problem (with GHC 7.10.3). I am trying to implement type-level Nub which removes duplicates from a type-level list. My implementation [1] with an example of a list of length 20 takes forever to compile. If you reduce the size of the example list (e.g. to 15 items), it will compile faster. Also, if you remove the Nub application from exampleVals, it compiles instantly (this is how I know the problem is in Nub). My question is how can I speed up type-level Nub? And less importantly why exactly is it this slow? The practical application for this is building automatic tests [2] for servant-swagger. There I am interested in generating exactly one test for each distinct type. Kind regards, Nick [1] https://gist.github.com/fizruk/06458fe8b62a1e562af1 [2] http://hackage.haskell.org/package/servant-swagger-1.0.2/docs/Servant-Swagger-Test.html -------------- next part -------------- An HTML attachment was scrubbed... URL: From guthrie at mum.edu Sun Feb 7 13:58:47 2016 From: guthrie at mum.edu (Gregory Guthrie) Date: Sun, 7 Feb 2016 07:58:47 -0600 Subject: [Haskell-cafe] Language complexity & beginners Message-ID: <08EF9DA445C4B5439C4733E1F35705BA05847E6DB5A3@MAIL.cs.mum.edu> I liked this description, and isn't the term for this a "leaky abstraction"? Where one should not have to know the underlying details of an implementation of an abstraction, but.. due to limitations in the ability to actually abstract out these details, they do have to see down a level into the virtual machine (implementation). It seems like a theme of the discussion here is if users should need (want) to know the boxed/unboxed issues because it is part of the intended programming model (=good), or if they need to know it because of "details" of the underlying implementation and resulting usage effects (=baggage/complexity). IMHO the Java need to understand this early on is just an unfortunate by-product of it being a mixed paradigm language. I could see later having more advanced introduction of a feature that allows one to utilize some specific underlying unboxed/primitive representations for performance reasons, but even then seems like it is just an apology for a language weakness, that might go away with future implementations, an abstraction that didn't quite work, "so let me explain the underlying reason and how to get around it..." to optimize your code. ------------------------------------------- > It also feels like the same class of problem as what the segmentation registers in the x86 > architecture try to address. Does anyone here know how the 8086 processor addresses more > than 64k of memory with only 16-bit address registers? I sure wish I didn?t. As a budding > young programmer, reading about these details was a way to learn how computers operate, but > it?s not information I would inflict on any of my current students. > > With Int/Int#, public/private and x86 segmentation, the abstraction never really worked in > the first place. However, because there weren?t any other obvious solutions at the time, these > ?features? were grandfathered into the culture of the technology. For the disciples of a > particular technology, the recognition of problems in the fundamental design of that > technology tends to result in extensions to what they already have -- rather than backing up > and reconsidering WTF they were thinking in the first place. From eir at cis.upenn.edu Sun Feb 7 14:59:25 2016 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Sun, 7 Feb 2016 09:59:25 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> Message-ID: <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> On Feb 7, 2016, at 4:22 AM, Evan Laforge wrote: > 1, Just to clarify, there are no actual known uses for a > TypeRep-polymorphic ($), right? I thought I saw someone say that. Here is where this treatment of ($) was introduced: https://ghc.haskell.org/trac/ghc/ticket/8739 > > 2, ($) has had a fib in its type for a very long time, but did it ever > hurt anyone? The closest I saw was a generalized concern about it > being bad when people report a bug and then hear that things are more > general than they thought and I guess this makes their bug not a bug > or something? Results in some confusing back-and-forth? It would be > nice to get more specific about how much trouble the ($) lie has > caused. I don't have data, but there is a real cost to lying. It shows up in the slow-ish but steady stream of posts / questions / bug reports that are produced saying something is weird. I've seen a good number of these come up in my years in the Haskell community. I'll note that there is also a real cost to telling the truth: witness this thread. This all adds up to a need to do both, which is what we would get by having a richer REPL environment. > > 3, Is anything other than ($) TypeRep-polymorphic? Yes: undefined and error. These really are used at unlifted types. > > > If 2 is "not very much", an obvious solution is to keep lying and not > worry about it. But clearly someone had a reason strong enough to > make this change... what was it? The change to the user-visible type of ($) is due to updates around TypeInType. But ($)'s ability to handle this case has been around since 7.8. Note that if you say :i $ in GHCi 7.10 you get a mention of OpenKind, which is the ancestor of current representation-polymorphism. It's just that :t ($) did a nice job of hiding it. > > > I hesitate to get distracted from the specifics, but I agree with Ben > Lippemeier in that I like how haskell doesn't make me worry about > boxed vs. unboxed. I'm not saying one little type annotation on one > operator is suddenly making me worry since I've never even thought to > run :t ($). But I'm happy that # is mostly off in its own little > corner and you don't even have to know it exists until you need to get > into low level optimization. And this is what the new -fshow-runtime-rep flag will (re-)enable. Richard From eir at cis.upenn.edu Sun Feb 7 15:00:48 2016 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Sun, 7 Feb 2016 10:00:48 -0500 Subject: [Haskell-cafe] Incredibly slow type-level Nub In-Reply-To: References: Message-ID: If you have a practical example of where GHC's current type-level reduction machinery is too slow, please post a bug report. We have only a few real examples of this, and so GHC's implementation is tuned for those examples. With more examples, we can tune more widely. Thanks! Richard On Feb 7, 2016, at 8:37 AM, Nickolay Kudasov wrote: > Dear Cafe, > > I have faced a type-level performance problem (with GHC 7.10.3). > I am trying to implement type-level Nub which removes duplicates from a type-level list. > > My implementation [1] with an example of a list of length 20 takes forever to compile. If you reduce the size of the example list (e.g. to 15 items), it will compile faster. Also, if you remove the Nub application from exampleVals, it compiles instantly (this is how I know the problem is in Nub). > > My question is how can I speed up type-level Nub? > And less importantly why exactly is it this slow? > > The practical application for this is building automatic tests [2] for servant-swagger. There I am interested in generating exactly one test for each distinct type. > > Kind regards, > Nick > > [1] https://gist.github.com/fizruk/06458fe8b62a1e562af1 > [2] http://hackage.haskell.org/package/servant-swagger-1.0.2/docs/Servant-Swagger-Test.html > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sun Feb 7 15:11:33 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sun, 7 Feb 2016 15:11:33 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <20160206123157.GC30442@weber> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <87r3gq9g8b.fsf@smart-cactus.org> <20160206123157.GC30442@weber> Message-ID: <20160207151133.GA2590@weber> On Sat, Feb 06, 2016 at 12:31:57PM +0000, Tom Ellis wrote: > On Sat, Feb 06, 2016 at 01:27:00PM +0100, Ben Gamari wrote: > > Tom Ellis writes: > > > On Fri, Feb 05, 2016 at 07:19:25PM +0000, Tom Ellis wrote: > > >> On Fri, Feb 05, 2016 at 01:13:23PM -0500, Richard Eisenberg wrote: > > >> > We're in a bit of a bind in all this. We really need the fancy type for > > >> > ($) so that it can be used in all situations where it is used currently. > > >> > > >> Is there a list of situations where ($) is used currently that give rise to > > >> this need? > > > > > > Does anyone have any idea about this? What is it about ($) that means it > > > needs a new funky type whereas (apparently) nothing else does? > > > > The first (albeit rather unconvincing) example I can think of is be > > something like, > > > > getI# :: Int -> Int# > > getI# (I# n#) = n# > > > > n# :: Int# > > n# = getI# $ 5 + 8 > > > > Richard likely has something a bit less contrived though. > > I hope there's something less contrived, because if the benefit is "you get > to use $ to apply functions whose return type is not of kind *" then the > power to weight ratio of this is extremely low. No one has suggested anything less contrived, so I'm going to assume this encompasses all use cases for the new type. in which case may I make a counter proposal: Give Prelude.($) a truthful type of '(a -> b) -> a -> b' and put the generalized version in a separate module, at least for now? I note that with the Foldable/Traversable Prelude we had * Foldable and Traversable in separate modules for a long, long time * A long discussion about merging them * Lots and lots of people using Foldable and Traversable None of these cases seems to apply to generalized ($) so I don't think it warrants inclusion in base (yet). (This is not to suggest that the work on the type system to make this sort of polymorphism is not technically excellent -- I just think we need to hold fire regarding merging such changes to base). Tom From eir at cis.upenn.edu Sun Feb 7 15:15:49 2016 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Sun, 7 Feb 2016 10:15:49 -0500 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <20160207151133.GA2590@weber> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <87r3gq9g8b.fsf@smart-cactus.org> <20160206123157.GC30442@weber> <20160207151133.GA2590@weber> Message-ID: <5E57ADF3-B6C8-46B7-BEA0-DA4B9278D3B9@cis.upenn.edu> On Feb 7, 2016, at 10:11 AM, Tom Ellis wrote: > > No one has suggested anything less contrived, so I'm going to assume this > encompasses all use cases for the new type. in which case may I make a > counter proposal: > > Give Prelude.($) a truthful type of '(a -> b) -> a -> b' and put the > generalized version in a separate module, at least for now? I would agree with this... except that the version of ($) in base in 7.8 and 7.10 already *was* generalized in this way. But no one got as itchy about the OpenKind that appears in 7.10's `:i $` as they are about the guck that appears in 8.0's `:t ($)`. So moving it out now would break code in the wild like https://ghc.haskell.org/trac/ghc/ticket/8739 Just to amplify this point: the generalization of ($) that we are debating **is not new**. The way it's rendered in GHCi is new, however. Richard From vandijk.roel at gmail.com Sun Feb 7 15:23:45 2016 From: vandijk.roel at gmail.com (Roel van Dijk) Date: Sun, 7 Feb 2016 16:23:45 +0100 Subject: [Haskell-cafe] Incredibly slow type-level Nub In-Reply-To: References: Message-ID: Hi Nickolay, I'm not sure why your version was *that* slow. But the algorithm was not optimal. I translated the Haskell Report prelude version of nub to the type level. That version compiles instantly with the long list. I tested with GHC 7.10.2. https://gist.github.com/roelvandijk/f115c6b85a3961e1b689 Regards, Roel 2016-02-07 14:37 GMT+01:00 Nickolay Kudasov : > Dear Cafe, > > I have faced a type-level performance problem (with GHC 7.10.3). > I am trying to implement type-level Nub which removes duplicates from a > type-level list. > > My implementation [1] with an example of a list of length 20 takes forever > to compile. If you reduce the size of the example list (e.g. to 15 items), > it will compile faster. Also, if you remove the Nub application from > exampleVals, it compiles instantly (this is how I know the problem is in > Nub). > > My question is how can I speed up type-level Nub? > And less importantly why exactly is it this slow? > > The practical application for this is building automatic tests [2] for > servant-swagger. There I am interested in generating exactly one test for > each distinct type. > > Kind regards, > Nick > > [1] https://gist.github.com/fizruk/06458fe8b62a1e562af1 > [2] > http://hackage.haskell.org/package/servant-swagger-1.0.2/docs/Servant-Swagger-Test.html > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mithrandi at mithrandi.net Sun Feb 7 15:24:10 2016 From: mithrandi at mithrandi.net (Tristan Seligmann) Date: Sun, 07 Feb 2016 15:24:10 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <5E57ADF3-B6C8-46B7-BEA0-DA4B9278D3B9@cis.upenn.edu> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <87r3gq9g8b.fsf@smart-cactus.org> <20160206123157.GC30442@weber> <20160207151133.GA2590@weber> <5E57ADF3-B6C8-46B7-BEA0-DA4B9278D3B9@cis.upenn.edu> Message-ID: On Sun, 7 Feb 2016 at 17:16 Richard Eisenberg wrote: > > I would agree with this... except that the version of ($) in base in 7.8 > and 7.10 already *was* generalized in this way. But no one got as itchy > about the OpenKind that appears in 7.10's `:i $` as they are about the guck > that appears in 8.0's `:t ($)`. So moving it out now would break code in > the wild like https://ghc.haskell.org/trac/ghc/ticket/8739 My GHC 7.10 doesn't seem to have any OpenKind stuff: GHCi, version 7.10.3: http://www.haskell.org/ghc/ :? for help Prelude> :i $ ($) :: (a -> b) -> a -> b -- Defined in ?GHC.Base? infixr 0 $ -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sun Feb 7 15:39:09 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sun, 7 Feb 2016 15:39:09 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <20160206122049.GB30442@weber> <20160206123309.GD30442@weber> Message-ID: <20160207153909.GB2590@weber> On Sat, Feb 06, 2016 at 12:12:47PM -0500, Edward Kmett wrote: > The primitives that GHC uses to implement arrays, references and the like > live in #. We then wrap them in something in * before exposing them to the > user, but you can shave a level of indirection by knowing what lives in # > and what doesn't. > > But even if you never care about #, Int, Double, etc. are of kind *, > Functors are of kind * -> *, etc. so to talk about the type of types at all > you need to be able to talk about these concepts at all with any rigor, and > to understand why Maybe Maybe isn't a thing. (This question is for my own edification and is not meant to be a point in the current debate) If we were inventing a language from the beginning, would it be strictly necessary to have two kinds? Could we have just an unboxed kind #, and have a box be an explicit type constructor? If the type constructor were called 'P' (standing for pointer) then we could have id :: P a -> P a data [a] = (P a) : [a] | [] etc. Does this thing seem remotely plausible to people who know clever type theory? Tom From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sun Feb 7 15:45:37 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sun, 7 Feb 2016 15:45:37 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <5E57ADF3-B6C8-46B7-BEA0-DA4B9278D3B9@cis.upenn.edu> References: <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <87r3gq9g8b.fsf@smart-cactus.org> <20160206123157.GC30442@weber> <20160207151133.GA2590@weber> <5E57ADF3-B6C8-46B7-BEA0-DA4B9278D3B9@cis.upenn.edu> Message-ID: <20160207154536.GC2590@weber> On Sun, Feb 07, 2016 at 10:15:49AM -0500, Richard Eisenberg wrote: > On Feb 7, 2016, at 10:11 AM, Tom Ellis wrote: > > No one has suggested anything less contrived, so I'm going to assume this > > encompasses all use cases for the new type. in which case may I make a > > counter proposal: > > > > Give Prelude.($) a truthful type of '(a -> b) -> a -> b' and put the > > generalized version in a separate module, at least for now? > > I would agree with this... except that the version of ($) in base in 7.8 > and 7.10 already *was* generalized in this way. But no one got as itchy > about the OpenKind that appears in 7.10's `:i $` as they are about the > guck that appears in 8.0's `:t ($)`. So moving it out now would break > code in the wild like https://ghc.haskell.org/trac/ghc/ticket/8739 This sounds a bit like throwing good money after bad. The levity polymorphic behaviour of ($) in 7.8 and 7.10 was not advertised in its type, nor in the documentation: https://hackage.haskell.org/package/base-4.8.2.0/docs/src/GHC.Base.html#%24 If people were relying on it to do something non-Haskell 2010, undocumented, GHC specific, then that's sad for them. But there are probably one hundred times as many people (literally) who would be startled to see the "correct" type pop up in GHC 8. Why not move the polymorphic version to a library and all those who really need it can get it from there. In time, when it has demonstrated itself to be an indisposable generalization, then it can be moved to base. > Just to amplify this point: the generalization of ($) that we are debating > **is not new**. The way it's rendered in GHCi is new, however. Sure I get that. It's just that few really knew that's how it was, because it wasn't advertised as being as it was, so few could question it :) (I've known for a while ($) has some magic around runST, but two days ago was the first time I heard about it being levity polymorphic.) Tom From dgorin at dc.uba.ar Sun Feb 7 15:56:25 2016 From: dgorin at dc.uba.ar (=?utf-8?Q?Daniel_Gor=C3=ADn?=) Date: Sun, 7 Feb 2016 15:56:25 +0000 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> Message-ID: <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> > On 7 Feb 2016, at 2:59 pm, Richard Eisenberg wrote: >> >> 2, ($) has had a fib in its type for a very long time, but did it ever >> hurt anyone? The closest I saw was a generalized concern about it >> being bad when people report a bug and then hear that things are more >> general than they thought and I guess this makes their bug not a bug >> or something? Results in some confusing back-and-forth? It would be >> nice to get more specific about how much trouble the ($) lie has >> caused. > > I don't have data, but there is a real cost to lying. It shows up in the slow-ish but steady stream of posts / questions / bug reports that are produced saying something is weird. I've seen a good number of these come up in my years in the Haskell community. I'll note that there is also a real cost to telling the truth: witness this thread. This all adds up to a need to do both, which is what we would get by having a richer REPL environment. This reminds a lot of the FTP controversy and I feel that here too we could side step the problem by allowing modules to re-export type-specialized versions of imported symbols. E.g., Data.Function could define ($) with the new type, Prelude would re-export it with the old type (as a specialization) and anyone who needs to use the more general version would have to opt-in by importing Data.Function. In terms of documentation, the haddock version of (Data.Function.$) would show the more general type while the haddock for Prelude would show the current type (ideally with a link to the more general one). From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sun Feb 7 15:59:13 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sun, 7 Feb 2016 15:59:13 +0000 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> Message-ID: <20160207155913.GA3787@weber> On Sun, Feb 07, 2016 at 03:56:25PM +0000, Daniel Gor?n wrote: > > On 7 Feb 2016, at 2:59 pm, Richard Eisenberg wrote: > >> > >> 2, ($) has had a fib in its type for a very long time, but did it ever > >> hurt anyone? The closest I saw was a generalized concern about it > >> being bad when people report a bug and then hear that things are more > >> general than they thought and I guess this makes their bug not a bug > >> or something? Results in some confusing back-and-forth? It would be > >> nice to get more specific about how much trouble the ($) lie has > >> caused. > > > > I don't have data, but there is a real cost to lying. It shows up in the > > slow-ish but steady stream of posts / questions / bug reports that are > > produced saying something is weird. I've seen a good number of these > > come up in my years in the Haskell community. I'll note that there is > > also a real cost to telling the truth: witness this thread. This all > > adds up to a need to do both, which is what we would get by having a > > richer REPL environment. > [..] > Data.Function could define ($) with the new type, Prelude would re-export > it with the old type (as a specialization) [..] Could you explain why re-exporting a specialized version is better than just *defining* a specialized equivalent? Tom From dgorin at dc.uba.ar Sun Feb 7 16:16:01 2016 From: dgorin at dc.uba.ar (=?windows-1252?Q?Daniel_Gor=EDn?=) Date: Sun, 7 Feb 2016 16:16:01 +0000 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <20160207155913.GA3787@weber> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> Message-ID: <64A0ABB1-8E5A-4753-BEB5-FB70F17FDBF0@dc.uba.ar> > [..] >> Data.Function could define ($) with the new type, Prelude would re-export >> it with the old type (as a specialization) > [..] > > Could you explain why re-exporting a specialized version is better than just > *defining* a specialized equivalent? I guess that for the same reasons it was considered better not to have duplicated definitions in Data.List of the more general functions in Data.Foldable? I?m just saying this seems to be another instance of a recurrent problem that we had before and that we?ll probably face again in the future. From cdsmith at gmail.com Sun Feb 7 19:08:33 2016 From: cdsmith at gmail.com (Chris Smith) Date: Sun, 7 Feb 2016 11:08:33 -0800 Subject: [Haskell-cafe] RebindableSyntax, ifThenElse, and pattern matching Message-ID: In a custom prelude, I have written the following definitions: data Truth = True | False ifThenElse :: Truth -> a -> a -> a ifThenElse True x _ = x ifThenElse False _ x = x (==) :: a -> a -> Truth (==) = ... I'm replacing Bool with my own Truth type. Clients will be built with RebindableSyntax, so that they will use these definitions for desugaring. However, if I write this: f :: Text -> Text f "r" = "rrr" f other = other I get a build error indicating that GHC expected the (==) operator to return a value of type Bool, rather than Truth. Shouldn't pattern matching desugar to use overloaded ifThenElse in these situations? Or is it expected that use of GHC.Types.Bool is hard-coded even with RebindableSyntax enabled? Thanks, Chris -------------- next part -------------- An HTML attachment was scrubbed... URL: From adam at bergmark.nl Sun Feb 7 20:00:28 2016 From: adam at bergmark.nl (Adam Bergmark) Date: Sun, 7 Feb 2016 21:00:28 +0100 Subject: [Haskell-cafe] RebindableSyntax, ifThenElse, and pattern matching In-Reply-To: References: Message-ID: There are a number of things one might expect RebindableSyntax to support, but it doesn't. Another examples is that `[1..2]' uses `GHC.Enum.enumFromTo' instead of the `enumFromTo' in scope. My guess is that RebindableSyntax isn't on the priority list. - Adam On Sun, Feb 7, 2016 at 8:08 PM, Chris Smith wrote: > In a custom prelude, I have written the following definitions: > > data Truth = True | False > > ifThenElse :: Truth -> a -> a -> a > ifThenElse True x _ = x > ifThenElse False _ x = x > > (==) :: a -> a -> Truth > (==) = ... > > I'm replacing Bool with my own Truth type. Clients will be built with > RebindableSyntax, so that they will use these definitions for desugaring. > > However, if I write this: > > f :: Text -> Text > f "r" = "rrr" > f other = other > > I get a build error indicating that GHC expected the (==) operator to > return a value of type Bool, rather than Truth. > > Shouldn't pattern matching desugar to use overloaded ifThenElse in these > situations? Or is it expected that use of GHC.Types.Bool is hard-coded > even with RebindableSyntax enabled? > > Thanks, > Chris > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From nickolay.kudasov at gmail.com Sun Feb 7 20:27:19 2016 From: nickolay.kudasov at gmail.com (Nickolay Kudasov) Date: Sun, 07 Feb 2016 20:27:19 +0000 Subject: [Haskell-cafe] Incredibly slow type-level Nub In-Reply-To: References: Message-ID: Roel, thanks, your solution works perfectly for me! I should've checked that implementation myself. Richard, since Roel's solution works for me, I think I should not file this. I think type-list [1] is the place on Hackage for list-related type-level functions. I probably should send a PR adding Roel's Nub there. Thanks for your help! Nick [1] https://hackage.haskell.org/package/type-list On Sun, 7 Feb 2016 at 18:24 Roel van Dijk wrote: > Hi Nickolay, > > I'm not sure why your version was *that* slow. But the algorithm was not > optimal. I translated the Haskell Report prelude version of nub to the type > level. That version compiles instantly with the long list. I tested with > GHC 7.10.2. > > https://gist.github.com/roelvandijk/f115c6b85a3961e1b689 > > Regards, > Roel > > > 2016-02-07 14:37 GMT+01:00 Nickolay Kudasov : > >> Dear Cafe, >> >> I have faced a type-level performance problem (with GHC 7.10.3). >> I am trying to implement type-level Nub which removes duplicates from a >> type-level list. >> >> My implementation [1] with an example of a list of length 20 takes >> forever to compile. If you reduce the size of the example list (e.g. to 15 >> items), it will compile faster. Also, if you remove the Nub application >> from exampleVals, it compiles instantly (this is how I know the problem is >> in Nub). >> >> My question is how can I speed up type-level Nub? >> And less importantly why exactly is it this slow? >> >> The practical application for this is building automatic tests [2] for >> servant-swagger. There I am interested in generating exactly one test for >> each distinct type. >> >> Kind regards, >> Nick >> >> [1] https://gist.github.com/fizruk/06458fe8b62a1e562af1 >> [2] >> http://hackage.haskell.org/package/servant-swagger-1.0.2/docs/Servant-Swagger-Test.html >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From m.farkasdyck at gmail.com Sun Feb 7 21:07:05 2016 From: m.farkasdyck at gmail.com (M Farkas-Dyck) Date: Sun, 7 Feb 2016 13:07:05 -0800 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <20160207155913.GA3787@weber> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> Message-ID: On 07/02/2016, Tom Ellis wrote: > Could you explain why re-exporting a specialized version is better than > just *defining* a specialized equivalent? No name clash, to my knowledge From olshanskydr at gmail.com Sun Feb 7 21:21:18 2016 From: olshanskydr at gmail.com (Dmitry Olshansky) Date: Mon, 8 Feb 2016 00:21:18 +0300 Subject: [Haskell-cafe] Incredibly slow type-level Nub In-Reply-To: References: Message-ID: I suppose that a problem is with "non-lazy type-level If". This was discussed here . And there is a ticket with workaround. Best regards, Dmitry 2016-02-07 16:37 GMT+03:00 Nickolay Kudasov : > Dear Cafe, > > I have faced a type-level performance problem (with GHC 7.10.3). > I am trying to implement type-level Nub which removes duplicates from a > type-level list. > > My implementation [1] with an example of a list of length 20 takes forever > to compile. If you reduce the size of the example list (e.g. to 15 items), > it will compile faster. Also, if you remove the Nub application from > exampleVals, it compiles instantly (this is how I know the problem is in > Nub). > > My question is how can I speed up type-level Nub? > And less importantly why exactly is it this slow? > > The practical application for this is building automatic tests [2] for > servant-swagger. There I am interested in generating exactly one test for > each distinct type. > > Kind regards, > Nick > > [1] https://gist.github.com/fizruk/06458fe8b62a1e562af1 > [2] > http://hackage.haskell.org/package/servant-swagger-1.0.2/docs/Servant-Swagger-Test.html > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From wren at community.haskell.org Sun Feb 7 23:23:21 2016 From: wren at community.haskell.org (wren romano) Date: Sun, 7 Feb 2016 18:23:21 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> Message-ID: I'm curious... Ultimately, ($) is just a name for what is otherwise unnameable: the whitespace which means application. However, application whitespace is a bit funny since it works uniformly for mono-/polymorphic arguments, un/boxed arguments, functions/record fields, etc? which is why we keep running into issues with typing ($). So my curiosity is this: why do we insist on considering ($) to be a function in the language rather than being syntax? We have overt syntax for other forms of whitespace, namely to deal with blocks and indentation, and we don't worry about what their types are, so why not treat ($) similarly? Sure, there are higher-order uses of ($), as when people write things like fmap($x), but afaict none of our typing hacks are worried about continuing to work in those settings, so there's no particular reason to think that those uses of a higher-order function capturing function application should be considered identical to the ($) used with runST, Int#, etc. -- Live well, ~wren From michael at orlitzky.com Mon Feb 8 00:42:29 2016 From: michael at orlitzky.com (Michael Orlitzky) Date: Sun, 7 Feb 2016 19:42:29 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> Message-ID: <56B7E475.5040001@orlitzky.com> On 02/07/2016 06:23 PM, wren romano wrote: > I'm curious... > > Ultimately, ($) is just a name for what is otherwise unnameable: the > whitespace which means application. However, application whitespace is > a bit funny since it works uniformly for mono-/polymorphic arguments, > un/boxed arguments, functions/record fields, etc? which is why we keep > running into issues with typing ($). I like the new type signature. It indicates that you're about to invoke dark magic line noise to avoid something simple and well-understood and in use since the beginning of time (parentheses). From eir at cis.upenn.edu Mon Feb 8 03:06:54 2016 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Sun, 7 Feb 2016 22:06:54 -0500 Subject: [Haskell-cafe] RebindableSyntax, ifThenElse, and pattern matching In-Reply-To: References: Message-ID: If you have a use-case that requires an expansion of RebindableSyntax, please post a feature request. There is a very limited number of person-hours devoted to improving GHC, so we need concrete direction from users. That said, RebindableSyntax has gotten quite a face-lift for 8.0, mostly internally. But it means that some types are more flexible than they were. However, neither problem in this thread is addressed by the changes. But to the email below: I'm not sure how we would support anything but Bool. According to the Report, > f "r" = "rrr" becomes > f x | x == "r" = "rrr" Because the result of == is used as a guard, it would have to be a Bool. I'd be all for a new -XOverloadedBooleans, but that's still separate from RebindableSyntax. The enumFromTo bit would be easy to fix, though. If you want it for practical purposes (that is, not just because its omission is aesthetically suboptimal -- which it is), please post a feature request. Richard On Feb 7, 2016, at 3:00 PM, Adam Bergmark wrote: > There are a number of things one might expect RebindableSyntax to support, but it doesn't. Another examples is that `[1..2]' uses `GHC.Enum.enumFromTo' instead of the `enumFromTo' in scope. > > My guess is that RebindableSyntax isn't on the priority list. > > - Adam > > > > On Sun, Feb 7, 2016 at 8:08 PM, Chris Smith wrote: > In a custom prelude, I have written the following definitions: > > data Truth = True | False > > ifThenElse :: Truth -> a -> a -> a > ifThenElse True x _ = x > ifThenElse False _ x = x > > (==) :: a -> a -> Truth > (==) = ... > > I'm replacing Bool with my own Truth type. Clients will be built with RebindableSyntax, so that they will use these definitions for desugaring. > > However, if I write this: > > f :: Text -> Text > f "r" = "rrr" > f other = other > > I get a build error indicating that GHC expected the (==) operator to return a value of type Bool, rather than Truth. > > Shouldn't pattern matching desugar to use overloaded ifThenElse in these situations? Or is it expected that use of GHC.Types.Bool is hard-coded even with RebindableSyntax enabled? > > Thanks, > Chris > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: From twhitehead at gmail.com Mon Feb 8 05:35:12 2016 From: twhitehead at gmail.com (Tyson Whitehead) Date: Sun, 7 Feb 2016 21:35:12 -0800 (PST) Subject: [Haskell-cafe] Pulling an applicative/apply out of a record In-Reply-To: <20160207101746.GC803@weber> References: <56B6F175.1000203@gmail.com> <20160207101746.GC803@weber> Message-ID: <0c62dace-fde6-40d6-a164-aff049e25ac3@googlegroups.com> On Sunday, 7 February 2016 05:17:55 UTC-5, Tom Ellis wrote: > > On Sun, Feb 07, 2016 at 02:25:41AM -0500, Tyson Whitehead wrote: > > RecordF (f Type1) (f Type2) ... -> (f Type1, f Type2, ....) > > -> f (Type1, Type2, ...) -> f (Record Type1 Type2 ...) > > > > I can't seem to find any uncurried zip implementations for arbitrarily > > large tuples (or any other way to do this without writing the > > boilerplate). Am I missing something? Is there a better way to do > this? > > I would call this a multi-typed 'Data.Traversable.sequence'. > > Data.Profunctor.Product.TH generates this (in fact something slightly > more > general that works for ProductProfunctors, not just Applicatives). > Thanks for the pointer Tom. Currently reading up about it. Found your post too. http://h2.jaguarpaw.co.uk/posts/product-profunctor-folds/ Cheers! -Tyson -------------- next part -------------- An HTML attachment was scrubbed... URL: From cdsmith at gmail.com Mon Feb 8 06:16:48 2016 From: cdsmith at gmail.com (Chris Smith) Date: Sun, 7 Feb 2016 22:16:48 -0800 Subject: [Haskell-cafe] RebindableSyntax, ifThenElse, and pattern matching In-Reply-To: References: Message-ID: Thanks! Yeah, I just wondered if this was known, or if there's an easy way around it that I was missing. For my specific case, I can do just as well by defining a type synonym, and then post-processing the error messages from GHC. That's all stuff I already do, so there's no need to do any work on my account. :) On Sun, Feb 7, 2016 at 7:06 PM, Richard Eisenberg wrote: > If you have a use-case that requires an expansion of RebindableSyntax, > please post a feature request. There is a very limited number of > person-hours devoted to improving GHC, so we need concrete direction from > users. > > That said, RebindableSyntax has gotten quite a face-lift for 8.0, mostly > internally. But it means that some types are more flexible than they were. > However, neither problem in this thread is addressed by the changes. > > But to the email below: I'm not sure how we would support anything but > Bool. According to the Report, > > > f "r" = "rrr" > > becomes > > > f x | x == "r" = "rrr" > > Because the result of == is used as a guard, it would have to be a Bool. > I'd be all for a new -XOverloadedBooleans, but that's still separate from > RebindableSyntax. > > The enumFromTo bit would be easy to fix, though. If you want it for > practical purposes (that is, not just because its omission is aesthetically > suboptimal -- which it is), please post a feature request. > > Richard > > On Feb 7, 2016, at 3:00 PM, Adam Bergmark wrote: > > There are a number of things one might expect RebindableSyntax to support, > but it doesn't. Another examples is that `[1..2]' uses > `GHC.Enum.enumFromTo' instead of the `enumFromTo' in scope. > > My guess is that RebindableSyntax isn't on the priority list. > > - Adam > > > > On Sun, Feb 7, 2016 at 8:08 PM, Chris Smith wrote: > >> In a custom prelude, I have written the following definitions: >> >> data Truth = True | False >> >> ifThenElse :: Truth -> a -> a -> a >> ifThenElse True x _ = x >> ifThenElse False _ x = x >> >> (==) :: a -> a -> Truth >> (==) = ... >> >> I'm replacing Bool with my own Truth type. Clients will be built with >> RebindableSyntax, so that they will use these definitions for desugaring. >> >> However, if I write this: >> >> f :: Text -> Text >> f "r" = "rrr" >> f other = other >> >> I get a build error indicating that GHC expected the (==) operator to >> return a value of type Bool, rather than Truth. >> >> Shouldn't pattern matching desugar to use overloaded ifThenElse in these >> situations? Or is it expected that use of GHC.Types.Bool is hard-coded >> even with RebindableSyntax enabled? >> >> Thanks, >> Chris >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Mon Feb 8 08:16:03 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 8 Feb 2016 09:16:03 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <56B7E475.5040001@orlitzky.com> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B7E475.5040001@orlitzky.com> Message-ID: what if use of ($) were confined to boxed & lifted types only? use (...) for unboxed / unlifted types. would this not simplify the issue somewhat? From takenobu.hs at gmail.com Mon Feb 8 10:08:55 2016 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Mon, 8 Feb 2016 19:08:55 +0900 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B6097C.1010500@ro-che.info> Message-ID: Hi Richard and devs, What a wonderful (#11549) ! This is a beautiful solution for beginners/newcomers. Beginners will not confuse and they can gradually go ahead. I extremely appreciate that you are continuously improving the ghc for us. Thank you very much, Takenobu 2016-02-07 0:17 GMT+09:00 Richard Eisenberg : > I have made a ticket #11549 (https://ghc.haskell.org/trac/ghc/ticket/11549) > requesting a -fshow-runtime-rep flag (recalling that the name levity will > soon be outdated) as described in this thread. I will make sure this gets > in for the release of 8.0. > > Other points: > > - You're quite right that (.) could be generalized. But I'll wait for > someone to really want this. > > - I don't have a non-contrived example of the use of ($) with unlifted > types. It's quite possible that when adding the dirty runST hack, it was > observed that an unlifted type would be OK. At that point, the type of ($) > didn't need to become so elaborate. And now we're just trying not to change > old (but perhaps unrequested) behavior. > > - For the record, this debate is entirely unrelated to the runST > impredicativity hack. (Except, as noted above, perhaps in history.) That > hack remains, basically unchanged. > > - On Feb 6, 2016, at 9:55 AM, Roman Cheplyaka wrote: > > > > I would call this a simplification rather than a lie. > > This is a very convincing argument. > > - Thanks, also, for the voice of support. What I love about the Haskell > community is that we can have an impassioned debate full of strong > opinions, and it all very rarely devolves into a proper flame war. All the > posts I've seen in this thread have been constructive and helpful. Thanks. > > Richard > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From takenobu.hs at gmail.com Mon Feb 8 10:14:05 2016 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Mon, 8 Feb 2016 19:14:05 +0900 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> Message-ID: Hi Imants and cafe, Related informal illustrations (and references) are here: Lifted/unlifted, boxed/unboxed types https://takenobu-hs.github.io/downloads/haskell_lazy_evaluation.pdf#page=182 Bottom https://takenobu-hs.github.io/downloads/haskell_lazy_evaluation.pdf#page=164 Regards, Takenobu 2016-02-07 0:54 GMT+09:00 Imants Cekusins : > in addition to Takenobu's links, Real World Haskell explains unboxing > and lifting on p.583 > > just to clarify, for practical use, is it safe to say that "boxed" and > "lifted" are synonyms? you see, term "boxed" is used in other > languages. I assumed "lifting" related to monads. Hence the confusion. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From olshanskydr at gmail.com Mon Feb 8 10:21:34 2016 From: olshanskydr at gmail.com (Dmitry Olshansky) Date: Mon, 8 Feb 2016 13:21:34 +0300 Subject: [Haskell-cafe] Incredibly slow type-level Nub In-Reply-To: References: Message-ID: Hello, I wonder if singletons library doesn't satisfy your requrements? Did you look at this opportunity? Here is a Nub implementation. I am particulary interested in this because I am checking now this library for usung it in my project. Had you some reasons to refuse it? Best regards, Dmitry 2016-02-07 16:37 GMT+03:00 Nickolay Kudasov : > Dear Cafe, > > I have faced a type-level performance problem (with GHC 7.10.3). > I am trying to implement type-level Nub which removes duplicates from a > type-level list. > > My implementation [1] with an example of a list of length 20 takes forever > to compile. If you reduce the size of the example list (e.g. to 15 items), > it will compile faster. Also, if you remove the Nub application from > exampleVals, it compiles instantly (this is how I know the problem is in > Nub). > > My question is how can I speed up type-level Nub? > And less importantly why exactly is it this slow? > > The practical application for this is building automatic tests [2] for > servant-swagger. There I am interested in generating exactly one test for > each distinct type. > > Kind regards, > Nick > > [1] https://gist.github.com/fizruk/06458fe8b62a1e562af1 > [2] > http://hackage.haskell.org/package/servant-swagger-1.0.2/docs/Servant-Swagger-Test.html > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Mon Feb 8 11:01:36 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 8 Feb 2016 12:01:36 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> Message-ID: Thank you very much Takenobu, these are very clear and extensive explanations. From rustompmody at gmail.com Mon Feb 8 13:02:08 2016 From: rustompmody at gmail.com (Rustom Mody) Date: Mon, 8 Feb 2016 18:32:08 +0530 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> Message-ID: On Mon, Feb 8, 2016 at 4:53 AM, wren romano wrote: > I'm curious... > > Ultimately, ($) is just a name for what is otherwise unnameable: the > whitespace which means application. However, application whitespace is > a bit funny since? > > A view from the other side: 1. Delete the unnameable 2. First-class application (its not called '$' but '.' -- a minor difference) 3. Remove all specialness of it http://blog.languager.org/2014/09/pugofer.html With justifications here: http://www.the-magus.in/Publications/ewd.pdf -------------- next part -------------- An HTML attachment was scrubbed... URL: From alpmestan at gmail.com Mon Feb 8 13:34:19 2016 From: alpmestan at gmail.com (Alp Mestanogullari) Date: Mon, 8 Feb 2016 14:34:19 +0100 Subject: [Haskell-cafe] Including a "XXX_stub.h" file from another Haskell library? Message-ID: Hello -cafe! Let's say I have two Haskell libraries, `A` and `B`. `A` uses the FFI, `foreign export` to be precise, to make a Haskell function available to C land. This generates a "stub" C header file with a corresponding C function declaration. `B` has some C code in it and needs to include the stub header that was generated when compiling `A`, in order to call the function that I 'foreign export'ed in A. When I "naively" include the stub header file for the module in A that contains the 'foreign export' statement, inside one of the C files of the `B` library, the said header can't be found. Is what I want to do at all possible? If yes, how could I make this work? Thanks! -- Alp Mestanogullari -------------- next part -------------- An HTML attachment was scrubbed... URL: From m.farkasdyck at gmail.com Mon Feb 8 16:03:05 2016 From: m.farkasdyck at gmail.com (M Farkas-Dyck) Date: Mon, 8 Feb 2016 08:03:05 -0800 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> Message-ID: On 07/02/2016, wren romano wrote: > Ultimately, ($) is just a name for what is otherwise unnameable: the > whitespace which means application. It is in fact otherwise called "id" ? > So my curiosity is this: why do > we insist on considering ($) to be a function in the language rather > than being syntax? We have overt syntax for other forms of whitespace, > namely to deal with blocks and indentation, and we don't worry about > what their types are, so why not treat ($) similarly? These other symbols, the block delimiters, are not terms, and so have no types. From marcin.jan.mrotek at gmail.com Mon Feb 8 16:13:04 2016 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Mon, 8 Feb 2016 17:13:04 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> Message-ID: > > 1. Delete the unnameable > 3. Remove all specialness of it > ... and end up with absolutely no way to apply functions that return unboxed values? Best regards, Marcin Mrotek -------------- next part -------------- An HTML attachment was scrubbed... URL: From m.farkasdyck at gmail.com Mon Feb 8 16:28:35 2016 From: m.farkasdyck at gmail.com (M Farkas-Dyck) Date: Mon, 8 Feb 2016 08:28:35 -0800 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> Message-ID: On 06/02/2016, Micha? Antkiewicz wrote: > Every programmer should understand the difference between boxed and > unboxed values. Period. Why? The performance of some code is not critical. Sometimes i need not care about 1 more indirection in their code, and some authors need never care, and in these cases i appreciate Haskell not forcing me to care. I'm not saying every language ought to hide this ?? i quite like Rust, for example ? but most times hiding it works quite well for me in Haskell. From michael at orlitzky.com Mon Feb 8 16:32:17 2016 From: michael at orlitzky.com (Michael Orlitzky) Date: Mon, 8 Feb 2016 11:32:17 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> Message-ID: <56B8C311.6060405@orlitzky.com> On 02/08/2016 11:13 AM, Marcin Mrotek wrote: > 1. Delete the unnameable > 3. Remove all specialness of it > > > ... and end up with absolutely no way to apply functions that return > unboxed values? > I think the point is that we don't need to worry about what the type of " " is in the expression "f x", because it's syntax for function application. If we had /explicit/ syntax for function application (read the PDF, it's good), there would be no problem to begin with -- syntax isn't typed. The suggestion in the PDF is basically to drop the "f x" syntax and always use "f $ x" which has a lot of merit if you rename "$" to something less ugly and more obvious. The paper proposes "f.x", but you could also equate "f." with "f()" to make something crazy like "f(x)" work. From jo at durchholz.org Mon Feb 8 16:45:33 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Mon, 8 Feb 2016 17:45:33 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <56B8C311.6060405@orlitzky.com> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B8C311.6060405@orlitzky.com> Message-ID: <56B8C62D.3070807@durchholz.org> Am 08.02.2016 um 17:32 schrieb Michael Orlitzky: > The suggestion in the PDF is basically to drop the "f x" syntax and > always use "f $ x" which has a lot of merit if you rename "$" to > something less ugly and more obvious. I'm wondering what the merit would be. From michael at orlitzky.com Mon Feb 8 16:56:53 2016 From: michael at orlitzky.com (Michael Orlitzky) Date: Mon, 8 Feb 2016 11:56:53 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <56B8C62D.3070807@durchholz.org> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B8C311.6060405@orlitzky.com> <56B8C62D.3070807@durchholz.org> Message-ID: <56B8C8D5.4080805@orlitzky.com> On 02/08/2016 11:45 AM, Joachim Durchholz wrote: > Am 08.02.2016 um 17:32 schrieb Michael Orlitzky: >> The suggestion in the PDF is basically to drop the "f x" syntax and >> always use "f $ x" which has a lot of merit if you rename "$" to >> something less ugly and more obvious. > > I'm wondering what the merit would be. By making "f $ x" or more generally "f $" syntax, we avoid the very issue that sparked this thread (that's what wren suggested...). We also no longer need the voodoo hacks for things like runST. It's less confusing for the parser and for students (explicit is better than implicit), etc. From jo at durchholz.org Mon Feb 8 17:15:14 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Mon, 8 Feb 2016 18:15:14 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <56B8C8D5.4080805@orlitzky.com> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B8C311.6060405@orlitzky.com> <56B8C62D.3070807@durchholz.org> <56B8C8D5.4080805@orlitzky.com> Message-ID: <56B8CD22.7060108@durchholz.org> Am 08.02.2016 um 17:56 schrieb Michael Orlitzky: > On 02/08/2016 11:45 AM, Joachim Durchholz wrote: >> Am 08.02.2016 um 17:32 schrieb Michael Orlitzky: >>> The suggestion in the PDF is basically to drop the "f x" syntax and >>> always use "f $ x" which has a lot of merit if you rename "$" to >>> something less ugly and more obvious. >> >> I'm wondering what the merit would be. > > By making "f $ x" or more generally "f $" syntax, we avoid the very > issue that sparked this thread (that's what wren suggested...). Wouldn't the type of function application be independent of its syntax? > We also > no longer need the voodoo hacks for things like runST. I can't comment on runST (my Haskell knowledge is really basic). But if there's a problem because juxtaposition has no representation as an operator symbol or function name, it should be easier to fix the syntactic problem than to rewrite the type system. Of course, if the type system got warts because of the existence of juxtaposition, then that should be fixed. > It's less > confusing for the parser and for students (explicit is better than > implicit), etc. Sure, but you don't make that an absolute. Otherwise you'd have to remove operator precedence, too. And the end result would look like Lisp. juxtaposition is so entrenched in almost all branches of math that using that implicitness to reduce syntactic overhead is a net win. From will.yager at gmail.com Mon Feb 8 17:21:26 2016 From: will.yager at gmail.com (Will Yager) Date: Mon, 8 Feb 2016 11:21:26 -0600 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> Message-ID: <59BCB7FA-CDAC-414F-B50C-C9BBE245FD68@gmail.com> On Feb 8, 2016, at 10:13, Marcin Mrotek wrote: > ... and end up with absolutely no way to apply functions that return unboxed values? Besides juxtaposition, could you not make another operator (e.g. "$#") for this purpose? --Will From imantc at gmail.com Mon Feb 8 17:33:46 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 8 Feb 2016 18:33:46 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <59BCB7FA-CDAC-414F-B50C-C9BBE245FD68@gmail.com> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <59BCB7FA-CDAC-414F-B50C-C9BBE245FD68@gmail.com> Message-ID: would f 1 ; 2 + 3 look ok instead of f 1 $ 2 + 3 ? the semicolon would be part of syntax, not something with a type the intuition is: pause application until the rest is applied From ekmett at gmail.com Mon Feb 8 17:39:51 2016 From: ekmett at gmail.com (Edward Kmett) Date: Mon, 8 Feb 2016 12:39:51 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <619CFC50-DD2A-402F-A5D6-D986C9F4C4DE@ouroborus.net> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <56B72180.6040900@durchholz.org> <619CFC50-DD2A-402F-A5D6-D986C9F4C4DE@ouroborus.net> Message-ID: This doesn't really work in a non-strict language like Haskell with uncontrolled recursion. We often need a lazy int that may be _|_ and shouldn't affect termination of the program unless demanded. The result would be that you'd actually have to compile all of your code several ways times the number of type arguments and you'd get rather severely different semantics around evaluation as it switched between strictness and laziness. Moreover, cycles that happened to involve one of these values would have to tie the knot strictly, meaning you'd have issues like scheme where letrec secretly exposes extra, observable, #f cases when you encounter a cycle. -Edward On Sun, Feb 7, 2016 at 7:17 AM, Ben Lippmeier wrote: > > > On 7 Feb 2016, at 9:50 pm, Joachim Durchholz wrote: > > > For the Int/Int# concept, the approaches I have seen either ignore the > efficiency and let the machine figure out what to do (Smalltalk, Python, > pre-Int# Haskell), or they complicate the type system at the expense of > polymorphism (Java, Eiffel), or they complicate the type system even more > to regain some form of polymorphism (C++, today's Haskell). > > Although I haven?t implemented it, I suspect another approach is to just > specialise every polymorphic function at its unboxed type arguments. Boxed > and unboxed value types would share the same kind. Of course, full > specialisation of polymorphic code assumes that code is available in the > interface files, but we?ve almost got that already. Dealing with mutual > recursion could be a pain, though. > > I don?t think specialisation was an option back when unboxed types were > originally implemented. I believe GHC?s support for cross module inlining > came some time after the unboxed types, if the publication dates of the > relative papers are to be a guide. > > Ben. > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at orlitzky.com Mon Feb 8 17:45:46 2016 From: michael at orlitzky.com (Michael Orlitzky) Date: Mon, 8 Feb 2016 12:45:46 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <59BCB7FA-CDAC-414F-B50C-C9BBE245FD68@gmail.com> Message-ID: <56B8D44A.608@orlitzky.com> On 02/08/2016 12:33 PM, Imants Cekusins wrote: > would > f 1 ; 2 + 3 > > look ok instead of > f 1 $ 2 + 3 > > ? > > the semicolon would be part of syntax, not something with a type > the intuition is: pause application until the rest is applied The semicolon is already appropriated sadly: ghci> do { putStr "Hello" ; putStrLn " world!"; } Hello world! From michael at orlitzky.com Mon Feb 8 17:59:29 2016 From: michael at orlitzky.com (Michael Orlitzky) Date: Mon, 8 Feb 2016 12:59:29 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <56B8CD22.7060108@durchholz.org> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B8C311.6060405@orlitzky.com> <56B8C62D.3070807@durchholz.org> <56B8C8D5.4080805@orlitzky.com> <56B8CD22.7060108@durchholz.org> Message-ID: <56B8D781.7080902@orlitzky.com> On 02/08/2016 12:15 PM, Joachim Durchholz wrote: > > Sure, but you don't make that an absolute. > Otherwise you'd have to remove operator precedence, too. And the end > result would look like Lisp. > > juxtaposition is so entrenched in almost all branches of math that using > that implicitness to reduce syntactic overhead is a net win. I don't think anyone was seriously suggesting getting rid of "f x" for function application. Rustom's post is interesting because it suggests that if you're going to have only one of "f x" or "f $ x", then it should be the latter. It's a fun thought experiment. Since we're stuck with "f x", the question is: do we want *both* as syntax? If most uses of "$" are for, putStrLn $ "Hello" ++ " world!" to avoid, putStrLn ("Hello" ++ " world!") then I think it's silly to worry about the type of "$". Most people don't have to know, care, or use it -- the second example is much clearer. And if instead you're doing some kind of fmap (((f $) $) $) gymnastics, then you probably don't mind the type of "$". From imantc at gmail.com Mon Feb 8 18:01:37 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 8 Feb 2016 19:01:37 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <56B8D44A.608@orlitzky.com> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <59BCB7FA-CDAC-414F-B50C-C9BBE245FD68@gmail.com> <56B8D44A.608@orlitzky.com> Message-ID: > The semicolon is already appropriated sadly: ghci> do { putStr "Hello" ; putStrLn " world!"; } is it only used for this purpose within braces? would it be a bad taste to overload ;? there are examples: dot, parentheses even have type in their moonlighting capacity: Prelude> :t () () :: () From bog at khumba.net Mon Feb 8 18:11:36 2016 From: bog at khumba.net (Bryan Gardiner) Date: Mon, 8 Feb 2016 10:11:36 -0800 Subject: [Haskell-cafe] ANNOUNCE: hoppy, qtah Message-ID: <20160208101136.13365424@khumba.net> Are you sick and tired of the ease with which Haskell code flows onto the page? Even the thrill of binding to a C library losing its lustre? Look no further! I present to you a tool restoring the good old days of pointer arithmetic, manual memory management, and hours lost to the debugger: Hoppy is a new C++ FFI generator for Haskell. It takes Haskell code that describes a C++ API, and generates C++ and Haskell code to allow the two languages to interact. It supports a good subset of C++, including functions, classes, variables, enums and bitflags, operator overloading, constness, and simple templates. Adding a function takes only a few lines of code, and you normally don't need to write C++ yourself. For example, a definition for std::string is: c_string :: Class c_string = addReqIncludes [includeStd "string"] $ classAddFeatures [Assignable, Comparable, Copyable, Equatable] $ makeClass (ident1 "std" "string") (Just $ toExtName "StdString") [] [ mkCtor "new" [] , mkCtor "newFromCString" [TPtr $ TConst TChar] ] [ mkConstMethod' "at" "at" [TInt] $ TRef TChar , mkConstMethod' "at" "get" [TInt] TChar , mkConstMethod "c_str" [] $ TPtr $ TConst TChar , mkConstMethod "size" [] TSize , mkConstMethod OpAdd [TObj c_string] $ TObj c_string ] Now, writing a FFI generator isn't much fun unless you have a project to use it with. So I am pleased to also announce Qtah, a fresh set of Qt 4/5 bindings. These include portions of QtCore, QtGui, and QtWidgets, and are on the whole wildly incomplete, but are usable for basic tasks so far, and I am working on extending coverage. (On qtHaskell/hsQt: I started Qtah before qtHaskell began being updated in 2015 and I missed when that happened. My hope is that Qtah requires less code and effort to maintain; at least, qtHaskell contains a lot of generated code and I haven't seen where it came from, so please correct me if the generator is in fact available somewhere. Hoppy also doesn't (currently) do many of the fancy things that qtHaskell does, like overloading and garbage collection.) Both Hoppy and Qtah are young, and I am very interested in discussing how to make them most useful for the community. Because of questions such as this[1], their APIs (including those of generated bindings) should be considered experimental at this time. I will be uploading Hoppy to Hackage shortly. Becuase Qtah includes a shared library, I haven't figured out how to get that on Hackage yet, so you'll have to clone the repo yourself. http://khumba.net/projects/hoppy http://khumba.net/projects/qtah Happy hacking! Bryan Gardiner [1] https://gitlab.com/khumba/hoppy/issues/3 -------------- next part -------------- A non-text attachment was scrubbed... Name: not available Type: application/pgp-signature Size: 801 bytes Desc: OpenPGP digital signature URL: From mihai.maruseac at gmail.com Mon Feb 8 18:16:58 2016 From: mihai.maruseac at gmail.com (Mihai Maruseac) Date: Mon, 8 Feb 2016 13:16:58 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <59BCB7FA-CDAC-414F-B50C-C9BBE245FD68@gmail.com> <56B8D44A.608@orlitzky.com> Message-ID: On Mon, Feb 8, 2016 at 1:01 PM, Imants Cekusins wrote: > would it be a bad taste to overload ;? Won't it create ambiguity problems like the following? ghci> do { putStr "Hello, the answer is "; print $ 40 + 2 } being changed into the invalid ghci> do { putStr "Hello, the answer is "; print ; 40 + 2 } -- Mihai Maruseac (MM) "If you can't solve a problem, then there's an easier problem you can solve: find it." -- George Polya From imantc at gmail.com Mon Feb 8 18:31:16 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 8 Feb 2016 19:31:16 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <59BCB7FA-CDAC-414F-B50C-C9BBE245FD68@gmail.com> <56B8D44A.608@orlitzky.com> Message-ID: > Won't it create ambiguity problems...? we could set simple criteria for "; " a) within code block - keep the current meaning : new statement b) elsewhere: pause application ($) $ would keep its current meaning and the new "honest, confusing" type. Still be usable, would not break the code. ; may mark the code visually better than $ e.g. braces are overloaded: code block, data record From imantc at gmail.com Mon Feb 8 18:33:22 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 8 Feb 2016 19:33:22 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <59BCB7FA-CDAC-414F-B50C-C9BBE245FD68@gmail.com> <56B8D44A.608@orlitzky.com> Message-ID: a) within { code block 1; code block 2; } - keep the current meaning : new statement From imantc at gmail.com Mon Feb 8 18:46:34 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 8 Feb 2016 19:46:34 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <59BCB7FA-CDAC-414F-B50C-C9BBE245FD68@gmail.com> <56B8D44A.608@orlitzky.com> Message-ID: ghci> do { putStr "Hello, the answer is "; print (40 + 2); } reasonably easy to remember rule of thumb: using braces? use parentheses, too! From jo at durchholz.org Mon Feb 8 19:28:23 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Mon, 8 Feb 2016 20:28:23 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <56B8D781.7080902@orlitzky.com> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B8C311.6060405@orlitzky.com> <56B8C62D.3070807@durchholz.org> <56B8C8D5.4080805@orlitzky.com> <56B8CD22.7060108@durchholz.org> <56B8D781.7080902@orlitzky.com> Message-ID: <56B8EC57.8060502@durchholz.org> Am 08.02.2016 um 18:59 schrieb Michael Orlitzky: > If most uses of "$" are for, > > putStrLn $ "Hello" ++ " world!" > > to avoid, > > putStrLn ("Hello" ++ " world!") > > then I think it's silly to worry about the type of "$". Most people > don't have to know, care, or use it -- the second example is much > clearer. Only if you are on the standard programming language mindset. I.e. those who learn Haskell first will find putStrLn "Hello" ++ "world!" more natural. From nickolay.kudasov at gmail.com Mon Feb 8 20:34:57 2016 From: nickolay.kudasov at gmail.com (Nickolay Kudasov) Date: Mon, 08 Feb 2016 20:34:57 +0000 Subject: [Haskell-cafe] Incredibly slow type-level Nub In-Reply-To: References: Message-ID: Dmitry, Well, actually, I was not aware that singletons provide this functionality! >From what I see singletons seem to be an overkill for my use case. Thanks for the hint though, I will look into singletons more to see if it fits the bill. Kind regards, Nick On Mon, 8 Feb 2016 at 13:21 Dmitry Olshansky wrote: > Hello, > > I wonder if singletons library > doesn't satisfy your requrements? Did you look at this opportunity? Here > is > a Nub implementation. > > I am particulary interested in this because I am checking now this library > for usung it in my project. Had you some reasons to refuse it? > > Best regards, > Dmitry > > 2016-02-07 16:37 GMT+03:00 Nickolay Kudasov : > >> Dear Cafe, >> >> I have faced a type-level performance problem (with GHC 7.10.3). >> I am trying to implement type-level Nub which removes duplicates from a >> type-level list. >> >> My implementation [1] with an example of a list of length 20 takes >> forever to compile. If you reduce the size of the example list (e.g. to 15 >> items), it will compile faster. Also, if you remove the Nub application >> from exampleVals, it compiles instantly (this is how I know the problem is >> in Nub). >> >> My question is how can I speed up type-level Nub? >> And less importantly why exactly is it this slow? >> >> The practical application for this is building automatic tests [2] for >> servant-swagger. There I am interested in generating exactly one test for >> each distinct type. >> >> Kind regards, >> Nick >> >> [1] https://gist.github.com/fizruk/06458fe8b62a1e562af1 >> [2] >> http://hackage.haskell.org/package/servant-swagger-1.0.2/docs/Servant-Swagger-Test.html >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> -------------- next part -------------- An HTML attachment was scrubbed... URL: From mhoermann at gmail.com Mon Feb 8 20:39:20 2016 From: mhoermann at gmail.com (=?UTF-8?Q?Matthias_H=C3=B6rmann?=) Date: Mon, 8 Feb 2016 21:39:20 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <56B8EC57.8060502@durchholz.org> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B8C311.6060405@orlitzky.com> <56B8C62D.3070807@durchholz.org> <56B8C8D5.4080805@orlitzky.com> <56B8CD22.7060108@durchholz.org> <56B8D781.7080902@orlitzky.com> <56B8EC57.8060502@durchholz.org> Message-ID: Are you seriously suggesting to overloaded semicolons to *avoid* confusing newcomers to Haskell from other languages? And all of that just in case that newcomer happens to look at the output of :t ($)? On Mon, Feb 8, 2016 at 8:28 PM, Joachim Durchholz wrote: > Am 08.02.2016 um 18:59 schrieb Michael Orlitzky: >> >> If most uses of "$" are for, >> >> putStrLn $ "Hello" ++ " world!" >> >> to avoid, >> >> putStrLn ("Hello" ++ " world!") >> >> then I think it's silly to worry about the type of "$". Most people >> don't have to know, care, or use it -- the second example is much >> clearer. > > > Only if you are on the standard programming language mindset. > I.e. those who learn Haskell first will find putStrLn "Hello" ++ "world!" > more natural. > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From adam at bergmark.nl Mon Feb 8 21:22:02 2016 From: adam at bergmark.nl (Adam Bergmark) Date: Mon, 8 Feb 2016 22:22:02 +0100 Subject: [Haskell-cafe] [ANN] aeson 0.11.0.0 Message-ID: Hi haskellers, As a new co-maintainer of aeson I'm happy to announce aeson 0.11.0.0[1]. v0.10 had a number of issues and v0.11 aims to fix all of these. I'm happy to see that all known regressions have been fixed, and I didn't have to write any code myself! ;) Going 0.9 to 0.11 should be no work for most users. I've built all packages in stackage nightly[2] and out of 222 only one needs a non-trivial change (sorry pagerduty maintainers!) Please help out by letting us know if we missed something, including if something should be added to the CHANGELOG[3]. A big thanks to everyone who contributed code to this release: Bryan O'Sullivan Bas van Dijk Oleg Grenrus Herbert Valerio Riedel Ben Weitzman Daniel D?az RyanGlScott David Johnson Artyom Cale Gibbard Mikhail Glushenkov Ondrej Palkovsky Tim Bodeit mrkkrp And a thank you to everyone else who helped in other ways! All the best, Adam [1] https://hackage.haskell.org/package/aeson-0.11.0.0 [2] https://github.com/bos/aeson/issues/355 [3] https://github.com/bos/aeson/blob/master/changelog.md -------------- next part -------------- An HTML attachment was scrubbed... URL: From ok at cs.otago.ac.nz Mon Feb 8 22:35:57 2016 From: ok at cs.otago.ac.nz (Richard A. O'Keefe) Date: Tue, 9 Feb 2016 11:35:57 +1300 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <59BCB7FA-CDAC-414F-B50C-C9BBE245FD68@gmail.com> Message-ID: <56B9184D.40401@cs.otago.ac.nz> On 9/02/16 6:33 am, Imants Cekusins wrote: > would > f 1 ; 2 + 3 > > look ok instead of > f 1 $ 2 + 3 No. Semicolon already means something in Haskell, and that's not it. From jo at durchholz.org Mon Feb 8 22:51:43 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Mon, 8 Feb 2016 23:51:43 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B8C311.6060405@orlitzky.com> <56B8C62D.3070807@durchholz.org> <56B8C8D5.4080805@orlitzky.com> <56B8CD22.7060108@durchholz.org> <56B8D781.7080902@orlitzky.com> <56B8EC57.8060502@durchholz.org> Message-ID: <56B91BFF.8060202@durchholz.org> I'm not seeing a semicolon anywhere here... Am 08.02.2016 um 21:39 schrieb Matthias H?rmann: > Are you seriously suggesting to overloaded semicolons to *avoid* > confusing newcomers to Haskell from other languages? > > And all of that just in case that newcomer happens to look at the > output of :t ($)? > > On Mon, Feb 8, 2016 at 8:28 PM, Joachim Durchholz wrote: >> Am 08.02.2016 um 18:59 schrieb Michael Orlitzky: >>> >>> If most uses of "$" are for, >>> >>> putStrLn $ "Hello" ++ " world!" >>> >>> to avoid, >>> >>> putStrLn ("Hello" ++ " world!") >>> >>> then I think it's silly to worry about the type of "$". Most people >>> don't have to know, care, or use it -- the second example is much >>> clearer. >> >> >> Only if you are on the standard programming language mindset. >> I.e. those who learn Haskell first will find putStrLn "Hello" ++ "world!" >> more natural. >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > From rf at rufflewind.com Mon Feb 8 23:05:34 2016 From: rf at rufflewind.com (Phil Ruffwind) Date: Mon, 8 Feb 2016 18:05:34 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> Message-ID: > Another great question that has come up is about Haddock output (Hackage). I > think Haddock needs to add a facility where library authors can include > specializations of an overly general type. This can be done in commentary, > but it's not as prominent. I think a low-hanging fruit would be to add the ability for Haddock to parse some sort of specialized types annotation (could be entirely in the comments) and display them adjacent to the true type. The types do have to be manually written, but at least they can be type-checked. Lens does this in its documentation and they are very helpful for learning the library. > (^.) :: s -> Getting a s a -> a > (^.) :: s -> Getter s a -> a > (^.) :: Monoid m => s -> Fold s m -> m > (^.) :: s -> Iso' s a -> a > (^.) :: s -> Lens' s a -> a > (^.) :: Monoid m => s -> Traversal' s m -> m From vogt.adam at gmail.com Mon Feb 8 23:19:24 2016 From: vogt.adam at gmail.com (adam vogt) Date: Mon, 8 Feb 2016 18:19:24 -0500 Subject: [Haskell-cafe] Pulling an applicative/apply out of a record In-Reply-To: <56B6F175.1000203@gmail.com> References: <56B6F175.1000203@gmail.com> Message-ID: On Sun, Feb 7, 2016 at 2:25 AM, Tyson Whitehead wrote: > Quick question for the experts out there. > > I need to process some records. The records come in in an unordered > stream of record fields. From each stream of fields I want to produce a > Record entry containing the fields I need to do my calculation. > > data Record = { field1 :: Type1, field2 :: Type2, ... } >> > > I was thinking this setup might work nice with something like > > data RecordF d = RecordF { field1 :: f Type1, field2 :: f Type2, ... } >> > > as I could then have (1) a monoid version I could accumulate use as an > accumulator over the stream > > type RecordM = RecordF [] >> > > and (2) a final version. > > type Record = RecordF Identity >> > > This final version seems like it should easily come from the later by > pulling the [] (or anything else that has the Apply/Applicative structure) > to the outside and then taking the head of the resulting list. > > While I could write the boilerplate to do this, it seems like something I > should be able to do more elegantly. The best I have come up with so far > is to use the lens package to give me an isomorphism to a tuple. Then I > need a uncurried zip for arbitrarily large tuples. Follow this by an > isomorphism back. > > RecordF (f Type1) (f Type2) ... -> (f Type1, f Type2, ....) > -> f (Type1, Type2, ...) -> f (Record Type1 Type2 ...) > > I can't seem to find any uncurried zip implementations for arbitrarily > large tuples (or any other way to do this without writing the > boilerplate). Am I missing something? Is there a better way to do this? > > Thanks! -Tyson > > PS: It seems the Data.Vinyl package has something along these lines with > the rtraverse function > > https://hackage.haskell.org/package/vinyl-0.5.1/docs/Data-Vinyl-Core.html > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > https://gist.github.com/aavogt/f7d875abaf504dc3bf12 shows how you can do it with extensible, HList, and vinyl. Or if you want to stick with your current way of defining records, I think https://wiki.haskell.org/Template_Haskell#.27generic.27_zipWith could work too. Regards, Adam -------------- next part -------------- An HTML attachment was scrubbed... URL: From ok at cs.otago.ac.nz Mon Feb 8 23:54:04 2016 From: ok at cs.otago.ac.nz (Richard A. O'Keefe) Date: Tue, 9 Feb 2016 12:54:04 +1300 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <56B7E475.5040001@orlitzky.com> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B7E475.5040001@orlitzky.com> Message-ID: <56B92A9C.4090608@cs.otago.ac.nz> On 8/02/16 1:42 pm, Michael Orlitzky wrote: > I like the new type signature. It indicates that you're about to invoke > dark magic line noise to avoid something simple and well-understood and > in use since the beginning of time (parentheses). So time began in the 15th century? No, wait, that's text. For mathematics, time must have begun in the 16th century. http://jeff560.tripod.com/grouping.html Wait, those were grouping parentheses, not application ones. According to https://en.wikipedia.org/wiki/History_of_the_function_concept something explicit resembling modern ideas of a "function" appeared in the 17th century, so THAT's when time began. I always wondered. From ok at cs.otago.ac.nz Tue Feb 9 00:32:11 2016 From: ok at cs.otago.ac.nz (Richard A. O'Keefe) Date: Tue, 9 Feb 2016 13:32:11 +1300 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56B4CA58.4050101@htwk-leipzig.de> References: <56B4CA58.4050101@htwk-leipzig.de> Message-ID: <56B9338B.4070102@cs.otago.ac.nz> As Manuel wrote: >> I expect that every single person teaching Haskell >> is going to be unhappy about it. If I were in the happy position of still teaching Haskell, I would be unhappy about it. In my own use of Haskell, I've only played briefly with # types and then decided to leave them to library writers. I'd certainly never heard of "levity polymorphism" before. I can agree that for a functional language, being able to apply any reasonable function to any reasonable matching argument has to be doable, but such a fundamental operation surely needs to be simple to describe? Is there a complete lit of all the affected functions? Is a complete list even possible? From michael at orlitzky.com Tue Feb 9 00:34:31 2016 From: michael at orlitzky.com (Michael Orlitzky) Date: Mon, 8 Feb 2016 19:34:31 -0500 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <56B92A9C.4090608@cs.otago.ac.nz> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B7E475.5040001@orlitzky.com> <56B92A9C.4090608@cs.otago.ac.nz> Message-ID: <56B93417.5090904@orlitzky.com> On 02/08/2016 06:54 PM, Richard A. O'Keefe wrote: > > Wait, those were grouping parentheses, not application ones. > According to https://en.wikipedia.org/wiki/History_of_the_function_concept > something explicit resembling modern ideas of a "function" appeared > in the 17th century, so THAT's when time began. > > I always wondered. > I was referring to grouping parentheses. Most uses of "$" are for stupid things like "sin $ 1 + 2" where parentheses would be much more clear. By "beginning of time" I thought it was clear I meant "I don't feel like looking it up," but thanks -- we now know that people have been using parentheses about 400 years longer than "$" for grouping. From bos at serpentine.com Tue Feb 9 00:41:31 2016 From: bos at serpentine.com (Bryan O'Sullivan) Date: Mon, 8 Feb 2016 16:41:31 -0800 Subject: [Haskell-cafe] [ANN] aeson 0.11.0.0 In-Reply-To: References: Message-ID: On Mon, Feb 8, 2016 at 1:22 PM, Adam Bergmark wrote: > As a new co-maintainer of aeson I'm happy to announce aeson 0.11.0.0[1]. > v0.10 had a number of issues and v0.11 aims to fix all of these. I'm happy > to see that all known regressions have been fixed, and I didn't have to > write any code myself! ;) > Thank you for your help, Adam! -------------- next part -------------- An HTML attachment was scrubbed... URL: From strikingwolf2012 at gmail.com Tue Feb 9 02:02:37 2016 From: strikingwolf2012 at gmail.com (Strikingwolf2012 .) Date: Mon, 8 Feb 2016 20:02:37 -0600 Subject: [Haskell-cafe] Matrices as Applicatives and Monads Message-ID: I have been writing code encoding matrices here as a learning experience. However, I cannot figure out a method to make Matrix an instance of Applicative and Monad. I believe it is possible, but I cannot find an implementation. For context my form of Matrix does not have a requirement to be of integers, it is just a 2-Dimensional array in essence. Thank you in advance for any help you may provide :) -------------- next part -------------- An HTML attachment was scrubbed... URL: From tkoster at gmail.com Tue Feb 9 03:43:27 2016 From: tkoster at gmail.com (Thomas Koster) Date: Tue, 9 Feb 2016 14:43:27 +1100 Subject: [Haskell-cafe] Combining ST with STM Message-ID: Hi friends, I have an STM transaction that needs some private, temporary state. The most obvious way is to simply pass pure state as arguments, but for efficiency, I would like this state to be some kind of mutable array, like STArray. I know, STM has TVars and TArray, but since this state is private to the transaction, I am wondering if using TVars/TArrays for private state might be overkill that will unnecessarily slow down the STM commit process. The private state is, by definition, not shared, so including it in the STM log and commit process is, as far as I can tell, pointless. ST and STArray still appear to be the most appropriate tools for the private state, because STRefs and STArrays really, really are private. So this basically means I want to interleave ST and STM in a "safe" way. That is, if the STM transaction retries, I want the ST state to be vaporised as well. Ideally, I would love to be able to say something like this: -- | Copy the value from the shared TVar into the private STRef. load :: TVar a -> STRef a -> STSTM s () load shared private = do value <- liftSTM (readTVar shared) liftST (writeSTRef private value) Naturally, that STRef must originate from a call to newSTRef earlier in the same transaction and is private to it, just like the real ST monad. As far as I can tell, I am not trying to weaken either ST or STM in any way here. I found the STMonadTrans package on Hackage [1] that claims to implement ST as a monad transformer, STT, which sounds close to what I want. While its documentation does not mention STM, it does say that some monads are unsafe to use as a base monad for STT. Is STMonadTrans safe to use with STM? [1] https://hackage.haskell.org/package/STMonadTrans Thanks, Thomas Koster From fryguybob at gmail.com Tue Feb 9 04:16:43 2016 From: fryguybob at gmail.com (Ryan Yates) Date: Mon, 8 Feb 2016 23:16:43 -0500 Subject: [Haskell-cafe] Combining ST with STM In-Reply-To: References: Message-ID: I also have found need for what I think you are describing but only in the context of transactional arrays where there are multiple fields to initialize while I know that the array is private to the creating thread. For now I'm adding the primitives I need as I go, but I would like to have better safer story. You might be interested in how the stm-containers package uses ST to build internal nodes in transactions [1], [2]. [1]: https://github.com/nikita-volkov/stm-containers/blob/master/library/STMContainers/HAMT/Nodes.hs#L36 [2]: https://github.com/nikita-volkov/stm-containers/blob/master/library/STMContainers/WordArray.hs#L118 Ryan On Mon, Feb 8, 2016 at 10:43 PM, Thomas Koster wrote: > Hi friends, > > I have an STM transaction that needs some private, temporary state. > The most obvious way is to simply pass pure state as arguments, but > for efficiency, I would like this state to be some kind of mutable > array, like STArray. > > I know, STM has TVars and TArray, but since this state is private to > the transaction, I am wondering if using TVars/TArrays for private > state might be overkill that will unnecessarily slow down the STM > commit process. The private state is, by definition, not shared, so > including it in the STM log and commit process is, as far as I can > tell, pointless. > > ST and STArray still appear to be the most appropriate tools for the > private state, because STRefs and STArrays really, really are private. > > So this basically means I want to interleave ST and STM in a "safe" > way. That is, if the STM transaction retries, I want the ST state to > be vaporised as well. > > Ideally, I would love to be able to say something like this: > > -- | Copy the value from the shared TVar into the private STRef. > load :: TVar a -> STRef a -> STSTM s () > load shared private = do > value <- liftSTM (readTVar shared) > liftST (writeSTRef private value) > > Naturally, that STRef must originate from a call to newSTRef earlier > in the same transaction and is private to it, just like the real ST > monad. As far as I can tell, I am not trying to weaken either ST or > STM in any way here. > > I found the STMonadTrans package on Hackage [1] that claims to > implement ST as a monad transformer, STT, which sounds close to what I > want. While its documentation does not mention STM, it does say that > some monads are unsafe to use as a base monad for STT. > > Is STMonadTrans safe to use with STM? > > [1] https://hackage.haskell.org/package/STMonadTrans > > Thanks, > Thomas Koster > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From dhelta.diaz at gmail.com Tue Feb 9 05:59:18 2016 From: dhelta.diaz at gmail.com (=?UTF-8?Q?Daniel_D=C3=ADaz_Casanueva?=) Date: Tue, 9 Feb 2016 06:59:18 +0100 Subject: [Haskell-cafe] Matrices as Applicatives and Monads In-Reply-To: References: Message-ID: Hey, I don't currently have the time to go into details, but you might want to take look at this: https://github.com/Daniel-Diaz/matrix/blob/555cb93a759536cd9ff03059ec4b813640607c89/Data/Matrix.hs#L177 It is inspired by tensor product. Monad is not possible though. Think about how would you implement the 'join' function. I hope that helps! Best, Daniel D?az. On Tue, Feb 9, 2016 at 3:02 AM, Strikingwolf2012 . < strikingwolf2012 at gmail.com> wrote: > I have been writing code encoding matrices here > as > a learning experience. However, I cannot figure out a method to make Matrix > an instance of Applicative and Monad. I believe it is possible, but I > cannot find an implementation. For context my form of Matrix does not have > a requirement to be of integers, it is just a 2-Dimensional array in > essence. Thank you in advance for any help you may provide :) > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From icfp.publicity at googlemail.com Tue Feb 9 06:09:58 2016 From: icfp.publicity at googlemail.com (Lindsey Kuper) Date: Mon, 8 Feb 2016 22:09:58 -0800 Subject: [Haskell-cafe] ICFP 2016 Second Call for Papers Message-ID: ICFP 2016 The 21st ACM SIGPLAN International Conference on Functional Programming http://conf.researchr.org/home/icfp-2016 Second Call for Papers Important dates --------------- Submissions due: Wednesday, March 16 2016, 15:00 (UTC) https://icfp2016.hotcrp.com (now open) Author response: Monday, 2 May, 2016, 15:00 (UTC) - Thursday, 5 May, 2016, 15:00 (UTC) Notification: Friday, 20 May, 2016 Final copy due: TBA Early registration: TBA Conference: Monday, 19 September - Wednesday, 21 September, 2016 (note updated conference dates) Scope ----- ICFP 2016 seeks original papers on the art and science of functional programming. Submissions are invited on all topics from principles to practice, from foundations to features, and from abstraction to application. The scope includes all languages that encourage functional programming, including both purely applicative and imperative languages, as well as languages with objects, concurrency, or parallelism. Topics of interest include (but are not limited to): - Language Design: concurrency, parallelism, and distribution; modules; components and composition; metaprogramming; type systems; interoperability; domain-specific languages; and relations to imperative, object-oriented, or logic programming. - Implementation: abstract machines; virtual machines; interpretation; compilation; compile-time and run-time optimization; garbage collection and memory management; multi-threading; exploiting parallel hardware; interfaces to foreign functions, services, components, or low-level machine resources. - Software-Development Techniques: algorithms and data structures; design patterns; specification; verification; validation; proof assistants; debugging; testing; tracing; profiling. - Foundations: formal semantics; lambda calculus; rewriting; type theory; monads; continuations; control; state; effects; program verification; dependent types. - Analysis and Transformation: control-flow; data-flow; abstract interpretation; partial evaluation; program calculation. - Applications: symbolic computing; formal-methods tools; artificial intelligence; systems programming; distributed-systems and web programming; hardware design; databases; XML processing; scientific and numerical computing; graphical user interfaces; multimedia and 3D graphics programming; scripting; system administration; security. - Education: teaching introductory programming; parallel programming; mathematical proof; algebra. - Functional Pearls: elegant, instructive, and fun essays on functional programming. - Experience Reports: short papers that provide evidence that functional programming really works or describe obstacles that have kept it from working. If you are concerned about the appropriateness of some topic, do not hesitate to contact the program chair. Abbreviated instructions for authors ------------------------------------ - By Wednesday, March 16 2016, 15:00 (UTC), submit a full paper of at most 12 pages (6 pages for an Experience Report), in standard SIGPLAN conference format, including figures but ***excluding bibliography***. The deadlines will be strictly enforced and papers exceeding the page limits will be summarily rejected. ***ICFP 2016 will employ a lightweight double-blind reviewing process.*** To facilitate this, submitted papers must adhere to two rules: 1. ***author names and institutions must be omitted***, and 2. ***references to authors' own related work should be in the third person*** (e.g., not "We build on our previous work ..." but rather "We build on the work of ..."). The purpose of this process is to help the PC and external reviewers come to an initial judgement about the paper without bias, not to make it impossible for them to discover the authors if they were to try. Nothing should be done in the name of anonymity that weakens the submission or makes the job of reviewing the paper more difficult (e.g., important background references should not be omitted or anonymized). In addition, authors should feel free to disseminate their ideas or draft versions of their paper as they normally would. For instance, authors may post drafts of their papers on the web or give talks on their research ideas. We have put together a document answering frequently asked questions that should address many common concerns: http://conf.researchr.org/track/icfp-2016/icfp-2016-papers#Submission-and-Reviewing-FAQ (last updated February 8, 2016). - Authors have the option to attach supplementary material to a submission, on the understanding that reviewers may choose not to look at it. The material should be uploaded at submission time, as a single pdf or a tarball, not via a URL. This supplementary material may or may not be anonymized; if not anonymized, it will only be revealed to reviewers after they have submitted their review of your paper and learned your identity. - Each submission must adhere to SIGPLAN's republication policy, as explained on the web at: http://www.sigplan.org/Resources/Policies/Republication - Authors of resubmitted (but previously rejected) papers have the option to attach an annotated copy of the reviews of their previous submission(s), explaining how they have addressed these previous reviews in the present submission. If a reviewer identifies him/herself as a reviewer of this previous submission and wishes to see how his/her comments have been addressed, the program chair will communicate to this reviewer the annotated copy of his/her previous review. Otherwise, no reviewer will read the annotated copies of the previous reviews. Overall, a submission will be evaluated according to its relevance, correctness, significance, originality, and clarity. It should explain its contributions in both general and technical terms, clearly identifying what has been accomplished, explaining why it is significant, and comparing it with previous work. The technical content should be accessible to a broad audience. Functional Pearls and Experience Reports are separate categories of papers that need not report original research results and must be marked as such at the time of submission. Detailed guidelines on both categories are given below. Presentations will be videotaped and released online if the presenter consents. The proceedings will be freely available for download from the ACM Digital Library from at least one week before the start of the conference until two weeks after the conference. Formatting: Submissions must be in PDF format printable in black and white on US Letter sized paper and interpretable by Ghostscript. Papers must adhere to the standard SIGPLAN conference format: two columns, nine-point font on a ten-point baseline, with columns 20pc (3.33in) wide and 54pc (9in) tall, with a column gutter of 2pc (0.33in). A suitable document template for LaTeX is available at http://www.sigplan.org/Resources/Author/ Submission: Submissions will be accepted at https://icfp2016.hotcrp.com. Improved versions of a paper may be submitted at any point before the submission deadline using the same web interface. Author response: Authors will have a 72-hour period, starting at 15:00 UTC on Monday, 2 May, 2016, to read reviews and respond to them. ACM Author-Izer is a unique service that enables ACM authors to generate and post links on either their home page or institutional repository for visitors to download the definitive version of their articles from the ACM Digital Library at no charge. Downloads through Author-Izer links are captured in official ACM statistics, improving the accuracy of usage and impact measurements. Consistently linking the definitive version of ACM article should reduce user confusion over article versioning. After your article has been published and assigned to your ACM Author Profile page, please visit http://www.acm.org/publications/acm-author-izer-service to learn how to create your links for free downloads from the ACM DL. AUTHORS TAKE NOTE: The official publication date is the date the proceedings are made available in the ACM Digital Library. This date may be up to two weeks prior to the first day of your conference. The official publication date affects the deadline for any patent filings related to published work. Special categories of papers ---------------------------- In addition to research papers, ICFP solicits two kinds of papers that do not require original research contributions: Functional Pearls, which are full papers, and Experience Reports, which are limited to six pages. Authors submitting such papers may wish to consider the following advice. Functional Pearls ================= A Functional Pearl is an elegant essay about something related to functional programming. Examples include, but are not limited to: - a new and thought-provoking way of looking at an old idea - an instructive example of program calculation or proof - a nifty presentation of an old or new data structure - an interesting application of functional programming techniques - a novel use or exposition of functional programming in the classroom While pearls often demonstrate an idea through the development of a short program, there is no requirement or expectation that they do so. Thus, they encompass the notions of theoretical and educational pearls. Functional Pearls are valued as highly and judged as rigorously as ordinary papers, but using somewhat different criteria. In particular, a pearl is not required to report original research, but, it should be concise, instructive, and entertaining. Your pearl is likely to be rejected if your readers get bored, if the material gets too complicated, if too much specialized knowledge is needed, or if the writing is inelegant. The key to writing a good pearl is polishing. A submission you wish to have treated as a pearl must be marked as such on the submission web page, and should contain the words ``Functional Pearl'' somewhere in its title or subtitle. These steps will alert reviewers to use the appropriate evaluation criteria. Pearls will be combined with ordinary papers, however, for the purpose of computing the conference's acceptance rate. Experience Reports ================== The purpose of an Experience Report is to help create a body of published, refereed, citable evidence that functional programming really works ? or to describe what obstacles prevent it from working. Possible topics for an Experience Report include, but are not limited to: - insights gained from real-world projects using functional programming - comparison of functional programming with conventional programming in the context of an industrial project or a university curriculum - project-management, business, or legal issues encountered when using functional programming in a real-world project - curricular issues encountered when using functional programming in education - real-world constraints that created special challenges for an implementation of a functional language or for functional programming in general An Experience Report is distinguished from a normal ICFP paper by its title, by its length, and by the criteria used to evaluate it. - Both in the proceedings and in any citations, the title of each accepted Experience Report must begin with the words ``Experience Report'' followed by a colon. The acceptance rate for Experience Reports will be computed and reported separately from the rate for ordinary papers. - An Experience Report is at most six pages long. Each accepted Experience Report will be presented at the conference, but depending on the number of Experience Reports and regular papers accepted, authors of Experience reports may be asked to give shorter talks. - Because the purpose of Experience Reports is to enable our community to accumulate a body of evidence about the efficacy of functional programming, an acceptable Experience Report need not add to the body of knowledge of the functional-programming community by presenting novel results or conclusions. It is sufficient if the Report states a clear thesis and provides supporting evidence. The thesis must be relevant to ICFP, but it need not be novel. The program committee will accept or reject Experience Reports based on whether they judge the evidence to be convincing. Anecdotal evidence will be acceptable provided it is well argued and the author explains what efforts were made to gather as much evidence as possible. Typically, more convincing evidence is obtained from papers which show how functional programming was used than from papers which only say that functional programming was used. The most convincing evidence often includes comparisons of situations before and after the introduction or discontinuation of functional programming. Evidence drawn from a single person's experience may be sufficient, but more weight will be given to evidence drawn from the experience of groups of people. An Experience Report should be short and to the point: make a claim about how well functional programming worked on your project and why, and produce evidence to substantiate your claim. If functional programming worked for you in the same ways it has worked for others, you need only to summarize the results?the main part of your paper should discuss how well it worked and in what context. Most readers will not want to know all the details of your project and its implementation, but please characterize your project and its context well enough so that readers can judge to what degree your experience is relevant to their own projects. Be especially careful to highlight any unusual aspects of your project. Also keep in mind that specifics about your project are more valuable than generalities about functional programming; for example, it is more valuable to say that your team delivered its software a month ahead of schedule than it is to say that functional programming made your team more productive. If your paper not only describes experience but also presents new technical results, or if your experience refutes cherished beliefs of the functional-programming community, you may be better off submitting it as a full paper, which will be judged by the usual criteria of novelty, originality, and relevance. If you are unsure in which category to submit, the program chair will be happy to help you decide. Organizers ---------- General Co-Chairs: Jacques Garrigue (Nagoya University) Gabriele Keller (University of New South Wales) Program Chair: Eijiro Sumii (Tohoku University) Program Committee: Koen Claessen (Chalmers University of Technology) Joshua Dunfield (University of British Columbia, Canada) Matthew Fluet (Rochester Institute of Technology) Nate Foster (Cornell University) Dan Grossman (University of Washington, USA) Jurriaan Hage (Utrecht University) Roman Leshchinskiy (Standard Chartered Bank) Keisuke Nakano (The University of Electro-Communications) Aleksandar Nanevski (IMDEA Software Institute) Scott Owens (University of Kent) Sungwoo Park (Pohang University of Science and Technology) Amr Sabry (Indiana University) Tom Schrijvers (KU Leuven) Olin Shivers (Northeastern University) Walid Taha (Halmstad University) Dimitrios Vytiniotis (Microsoft Research, Cambridge) David Walker (Princeton University) Nobuko Yoshida (Imperial College London, UK) External Review Committee: See http://conf.researchr.org/committee/icfp-2016/icfp-2016-papers-external-review-committee. From tkoster at gmail.com Tue Feb 9 06:20:06 2016 From: tkoster at gmail.com (Thomas Koster) Date: Tue, 9 Feb 2016 17:20:06 +1100 Subject: [Haskell-cafe] Combining ST with STM In-Reply-To: References: Message-ID: On 9 February 2016 at 14:43, Thomas Koster wrote: > I have an STM transaction that needs some private, temporary state. > The most obvious way is to simply pass pure state as arguments, but > for efficiency, I would like this state to be some kind of mutable > array, like STArray. > > I know, STM has TVars and TArray, but since this state is private to > the transaction, I am wondering if using TVars/TArrays for private > state might be overkill that will unnecessarily slow down the STM > commit process. The private state is, by definition, not shared, so > including it in the STM log and commit process is, as far as I can > tell, pointless. > > ST and STArray still appear to be the most appropriate tools for the > private state, because STRefs and STArrays really, really are private. > > So this basically means I want to interleave ST and STM in a "safe" > way. That is, if the STM transaction retries, I want the ST state to > be vaporised as well. > > Ideally, I would love to be able to say something like this: > > -- | Copy the value from the shared TVar into the private STRef. > load :: TVar a -> STRef a -> STSTM s () > load shared private = do > value <- liftSTM (readTVar shared) > liftST (writeSTRef private value) > > Naturally, that STRef must originate from a call to newSTRef earlier > in the same transaction and is private to it, just like the real ST > monad. As far as I can tell, I am not trying to weaken either ST or > STM in any way here. > > I found the STMonadTrans package on Hackage [1] that claims to > implement ST as a monad transformer, STT, which sounds close to what I > want. While its documentation does not mention STM, it does say that > some monads are unsafe to use as a base monad for STT. > > Is STMonadTrans safe to use with STM? > > [1] https://hackage.haskell.org/package/STMonadTrans On 9 February 2016 at 15:16, Ryan Yates wrote: > I also have found need for what I think you are describing but only in the > context of transactional arrays where there are multiple fields to > initialize while I know that the array is private to the creating thread. > For now I'm adding the primitives I need as I go, but I would like to have > better safer story. You might be interested in how the stm-containers > package uses ST to build internal nodes in transactions [1], [2]. > > [1]: > https://github.com/nikita-volkov/stm-containers/blob/master/library/STMContainers/HAMT/Nodes.hs#L36 > [2]: > https://github.com/nikita-volkov/stm-containers/blob/master/library/STMContainers/WordArray.hs#L118 Thank you Ryan. Indeed, it is by experimenting with stm-containers that the need for mixing ST and STM arose. Where the previous iteration of my program used plain ST transactions serialized with an MVar, I am experimenting with stm-containers with the hope that I will see improved throughput for transactions that do not overlap, which, I believe, could complete in parallel, at least some of the time. It seems stm-containers itself uses unsafeFreezeArray from the "primitive" package. One difference though is that while my private array would be thawed, modified and refrozen regularly, the stm-containers WordArray stays immutable (not thawed) once frozen, as far as I can tell. Since I am using only a single array for the entire private state, sprinkling some runST calls with unsafeThawArray/unsafeFreezeArray in my STM transaction may be enough for my needs, as long as I am exceptionally careful not to leak one of these arrays into or out of any STM transaction demarcated by the "atomically" block. If anybody knows of any reason why I should abort this idea, please speak up. I noticed also that Data.Array.Unsafe in base also has unsafe freezing and thawing. Is there a reason to use one over the other? -- Thomas Koster From anselm.scholl at tu-harburg.de Tue Feb 9 08:36:26 2016 From: anselm.scholl at tu-harburg.de (Jonas Scholl) Date: Tue, 9 Feb 2016 09:36:26 +0100 Subject: [Haskell-cafe] Combining ST with STM In-Reply-To: References: Message-ID: <56B9A50A.1090601@tu-harburg.de> On 02/09/2016 07:20 AM, Thomas Koster wrote: > On 9 February 2016 at 14:43, Thomas Koster wrote: >> I have an STM transaction that needs some private, temporary state. >> The most obvious way is to simply pass pure state as arguments, but >> for efficiency, I would like this state to be some kind of mutable >> array, like STArray. This sounds like optimizing before you know what is really slow, complicating your code for no good reason... >> >> I know, STM has TVars and TArray, but since this state is private to >> the transaction, I am wondering if using TVars/TArrays for private >> state might be overkill that will unnecessarily slow down the STM >> commit process. The private state is, by definition, not shared, so >> including it in the STM log and commit process is, as far as I can >> tell, pointless. The STM log allows you to revert a failed transaction. If you do not record your writes to an array, you can not revert them and they can leak outside an aborted transaction. >> >> ST and STArray still appear to be the most appropriate tools for the >> private state, because STRefs and STArrays really, really are private. >> >> So this basically means I want to interleave ST and STM in a "safe" >> way. That is, if the STM transaction retries, I want the ST state to >> be vaporised as well. So how should this work? Some log recording what you did would be good, so the runtime knows which changes you did to the array... If you however create the array in the same transaction, this would work by just throwing away the whole array. >> >> Ideally, I would love to be able to say something like this: >> >> -- | Copy the value from the shared TVar into the private STRef. >> load :: TVar a -> STRef a -> STSTM s () >> load shared private = do >> value <- liftSTM (readTVar shared) >> liftST (writeSTRef private value) >> >> Naturally, that STRef must originate from a call to newSTRef earlier >> in the same transaction and is private to it, just like the real ST >> monad. As far as I can tell, I am not trying to weaken either ST or >> STM in any way here. >> >> I found the STMonadTrans package on Hackage [1] that claims to >> implement ST as a monad transformer, STT, which sounds close to what I >> want. While its documentation does not mention STM, it does say that >> some monads are unsafe to use as a base monad for STT. >> >> Is STMonadTrans safe to use with STM? It is not even safe to use with Maybe (for now), as it can share different STRefs and STArrays. I filed a bug report. After the bug is fixed, I see no reason, why it should not work with STM, as the complete ST action should be repeated if the STM transaction aborts. >> >> [1] https://hackage.haskell.org/package/STMonadTrans > > On 9 February 2016 at 15:16, Ryan Yates wrote: >> I also have found need for what I think you are describing but only in the >> context of transactional arrays where there are multiple fields to >> initialize while I know that the array is private to the creating thread. >> For now I'm adding the primitives I need as I go, but I would like to have >> better safer story. You might be interested in how the stm-containers >> package uses ST to build internal nodes in transactions [1], [2]. >> >> [1]: >> https://github.com/nikita-volkov/stm-containers/blob/master/library/STMContainers/HAMT/Nodes.hs#L36 >> [2]: >> https://github.com/nikita-volkov/stm-containers/blob/master/library/STMContainers/WordArray.hs#L118 > > Thank you Ryan. > > Indeed, it is by experimenting with stm-containers that the need for > mixing ST and STM arose. Where the previous iteration of my program > used plain ST transactions serialized with an MVar, I am experimenting > with stm-containers with the hope that I will see improved throughput > for transactions that do not overlap, which, I believe, could complete > in parallel, at least some of the time. > > It seems stm-containers itself uses unsafeFreezeArray from the > "primitive" package. One difference though is that while my private > array would be thawed, modified and refrozen regularly, the > stm-containers WordArray stays immutable (not thawed) once frozen, as > far as I can tell. So what happens if you thaw an array, write to it and then abort the transaction? You have to revert the writes because they could be visible to the transaction you just aborted. When this transaction restarts, the array will still contain the values written prior to it. Even if nothing else contains a reference to it, your array is garbage after you aborted a transaction only once. > > Since I am using only a single array for the entire private state, > sprinkling some runST calls with unsafeThawArray/unsafeFreezeArray in > my STM transaction may be enough for my needs, as long as I am > exceptionally careful not to leak one of these arrays into or out of > any STM transaction demarcated by the "atomically" block. If anybody > knows of any reason why I should abort this idea, please speak up. Keep in mind that ST is only "safe IO" in a sense such that no side effects are visible to the outside. You lose this if you start to modify anything which you did not create yourself. I think this is not that different from using http://hackage.haskell.org/package/base-4.8.2.0/docs/GHC-Conc-Sync.html#v:unsafeIOToSTM. To be safe, you should at least copy the arrays instead of unsafely thawing them... but then it could be faster just to use TArrays from the start. > > I noticed also that Data.Array.Unsafe in base also has unsafe freezing > and thawing. Is there a reason to use one over the other? > > -- > Thomas Koster > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 473 bytes Desc: OpenPGP digital signature URL: From nicola.gigante at gmail.com Tue Feb 9 08:59:37 2016 From: nicola.gigante at gmail.com (Nicola Gigante) Date: Tue, 9 Feb 2016 09:59:37 +0100 Subject: [Haskell-cafe] ANNOUNCE: hoppy, qtah In-Reply-To: <20160208101136.13365424@khumba.net> References: <20160208101136.13365424@khumba.net> Message-ID: <0D66E65E-9053-48E2-B8DF-A240367672B0@gmail.com> > Il giorno 08 feb 2016, alle ore 19:11, Bryan Gardiner ha scritto: > > Are you sick and tired of the ease with which Haskell code flows onto > the page? Even the thrill of binding to a C library losing its > lustre? Look no further! I present to you a tool restoring the good > old days of pointer arithmetic, manual memory management, and hours > lost to the debugger: > > Hoppy is a new C++ FFI generator for Haskell. It takes Haskell code > that describes a C++ API, and generates C++ and Haskell code to allow > the two languages to interact. It supports a good subset of C++, > including functions, classes, variables, enums and bitflags, operator > overloading, constness, and simple templates. Adding a function takes > only a few lines of code, and you normally don't need to write C++ > yourself. For example, a definition for std::string is: > > c_string :: Class > c_string = > addReqIncludes [includeStd "string"] $ > classAddFeatures [Assignable, Comparable, Copyable, Equatable] $ > makeClass (ident1 "std" "string") (Just $ toExtName "StdString") [] > [ mkCtor "new" [] > , mkCtor "newFromCString" [TPtr $ TConst TChar] > ] > [ mkConstMethod' "at" "at" [TInt] $ TRef TChar > , mkConstMethod' "at" "get" [TInt] TChar > , mkConstMethod "c_str" [] $ TPtr $ TConst TChar > , mkConstMethod "size" [] TSize > , mkConstMethod OpAdd [TObj c_string] $ TObj c_string > ] > > Now, writing a FFI generator isn't much fun unless you have a project > to use it with. So I am pleased to also announce Qtah, a fresh set of > Qt 4/5 bindings. These include portions of QtCore, QtGui, and > QtWidgets, and are on the whole wildly incomplete, but are usable for > basic tasks so far, and I am working on extending coverage. > > (On qtHaskell/hsQt: I started Qtah before qtHaskell began being > updated in 2015 and I missed when that happened. My hope is that Qtah > requires less code and effort to maintain; at least, qtHaskell > contains a lot of generated code and I haven't seen where it came > from, so please correct me if the generator is in fact available > somewhere. Hoppy also doesn't (currently) do many of the fancy things > that qtHaskell does, like overloading and garbage collection.) > > Both Hoppy and Qtah are young, and I am very interested in discussing > how to make them most useful for the community. Because of questions > such as this[1], their APIs (including those of generated bindings) > should be considered experimental at this time. > > I will be uploading Hoppy to Hackage shortly. Becuase Qtah includes a > shared library, I haven't figured out how to get that on Hackage yet, > so you'll have to clone the repo yourself. > > http://khumba.net/projects/hoppy > > http://khumba.net/projects/qtah > > Happy hacking! > That?s wonderful! A couple of questions: - Do you think it would fit well to provide a monadic interface to construct a clean and readable DSL on top of your functions? - What is the definition of ?simple? template? Good job! > Bryan Gardiner Regards, Nicola From marcin.jan.mrotek at gmail.com Tue Feb 9 09:15:47 2016 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Tue, 9 Feb 2016 10:15:47 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56B9338B.4070102@cs.otago.ac.nz> References: <56B4CA58.4050101@htwk-leipzig.de> <56B9338B.4070102@cs.otago.ac.nz> Message-ID: > > I can agree that for a functional language, being able to apply any > reasonable > function to any reasonable matching argument has to be doable, but such a > fundamental operation surely needs to be simple to describe? > But it is already rather simple conceptually, it's just that Haskell's kind signature syntax makes it look hairy. I mean, if you squint enough, this: ($) :: forall (r :: RuntimeRep) (a :: *) (b :: TYPE r). (a -> b) -> a -> b could be written like: ($) :: RuntimeRep r => (a :: TYPE Lifted) (b :: TYPE r). (a -> b) -> a -> b or like I've previously suggested (if * is the default kind and wildcards are allowed in kinds): ($) :: forall a (b :: TYPE _). (a -> b) -> a -> b I mean, perhaps the syntax could be improved, but the information that: * a is lifted and boxed * b can have any kind that has a runtime representation (so unlifted and unboxed types are ok, but data kinds are not) has to go somewhere if the ability to write levity-polymorphic functions is to be given to the user, rather than only available as a one-off hack in the compiler. Perhaps going fully dependently typed and giving up on the distinction between values and types would change that; I'm not sure how for example Idris would handle levity polymorphism. Best regards, Marcin Mrotek -------------- next part -------------- An HTML attachment was scrubbed... URL: From f at mazzo.li Tue Feb 9 10:19:35 2016 From: f at mazzo.li (Francesco Mazzoli) Date: Tue, 9 Feb 2016 11:19:35 +0100 Subject: [Haskell-cafe] PSA: If you're serializing floating point numbers, don't use binary Message-ID: Serialization of floating point numbers with binary is fantastically slow and incorrect if you?re using NaNs, see https://github.com/kolmodin/binary/issues/64 https://github.com/kolmodin/binary/issues/69 I recently spent half a day debugging performance problems because of this, and since backwards compatibility with older formats is required, this problem is probably not going to be solved. We decided to switch to cereal for this reason. With some patches cereal was 30x faster for the data we were serializing (scientific computing, mostly Doubles packed in nested records containing vectors). The size of the serialized data is also roughly 3 times smaller ? with binary a Double takes at least 25 bytes of space instead of 8. With Float it?s even worse, 25 bytes instead of 8. -------------- next part -------------- An HTML attachment was scrubbed... URL: From tomn at beautifuldestinations.com Tue Feb 9 10:40:25 2016 From: tomn at beautifuldestinations.com (Tom Nielsen) Date: Tue, 9 Feb 2016 10:40:25 +0000 Subject: [Haskell-cafe] PSA: If you're serializing floating point numbers, don't use binary In-Reply-To: References: Message-ID: I unsafeCoerce to Word64 first. This usually helps in making the output compatible with non-Haskell applications and is much faster. Tom On Tue, Feb 9, 2016 at 10:19 AM, Francesco Mazzoli wrote: > Serialization of floating point numbers with binary is fantastically slow > and incorrect if you?re using NaNs, see > > - https://github.com/kolmodin/binary/issues/64 > - https://github.com/kolmodin/binary/issues/69 > > I recently spent half a day debugging performance problems because of > this, and since backwards compatibility with older formats is required, > this problem is probably not going to be solved. > > We decided to switch to cereal for this reason. With some patches > cereal was 30x faster for > the data we were serializing (scientific computing, mostly Doubles packed > in nested records containing vectors). > > The size of the serialized data is also roughly 3 times smaller ? with > binary a Double takes at least 25 bytes of space instead of 8. With Float it?s > even worse, 25 bytes instead of 8. > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -- *Tom Nielsen | Chief Data Science Officer * Soho works | Tea building | 56 Shoreditch High St | London E1 6JJ +44 7961 270 416 *Beautiful Destinations | The world?s largest travel influencer on Instagram* Destinations | Hotels | Cuisines | Matters www.beautifuldestinations.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From f at mazzo.li Tue Feb 9 10:46:07 2016 From: f at mazzo.li (Francesco Mazzoli) Date: Tue, 9 Feb 2016 11:46:07 +0100 Subject: [Haskell-cafe] PSA: If you're serializing floating point numbers, don't use binary In-Reply-To: References: Message-ID: `cereal` and `bytestring` `Builder` work by encoding to a big-endian `Word64`. A bit more expensive than a blind `unsafeCoerce`, but same idea. Francesco > On 9 Feb 2016, at 11:40, Tom Nielsen wrote: > > I unsafeCoerce to Word64 first. This usually helps in making the output compatible with non-Haskell applications and is much faster. > > Tom > > On Tue, Feb 9, 2016 at 10:19 AM, Francesco Mazzoli > wrote: > Serialization of floating point numbers with binary is fantastically slow and incorrect if you?re using NaNs, see > > https://github.com/kolmodin/binary/issues/64 > https://github.com/kolmodin/binary/issues/69 > I recently spent half a day debugging performance problems because of this, and since backwards compatibility with older formats is required, this problem is probably not going to be solved. > > We decided to switch to cereal for this reason. With some patches cereal was 30x faster for the data we were serializing (scientific computing, mostly Doubles packed in nested records containing vectors). > > The size of the serialized data is also roughly 3 times smaller ? with binary a Double takes at least 25 bytes of space instead of 8. With Float it?s even worse, 25 bytes instead of 8. > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > > > -- > Tom Nielsen | Chief Data Science Officer > Soho works | Tea building | 56 Shoreditch High St | London E1 6JJ > +44 7961 270 416 > > Beautiful Destinations | The world?s largest travel influencer on Instagram > Destinations | Hotels | Cuisines | Matters > www.beautifuldestinations.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From robstewart57 at gmail.com Tue Feb 9 11:25:41 2016 From: robstewart57 at gmail.com (Rob Stewart) Date: Tue, 9 Feb 2016 11:25:41 +0000 Subject: [Haskell-cafe] maps over arrays that provide the position index for the array and accelerate libraries? Message-ID: In vector library there's this useful function: imap :: (Int -> a -> b) -> Vector a -> Vector b And in Data.Map there's this similar function: mapWithKey :: (k -> a -> b) -> Map k a -> Map k b I'm looking for something similar in the array and accelerate libraries, i.e. On arrays in Data.Array.IArray: imap :: (IArray a e, IArray a e', Ix i) => (i -> e -> e') -> a i e -> a i e' And on Accelerate arrays: imap :: (Shape ix, Elt a, Elt b) => (Exp ix -> Exp a -> Exp b) -> Acc (Array ix a) -> Acc (Array ix b) Is anyone aware of such map implementations for arrays in the array and accelerate libraries, that provide your mapped function not only the element at a position, but also the index at that position? Thanks, -- Rob From _deepfire at feelingofgreen.ru Tue Feb 9 11:27:44 2016 From: _deepfire at feelingofgreen.ru (Kosyrev Serge) Date: Tue, 09 Feb 2016 14:27:44 +0300 Subject: [Haskell-cafe] Language complexity & beginners In-Reply-To: <56B93417.5090904@orlitzky.com> (Michael Orlitzky's message of "Mon, 8 Feb 2016 19:34:31 -0500") References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B7E475.5040001@orlitzky.com> <56B92A9C.4090608@cs.otago.ac.nz> <56B93417.5090904@orlitzky.com> Message-ID: <877fieqg27.fsf@feelingofgreen.ru> Michael Orlitzky writes: > Most uses of "$" are for stupid > things like "sin $ 1 + 2" where parentheses would be much more clear. "$" simplifies visual perception through two factors: 1. we are relieved from counting parentheses 2. it serves as a cue to treat the entire remaining part until ")" as part of the same expression Case in point (only slightly contrived) -- which one is easier to visually parse to you: foo (thInt $ fromIntegral $ c2hsValueInt cexp) (thInt $ fromIntegral $ c2hsValueInt cexp) foo (thInt (fromIntegral (c2hsValueInt cexp))) (thInt (fromIntegral (c2hsValueInt cexp))) Me, I get a blood pressure spike roughy here ---^ -- ? ???????e? / respectfully, ??????? ?????? From agocorona at gmail.com Tue Feb 9 11:29:20 2016 From: agocorona at gmail.com (Alberto G. Corona ) Date: Tue, 9 Feb 2016 12:29:20 +0100 Subject: [Haskell-cafe] Combining ST with STM In-Reply-To: <56B9A50A.1090601@tu-harburg.de> References: <56B9A50A.1090601@tu-harburg.de> Message-ID: Why not use the state monad transformer? http://hackage.haskell.org/package/transformers-0.5.1.0/docs/Control-Monad-Trans-State-Lazy.html#t:StateT atomically $ evalStateT todo initialState Seems Ok to me evalStateT :: Monad m => StateT s m a -> s -> m a in this case: evalStateT :: StateT MyState STM a -> MyState -> STM a 2016-02-09 9:36 GMT+01:00 Jonas Scholl : > On 02/09/2016 07:20 AM, Thomas Koster wrote: > > On 9 February 2016 at 14:43, Thomas Koster wrote: > >> I have an STM transaction that needs some private, temporary state. > >> The most obvious way is to simply pass pure state as arguments, but > >> for efficiency, I would like this state to be some kind of mutable > >> array, like STArray. > > This sounds like optimizing before you know what is really slow, > complicating your code for no good reason... > > >> > >> I know, STM has TVars and TArray, but since this state is private to > >> the transaction, I am wondering if using TVars/TArrays for private > >> state might be overkill that will unnecessarily slow down the STM > >> commit process. The private state is, by definition, not shared, so > >> including it in the STM log and commit process is, as far as I can > >> tell, pointless. > > The STM log allows you to revert a failed transaction. If you do not > record your writes to an array, you can not revert them and they can > leak outside an aborted transaction. > > >> > >> ST and STArray still appear to be the most appropriate tools for the > >> private state, because STRefs and STArrays really, really are private. > >> > >> So this basically means I want to interleave ST and STM in a "safe" > >> way. That is, if the STM transaction retries, I want the ST state to > >> be vaporised as well. > > So how should this work? Some log recording what you did would be good, > so the runtime knows which changes you did to the array... If you > however create the array in the same transaction, this would work by > just throwing away the whole array. > > >> > >> Ideally, I would love to be able to say something like this: > >> > >> -- | Copy the value from the shared TVar into the private STRef. > >> load :: TVar a -> STRef a -> STSTM s () > >> load shared private = do > >> value <- liftSTM (readTVar shared) > >> liftST (writeSTRef private value) > >> > >> Naturally, that STRef must originate from a call to newSTRef earlier > >> in the same transaction and is private to it, just like the real ST > >> monad. As far as I can tell, I am not trying to weaken either ST or > >> STM in any way here. > >> > >> I found the STMonadTrans package on Hackage [1] that claims to > >> implement ST as a monad transformer, STT, which sounds close to what I > >> want. While its documentation does not mention STM, it does say that > >> some monads are unsafe to use as a base monad for STT. > >> > >> Is STMonadTrans safe to use with STM? > > It is not even safe to use with Maybe (for now), as it can share > different STRefs and STArrays. I filed a bug report. After the bug is > fixed, I see no reason, why it should not work with STM, as the complete > ST action should be repeated if the STM transaction aborts. > > >> > >> [1] https://hackage.haskell.org/package/STMonadTrans > > > > On 9 February 2016 at 15:16, Ryan Yates wrote: > >> I also have found need for what I think you are describing but only in > the > >> context of transactional arrays where there are multiple fields to > >> initialize while I know that the array is private to the creating > thread. > >> For now I'm adding the primitives I need as I go, but I would like to > have > >> better safer story. You might be interested in how the stm-containers > >> package uses ST to build internal nodes in transactions [1], [2]. > >> > >> [1]: > >> > https://github.com/nikita-volkov/stm-containers/blob/master/library/STMContainers/HAMT/Nodes.hs#L36 > >> [2]: > >> > https://github.com/nikita-volkov/stm-containers/blob/master/library/STMContainers/WordArray.hs#L118 > > > > Thank you Ryan. > > > > Indeed, it is by experimenting with stm-containers that the need for > > mixing ST and STM arose. Where the previous iteration of my program > > used plain ST transactions serialized with an MVar, I am experimenting > > with stm-containers with the hope that I will see improved throughput > > for transactions that do not overlap, which, I believe, could complete > > in parallel, at least some of the time. > > > > It seems stm-containers itself uses unsafeFreezeArray from the > > "primitive" package. One difference though is that while my private > > array would be thawed, modified and refrozen regularly, the > > stm-containers WordArray stays immutable (not thawed) once frozen, as > > far as I can tell. > > So what happens if you thaw an array, write to it and then abort the > transaction? You have to revert the writes because they could be visible > to the transaction you just aborted. When this transaction restarts, the > array will still contain the values written prior to it. Even if nothing > else contains a reference to it, your array is garbage after you aborted > a transaction only once. > > > > > Since I am using only a single array for the entire private state, > > sprinkling some runST calls with unsafeThawArray/unsafeFreezeArray in > > my STM transaction may be enough for my needs, as long as I am > > exceptionally careful not to leak one of these arrays into or out of > > any STM transaction demarcated by the "atomically" block. If anybody > > knows of any reason why I should abort this idea, please speak up. > > Keep in mind that ST is only "safe IO" in a sense such that no side > effects are visible to the outside. You lose this if you start to modify > anything which you did not create yourself. I think this is not that > different from using > > http://hackage.haskell.org/package/base-4.8.2.0/docs/GHC-Conc-Sync.html#v:unsafeIOToSTM > . > To be safe, you should at least copy the arrays instead of unsafely > thawing them... but then it could be faster just to use TArrays from the > start. > > > > > I noticed also that Data.Array.Unsafe in base also has unsafe freezing > > and thawing. Is there a reason to use one over the other? > > > > -- > > Thomas Koster > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -- Alberto. -------------- next part -------------- An HTML attachment was scrubbed... URL: From heraldhoi at gmail.com Tue Feb 9 11:48:59 2016 From: heraldhoi at gmail.com (Geraldus) Date: Tue, 09 Feb 2016 11:48:59 +0000 Subject: [Haskell-cafe] Language complexity & beginners In-Reply-To: <877fieqg27.fsf@feelingofgreen.ru> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B7E475.5040001@orlitzky.com> <56B92A9C.4090608@cs.otago.ac.nz> <56B93417.5090904@orlitzky.com> <877fieqg27.fsf@feelingofgreen.ru> Message-ID: As for me, I don't like ubiquitous $ everywhere, often I prefer parentheses over $ (this might be due to my Elisp practices), and I like very much dot style. Most uses of "$" are for stupid things like "sin $ 1 + 2" where parentheses would be much more clear. Agree. "$" simplifies visual perception through two factors: I think this does not hold for every single person. 1. we are relieved from counting parentheses This is not big deal if your editor/IDE can highlight parentheses and even better provide commands to jump to opening/closing parenthesis. foo (thInt $ fromIntegral $ c2hsValueInt cexp) (thInt $ fromIntegral $ c2hsValueInt cexp) foo (thInt (fromIntegral (c2hsValueInt cexp))) (thInt (fromIntegral (c2hsValueInt cexp))) Me, I get a blood pressure spike roughy here ---^ Personally, I find hard to read expressions like: someFn $ someOtherFn $ more $ more $ val (someFn . someOtherFn . more . more $ val) seems better for me, but this is also good: someFn (someOtherFn (more (more val))) Parentheses annoys me only when I need to wrap something by parentheses in Emacs with electric-pairs-mode :D -------------- next part -------------- An HTML attachment was scrubbed... URL: From jo at durchholz.org Tue Feb 9 12:17:22 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Tue, 9 Feb 2016 13:17:22 +0100 Subject: [Haskell-cafe] Language complexity & beginners In-Reply-To: <877fieqg27.fsf@feelingofgreen.ru> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B7E475.5040001@orlitzky.com> <56B92A9C.4090608@cs.otago.ac.nz> <56B93417.5090904@orlitzky.com> <877fieqg27.fsf@feelingofgreen.ru> Message-ID: <56B9D8D2.6040304@durchholz.org> Am 09.02.2016 um 12:27 schrieb Kosyrev Serge: > Case in point (only slightly contrived) -- which one is easier to > visually parse to you: > > foo (thInt $ fromIntegral $ c2hsValueInt cexp) (thInt $ fromIntegral $ c2hsValueInt cexp) > > foo (thInt (fromIntegral (c2hsValueInt cexp))) (thInt (fromIntegral (c2hsValueInt cexp))) You can always denest by naming subexpressions. e.g. let subexpr = thInt (fromIntegral (c2hsValueInt cexp))) in foo subexpr subexpr or let subexpr = (thInt . fromIntegral . c2hsValueInt) cexp in foo subexpr subexpr or let fn = thInt . fromIntegral . c2hsValueInt in foo (fn cexp) (fn cexp) I routinely do that kind of denesting as soon as a line goes beyond 72 characters. I have found that such code is usually far easier to read regardless of what I'm doing in the line. I think the problem is not that you cannot write readable code, it is that people do not use existing facilities for that. If that's correct, then adding another facility for the same purpose is unlikely to help. From tkoster at gmail.com Tue Feb 9 12:43:04 2016 From: tkoster at gmail.com (Thomas Koster) Date: Tue, 9 Feb 2016 23:43:04 +1100 Subject: [Haskell-cafe] Combining ST with STM In-Reply-To: <56B9A50A.1090601@tu-harburg.de> References: <56B9A50A.1090601@tu-harburg.de> Message-ID: Jonas, On 9 February 2016 at 14:43, Thomas Koster wrote: > I have an STM transaction that needs some private, temporary state. > The most obvious way is to simply pass pure state as arguments, but > for efficiency, I would like this state to be some kind of mutable > array, like STArray. On 9 February 2016 at 19:36, Jonas Scholl wrote: > This sounds like optimizing before you know what is really slow, > complicating your code for no good reason... >From my wording it sounded like I was "only thinking about it". This is not actually the case, sorry. Very early versions of my program did use a plain, immutable array (Vector actually), but now it uses STArray. The benefits to my program of ST are significant and proven by benchmarks. Switching to ST did not significantly complicate the program. By going back to immutable arrays and all that excessive copying and GC, I could easily wipe out the small benefits of any extra parallelism I might squeeze out of STM. If it turns out that what I want is impossible, I will keep ST, drop STM, and say that my program is single- threaded. What *is* unknown is the cost of replacing the STArrays with TArrays as proposed below. On 9 February 2016 at 14:43, Thomas Koster wrote: > I know, STM has TVars and TArray, but since this state is private to > the transaction, I am wondering if using TVars/TArrays for private > state might be overkill that will unnecessarily slow down the STM > commit process. The private state is, by definition, not shared, so > including it in the STM log and commit process is, as far as I can > tell, pointless. On 9 February 2016 at 19:36, Jonas Scholl wrote: > The STM log allows you to revert a failed transaction. If you do not > record your writes to an array, you can not revert them and they can > leak outside an aborted transaction. The array is not shared between transactions or threads; it is local to the transaction and is not referenced outside the transaction that created it. Sorry if this was not clear. Like ST state, it is created inside the transaction, invisible outside the transaction, and discarded whenever the transaction commits or retries. There is no need to revert it, ever. The closest thing to reverting it is to have the GC reclaim it. On 9 February 2016 at 14:43, Thomas Koster wrote: > ST and STArray still appear to be the most appropriate tools for the > private state, because STRefs and STArrays really, really are private. > > So this basically means I want to interleave ST and STM in a "safe" > way. That is, if the STM transaction retries, I want the ST state to > be vaporised as well. On 9 February 2016 at 19:36, Jonas Scholl wrote: > So how should this work? Some log recording what you did would be good, > so the runtime knows which changes you did to the array... If you > however create the array in the same transaction, this would work by > just throwing away the whole array. The array is indeed created in same transaction, for that transaction. Throwing away the whole array is exactly what *must* occur, just as it does with ordinary ST. Otherwise, as you say, the invariants of STM are violated. On 9 February 2016 at 14:43, Thomas Koster wrote: > Ideally, I would love to be able to say something like this: > > -- | Copy the value from the shared TVar into the private STRef. > load :: TVar a -> STRef a -> STSTM s () > load shared private = do > value <- liftSTM (readTVar shared) > liftST (writeSTRef private value) > > Naturally, that STRef must originate from a call to newSTRef earlier > in the same transaction and is private to it, just like the real ST > monad. As far as I can tell, I am not trying to weaken either ST or > STM in any way here. Please forgive the typo in the type signature of "load", which should have been: load :: TVar a -> STRef s a -> STSTM s () I will elaborate on this imagined STSTM monad in a separate reply, shortly. > I found the STMonadTrans package on Hackage [1] that claims to > implement ST as a monad transformer, STT, which sounds close to what I > want. While its documentation does not mention STM, it does say that > some monads are unsafe to use as a base monad for STT. > > Is STMonadTrans safe to use with STM? On 9 February 2016 at 19:36, Jonas Scholl wrote: > It is not even safe to use with Maybe (for now), as it can share > different STRefs and STArrays. I filed a bug report. After the bug is > fixed, I see no reason, why it should not work with STM, as the complete > ST action should be repeated if the STM transaction aborts. I see. Thank you for evaluating STMonadTrans. I will propose an implementation of the STSTM monad I mentioned above in a separate reply, and would be very grateful if you could evaluate the Core of that one too. On 9 February 2016 at 17:20, Thomas Koster wrote: > It seems stm-containers itself uses unsafeFreezeArray from the > "primitive" package. One difference though is that while my private > array would be thawed, modified and refrozen regularly, the > stm-containers WordArray stays immutable (not thawed) once frozen, as > far as I can tell. > > Since I am using only a single array for the entire private state, > sprinkling some runST calls with unsafeThawArray/unsafeFreezeArray in > my STM transaction may be enough for my needs, as long as I am > exceptionally careful not to leak one of these arrays into or out of > any STM transaction demarcated by the "atomically" block. If anybody > knows of any reason why I should abort this idea, please speak up. On 9 February 2016 at 19:36, Jonas Scholl wrote: > So what happens if you thaw an array, write to it and then abort the > transaction? You have to revert the writes because they could be visible > to the transaction you just aborted. When this transaction restarts, the > array will still contain the values written prior to it. Even if nothing > else contains a reference to it, your array is garbage after you aborted > a transaction only once. > > Keep in mind that ST is only "safe IO" in a sense such that no side > effects are visible to the outside. You lose this if you start to modify > anything which you did not create yourself. I think this is not that > different from using > http://hackage.haskell.org/package/base-4.8.2.0/docs/GHC-Conc-Sync.html#v:unsafeIOToSTM. > To be safe, you should at least copy the arrays instead of unsafely > thawing them... but then it could be faster just to use TArrays from the > start. No argument there, but as before, no revert is necessary because there are no references to the array outside of the STM transaction that created it (by abstinence, I concede, not by a ruling from the type checker as with ST). Having it collected immediately after a retry or commit is exactly what I want. The sooner the better! -- Thomas Koster From tkoster at gmail.com Tue Feb 9 12:46:36 2016 From: tkoster at gmail.com (Thomas Koster) Date: Tue, 9 Feb 2016 23:46:36 +1100 Subject: [Haskell-cafe] Combining ST with STM In-Reply-To: <56B9A50A.1090601@tu-harburg.de> References: <56B9A50A.1090601@tu-harburg.de> Message-ID: On 9 February 2016 at 14:43, Thomas Koster wrote: > I have an STM transaction that needs some private, temporary state. > The most obvious way is to simply pass pure state as arguments, but > for efficiency, I would like this state to be some kind of mutable > array, like STArray. > > The private state is, by definition, not shared, so > including it in the STM log and commit process is, as far as I can > tell, pointless. > > ST and STArray still appear to be the most appropriate tools for the > private state, because STRefs and STArrays really, really are private. > > So this basically means I want to interleave ST and STM in a "safe" > way. That is, if the STM transaction retries, I want the ST state to > be vaporised as well. > > Ideally, I would love to be able to say something like this: > > -- | Copy the value from the shared TVar into the private STRef. > load :: TVar a -> STRef a -> STSTM s () > load shared private = do > value <- liftSTM (readTVar shared) > liftST (writeSTRef private value) > > Naturally, that STRef must originate from a call to newSTRef earlier > in the same transaction and is private to it, just like the real ST > monad. As far as I can tell, I am not trying to weaken either ST or > STM in any way here. Please forgive the typo in the type signature of "load", which should have been: load :: TVar a -> STRef s a -> STSTM s () Let me elaborate on STSTM, a monad I made up for this example that combines the characteristics of ST and STM in the way that I want. If my requirements were unclear from my prose, perhaps the code below will illuminate them better. An STSTM transaction is intended to be an STM transaction imbued with a state token that encapsulates additional, transaction-local state in the spirit of ST. It is not intended to secretly perform IO inside STM, a la GHC.Conc.unsafeIOToSTM. It is not intended to facilitate the leaking of state into or out of an STM transaction through STRefs, nor to communicate state between successive retries of an STM transaction. Thanks to hints from Ryan and Jonas, I made an attempt at implementing it myself. Below is my implementation of STSTM and associated operations. You will need to link with the "primitive" and "stm" packages. I used versions 0.6 and 2.4.4, resp., and GHC 7.10.2. {-# LANGUAGE GeneralizedNewtypeDeriving, Rank2Types #-} module Control.Monad.STSTM ( STSTM, liftST, liftSTM, atomicallyRunST, module Control.Monad.STM ) where import Control.Monad.Primitive import Control.Monad.ST import Control.Monad.STM -- | A computation of type @STSTM s a@ is an 'STM' computation that -- also transforms a transaction-local internal state indexed by @s@, as -- in the 'ST' monad, and returns a value of type @a at . newtype STSTM s a = STSTM { unSTSTM :: STM a } deriving (Functor, Applicative, Monad) -- | Lift an 'ST' computation into the 'STSTM' transaction. liftST :: ST s a -> STSTM s a {-# INLINE liftST #-} liftST x = STSTM $ let y = unsafeInlineST x in y `seq` return y -- | Lift an 'STM' computation into the 'STSTM' transaction. liftSTM :: STM a -> STSTM s a {-# INLINE liftSTM #-} liftSTM = STSTM -- | Perform a series of 'STSTM' actions atomically. -- -- The 'ST' state is discarded when the 'STM' transaction commits or -- retries. atomicallyRunST :: (forall s. STSTM s a) -> IO a {-# INLINE atomicallyRunST #-} atomicallyRunST x = atomically (unSTSTM x) Some commentary follows: Some initial sanity testing with the GHC threaded runtime shows that it does what I want, but I am not familiar enough with Core or the RTS to predict whether or not it will launch nuclear missiles at the next transit of Venus. I would be grateful for any feedback. The use of rank-2 polymorphism in the type of atomicallyRunST is intended to encapsulate the ST state exactly like it does for runST, and that the ST state cannot leak into or out of the transaction. STSTM is not a monad transformer (visibly or internally). I hope that any potential problems that might afflict the STMonadTrans package are irrelevant here. I use seq in liftST to force the unsafe inline ST computation to occur before bind proceeds to the next computation. Without seq, ST computations returning () (or anything else that is not evaluated) appear to stay as thunks and never transform any state. I suspect this may cause problems with bottoms, but I am not sure if that is any different from real ST/runST. -- Thomas Koster From tkoster at gmail.com Tue Feb 9 13:13:14 2016 From: tkoster at gmail.com (Thomas Koster) Date: Wed, 10 Feb 2016 00:13:14 +1100 Subject: [Haskell-cafe] Combining ST with STM In-Reply-To: References: <56B9A50A.1090601@tu-harburg.de> Message-ID: Alberto, On 9 February 2016 at 14:43, Thomas Koster wrote: > I have an STM transaction that needs some private, temporary state. > The most obvious way is to simply pass pure state as arguments, but > for efficiency, I would like this state to be some kind of mutable > array, like STArray. On 9 February 2016 at 22:29, Alberto G. Corona wrote: > Why not use the state monad transformer? > > http://hackage.haskell.org/package/transformers-0.5.1.0/docs/Control-Monad-Trans-State-Lazy.html#t:StateT > > atomically $ evalStateT todo initialState > > Seems Ok to me > > evalStateT :: Monad m => StateT s m a -> s -> m a > > in this case: > > evalStateT :: StateT MyState STM a -> MyState -> STM a Thank you for your suggestion. Certainly, if the state was an immutable value, small or otherwise cheaply modified, like a finger tree spine, StateT would be a much cleaner alternative. But unfortunately it is the mutability of the STArray that makes it valuable to my application. "StateT (Vector Value) STM" would not help me much as the state would need to be copied every time it was modified. In fact, I used a variation of this in a very early version of my program, except that the Vector was passed even more simply: as an argument, the way ReaderT does, with no actual transformer in sight. Switching over to ST and passing an STArray instead has improved the throughput of my program greatly (far more than I expect to see from any extra parallelism I might gain from using STM). -- Thomas Koster From rustompmody at gmail.com Tue Feb 9 13:20:32 2016 From: rustompmody at gmail.com (Rustom Mody) Date: Tue, 9 Feb 2016 18:50:32 +0530 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> Message-ID: On Fri, Feb 5, 2016 at 11:29 PM, Christopher Allen wrote: > > > On Fri, Feb 5, 2016 at 11:55 AM, Kyle Hanson wrote: > >> I am also happy the discussion was posted here. Although I don't teach >> Haskell professionally, one of the things I loved to do was show people how >> simple Haskell really was by inspecting types and slowly putting the puzzle >> pieces together. >> >> Summary of the problem for others: >> >> From *Takenobu Tani* >> >> Before ghc7.8: >> >> Prelude> :t foldr >> foldr :: (a -> b -> b) -> b -> [a] -> b >> >> Prelude> :t ($) >> ($) :: (a -> b) -> a -> b >> >> Beginners should only understand about following: >> >> * type variable (polymorphism) >> >> >> After ghc8.0: >> >> Prelude> :t foldr >> foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b >> >> Prelude> :t ($) >> ($) >> :: forall (w :: GHC.Types.Levity) a (b :: TYPE w). >> (a -> b) -> a -> b >> >> >> >> With this change it looks like I will no longer be able to keep `$` in my >> toolbox since telling a beginner its "magic" goes against what I believe >> Haskell is good at, being well defined and easy to understand (Not well >> defined in terms of Types but well defined in terms of ability to precisely >> and concisely explain and define whats going on). >> >> It looks like where the discussion is going is to have these types show >> by default but eventually have an Alternative prelude for beginners. >> >> From *Richard Eisenberg:* >> >> - It's interesting that the solution to the two problems Takenobu pulls out below (but others have hinted at in this thread) is by having an alternate Prelude for beginners. I believe that having an alternate beginners' Prelude is becoming essential. I know I'm not the first one to suggest this, but a great many issues that teachers of Haskell have raised with me and posts on this and other lists would be solved by an alternate Prelude for beginners. >> >> I don't like the idea of fragmenting Haskell into "beginners" and >> "advanced" versions. Its hard enough to get people to believe Haskell is >> easy. If they see that they aren't using the "real" prelude, Haskell will >> still be this magic black box that is too abstract and difficult to >> understand. If they have to use a "dumbed down" version of Haskell to >> learn, its not as compelling. >> >> There is something powerful about using the same idiomatic tools as the >> "big boys" and have the tools still be able to be easy to understand.... by >> default. Adding complexity to the default Haskell runs the risk of further >> alienating newcomers to the language who have a misconception that its too >> hard. >> >> Admittedly, I am not well informed of the state of GHC 8.0 development >> and haven't had time to fully look into the situation. I am very interested >> to see where this conversation and the default complexity of Haskell goes. >> >> -- >> Kyle >> >> >> I don't want, nor do I think it's a good idea, to have a beginners' > Prelude. My point about ($) was not expressly about beginners, it was about > intermediate practitioners too. > Consider these two delightful pianists: Martha and Rose - Are they playing the same instruments? - Would they need the same teachers? - Ultimately, is the single moniker "pianist" meaningfully applicable to both? I believe we are too taken with the fact that programming language *theory* has advanced in the last couple of decades, while we miss the fact that programming *pedagogy* has regressed in the same period. And one of the big regresses is the illusion that a *single *language that spans the spectrum from beginner learning to serious software engineering is a neat idea: a grand unified/universal language. Such a language already exists -- C++. An earlier generation called it PL-1. FP in ACM Curriculum 2013 spells out this ? omnibus language ? and such fallacies in more detail. And as regards prior art regarding the benefits for multiple close but different languages for teaching, one could see the multiple teachpacks of Scheme/Racket And even closer to home, helium is a haskell expressly designed to make teaching easier by not over-generalizing types -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at orlitzky.com Tue Feb 9 13:26:13 2016 From: michael at orlitzky.com (Michael Orlitzky) Date: Tue, 9 Feb 2016 08:26:13 -0500 Subject: [Haskell-cafe] Language complexity & beginners In-Reply-To: <877fieqg27.fsf@feelingofgreen.ru> References: <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B7E475.5040001@orlitzky.com> <56B92A9C.4090608@cs.otago.ac.nz> <56B93417.5090904@orlitzky.com> <877fieqg27.fsf@feelingofgreen.ru> Message-ID: <56B9E8F5.6050603@orlitzky.com> On 02/09/2016 06:27 AM, Kosyrev Serge wrote: > > Case in point (only slightly contrived) -- which one is easier to > visually parse to you: > > foo (thInt $ fromIntegral $ c2hsValueInt cexp) (thInt $ fromIntegral $ c2hsValueInt cexp) > > foo (thInt (fromIntegral (c2hsValueInt cexp))) (thInt (fromIntegral (c2hsValueInt cexp))) > > Me, I get a blood pressure spike roughy here ---^ > let th_exp = (thInt . fromIntegral . c2hsValueInt) cexp foo th_exp th_exp The parentheses are a warning sign, and using "$" above only lets you make it look cleaner without fixing the problem. It has hidden the fact that you're computing f(g(h(x))) twice, and there's a better way to do that. From anselm.scholl at tu-harburg.de Tue Feb 9 14:12:17 2016 From: anselm.scholl at tu-harburg.de (Jonas Scholl) Date: Tue, 9 Feb 2016 15:12:17 +0100 Subject: [Haskell-cafe] Combining ST with STM In-Reply-To: References: <56B9A50A.1090601@tu-harburg.de> Message-ID: <56B9F3C1.308@tu-harburg.de> On 02/09/2016 01:46 PM, Thomas Koster wrote: > On 9 February 2016 at 14:43, Thomas Koster wrote: >> I have an STM transaction that needs some private, temporary state. >> The most obvious way is to simply pass pure state as arguments, but >> for efficiency, I would like this state to be some kind of mutable >> array, like STArray. >> >> The private state is, by definition, not shared, so >> including it in the STM log and commit process is, as far as I can >> tell, pointless. >> >> ST and STArray still appear to be the most appropriate tools for the >> private state, because STRefs and STArrays really, really are private. >> >> So this basically means I want to interleave ST and STM in a "safe" >> way. That is, if the STM transaction retries, I want the ST state to >> be vaporised as well. >> >> Ideally, I would love to be able to say something like this: >> >> -- | Copy the value from the shared TVar into the private STRef. >> load :: TVar a -> STRef a -> STSTM s () >> load shared private = do >> value <- liftSTM (readTVar shared) >> liftST (writeSTRef private value) >> >> Naturally, that STRef must originate from a call to newSTRef earlier >> in the same transaction and is private to it, just like the real ST >> monad. As far as I can tell, I am not trying to weaken either ST or >> STM in any way here. > > Please forgive the typo in the type signature of "load", which should > have been: > > load :: TVar a -> STRef s a -> STSTM s () > > Let me elaborate on STSTM, a monad I made up for this example that > combines the characteristics of ST and STM in the way that I want. > If my requirements were unclear from my prose, perhaps the code below > will illuminate them better. > > An STSTM transaction is intended to be an STM transaction imbued with a > state token that encapsulates additional, transaction-local state in the > spirit of ST. > > It is not intended to secretly perform IO inside STM, a la > GHC.Conc.unsafeIOToSTM. > > It is not intended to facilitate the leaking of state into or out of an > STM transaction through STRefs, nor to communicate state between > successive retries of an STM transaction. I understand that, you just said, you wanted to sprinkle some runST calls with unsafeThawArray and unsafeFreezeArray into your STM code. So I assumed you wanted to share an (ST)Array between these STM actions. > > Thanks to hints from Ryan and Jonas, I made an attempt at implementing > it myself. > > Below is my implementation of STSTM and associated operations. You will > need to link with the "primitive" and "stm" packages. I used versions > 0.6 and 2.4.4, resp., and GHC 7.10.2. > > > {-# LANGUAGE GeneralizedNewtypeDeriving, Rank2Types #-} > > module Control.Monad.STSTM > ( > STSTM, > liftST, > liftSTM, > atomicallyRunST, > module Control.Monad.STM > ) > where > > import Control.Monad.Primitive > import Control.Monad.ST > import Control.Monad.STM > > -- | A computation of type @STSTM s a@ is an 'STM' computation that > -- also transforms a transaction-local internal state indexed by @s@, as > -- in the 'ST' monad, and returns a value of type @a at . > newtype STSTM s a = STSTM { unSTSTM :: STM a } > deriving (Functor, Applicative, Monad) > > -- | Lift an 'ST' computation into the 'STSTM' transaction. > liftST :: ST s a -> STSTM s a > {-# INLINE liftST #-} > liftST x = STSTM $ > let y = unsafeInlineST x > in y `seq` return y This is highly unsafe and will not do what you think it does! unsafeInlineST provides an ST action with a realWorld# token out of thin air and thus can float outside liftST, especially because you inline it. This produces exactly the bug I reported against STMonadTrans. A safe version could take the state token from the STM action, pass it into the ST action and carry on with the returned state token (look at GHC.Conc.Sync). Or convert the ST action to IO and then just run the IO action in STM. This should be fine if you do not use unsafeThaw - any garbage written to some STRef/STArray will be thrown away after the runtime sees the STM action will fail and restarts it. > > -- | Lift an 'STM' computation into the 'STSTM' transaction. > liftSTM :: STM a -> STSTM s a > {-# INLINE liftSTM #-} > liftSTM = STSTM > > -- | Perform a series of 'STSTM' actions atomically. > -- > -- The 'ST' state is discarded when the 'STM' transaction commits or > -- retries. > atomicallyRunST :: (forall s. STSTM s a) -> IO a > {-# INLINE atomicallyRunST #-} > atomicallyRunST x = atomically (unSTSTM x) > > > Some commentary follows: > > Some initial sanity testing with the GHC threaded runtime shows that it > does what I want, but I am not familiar enough with Core or the RTS to > predict whether or not it will launch nuclear missiles at the next > transit of Venus. I would be grateful for any feedback. > > The use of rank-2 polymorphism in the type of atomicallyRunST is > intended to encapsulate the ST state exactly like it does for runST, > and that the ST state cannot leak into or out of the transaction. What you still can not use is unsafeThaw. Consider this: foo :: Array Int Val -> TVar Int -> IO someResult foo arr var = atomicallyRunST $ do marr <- liftST $ unsafeThaw arr val <- liftSTM $ readTVar var liftST $ writeArray marr val someOtherVal ... do something more... What happens if the transaction is restarted after the write? You've written into arr (unsafeThaw did not copy it), but have no log to revert the write. Now you see a different immutable array. This is bad. So you can not use unsafeThaw. Even if only one transaction gets a hold on this array and it would be safe to use unsafeThaw with plain ST (as this can not retry), because the transaction has to depend on other TVars etc, otherwise there would be no need for STM. And now I am wondering what happens if a thread evaluates something like runST ... unsafeThawArray ... unsafeFreezeArray ... and is hit by an asynchronous exception... The computation is restated the next time the thunk is demanded, but this could have already changed the array, right? So can runST ... unsafeThawArray ... be used in a safe way or is this combination inherently broken? Anyway, I think the following holds true: - using STRefs: These must have been created in the transaction, so it works. - using STArrays: unsafeThawing an incoming Array will break referential transparency sooner or later. Thawing (and thus copying) the incoming array or creating a fresh one should work. - using TArrays: You can return these from the STM action and start another one later with them without breaking referential transparency as always. If you have to modify incoming arguments, even if only one STM action has a reference to them at a time, these can be faster as you do not have to copy everything - instead they will have a log of the writes, so you would have to benchmark copying against transaction logs. > > STSTM is not a monad transformer (visibly or internally). I hope that > any potential problems that might afflict the STMonadTrans package are > irrelevant here. You won't have problems with lists as underlying monad, yes. > > I use seq in liftST to force the unsafe inline ST computation to occur > before bind proceeds to the next computation. Without seq, ST > computations returning () (or anything else that is not evaluated) > appear to stay as thunks and never transform any state. I suspect this > may cause problems with bottoms, but I am not sure if that is any > different from real ST/runST. Keep in mind that a `seq` b does not guarantee that a is evaluated before b. I think this is not a problem here, as there are more severe problems anyway (see above), but this is generally good to have in mind when writing such code. Jonas > > -- > Thomas Koster > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 473 bytes Desc: OpenPGP digital signature URL: From jo at durchholz.org Tue Feb 9 14:43:00 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Tue, 9 Feb 2016 15:43:00 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> Message-ID: <56B9FAF4.4040109@durchholz.org> Am 09.02.2016 um 14:20 schrieb Rustom Mody: > And one of the big > regresses is the illusion that a *single *language that spans the spectrum > from beginner learning to serious software engineering is a neat idea: a > grand unified/universal language. It is still an ideal. Not because it is such a good idea. I'm pretty much unconvinced whether that is the case or not. It is an ideal to approximatet because learning a new language, and learning it well enough to use it in anger, is such a huge investment in time and effort, and we simply cannot afford to build a language for each domain. Also, we cannot do so because there isn't even a consensus what the domains should be, and I'd expect such a list to be a moving target anyway. > Such a language already exists -- C++. > An earlier generation called it PL-1. No no no. C++ was never meant to be easy to learn. It was intended to be easy to learn for C programmers, but C wasn't intended to be easy to learn, it was intended to be efficient on PDP-series computers with a non-optimizing compiler. PL-1 wasn't intended to be easy to learn either - it was hoped it would be, but the primary goal was to include as many language features as humanly possible, in the hopes of creating something powerful. So the two languages and the universal-easy-to-learn camp do not share any design goals. > FP in ACM Curriculum 2013 > > spells out this ? omnibus language ? and such fallacies in more detail. He claims this, but he does not back that up with any arguments. There's only reference to authority (Peter Naur). > And as regards prior art regarding the benefits for multiple close but > different languages for teaching, one could see the multiple teachpacks > of Scheme/Racket > And even closer to home, helium > is a haskell expressly > designed to make teaching easier by not over-generalizing types I think the link you gave is making a subtly but fundamentally different point: That to teach programming, you need a different and simplified language to get the core points across. There are actually good points to be made in favor of that approach. However, this is about making Haskell the working language easy to learn. The demography includes people who know what a type system is, what a function is, and they will usually even know what a side effect is and already avoid that if they can. Tell them that they see a simplified prelude and they will want to see the real one. Show them the real one and they will run away, flailing and scream, just as ten years ago, you could achieve the same effect by mentioning monads. If the type system is starting to make it hard to learn the language well enough to use it professionally, or to even understand what the professional library writers did and why, then the type system has become too difficult. From carter.schonwald at gmail.com Tue Feb 9 17:04:04 2016 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Tue, 9 Feb 2016 12:04:04 -0500 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56B9FAF4.4040109@durchholz.org> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> Message-ID: I'd like to opine that I personally like that our types are getting more honest in reflecting how things work, and that even the impredicativety hack might be on track to being a userland expressible construct in a later ghc release (if my fuzzy understanding of the impredicative subsumption work thats in progress is correct and that it actually pans out ) i like the bike shed, i dont care how we mix the paint colors, as long as it doesn't create more confusion cheers _Carter On Tue, Feb 9, 2016 at 9:43 AM, Joachim Durchholz wrote: > Am 09.02.2016 um 14:20 schrieb Rustom Mody: > >> And one of the big >> regresses is the illusion that a *single *language that spans the spectrum >> from beginner learning to serious software engineering is a neat idea: a >> grand unified/universal language. >> > > It is still an ideal. > Not because it is such a good idea. I'm pretty much unconvinced whether > that is the case or not. > It is an ideal to approximatet because learning a new language, and > learning it well enough to use it in anger, is such a huge investment in > time and effort, and we simply cannot afford to build a language for each > domain. Also, we cannot do so because there isn't even a consensus what the > domains should be, and I'd expect such a list to be a moving target anyway. > > > Such a language already exists -- C++. > >> An earlier generation called it PL-1. >> > > No no no. > C++ was never meant to be easy to learn. It was intended to be easy to > learn for C programmers, but C wasn't intended to be easy to learn, it was > intended to be efficient on PDP-series computers with a non-optimizing > compiler. > PL-1 wasn't intended to be easy to learn either - it was hoped it would > be, but the primary goal was to include as many language features as > humanly possible, in the hopes of creating something powerful. > So the two languages and the universal-easy-to-learn camp do not share any > design goals. > > FP in ACM Curriculum 2013 >> < >> http://blog.languager.org/2015/06/functional-programming-moving-target.html >> > >> spells out this ? omnibus language ? and such fallacies in more detail. >> > > He claims this, but he does not back that up with any arguments. > There's only reference to authority (Peter Naur). > > And as regards prior art regarding the benefits for multiple close but >> different languages for teaching, one could see the multiple teachpacks >> of Scheme/Racket >> And even closer to home, helium >> is a haskell expressly >> designed to make teaching easier by not over-generalizing types >> > > I think the link you gave is making a subtly but fundamentally different > point: That to teach programming, you need a different and simplified > language to get the core points across. There are actually good points to > be made in favor of that approach. > > However, this is about making Haskell the working language easy to learn. > The demography includes people who know what a type system is, what a > function is, and they will usually even know what a side effect is and > already avoid that if they can. > Tell them that they see a simplified prelude and they will want to see the > real one. Show them the real one and they will run away, flailing and > scream, just as ten years ago, you could achieve the same effect by > mentioning monads. > > If the type system is starting to make it hard to learn the language well > enough to use it professionally, or to even understand what the > professional library writers did and why, then the type system has become > too difficult. > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From b at chreekat.net Tue Feb 9 17:12:40 2016 From: b at chreekat.net (Bryan Richter) Date: Tue, 9 Feb 2016 09:12:40 -0800 Subject: [Haskell-cafe] Language complexity & beginners In-Reply-To: <877fieqg27.fsf@feelingofgreen.ru> References: <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B7E475.5040001@orlitzky.com> <56B92A9C.4090608@cs.otago.ac.nz> <56B93417.5090904@orlitzky.com> <877fieqg27.fsf@feelingofgreen.ru> Message-ID: <20160209171240.GD29894@fuzzbomb> On Tue, Feb 09, 2016 at 02:27:44PM +0300, Kosyrev Serge wrote: > Michael Orlitzky writes: > > Most uses of "$" are for stupid > > things like "sin $ 1 + 2" where parentheses would be much more clear. > > "$" simplifies visual perception through two factors: > > 1. we are relieved from counting parentheses > 2. it serves as a cue to treat the entire remaining part until ")" as > part of the same expression > > Case in point (only slightly contrived) -- which one is easier to > visually parse to you: > > foo (thInt $ fromIntegral $ c2hsValueInt cexp) (thInt $ fromIntegral $ c2hsValueInt cexp) > > foo (thInt (fromIntegral (c2hsValueInt cexp))) (thInt (fromIntegral (c2hsValueInt cexp))) My readability problem with this statement is line length. How about: foo (thInt (fromIntegral (c2hsValueInt cexp))) (thInt (fromIntegral (c2hsValueInt cexp))) I apologize for playing syntax golf, but I do want to cast a small vote for preferring parentheses over ($). It is this preference that makes me side with Orlitzky's argument that the type of ($) is irrelevant for beginners, since beginners should be encouraged to use parentheses anyways. It's One Less Thing To Worry About(tm). -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 801 bytes Desc: Digital signature URL: From rustompmody at gmail.com Tue Feb 9 17:13:36 2016 From: rustompmody at gmail.com (Rustom Mody) Date: Tue, 9 Feb 2016 22:43:36 +0530 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> Message-ID: On Tue, Feb 9, 2016 at 10:34 PM, Carter Schonwald < carter.schonwald at gmail.com> wrote: > I'd like to opine that I personally like that our types are getting more > honest in reflecting how things work, > Me too! I just want to +1 the alternative/noob prelude suggestion which I believe came from many people; not to reduce the (default) honesty of the *standard* prelude -------------- next part -------------- An HTML attachment was scrubbed... URL: From jo at durchholz.org Tue Feb 9 17:17:37 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Tue, 9 Feb 2016 18:17:37 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> Message-ID: <56BA1F31.1030607@durchholz.org> Am 09.02.2016 um 18:04 schrieb Carter Schonwald: > I'd like to opine that I personally like that our types are getting more > honest in reflecting how things work, I'm pretty much in the same boat with that. I just have a feeling that the typing is getting complicated because the compiler isn't good enough to infer whether a type is lifted or not, boxed or not. Essentially, there's that constant temptation to give programmers access to machine integers. It's a valid concern, but it complicates the type system tremendously. I feel that this is similar to expressing value constraints in the type system, e.g. ranges or squareness of matrixes. Yes it can be done in Haskell's type system, yes it does typecheck beautifully, but the type declarations behind these kinds of feats will just make any ordinary programmer go MEGO. Even the bright ones. I conclude that the type system isn't the right place for that kind of checking. To be understandable, such constraints need to be expressed as boolean assertions, not as some inductive construct. YMMV. From mark.fine at gmail.com Tue Feb 9 17:23:30 2016 From: mark.fine at gmail.com (Mark Fine) Date: Tue, 9 Feb 2016 09:23:30 -0800 Subject: [Haskell-cafe] A Sliding TChan? In-Reply-To: <56B2AC76.1070903@informatik.uni-marburg.de> References: <56B2AC76.1070903@informatik.uni-marburg.de> Message-ID: Hey Thomas, Thanks for the implementation ideas! It's worked out great for us and introduced a lot of stability in our system! Thanks again for your help! Mark On Wed, Feb 3, 2016 at 5:42 PM, Thomas Horstmeyer < horstmey at mathematik.uni-marburg.de> wrote: > Hi Mark, > > your question made me take a look at the TChan implementation, which I > always had wanted to do (but never had the time). To test my understanding, > I sketched a TChan variation that should solve the problem. (A test with > one sender and two receivers showed expected output but I did not measure > memory usage.) > > The sender replaces older messages with a marker. This should make the > content available to the garbage collector (if it is not referenced by a > receiver who has read it). On reading a marker, a receiver skips directly > to the next valid message. > > On the downside, the sender keeps a reference to the last n messages, so > they will not be garbage collected even if every receiver has read them. > > Thomas > > > {-# LANGUAGE CPP, DeriveDataTypeable #-} > > module Control.Concurrent.STM.TBBroadcast( > #ifdef __GLASGOW_HASKELL__ > TSender, TReceiver, > newSender, newSenderIO, writeBC, > newReceiver, readBC > #endif > ) where > > #ifdef __GLASGOW_HASKELL__ > > import GHC.Conc > import Data.Typeable (Typeable) > > > data TSender a = Sender {-# UNPACK #-} !(TVar Int) > {-# UNPACK #-} !(TVar (TVarList a)) > {-# UNPACK #-} !(TVar (TVarList a)) > deriving (Eq, Typeable) > > > type TVarList a = TVar (TList a) > data TList a = TNil > | TCons a {-# UNPACK #-} !(TVarList a) > | Outdated {-# UNPACK #-} !(TVar (TVarList a)) > > > newSender :: Int -> STM (TSender a) > newSender n | n <= 0 = error "windows size must be >=0" > | otherwise = do > hole <- newTVar TNil > first <- newTVar hole > end <- newTVar hole > count <- newTVar n > return (Sender count first end) > > newSenderIO :: Int -> IO (TSender a) > newSenderIO n | n <= 0 = error "windows size must be >=0" > | otherwise = do > hole <- newTVarIO TNil > first <- newTVarIO hole > end <- newTVarIO hole > count <- newTVarIO n > return (Sender count first end) > > > > writeBC :: TSender a -> a -> STM () > writeBC (Sender count first end) a = do > listend <- readTVar end > new_listend <- newTVar TNil > writeTVar listend (TCons a new_listend) > writeTVar end new_listend > n <- readTVar count > case n of > 0 -> do > listhead <- readTVar first > head <- readTVar listhead > case head of > TCons _ tl -> writeTVar first tl > writeTVar listhead (Outdated first) > _ -> writeTVar count $! (n-1) > > > data TReceiver a = Receiver {-# UNPACK #-} !(TVar (TVarList a)) > > newReceiver :: TSender a -> STM (TReceiver a) > newReceiver (Sender _ _ end) = do > hole <- readTVar end > first <-newTVar hole > return (Receiver first) > > > readBC :: TReceiver a -> STM a > readBC (Receiver first) = do > listhead <- readTVar first > head <- readTVar listhead > case head of > TNil -> retry > TCons a tl -> do > writeTVar first tl > return a > Outdated next -> do > next' <- readTVar next > writeTVar first next' > readBC (Receiver first) > > #endif > > > Am 28.01.2016 um 20:30 schrieb Mark Fine: > >> We're currently using a TMChan to broadcast from a single producer >> thread to many consumer threads. This works well! However, we're seeing >> issues with a fast producer and/or a slow consumer, with the channel >> growing unbounded. Fortunately, our producer-consumer communication is >> time-sensitive and tolerant of loss: we're ok with the producer always >> writing at the expense of dropping communication to a slow consumer. >> >> A TMBChan provides a bounded channel (but no means to dupe/broadcast) >> where a writer will block once the channel fills up. In our use case, >> we'd like to continue writing to the channel but dropping off the end of >> the channel. Clojure's core-async module has some related concepts, in >> particular the notion of a sliding buffer >> >> that >> drops the oldest elements once full. Has anyone encountered something >> similar in working with channels and/or have any solutions? Thanks! >> >> Mark >> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> -------------- next part -------------- An HTML attachment was scrubbed... URL: From trebla at vex.net Tue Feb 9 17:23:40 2016 From: trebla at vex.net (Albert Y. C. Lai) Date: Tue, 9 Feb 2016 12:23:40 -0500 Subject: [Haskell-cafe] Including a "XXX_stub.h" file from another Haskell library? In-Reply-To: References: Message-ID: <56BA209C.7060802@vex.net> On 2016-02-08 08:34 AM, Alp Mestanogullari wrote: > Let's say I have two Haskell libraries, `A` and `B`. > > `A` uses the FFI, `foreign export` to be precise, to make a Haskell > function available to C land. This generates a "stub" C header file > with a corresponding C function declaration. > > `B` has some C code in it and needs to include the stub header that > was generated when compiling `A`, in order to call the function that I > 'foreign export'ed in A. > > When I "naively" include the stub header file for the module in A that > contains the 'foreign export' statement, inside one of the C files of > the `B` library, the said header can't be found. A_stub.h has the problem of #include'ing . (Read A_stub.h to see.) HsFFI.h has the problem of strongly inflicting "you have to install a Haskell compiler" on C programmers who just want to build B (which is just C code that just calls a binary library callable from C). Firstly it only comes with a Haskell compiler. Secondly its location is usually under the Haskell compiler's directory, not the usual ones configured to the C compiler, therefore either (recommended) you call "ghc -c B.c" so that it calls gcc with HsFFI.h's location, or (unmaintainable) you enter it manually. My recommendation is to ignore A_stub.h and write your own simple independent A.h. It can be correct because Haskell 2010 asserts that, for example, HsInt64 must be "signed integral type, 64 bit; int64_t if available". There is no choice. You don't need HsFFI.h to tell you what HsInt64 is, you can already enter "int64_t" today. HsPtr is even better, it is "(void *)". There is no choice. (See Haskell 2010 Report, section 8.7.) As for HsInt, yes that varies across Haskell compilers, but you are supposed to use HsInt8 or HsInt16 or HsInt32 or HsInt64. From _deepfire at feelingofgreen.ru Tue Feb 9 17:24:33 2016 From: _deepfire at feelingofgreen.ru (Kosyrev Serge) Date: Tue, 09 Feb 2016 20:24:33 +0300 Subject: [Haskell-cafe] Language complexity & beginners In-Reply-To: <20160209171240.GD29894@fuzzbomb> (Bryan Richter's message of "Tue, 9 Feb 2016 09:12:40 -0800") References: <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B7E475.5040001@orlitzky.com> <56B92A9C.4090608@cs.otago.ac.nz> <56B93417.5090904@orlitzky.com> <877fieqg27.fsf@feelingofgreen.ru> <20160209171240.GD29894@fuzzbomb> Message-ID: <87oabpyey6.fsf@feelingofgreen.ru> Bryan Richter writes: > On Tue, Feb 09, 2016 at 02:27:44PM +0300, Kosyrev Serge wrote: >> Michael Orlitzky writes: >> > Most uses of "$" are for stupid >> > things like "sin $ 1 + 2" where parentheses would be much more clear. >> >> "$" simplifies visual perception through two factors: >> >> 1. we are relieved from counting parentheses >> 2. it serves as a cue to treat the entire remaining part until ")" as >> part of the same expression >> >> Case in point (only slightly contrived) -- which one is easier to >> visually parse to you: >> >> foo (thInt $ fromIntegral $ c2hsValueInt cexp) (thInt $ fromIntegral $ c2hsValueInt cexp) >> >> foo (thInt (fromIntegral (c2hsValueInt cexp))) (thInt (fromIntegral (c2hsValueInt cexp))) > > My readability problem with this statement is line length. How about: > > foo (thInt (fromIntegral (c2hsValueInt cexp))) > (thInt (fromIntegral (c2hsValueInt cexp))) I clearly made a mistake of duplicating a real expression.. should have picked two different expressions for an example. The point I have tried to convey was that: - the ))) ( patterns are hard to parse visually - the $ helps to alleviate that ..which is fairly orthogonal to common subexpression elimination or formatting. $ allows one to write more complex expressions -- precisely without resorting to diluting code with formatting. -- ? ???????e? / respectfully, ??????? ?????? From trevor.mcdonell at gmail.com Tue Feb 9 17:28:55 2016 From: trevor.mcdonell at gmail.com (Trevor McDonell) Date: Tue, 09 Feb 2016 17:28:55 +0000 Subject: [Haskell-cafe] maps over arrays that provide the position index for the array and accelerate libraries? In-Reply-To: References: Message-ID: This will do it. imap :: (Shape ix, Elt a, Elt b) => (Exp ix -> Exp a -> Exp b) -> Acc (Array ix a) -> Acc (Array ix b) imap f xs = A.zipWith f (A.generate (shape xs) id) xs I'll add this and similar functions for zipWithN to the Accelerate prelude. Cheers, -Trev On Tue, 9 Feb 2016 at 06:26 Rob Stewart wrote: > In vector library there's this useful function: > > imap :: (Int -> a -> b) -> Vector a -> Vector b > > And in Data.Map there's this similar function: > > mapWithKey :: (k -> a -> b) -> Map k a -> Map k b > > I'm looking for something similar in the array and accelerate libraries, > i.e. > > On arrays in Data.Array.IArray: > > imap :: (IArray a e, IArray a e', Ix i) => (i -> e -> e') -> a i e -> a i > e' > > And on Accelerate arrays: > > imap :: (Shape ix, Elt a, Elt b) => (Exp ix -> Exp a -> Exp b) -> Acc > (Array ix a) -> Acc (Array ix b) > > Is anyone aware of such map implementations for arrays in the array > and accelerate libraries, that provide your mapped function not only > the element at a position, but also the index at that position? > > Thanks, > > -- > Rob > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mwm at mired.org Tue Feb 9 18:03:39 2016 From: mwm at mired.org (Mike Meyer) Date: Tue, 09 Feb 2016 18:03:39 +0000 Subject: [Haskell-cafe] Language complexity & beginners In-Reply-To: <87oabpyey6.fsf@feelingofgreen.ru> References: <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B7E475.5040001@orlitzky.com> <56B92A9C.4090608@cs.otago.ac.nz> <56B93417.5090904@orlitzky.com> <877fieqg27.fsf@feelingofgreen.ru> <20160209171240.GD29894@fuzzbomb> <87oabpyey6.fsf@feelingofgreen.ru> Message-ID: > > The point I have tried to convey was that: > > - the ))) ( patterns are hard to parse visually > - the $ helps to alleviate that > > ..which is fairly orthogonal to common subexpression elimination or > formatting. > > $ allows one to write more complex expressions -- precisely without > resorting to diluting code with formatting. > I agree, but '$' still needs to be used with a bit of care. For instance, given these choices: > someFn $ someOtherFn $ more $ more $ val > (someFn . someOtherFn . more . more $ val) > someFn (someOtherFn (more (more val))) I like one not on the list: someFn . someOtherFn . more $ more val as it's simpler in that there are fewer things to parse than the other options. The middle option in the first three without the extra global '()'s is close, and might even be better in context once they are removed, but the last one makes me long for he old LISP super-parens, even though I thought and still think they were a bad idea. So my rule of thumb is one '$' for expression or sub-expression, using '.' instead of '$' prior to that to make the distinction between building a functional value and applying it stand out. -------------- next part -------------- An HTML attachment was scrubbed... URL: From Andrew.Butterfield at scss.tcd.ie Tue Feb 9 18:11:24 2016 From: Andrew.Butterfield at scss.tcd.ie (butrfeld) Date: Tue, 9 Feb 2016 18:11:24 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56BA1F31.1030607@durchholz.org> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BA1F31.1030607@durchholz.org> Message-ID: <02A71442-F573-45AE-BE11-787D2ED939CB@scss.tcd.ie> > On 9 Feb 2016, at 17:17, Joachim Durchholz wrote: > > I feel that this is similar to expressing value constraints in the type system, e.g. ranges or squareness of matrixes. Yes it can be done in Haskell's type system, yes it does typecheck beautifully, but the type declarations behind these kinds of feats will just make any ordinary programmer go MEGO. Even the bright ones. > I conclude that the type system isn't the right place for that kind of checking. To be understandable, such constraints need to be expressed as boolean assertions, not as some inductive construct. YMMV. +n to that, as n -> \infty Andrew Butterfield School of Computer Science & Statistics Trinity College Dublin 2, Ireland From jo at durchholz.org Tue Feb 9 18:11:57 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Tue, 9 Feb 2016 19:11:57 +0100 Subject: [Haskell-cafe] Language complexity & beginners In-Reply-To: <87oabpyey6.fsf@feelingofgreen.ru> References: <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B7E475.5040001@orlitzky.com> <56B92A9C.4090608@cs.otago.ac.nz> <56B93417.5090904@orlitzky.com> <877fieqg27.fsf@feelingofgreen.ru> <20160209171240.GD29894@fuzzbomb> <87oabpyey6.fsf@feelingofgreen.ru> Message-ID: <56BA2BED.9010300@durchholz.org> Am 09.02.2016 um 18:24 schrieb Kosyrev Serge: >>> foo (thInt (fromIntegral (c2hsValueInt cexp))) (thInt (fromIntegral (c2hsValueInt cexp))) >> > I clearly made a mistake of duplicating a real expression.. should have > picked two different expressions for an example. The counterexamples still work. This: foo (thInt1 (fromIntegral1 (c2hsValueInt1 cexp1))) (thInt2 (fromIntegral2 (c2hsValueInt2 cexp2))) can still become this: let int1 = thInt1 (fromIntegral1 (c2hsValueInt1 cexp1)) int2 = thInt2 (fromIntegral2 (c2hsValueInt2 cexp2)) in foo int1 int2 and that's perfectly readable in my book. If you don't like the nested parentheses, use function composition: let fn1 = thInt1 . fromIntegral1 . c2hsValueInt1 fn2 = thInt2 . fromIntegral2 . c2hsValueInt2 in foo (fn1 int1) (fn2 int2) Function composition isn't the main tool though; I found that naming subexpressions always works, plus the names can help with readability if they are chosen wisely. From bog at khumba.net Tue Feb 9 18:15:17 2016 From: bog at khumba.net (Bryan Gardiner) Date: Tue, 9 Feb 2016 10:15:17 -0800 Subject: [Haskell-cafe] ANNOUNCE: hoppy, qtah In-Reply-To: <0D66E65E-9053-48E2-B8DF-A240367672B0@gmail.com> References: <20160208101136.13365424@khumba.net> <0D66E65E-9053-48E2-B8DF-A240367672B0@gmail.com> Message-ID: <20160209101517.788d836d@khumba.net> On Tue, 9 Feb 2016 09:59:37 +0100 Nicola Gigante wrote: > > Il giorno 08 feb 2016, alle ore 19:11, Bryan Gardiner ha scritto: > > > > Are you sick and tired of the ease with which Haskell code flows onto > > the page? Even the thrill of binding to a C library losing its > > lustre? Look no further! I present to you a tool restoring the good > > old days of pointer arithmetic, manual memory management, and hours > > lost to the debugger: > > > > Hoppy is a new C++ FFI generator for Haskell. It takes Haskell code > > that describes a C++ API, and generates C++ and Haskell code to allow > > the two languages to interact. It supports a good subset of C++, > > including functions, classes, variables, enums and bitflags, operator > > overloading, constness, and simple templates. Adding a function takes > > only a few lines of code, and you normally don't need to write C++ > > yourself. For example, a definition for std::string is: > > > > c_string :: Class > > c_string = > > addReqIncludes [includeStd "string"] $ > > classAddFeatures [Assignable, Comparable, Copyable, Equatable] $ > > makeClass (ident1 "std" "string") (Just $ toExtName "StdString") [] > > [ mkCtor "new" [] > > , mkCtor "newFromCString" [TPtr $ TConst TChar] > > ] > > [ mkConstMethod' "at" "at" [TInt] $ TRef TChar > > , mkConstMethod' "at" "get" [TInt] TChar > > , mkConstMethod "c_str" [] $ TPtr $ TConst TChar > > , mkConstMethod "size" [] TSize > > , mkConstMethod OpAdd [TObj c_string] $ TObj c_string > > ] > > > > Now, writing a FFI generator isn't much fun unless you have a project > > to use it with. So I am pleased to also announce Qtah, a fresh set of > > Qt 4/5 bindings. These include portions of QtCore, QtGui, and > > QtWidgets, and are on the whole wildly incomplete, but are usable for > > basic tasks so far, and I am working on extending coverage. > > > > (On qtHaskell/hsQt: I started Qtah before qtHaskell began being > > updated in 2015 and I missed when that happened. My hope is that Qtah > > requires less code and effort to maintain; at least, qtHaskell > > contains a lot of generated code and I haven't seen where it came > > from, so please correct me if the generator is in fact available > > somewhere. Hoppy also doesn't (currently) do many of the fancy things > > that qtHaskell does, like overloading and garbage collection.) > > > > Both Hoppy and Qtah are young, and I am very interested in discussing > > how to make them most useful for the community. Because of questions > > such as this[1], their APIs (including those of generated bindings) > > should be considered experimental at this time. > > > > I will be uploading Hoppy to Hackage shortly. Becuase Qtah includes a > > shared library, I haven't figured out how to get that on Hackage yet, > > so you'll have to clone the repo yourself. > > > > http://khumba.net/projects/hoppy > > > > http://khumba.net/projects/qtah > > > > Happy hacking! Hi Nicola, > That?s wonderful! > > A couple of questions: > - Do you think it would fit well to provide a monadic interface to construct > a clean and readable DSL on top of your functions? Yes! Really good idea. That would also help with referring to the right "version" of a class, since right now there are lots of 'Class -> Class' functions, and you have to be a little careful about capturing references to old state (this needs better documentation). > - What is the definition of ?simple? template? Template parameters must be non-template types. Literals, nested templates (Foo>), and things required for template metaprogramming can't be used yet because of how Identifier and Type are structured. These are things I want to change (and shouldn't be hard) but just haven't needed yet. C++11 type synonyms provide a workaround. (I'm actually cheating a little. Hoppy doesn't care about templates, only instantiations, which are just regular classes/functions. Hoppy provides the ability to specify template parameters as part of an identifier, and instantiation is left up to bindings authors. I while back I did have data types for templates, but it had versioning issues as above, and didn't let a template refer to its future instantiation.) Cheers, Bryan -------------- next part -------------- A non-text attachment was scrubbed... Name: not available Type: application/pgp-signature Size: 801 bytes Desc: OpenPGP digital signature URL: From miguelimo38 at yandex.ru Tue Feb 9 18:33:19 2016 From: miguelimo38 at yandex.ru (MigMit) Date: Tue, 9 Feb 2016 19:33:19 +0100 Subject: [Haskell-cafe] Language complexity & beginners In-Reply-To: <56BA2BED.9010300@durchholz.org> References: <0D5E0AE0-C90C-4A2E-80D2-47CBF6A2C463@cis.upenn.edu> <9BECA327-AFB2-4D0A-BA17-6DDE1C297D88@dc.uba.ar> <20160207155913.GA3787@weber> <56B7E475.5040001@orlitzky.com> <56B92A9C.4090608@cs.otago.ac.nz> <56B93417.5090904@orlitzky.com> <877fieqg27.fsf@feelingofgreen.ru> <20160209171240.GD29894@fuzzbomb> <87oabpyey6.fsf@feelingofgreen.ru> <56BA2BED.9010300@durchholz.org> Message-ID: I think that's the reason why Python doesn't have multi-line lambdas: Guido believed they aren't readable enough without giving them names. It's wrong for exactly the same reasons. > On 09 Feb 2016, at 19:11, Joachim Durchholz wrote: > > Am 09.02.2016 um 18:24 schrieb Kosyrev Serge: >>>> foo (thInt (fromIntegral (c2hsValueInt cexp))) (thInt (fromIntegral (c2hsValueInt cexp))) >>> >> I clearly made a mistake of duplicating a real expression.. should have >> picked two different expressions for an example. > > The counterexamples still work. > > This: > > foo (thInt1 (fromIntegral1 (c2hsValueInt1 cexp1))) (thInt2 (fromIntegral2 (c2hsValueInt2 cexp2))) > > can still become this: > > let int1 = thInt1 (fromIntegral1 (c2hsValueInt1 cexp1)) > int2 = thInt2 (fromIntegral2 (c2hsValueInt2 cexp2)) > in foo int1 int2 > > and that's perfectly readable in my book. > > If you don't like the nested parentheses, use function composition: > > let fn1 = thInt1 . fromIntegral1 . c2hsValueInt1 > fn2 = thInt2 . fromIntegral2 . c2hsValueInt2 > in foo (fn1 int1) (fn2 int2) > > Function composition isn't the main tool though; I found that naming subexpressions always works, plus the names can help with readability if they are chosen wisely. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From marcin.jan.mrotek at gmail.com Tue Feb 9 22:07:13 2016 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Tue, 9 Feb 2016 23:07:13 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56BA1F31.1030607@durchholz.org> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BA1F31.1030607@durchholz.org> Message-ID: > > I feel that this is similar to expressing value constraints in the type > system, e.g. ranges or squareness of matrixes. Yes it can be done in > Haskell's type system, yes it does typecheck beautifully, but the type > declarations behind these kinds of feats will just make any ordinary > programmer go MEGO. Even the bright ones. > I conclude that the type system isn't the right place for that kind of > checking. To be understandable, such constraints need to be expressed as > boolean assertions, not as some inductive construct. YMMV Two words: refinement types. Best regards, Marcin Mrotek -------------- next part -------------- An HTML attachment was scrubbed... URL: From jo at durchholz.org Tue Feb 9 22:55:29 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Tue, 9 Feb 2016 23:55:29 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BA1F31.1030607@durchholz.org> Message-ID: <56BA6E61.5000200@durchholz.org> Am 09.02.2016 um 23:07 schrieb Marcin Mrotek: >> >> I feel that this is similar to expressing value constraints in the type >> system, e.g. ranges or squareness of matrixes. Yes it can be done in >> Haskell's type system, yes it does typecheck beautifully, but the type >> declarations behind these kinds of feats will just make any ordinary >> programmer go MEGO. Even the bright ones. >> I conclude that the type system isn't the right place for that kind of >> checking. To be understandable, such constraints need to be expressed as >> boolean assertions, not as some inductive construct. YMMV > > Two words: refinement types. Are these in Haskell already? I see them referenced in something that's called LiquidHaskell, which has its last blog entry from Jan 2015. On http://goto.ucsd.edu/~rjhala/liquid/haskell/blog/blog/2013/12/09/checking-termination.lhs/ , it is doing termination checks via handcrafted induction. In functions, induction (i.e. standard recursion pattern) is handled using higher-order functions, where's the higher-order logic in the predicates? And termination proofs shouldn't be implicit in the proof structure, I'd prefer a "terminates" predicate ("unlifted" if you will) on the function (not the function's type) which could be true, false, or of the form "if parameter x has properties A, B, and C, then the function is guaranteed to terminate", i.e. an implication. Just off the top of my head where I see problems for the everyday programmer. It's still interesting work. I hope somebody gets the funding to carry that to practical usefulness. (Please answer to the list, CCing the list means I can't "reply to list".) From tkoster at gmail.com Wed Feb 10 02:02:44 2016 From: tkoster at gmail.com (Thomas Koster) Date: Wed, 10 Feb 2016 13:02:44 +1100 Subject: [Haskell-cafe] Combining ST with STM In-Reply-To: <56B9F3C1.308@tu-harburg.de> References: <56B9A50A.1090601@tu-harburg.de> <56B9F3C1.308@tu-harburg.de> Message-ID: Jonas, Thank you for your swift response. On 9 February 2016 at 14:43, Thomas Koster wrote: > I have an STM transaction that needs some private, temporary state. > The most obvious way is to simply pass pure state as arguments, but > for efficiency, I would like this state to be some kind of mutable > array, like STArray. > > The private state is, by definition, not shared, so > including it in the STM log and commit process is, as far as I can > tell, pointless. > > ST and STArray still appear to be the most appropriate tools for the > private state, because STRefs and STArrays really, really are private. > > So this basically means I want to interleave ST and STM in a "safe" > way. That is, if the STM transaction retries, I want the ST state to > be vaporised as well. > > Ideally, I would love to be able to say something like this: > > -- | Copy the value from the shared TVar into the private STRef. > load :: TVar a -> STRef a -> STSTM s () > load shared private = do > value <- liftSTM (readTVar shared) > liftST (writeSTRef private value) > > Naturally, that STRef must originate from a call to newSTRef earlier > in the same transaction and is private to it, just like the real ST > monad. As far as I can tell, I am not trying to weaken either ST or > STM in any way here. On 9 February 2016 at 23:46, Thomas Koster wrote: > Please forgive the typo in the type signature of "load", which should > have been: > > load :: TVar a -> STRef s a -> STSTM s () > > Let me elaborate on STSTM, a monad I made up for this example that > combines the characteristics of ST and STM in the way that I want. > If my requirements were unclear from my prose, perhaps the code below > will illuminate them better. > > An STSTM transaction is intended to be an STM transaction imbued with a > state token that encapsulates additional, transaction-local state in the > spirit of ST. > > It is not intended to secretly perform IO inside STM, a la > GHC.Conc.unsafeIOToSTM. > > It is not intended to facilitate the leaking of state into or out of an > STM transaction through STRefs, nor to communicate state between > successive retries of an STM transaction. On 10 February 2016 at 01:12, Jonas Scholl wrote: > I understand that, you just said, you wanted to sprinkle some runST > calls with unsafeThawArray and unsafeFreezeArray into your STM code. So > I assumed you wanted to share an (ST)Array between these STM actions. Sorry for the confusion. unsafeThawArray and unsafeFreezeArray were an alternative solution for modifying the transaction-local Array in place, directly in an STM action. Rather than use unsafeThawArray, STSTM is intended to allow the safe interleaving of safe STM actions with safe ST actions, where the ST state is local and private to the STM transaction. I don't plan on using any unsafe ST functions with STSTM at all. Naturally, the STSTM implementation itself must use some kind of unsafe function, but hopefully only in a safe way. On 9 February 2016 at 23:46, Thomas Koster wrote: > Thanks to hints from Ryan and Jonas, I made an attempt at implementing > it myself. > > Below is my implementation of STSTM and associated operations. You will > need to link with the "primitive" and "stm" packages. I used versions > 0.6 and 2.4.4, resp., and GHC 7.10.2. > > > {-# LANGUAGE GeneralizedNewtypeDeriving, Rank2Types #-} > > module Control.Monad.STSTM > ( > STSTM, > liftST, > liftSTM, > atomicallyRunST, > module Control.Monad.STM > ) > where > > import Control.Monad.Primitive > import Control.Monad.ST > import Control.Monad.STM > > -- | A computation of type @STSTM s a@ is an 'STM' computation that > -- also transforms a transaction-local internal state indexed by @s@, as > -- in the 'ST' monad, and returns a value of type @a at . > newtype STSTM s a = STSTM { unSTSTM :: STM a } > deriving (Functor, Applicative, Monad) > > -- | Lift an 'ST' computation into the 'STSTM' transaction. > liftST :: ST s a -> STSTM s a > {-# INLINE liftST #-} > liftST x = STSTM $ > let y = unsafeInlineST x > in y `seq` return y On 10 February 2016 at 01:12, Jonas Scholl wrote: > This is highly unsafe and will not do what you think it does! > unsafeInlineST provides an ST action with a realWorld# token out of thin > air and thus can float outside liftST, especially because you inline it. > This produces exactly the bug I reported against STMonadTrans. Thank you for checking it out. I am not surprised that it does not do what I think, because I don't even know what to think: unsafeInlineST had no documentation. I wonder what its purpose is then. So you are saying that because there is no data dependency on the *true* state token (it evaluates the fake token instead), GHC is free to rearrange, duplicate or elide the effects on the state with regard to the other calls to liftST (and the STM actions too), causing those effects on the state to be unpredictable? Is this also why I thought I needed seq, when in fact what I needed to do was thread the correct state token? > A safe version could take the state token from the STM action, pass it > into the ST action and carry on with the returned state token (look at > GHC.Conc.Sync). Or convert the ST action to IO and then just run the IO > action in STM. This makes much more sense. I will look into these alternatives. > This should be fine if you do not use unsafeThaw - any > garbage written to some STRef/STArray will be thrown away after the > runtime sees the STM action will fail and restarts it. That's what I want. On 9 February 2016 at 23:46, Thomas Koster wrote: > -- | Lift an 'STM' computation into the 'STSTM' transaction. > liftSTM :: STM a -> STSTM s a > {-# INLINE liftSTM #-} > liftSTM = STSTM > > -- | Perform a series of 'STSTM' actions atomically. > -- > -- The 'ST' state is discarded when the 'STM' transaction commits or > -- retries. > atomicallyRunST :: (forall s. STSTM s a) -> IO a > {-# INLINE atomicallyRunST #-} > atomicallyRunST x = atomically (unSTSTM x) > > > Some commentary follows: > > Some initial sanity testing with the GHC threaded runtime shows that it > does what I want, but I am not familiar enough with Core or the RTS to > predict whether or not it will launch nuclear missiles at the next > transit of Venus. I would be grateful for any feedback. > > The use of rank-2 polymorphism in the type of atomicallyRunST is > intended to encapsulate the ST state exactly like it does for runST, > and that the ST state cannot leak into or out of the transaction. On 10 February 2016 at 01:12, Jonas Scholl wrote: > What you still can not use is unsafeThaw. Consider this: > > foo :: Array Int Val -> TVar Int -> IO someResult > foo arr var = atomicallyRunST $ do > marr <- liftST $ unsafeThaw arr > val <- liftSTM $ readTVar var > liftST $ writeArray marr val someOtherVal > ... do something more... > > What happens if the transaction is restarted after the write? You've > written into arr (unsafeThaw did not copy it), but have no log to revert > the write. Now you see a different immutable array. This is bad. > > So you can not use unsafeThaw. Even if only one transaction gets a hold > on this array and it would be safe to use unsafeThaw with plain ST (as > this can not retry), because the transaction has to depend on other > TVars etc, otherwise there would be no need for STM. > > And now I am wondering what happens if a thread evaluates something like > runST ... unsafeThawArray ... unsafeFreezeArray ... and is hit by an > asynchronous exception... The computation is restated the next time the > thunk is demanded, but this could have already changed the array, right? > So can runST ... unsafeThawArray ... be used in a safe way or is this > combination inherently broken? Agreed. This is a problem wherever unsafeThawArray is used. I understand that nothing I do can make unsafeThawArray safer. Using unsafe functions here would be at least as unsafe as using them in ST. But if the idea of STSTM works and is safe, I will not be using any unsafe ST functions in the ST actions at all. > Anyway, I think the following holds true: > - using STRefs: These must have been created in the transaction, so it > works. > - using STArrays: unsafeThawing an incoming Array will break > referential transparency sooner or later. Thawing (and thus copying) the > incoming array or creating a fresh one should work. > - using TArrays: You can return these from the STM action and start > another one later with them without breaking referential transparency as > always. If you have to modify incoming arguments, even if only one STM > action has a reference to them at a time, these can be faster as you do > not have to copy everything - instead they will have a log of the > writes, so you would have to benchmark copying against transaction logs. On 9 February 2016 at 23:46, Thomas Koster wrote: > STSTM is not a monad transformer (visibly or internally). I hope that > any potential problems that might afflict the STMonadTrans package are > irrelevant here. On 10 February 2016 at 01:12, Jonas Scholl wrote: > You won't have problems with lists as underlying monad, yes. On 9 February 2016 at 23:46, Thomas Koster wrote: > I use seq in liftST to force the unsafe inline ST computation to occur > before bind proceeds to the next computation. Without seq, ST > computations returning () (or anything else that is not evaluated) > appear to stay as thunks and never transform any state. I suspect this > may cause problems with bottoms, but I am not sure if that is any > different from real ST/runST. On 10 February 2016 at 01:12, Jonas Scholl wrote: > Keep in mind that a `seq` b does not guarantee that a is evaluated > before b. I think this is not a problem here, as there are more severe > problems anyway (see above), but this is generally good to have in mind > when writing such code. I hope that if I can fix the unsafety by threading the true state token through, as per your suggestion above, seq will no longer be necessary. -- Thomas Koster From benl at ouroborus.net Wed Feb 10 04:11:14 2016 From: benl at ouroborus.net (Ben Lippmeier) Date: Wed, 10 Feb 2016 15:11:14 +1100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B542AF.4070106@artyom.me> <0D986829-3CD7-43C6-92A7-97BB954DB850@cis.upenn.edu> <1C16B40A-5196-44D1-8944-A8D253C46A95@ouroborus.net> <56B72180.6040900@durchholz.org> <619CFC50-DD2A-402F-A5D6-D986C9F4C4DE@ouroborus.net> Message-ID: I meant to retain the separate types Int and Int#, but to assign both of them the same kind *. I believe the unboxed kind # was added to prevent polymorphic functions being instantiated at unboxed types. This is done because while values with types of kind * have a uniform representation, values with types of kind # do not, so the usual code generation approach does not work. The solution I was proposing was to allow polymorphic functions to be used at unboxed types, and do the code generation by simply specialising those functions for the types they are instantiated at. You would need to compile each polymorphic function several times, but then if someone is writing code that uses explicit unboxed types the associated functions are probably INLINEd anyway. The Int type would still be lazy/lifted, and Int# unlifted, so that would not have to change. If you think the above plan would not work then I?d like to hear about it. I was planning to do something like it for DDC (which still progresses..) Ben. > On 9 Feb 2016, at 4:39 am, Edward Kmett wrote: > > This doesn't really work in a non-strict language like Haskell with uncontrolled recursion. We often need a lazy int that may be _|_ and shouldn't affect termination of the program unless demanded. > > The result would be that you'd actually have to compile all of your code several ways times the number of type arguments and you'd get rather severely different semantics around evaluation as it switched between strictness and laziness. > > Moreover, cycles that happened to involve one of these values would have to tie the knot strictly, meaning you'd have issues like scheme where letrec secretly exposes extra, observable, #f cases when you encounter a cycle. > > -Edward > > On Sun, Feb 7, 2016 at 7:17 AM, Ben Lippmeier > wrote: > > > On 7 Feb 2016, at 9:50 pm, Joachim Durchholz > wrote: > > > For the Int/Int# concept, the approaches I have seen either ignore the efficiency and let the machine figure out what to do (Smalltalk, Python, pre-Int# Haskell), or they complicate the type system at the expense of polymorphism (Java, Eiffel), or they complicate the type system even more to regain some form of polymorphism (C++, today's Haskell). > > Although I haven?t implemented it, I suspect another approach is to just specialise every polymorphic function at its unboxed type arguments. Boxed and unboxed value types would share the same kind. Of course, full specialisation of polymorphic code assumes that code is available in the interface files, but we?ve almost got that already. Dealing with mutual recursion could be a pain, though. > > I don?t think specialisation was an option back when unboxed types were originally implemented. I believe GHC?s support for cross module inlining came some time after the unboxed types, if the publication dates of the relative papers are to be a guide. > > Ben. > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcin.jan.mrotek at gmail.com Wed Feb 10 07:21:40 2016 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Wed, 10 Feb 2016 08:21:40 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56BA6E61.5000200@durchholz.org> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BA1F31.1030607@durchholz.org> <56BA6E61.5000200@durchholz.org> Message-ID: > > Are these in Haskell already? I see them referenced in something that's > called LiquidHaskell, which has its last blog entry from Jan 2015. > Unfortunately, I don't think they are, outside of LiquidHaskell. But LH seems to be actively developed, nevermind the stale blog - last commit to the Github repo was 11 days ago. Best regards, Marcin Mrotek -------------- next part -------------- An HTML attachment was scrubbed... URL: From rustompmody at gmail.com Wed Feb 10 07:42:13 2016 From: rustompmody at gmail.com (Rustom Mody) Date: Wed, 10 Feb 2016 13:12:13 +0530 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56B9FAF4.4040109@durchholz.org> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> Message-ID: On Tue, Feb 9, 2016 at 8:13 PM, Joachim Durchholz wrote: Am 09.02.2016 um 14:20 schrieb Rustom Mody: > > FP in ACM Curriculum 2013 >> < >> http://blog.languager.org/2015/06/functional-programming-moving-target.html >> > >> spells out this ? omnibus language ? and such fallacies in more detail. >> > > He claims this, but he does not back that up with any arguments. > There's only reference to authority (Peter Naur). > Well if you dont like external evidence of this -- "authority" -- here's some internal evidence: An excerpt from the burning bridges exchange from the libraries list On Wed, May 22, 2013 at 8:39 PM, Ivan Lazar Miljenovic wrote: >* On 23 May 2013 07:32, Malcolm Wallace wrote: *>>* -20 for generalising the Prelude *>>* +1 for removals from the Prelude *>>* -1 for adding monomorphic stuff *>>* +1000 for doing nothing *>>>>* You are all nuts. :-) *>>* I don't know if I'd go quite _that_ for as Malcolm for the weightings *>* for the different proposals... *>>* But I was speaking with a few other tutors of an introductory *>* CS/programming course that uses Haskell (note: it's teaching *>* programming with Haskell, not teaching Haskell per se: for example, *>* all pattern matchings must be done with case statements as the *>* lecturer considers top-level pattern matching a Haskell-specific *>* quirk) about these proposals... * Casey McCann responded: So in other words, your contention is that the design of the core library of Haskell should be driven by the needs of an introductory programming course, which is not even attempting to teach Haskell specifically, aimed at students who can't even figure out how tab characters work? That's marvelous. My conclusion: Casey representing library-authors and Ivan+Malcolm speaking for teachers have sufficiently divergent needs to need two different languages. Two different preludes+commandline options is a good start in that direction If you disagree what do you make of Richard Eisenberg's : > It may come as a surprise to many of you that I, too, am very worried about Haskell becoming > inaccessible to newcomers. If we can't induct new people into our ranks, we will die. It is > for this reason that I have always been unhappy with the FTP. But that ship has sailed. Just as a thought experiment: The FTP had a landslide support on the libraries list. How would it have fared on a Haskell-Edu list? -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom.schrijvers at cs.kuleuven.be Wed Feb 10 11:40:02 2016 From: tom.schrijvers at cs.kuleuven.be (Tom Schrijvers) Date: Wed, 10 Feb 2016 12:40:02 +0100 Subject: [Haskell-cafe] Postdoctoral position in Functional, Constraint and/or Logic Programming Message-ID: Prof. Tom Schrijvers invites applications for a postdoctoral position in the area of functional, constraint and logic programming. The position revolves around domain-specific languages (DSLs) embedded in Haskell for constraint programming. It is part of the EU project GRACeFUL whose overarching theme is tools for collective decision making. Responsibilities You will work closely with prof. Schrijvers and his PhD students at KU Leuven, as well as with the GRACeFUL project partners across Europe, in order to conduct research activities for the GRACeFUL project. For more details: https://icts.kuleuven.be/apps/jobsite/vacatures/53613023 -- prof. dr. ir. Tom Schrijvers Research Professor KU Leuven Department of Computer Science Celestijnenlaan 200A 3001 Leuven Belgium Phone: +32 16 327 830 http://people.cs.kuleuven.be/~tom.schrijvers/ -------------- next part -------------- An HTML attachment was scrubbed... URL: From r.gaschignard at gmail.com Wed Feb 10 13:59:53 2016 From: r.gaschignard at gmail.com (Raphael Gaschignard) Date: Wed, 10 Feb 2016 13:59:53 +0000 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> Message-ID: I think the "show a simple type, then the 'real' type " solution is pretty good ( especially since you need to be doing type level programming to hit issues where the simple type doesn't hold anyways) , but on the topic of several languages: doesn't Haskell98 kind of solve the teaching issue? If you're using the standard stuff stick to the old $... I know Racket does some "language swapping" so that a beginner language is available . I don't know how well that works -------------- next part -------------- An HTML attachment was scrubbed... URL: From bjp at informatik.uni-kiel.de Wed Feb 10 14:09:38 2016 From: bjp at informatik.uni-kiel.de (=?UTF-8?B?QmrDtnJuIFBlZW3DtmxsZXI=?=) Date: Wed, 10 Feb 2016 15:09:38 +0100 Subject: [Haskell-cafe] Hackage: Tarball and package description of package mtl differ Message-ID: <56BB44A2.2020608@informatik.uni-kiel.de> Hi Cafe, I just wanted to install the mtl package for GHC 8.0.1-rc2, but installation failed with Setup: Encountered missing dependencies: transformers ==0.4.* Taking a look at the package description [1], it specifies build-depends: base < 6, transformers >= 0.4 && < 0.6 but the Cabal description in the tarball [2] says build-depends: base < 6, transformers == 0.4.* Strangely, if I execute $ cabal unpack mtl-2.2.1 I obtain a version with the same specification as [1]. Does anybody has an explanation for this? Regards, Bj?rn [1]: http://hackage.haskell.org/package/mtl-2.2.1/mtl.cabal [2]: http://hackage.haskell.org/package/mtl-2.2.1/mtl-2.2.1.tar.gz From adam at bergmark.nl Wed Feb 10 14:18:30 2016 From: adam at bergmark.nl (Adam Bergmark) Date: Wed, 10 Feb 2016 15:18:30 +0100 Subject: [Haskell-cafe] Hackage: Tarball and package description of package mtl differ In-Reply-To: <56BB44A2.2020608@informatik.uni-kiel.de> References: <56BB44A2.2020608@informatik.uni-kiel.de> Message-ID: This is because a revision to the cabal file was published[1]. Tarballs always stay the same (because of possible signing, etc) but cabal-install will use the revised metadata when doing most of its operation including `install', `get', and `unpack'. You don't say how you are trying to install mtl, is it not through Cabal? Either way, make sure to use the revised cabal file and it should be fine. HTH, Adam [1] https://hackage.haskell.org/package/mtl-2.2.1/revisions/ On Wed, Feb 10, 2016 at 3:09 PM, Bj?rn Peem?ller wrote: > Hi Cafe, > > I just wanted to install the mtl package for GHC 8.0.1-rc2, but > installation failed with > > Setup: Encountered missing dependencies: > transformers ==0.4.* > > Taking a look at the package description [1], it specifies > > build-depends: base < 6, transformers >= 0.4 && < 0.6 > > but the Cabal description in the tarball [2] says > > build-depends: base < 6, transformers == 0.4.* > > Strangely, if I execute > > $ cabal unpack mtl-2.2.1 > > I obtain a version with the same specification as [1]. > > Does anybody has an explanation for this? > > Regards, > Bj?rn > > [1]: http://hackage.haskell.org/package/mtl-2.2.1/mtl.cabal > [2]: http://hackage.haskell.org/package/mtl-2.2.1/mtl-2.2.1.tar.gz > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From miguelimo38 at yandex.ru Wed Feb 10 14:26:26 2016 From: miguelimo38 at yandex.ru (Miguel Mitrofanov) Date: Wed, 10 Feb 2016 17:26:26 +0300 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> Message-ID: <5901041455114386@web21g.yandex.ru> One thing that I truly HATE about Scala API reference is that they show you the "simple" (meaning: fake) type, and you have to click to see the real type. It makes going through docs so much slower. 10.02.2016, 17:01, "Raphael Gaschignard" : > I think the "show a simple type, then the 'real' type " solution is pretty good ( especially since you need to be doing type level programming to hit issues where the simple type doesn't hold anyways) , but on the topic of several languages: doesn't ?Haskell98 kind of solve the teaching issue? If you're using the standard stuff stick to the old $... > > I know Racket does some "language swapping" so that a beginner language is available . I don't know how well that works > , > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From bjp at informatik.uni-kiel.de Wed Feb 10 14:27:08 2016 From: bjp at informatik.uni-kiel.de (=?UTF-8?B?QmrDtnJuIFBlZW3DtmxsZXI=?=) Date: Wed, 10 Feb 2016 15:27:08 +0100 Subject: [Haskell-cafe] Hackage: Tarball and package description of package mtl differ In-Reply-To: References: <56BB44A2.2020608@informatik.uni-kiel.de> Message-ID: <56BB48BC.3000205@informatik.uni-kiel.de> Am 10.02.2016 um 15:18 schrieb Adam Bergmark: > This is because a revision to the cabal file was published[1]. Tarballs > always stay the same (because of possible signing, etc) but > cabal-install will use the revised metadata when doing most of its > operation including `install', `get', and `unpack'. Hi Adam, thank you for the explanation. I tried to install cabal-install taken from GitHub for GHC 8.0.0.rc2 via the included `bootstrap.sh` script, which essentially obtains the tarball from hackage using `curl` and then calls $ cd mtl-2.2.1 $ ghc --make Setup.hs -o Setup $ ./configure # + additional options > You don't say how you are trying to install mtl, is it not through > Cabal? Either way, make sure to use the revised cabal file and it > should be fine. Okay, I will then install mtl by hand and try the bootstrap script afterwards. Thanks, Bj?rn From johannes.waldmann at htwk-leipzig.de Wed Feb 10 15:29:24 2016 From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann) Date: Wed, 10 Feb 2016 16:29:24 +0100 Subject: [Haskell-cafe] tighter bounds for Data.Map operations (using min(n.m))? Message-ID: <56BB5754.8040000@htwk-leipzig.de> Dear Cafe, I wonder if some of the resource bounds in https://hackage.haskell.org/package/containers-0.5.7.1/docs/Data-Map-Strict.html can be improved. I do not mean "improve the implementation", but "improve the (stated) bounds". For example, I am interested in intersection(With). Bound is stated as O(n+m) (*) This is a fine worst case bound - but I certainly use this function with the implied assumption that it will not visit both trees completely - in the case that one of them is small. So, what can we say in terms of min(n,m) ? Is it linear in that parameter? Perhaps with an additional factor log(max(n,m)) ? (for looking up the keys of the smaller tree in the larger one) The paper linked from the docs has this (p 18 before 9.3) "the running time of union is better for fortuitous inputs, for example, similar sized disjoint ranges, and trees which differ greatly in size" but does not make a formal statement. This is about union, not intersection, and not hedge_union, but it's the closest this paper gets to what I have in mind. Oh, and after that, same question for Data.IntMap. - J.W. (*) with the usual neglect for alphabetic order... From johannes.waldmann at htwk-leipzig.de Wed Feb 10 15:32:21 2016 From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann) Date: Wed, 10 Feb 2016 16:32:21 +0100 Subject: [Haskell-cafe] tighter bounds for Data.Map operations (using min(n.m))? Message-ID: <56BB5805.2050305@htwk-leipzig.de> See also https://github.com/haskell/containers/issues/177 (which I found only now) - J.W. From spam at scientician.net Wed Feb 10 15:32:56 2016 From: spam at scientician.net (Bardur Arantsson) Date: Wed, 10 Feb 2016 16:32:56 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> Message-ID: On 02/10/2016 02:59 PM, Raphael Gaschignard wrote: > I think the "show a simple type, then the 'real' type " solution is pretty > good ( especially since you need to be doing type level programming to hit > issues where the simple type doesn't hold anyways) It *might* work, but it needs to be *EXTREMELY* clear (visually and perhaps otherwise) in the documentation that is lying to -- ehm, I mean simplifying for -- you. Scala went with the same idea of lying (they call it the "use case") in the documentation of some of their collection method signatures and I can tell you from personal experience that it can be absolutely *infuriating* to have worked on trying to understand an error based on the documentation only to realise that what the compiler checks and what the documentation shows you isn't the same thing. Incidentally Java had a similar issue with the whole public class Foo { public static void main(String[] args) { } } incantation being needed to teach beginners the first thing about Java. You know what I did -- I just said "yeah, just ignore that bit, I'll explain when you're ready" and it wasn't actually a problem in practice. Turns out people are quite at ignoring things they don't understand as long as you *tell them* to just ignore it until later. (Also, remember that this is *one* symbol we're talking about, albeit a relatively common one. You could just *avoid* it entirely in teaching material if you so desire.) Regards, From jo at durchholz.org Wed Feb 10 17:30:28 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Wed, 10 Feb 2016 18:30:28 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> Message-ID: <56BB73B4.5@durchholz.org> Am 10.02.2016 um 16:32 schrieb Bardur Arantsson: > Incidentally Java had a similar issue with the whole > > public class Foo { > public static void main(String[] args) { > } > } > > incantation being needed to teach beginners the first thing about Java. > You know what I did -- I just said "yeah, just ignore that bit, I'll > explain when you're ready" and it wasn't actually a problem in practice. > Turns out people are quite at ignoring things they don't understand as > long as you *tell them* to just ignore it until later. Java's main() is a single thing that you simply copy&paste and can forget about while learning the language. Haskell's extended type declarations will reappear whenever a student explores the library. I.e. the Java issue is a single loose end. The Haskell issue keeps adding more loose ends as students progress. I am not sure how relevant that is going to be in practice. Maybe it's possible to come up with a short "for now" explanation that is consistent with what students will experience; if that's possible, I'd expect that to be much preferrable over a simplified/lying Prelude. One thing about a simplified Prelude: It will profoundly unnerve newbies. The feeling of shifting ground the first time they see that something is amiss will make them feel insecure, because they won't know how much of what they already learned will have to be thrown overboard. They won't know anymore how much they still have to learn, which is just as unnerving. If a simplified Prelude is used as a teaching tool, then that should be done in a way that allows students to look beyond that barrier, so they know which of their knowledge is preliminary, and how much they will have to learn after it. From spam at scientician.net Wed Feb 10 17:54:08 2016 From: spam at scientician.net (Bardur Arantsson) Date: Wed, 10 Feb 2016 18:54:08 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56BB73B4.5@durchholz.org> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BB73B4.5@durchholz.org> Message-ID: On 02/10/2016 06:30 PM, Joachim Durchholz wrote: [--snip--] > I am not sure how relevant that is going to be in practice. Maybe it's > possible to come up with a short "for now" explanation that is > consistent with what students will experience; if that's possible, I'd > expect that to be much preferrable over a simplified/lying Prelude. > > One thing about a simplified Prelude: It will profoundly unnerve > newbies. The feeling of shifting ground the first time they see that > something is amiss will make them feel insecure, because they won't know > how much of what they already learned will have to be thrown overboard. How do you know that they will feel this way? I feel like most people in this thread are just going by assumptions. (I guess I could be accused of the same thing, but I guess arguing for the status quo doesn't really incur a burden of proof. We can see that it at least works somewhat well. Granted the $ type is new, but advanced type signatures abound in Haskell already. It's kind of par for the course.) Regards, From ekmett at gmail.com Wed Feb 10 18:02:53 2016 From: ekmett at gmail.com (Edward Kmett) Date: Wed, 10 Feb 2016 13:02:53 -0500 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <20160207153909.GB2590@weber> References: <20160205191925.GC28854@weber> <20160206115920.GA30442@weber> <20160206122049.GB30442@weber> <20160206123309.GD30442@weber> <20160207153909.GB2590@weber> Message-ID: On Sun, Feb 7, 2016 at 10:39 AM, Tom Ellis < tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > If we were inventing a language from the beginning, would it be strictly > necessary to have two kinds? > Could we have just an unboxed kind #, and have > a box be an explicit type constructor? > Does this thing seem remotely plausible to people who know clever type > theory? > > Idris tries to do this with their Lazy type -- to somewhat mixed success, so yes, it is a thing that can be done in a language designed from scratch. -------------- next part -------------- An HTML attachment was scrubbed... URL: From dave at zednenem.com Wed Feb 10 21:23:57 2016 From: dave at zednenem.com (David Menendez) Date: Wed, 10 Feb 2016 16:23:57 -0500 Subject: [Haskell-cafe] Why do we want levity polymorphism? Message-ID: For context, there?s currently a big thread about the type of ($), which is going to be more complicated in GHC 8.0 due to levity/runtime rep polymorphism. As I understand it, the intention is that this more complex type will be hidden unless a levity polymorphism flag is active. From my perspective, makes the question of whether this type is too complicated for beginners moot. What puzzles me is that I still don?t understand what this feature is *for*. According to [1], levity polymorphism is a more principled replacement for OpenKind, which was a bit of hack. Fine. [1] https://ghc.haskell.org/trac/ghc/wiki/NoSubKinds OpenKind exists because developers wanted to use ($), undefined, and error with unboxed types. That?s understandable, but it doesn?t seem worth all this effort. Surely, having to use error# instead of error when working with unboxed or unlifed types is a small thing next to all the other differences. OpenKind is also used when doing type inference, because arguments to functions might be * or #. That?s more compelling, but doesn?t seem like something that needs to be exposed to the programmer. So, is that it? Are there less-trivial levity-polymorphic functions? Is this a step on a road to new features, like [2]? Is there an article or something that makes the case for this? [2] https://ghc.haskell.org/trac/ghc/wiki/UnliftedDataTypes -- Dave Menendez -------------- next part -------------- An HTML attachment was scrubbed... URL: From ok at cs.otago.ac.nz Thu Feb 11 00:02:36 2016 From: ok at cs.otago.ac.nz (Richard A. O'Keefe) Date: Thu, 11 Feb 2016 13:02:36 +1300 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> Message-ID: <56BBCF9C.6040101@cs.otago.ac.nz> > Just as a thought experiment: The FTP had a landslide support on the > libraries list. > How would it have fared on a Haskell-Edu list? Judging by the list of changes at https://wiki.haskell.org/Foldable_Traversable_In_Prelude the changes were mostly some extra classes (Monoid, Foldable, Traverseable) showing up in Prelude and a bunch of type changes to functions: ... [x] ... changing to (Foldable t) => ... t x ... ... [x] ... changing to (Traverseable t) => ... t x ... This is actually quite an interesting change. Using the same names *consistently* across a wide range of types makes programs easier to write and easier to read. From an educational point of view, you can't say "We didn't need the Prelude to write `all` for us. We could have written all p (x:xs) = p x && all p xs all _ [] = True " any more because that has the wrong (old, list-specific) type. You *can* say "We could have written all = foldr True (&&) " So you lose a lesson that comes somewhere near the beginning, when you are still trying to get across the idea of higher order functions and lazy evaluation, and gain a lesson that comes much later, about the power that typeclasses add to composition. Come to think of it, you could use this to motivate typeclasses. I think you could build *just as good* an introductory Haskell course on the post-FTP libraries as you could on the pre-FTP libraries, but it would be a *different* course. The current proposal feels qualitatively different. For one thing, the FTP approach *could* have been taken back in Haskell 98, or even earlier, had someone happened to think of it, because all the typeclass machinery was there to do the job. And it would have been obviously *useful* back then: "hey, you mean that if I define a Tree type just a few more lines of code give me all these summarisation methods? Cool, this is just as good as OOP." But the current change is mainly warranted by the desire to handle unboxed types. That's an "engineering" issue: if you're trying to make Haskell go fast, even 'unknown size integers that go wrong' (Int) isn't fast enough, 'unknown size integers that violate the all-values-are-the-same-size assumption behind polymorphism' (Int#) are what you want. This is not a problem in an introductory class, where you would normally be telling people to use Integer because they have enough problems without the weirdness of fixed-size integers. From takenobu.hs at gmail.com Thu Feb 11 12:19:03 2016 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Thu, 11 Feb 2016 21:19:03 +0900 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B6097C.1010500@ro-che.info> Message-ID: Hi, I understood one more point. (I share here.) The Prelude library document for ghc 8.0 is already well described for beginners/newcomers. * The ($)'s signature of 8.0.1 is already simple (not include forall ...). * The Bool's kind of 8.0.1 is already represented with "TYPE Lifted" (changed from '*'). ghc7.8.4 [1]: data Bool :: * foldr :: (a -> b -> b) -> b -> [a] -> b ($) :: (a -> b) -> a -> b ghc7.10.4 [2]: data Bool :: * foldr :: (a -> b -> b) -> b -> t a -> b ($) :: (a -> b) -> a -> b ghc8.0.1-rc2 [3]: data Bool :: TYPE Lifted foldr :: (a -> b -> b) -> b -> t a -> b ($) :: (a -> b) -> a -> b [1] https://downloads.haskell.org/~ghc/7.8.4/docs/html/libraries/base-4.7.0.2/Prelude.html [2] https://downloads.haskell.org/~ghc/latest/docs/html/libraries/base-4.8.2.0/Prelude.html [3] https://downloads.haskell.org/~ghc/8.0.1-rc2/docs/html/libraries/base-4.9.0.0/Prelude.html Regards, Takenobu 2016-02-08 19:08 GMT+09:00 Takenobu Tani : > Hi Richard and devs, > > What a wonderful (#11549) ! > This is a beautiful solution for beginners/newcomers. > Beginners will not confuse and they can gradually go ahead. > > I extremely appreciate that you are continuously improving the ghc for us. > > Thank you very much, > Takenobu > > > 2016-02-07 0:17 GMT+09:00 Richard Eisenberg : > >> I have made a ticket #11549 ( >> https://ghc.haskell.org/trac/ghc/ticket/11549) requesting a >> -fshow-runtime-rep flag (recalling that the name levity will soon be >> outdated) as described in this thread. I will make sure this gets in for >> the release of 8.0. >> >> Other points: >> >> - You're quite right that (.) could be generalized. But I'll wait for >> someone to really want this. >> >> - I don't have a non-contrived example of the use of ($) with unlifted >> types. It's quite possible that when adding the dirty runST hack, it was >> observed that an unlifted type would be OK. At that point, the type of ($) >> didn't need to become so elaborate. And now we're just trying not to change >> old (but perhaps unrequested) behavior. >> >> - For the record, this debate is entirely unrelated to the runST >> impredicativity hack. (Except, as noted above, perhaps in history.) That >> hack remains, basically unchanged. >> >> - On Feb 6, 2016, at 9:55 AM, Roman Cheplyaka wrote: >> > >> > I would call this a simplification rather than a lie. >> >> This is a very convincing argument. >> >> - Thanks, also, for the voice of support. What I love about the Haskell >> community is that we can have an impassioned debate full of strong >> opinions, and it all very rarely devolves into a proper flame war. All the >> posts I've seen in this thread have been constructive and helpful. Thanks. >> >> Richard >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ben at smart-cactus.org Thu Feb 11 12:33:09 2016 From: ben at smart-cactus.org (Ben Gamari) Date: Thu, 11 Feb 2016 13:33:09 +0100 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B6097C.1010500@ro-che.info> Message-ID: <87twlf8m0q.fsf@smart-cactus.org> Takenobu Tani writes: > Hi, > > I understood one more point. (I share here.) > The Prelude library document for ghc 8.0 is already well described for > beginners/newcomers. > > * The ($)'s signature of 8.0.1 is already simple (not include forall ...). > * The Bool's kind of 8.0.1 is already represented with "TYPE Lifted" > (changed from '*'). > > > ghc7.8.4 [1]: > > data Bool :: * > foldr :: (a -> b -> b) -> b -> [a] -> b > ($) :: (a -> b) -> a -> b > > > ghc7.10.4 [2]: > > data Bool :: * > foldr :: (a -> b -> b) -> b -> t a -> b > ($) :: (a -> b) -> a -> b > > > ghc8.0.1-rc2 [3]: > > data Bool :: TYPE Lifted To clarify, this isn't actually a change; `*` is merely a synonym for `TYPE 'Lifted`. Moreover, I believe this is a bug. In general we should continue to show `*` for plain lifted types. If you look at other types in the -rc2 haddocks you will see that they are indeed rendered as they were in previous releases, with no kind annotation at all. Bool is likely only rendered differently as it is a wired-in type; we'll need to fix this. I've opened #11567 to track this issue. Cheers, - Ben -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 472 bytes Desc: not available URL: From takenobu.hs at gmail.com Thu Feb 11 13:47:26 2016 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Thu, 11 Feb 2016 22:47:26 +0900 Subject: [Haskell-cafe] Language complexity & beginners (Was: New type of ($) operator in GHC 8.0 is problematic) In-Reply-To: <87twlf8m0q.fsf@smart-cactus.org> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <6B40AE7F-84DE-48A2-83FF-1940786CFC1F@cis.upenn.edu> <56B6097C.1010500@ro-che.info> <87twlf8m0q.fsf@smart-cactus.org> Message-ID: Hi Ben, Thank you for explanation. Sorry, I was misunderstood that ghc8 changes representation of '*'. (In addition to the Bool, but also Int, Float,..) There are also followings: Alternative f => Monoid (Alt (TYPE Lifted) f a) Functor (Proxy (TYPE Lifted)) Foldable (Const (TYPE Lifted) m) Thank you very much, Takenobu 2016-02-11 21:33 GMT+09:00 Ben Gamari : > Takenobu Tani writes: > > > Hi, > > > > I understood one more point. (I share here.) > > The Prelude library document for ghc 8.0 is already well described for > > beginners/newcomers. > > > > * The ($)'s signature of 8.0.1 is already simple (not include forall > ...). > > * The Bool's kind of 8.0.1 is already represented with "TYPE Lifted" > > (changed from '*'). > > > > > > ghc7.8.4 [1]: > > > > data Bool :: * > > foldr :: (a -> b -> b) -> b -> [a] -> b > > ($) :: (a -> b) -> a -> b > > > > > > ghc7.10.4 [2]: > > > > data Bool :: * > > foldr :: (a -> b -> b) -> b -> t a -> b > > ($) :: (a -> b) -> a -> b > > > > > > ghc8.0.1-rc2 [3]: > > > > data Bool :: TYPE Lifted > > To clarify, this isn't actually a change; `*` is merely a synonym for > `TYPE 'Lifted`. > > Moreover, I believe this is a bug. In general we should continue to show > `*` for plain lifted types. If you look at other types in the -rc2 > haddocks you will see that they are indeed rendered as they were in > previous releases, with no kind annotation at all. Bool is likely only > rendered differently as it is a wired-in type; we'll need to fix this. > I've opened #11567 to track this issue. > > Cheers, > > - Ben > -------------- next part -------------- An HTML attachment was scrubbed... URL: From roma at ro-che.info Thu Feb 11 15:02:22 2016 From: roma at ro-che.info (Roman Cheplyaka) Date: Thu, 11 Feb 2016 17:02:22 +0200 Subject: [Haskell-cafe] Why do we want levity polymorphism? In-Reply-To: References: Message-ID: <56BCA27E.9060503@ro-che.info> On 02/10/2016 11:23 PM, David Menendez wrote: > For context, there?s currently a big thread about the type of ($), which > is going to be more complicated in GHC 8.0 due to levity/runtime rep > polymorphism. As I understand it, the intention is that this more > complex type will be hidden unless a levity polymorphism flag is active. > From my perspective, makes the question of whether this type is too > complicated for beginners moot. > > What puzzles me is that I still don?t understand what this feature is > *for*. > [...] > So, is that it? Are there less-trivial levity-polymorphic functions? Is > this a step on a road to new features, like [2]? Is there an article or > something that makes the case for this? > > [2] https://ghc.haskell.org/trac/ghc/wiki/UnliftedDataTypes Exactly. At least from my perspective, the value comes from unlifted data types. Given how much doubt levity polymorphism has received recently, I might write an article about it, but for now I recommend watching Richard's ICFP talk https://www.youtube.com/watch?v=bDdkeKr9vVw (Also, for those who understand Russian, we discussed levity polymorphism in the episode 10 of the Bananas and Lenses podcast http://bananasandlenses.net/episode010.) Roman -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 819 bytes Desc: OpenPGP digital signature URL: From grutman123 at gmail.com Thu Feb 11 16:57:08 2016 From: grutman123 at gmail.com (Edward Grutman) Date: Thu, 11 Feb 2016 11:57:08 -0500 Subject: [Haskell-cafe] Source code for Control.Parallel.Strategies Message-ID: Unable to find source code for Control.Parallel.Strategies module in the libraries folder of the latest ghc ( downloaded from GitHub two weeks ago. ). -------------- next part -------------- An HTML attachment was scrubbed... URL: From roma at ro-che.info Thu Feb 11 17:02:26 2016 From: roma at ro-che.info (Roman Cheplyaka) Date: Thu, 11 Feb 2016 19:02:26 +0200 Subject: [Haskell-cafe] Source code for Control.Parallel.Strategies In-Reply-To: References: Message-ID: <56BCBEA2.1070007@ro-che.info> On 02/11/2016 06:57 PM, Edward Grutman wrote: > Unable to find source code for Control.Parallel.Strategies module in the > libraries folder of the latest ghc ( downloaded from GitHub two weeks > ago. ). What did you try? % find libraries -name 'Strategies*' libraries/parallel/Control/Parallel/Strategies.hs -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 819 bytes Desc: OpenPGP digital signature URL: From rustompmody at gmail.com Thu Feb 11 17:57:29 2016 From: rustompmody at gmail.com (Rustom Mody) Date: Thu, 11 Feb 2016 23:27:29 +0530 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56BBCF9C.6040101@cs.otago.ac.nz> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BBCF9C.6040101@cs.otago.ac.nz> Message-ID: Glad to hear a teacher-pov Richard! On Thu, Feb 11, 2016 at 5:32 AM, Richard A. O'Keefe wrote: > > Just as a thought experiment: The FTP had a landslide support on the >> libraries list. >> How would it have fared on a Haskell-Edu list? >> > > Judging by the list of changes at > https://wiki.haskell.org/Foldable_Traversable_In_Prelude > the changes were mostly some extra classes (Monoid, Foldable, > Traverseable) showing up > in Prelude and a bunch of type changes to functions: > ... [x] ... changing to (Foldable t) => ... t x ... > ... [x] ... changing to (Traverseable t) => ... t x ... > > This is actually quite an interesting change. > Using the same names *consistently* across a wide range of types > makes programs easier to write and easier to read. > From an educational point of view, you can't say > > "We didn't need the Prelude to write `all` for us. > We could have written > > all p (x:xs) = p x && all p xs > all _ [] = True > " > > any more because that has the wrong (old, list-specific) type. > You *can* say > > "We could have written > > all = foldr True (&&) > " > > So you lose a lesson that comes somewhere near the beginning, > when you are still trying to get across the idea of higher order > functions and lazy evaluation, and gain a lesson that comes > much later, about the power that typeclasses add to composition. > Come to think of it, you could use this to motivate typeclasses. > > I think you could build *just as good* an introductory Haskell > course on the post-FTP libraries as you could on the pre-FTP > libraries, but it would be a *different* course. > I think this is a good framing of the question Lets say you take the subject matter for the introductory programming course. And you topsort it along prerequisites; ie topic A precedes topic B if understanding B needs knowledge of A So is the structure/topography of the language Haskell conformant with this topsort? Or does one need to jump against the ordering at times? As example, take a course using C to teach programming. And consider input vs pointers. You have one of 3 choices: 1. Pointers before input -- you probably know programming earlier! 2. Input before pointers -- use getchar not scanf and laboriously write atoi etc before anything else -- classic K&R 3. Bardur's solution -- "just ignore that bit (the '&') , I'll explain when you're ready" For a one-off case that's ok; when it happens at every turn teaching/learning becomes a nightmare The C version of that is described in this old paper: C in education and software engineering I just hope Haskell does not repeat that history -- especially considering that this whole discussion starts with the need to distinguish pointer-types and non-pointer types -------------- next part -------------- An HTML attachment was scrubbed... URL: From aditya.siram at gmail.com Thu Feb 11 20:43:22 2016 From: aditya.siram at gmail.com (aditya siram) Date: Thu, 11 Feb 2016 14:43:22 -0600 Subject: [Haskell-cafe] FLTKHS on WIndows- Call for Help. Message-ID: Hi all, I am the author and maintainer of FLTKHS [1] a cross-platform GUI binding and I could use some help getting it installed on Windows. When I cut a release this past October it was working well on Windows 7 with MinGHC and CMake[2]. Unfortunately MinGHC is now no longer supported and I haven't had much luck getting it to work on with Stack and the mingw that now ships with recent versions GHC. The Stack team is not to blame, I am very much a noob on Windows. I have also recently lost access to my (woefully out-dated) Windows 7 box. As it stands FLTKHS does not work on GHC > 7.10.2 since that is the version supported by the final release of MinGHC. In short, if you are currently using this package on Windows with Stack, please tell me how you got it working. If not and you would benefit from this package could you give it a try and report back? It doesn't have to be a full write up or anything, just a short overview of what you did would be great. When I hear back I'll borrow a machine, try it out, update the documentation and cut another release. Thanks! -deech [1] http://hackage.haskell.org/package [2] http://hackage.haskell.org/package/fltkhs-0.4.0.2/docs/Graphics-UI-FLTK-LowLevel-FLTKHS.html#g:4 -------------- next part -------------- An HTML attachment was scrubbed... URL: From strikingwolf2012 at gmail.com Thu Feb 11 22:48:29 2016 From: strikingwolf2012 at gmail.com (Strikingwolf2012 .) Date: Thu, 11 Feb 2016 16:48:29 -0600 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> Message-ID: I would propose instead that two types are presented. A simple and complex type. The complex type being the most polymorphic and the simple type being the easiest to teach and explain while still not losing the concept of the operator. This way you can present what the real complex type is while also showing what it can be reduced to essentially for our current purposes To those saying this would turn others off Haskell I disagree because it is similar to how we treat functions like black boxes and only identify them by type, name, and documentation. For the purposes of a beginning student they do not need to know the full type system, and thus should treat it as a black box beyond the parts which they are learning. In time one comes to understand the type system but one does not need to understand it at first. On Tue, Feb 9, 2016 at 7:20 AM, Rustom Mody wrote: > On Fri, Feb 5, 2016 at 11:29 PM, Christopher Allen > wrote: > >> >> >> On Fri, Feb 5, 2016 at 11:55 AM, Kyle Hanson wrote: >> >>> I am also happy the discussion was posted here. Although I don't teach >>> Haskell professionally, one of the things I loved to do was show people how >>> simple Haskell really was by inspecting types and slowly putting the puzzle >>> pieces together. >>> >>> Summary of the problem for others: >>> >>> From *Takenobu Tani* >>> >>> Before ghc7.8: >>> >>> Prelude> :t foldr >>> foldr :: (a -> b -> b) -> b -> [a] -> b >>> >>> Prelude> :t ($) >>> ($) :: (a -> b) -> a -> b >>> >>> Beginners should only understand about following: >>> >>> * type variable (polymorphism) >>> >>> >>> After ghc8.0: >>> >>> Prelude> :t foldr >>> foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b >>> >>> Prelude> :t ($) >>> ($) >>> :: forall (w :: GHC.Types.Levity) a (b :: TYPE w). >>> (a -> b) -> a -> b >>> >>> >>> >>> With this change it looks like I will no longer be able to keep `$` in >>> my toolbox since telling a beginner its "magic" goes against what I believe >>> Haskell is good at, being well defined and easy to understand (Not well >>> defined in terms of Types but well defined in terms of ability to precisely >>> and concisely explain and define whats going on). >>> >>> It looks like where the discussion is going is to have these types show >>> by default but eventually have an Alternative prelude for beginners. >>> >>> From *Richard Eisenberg:* >>> >>> - It's interesting that the solution to the two problems Takenobu pulls out below (but others have hinted at in this thread) is by having an alternate Prelude for beginners. I believe that having an alternate beginners' Prelude is becoming essential. I know I'm not the first one to suggest this, but a great many issues that teachers of Haskell have raised with me and posts on this and other lists would be solved by an alternate Prelude for beginners. >>> >>> I don't like the idea of fragmenting Haskell into "beginners" and >>> "advanced" versions. Its hard enough to get people to believe Haskell is >>> easy. If they see that they aren't using the "real" prelude, Haskell will >>> still be this magic black box that is too abstract and difficult to >>> understand. If they have to use a "dumbed down" version of Haskell to >>> learn, its not as compelling. >>> >>> There is something powerful about using the same idiomatic tools as the >>> "big boys" and have the tools still be able to be easy to understand.... by >>> default. Adding complexity to the default Haskell runs the risk of further >>> alienating newcomers to the language who have a misconception that its too >>> hard. >>> >>> Admittedly, I am not well informed of the state of GHC 8.0 development >>> and haven't had time to fully look into the situation. I am very interested >>> to see where this conversation and the default complexity of Haskell goes. >>> >>> -- >>> Kyle >>> >>> >>> I don't want, nor do I think it's a good idea, to have a beginners' >> Prelude. My point about ($) was not expressly about beginners, it was about >> intermediate practitioners too. >> > > > Consider these two delightful pianists: Martha > and Rose > > > - Are they playing the same instruments? > - Would they need the same teachers? > - Ultimately, is the single moniker "pianist" meaningfully applicable > to both? > > > I believe we are too taken with the fact that programming language > *theory* has advanced in the last couple of decades, while we miss the > fact that programming *pedagogy* has regressed in the same period. And > one of the big regresses is the illusion that a *single *language that > spans the spectrum from beginner learning to serious software engineering > is a neat idea: a grand unified/universal language. Such a language > already exists -- C++. An earlier generation called it PL-1. > > FP in ACM Curriculum 2013 > > spells out this ? omnibus language ? and such fallacies in more detail. > > And as regards prior art regarding the benefits for multiple close but > different languages for teaching, one could see the multiple teachpacks > of Scheme/Racket > And even closer to home, helium > is a haskell expressly > designed to make teaching easier by not over-generalizing types > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From rustompmody at gmail.com Fri Feb 12 04:17:18 2016 From: rustompmody at gmail.com (Rustom Mody) Date: Fri, 12 Feb 2016 05:17:18 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BBCF9C.6040101@cs.otago.ac.nz> Message-ID: On Thu, Feb 11, 2016 at 6:57 PM, Rustom Mody wrote: > > > The C version of that is described in this old paper: C in education and > software engineering > > Whoops pointer-indirection error :-) Sorry The original is Horrors of teaching C The other link is a 20 year later retrospective: Yeah C was bad; what has followed is not much better -------------- next part -------------- An HTML attachment was scrubbed... URL: From jo at durchholz.org Fri Feb 12 08:55:21 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Fri, 12 Feb 2016 09:55:21 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BBCF9C.6040101@cs.otago.ac.nz> Message-ID: <56BD9DF9.2040706@durchholz.org> Am 12.02.2016 um 05:17 schrieb Rustom Mody: > On Thu, Feb 11, 2016 at 6:57 PM, Rustom Mody wrote: > >> >> >> The C version of that is described in this old paper: C in education and >> software engineering >> >> > > Whoops pointer-indirection error :-) Sorry Works now. Oh, and Java relevates ease of combining third-party modules, and deployment automation. The key ingredient for this was Java's mere recommendation that namespaces be based on domain names, this allowed libraries to be combined without name conflicts; the other languages don't have this, and come with horrible linking problems that only make me sad. > The original is Horrors of teaching C > > The other link is a 20 year later retrospective: Yeah C was bad; what has > followed is not much better Moving horizontally means unlearning a little and learning a lot, so it is possible. It is what I did when I was forced to move from Pascal to C, and when I wanted from C to (Turbo) Pascal, then to Eiffel, in the end to Java, while studying other languages left and right - Prolog, SML, Haskell, Lisp, Alice (no particular order, not even chronologically). Of course that's just my personal learning experience, teachers will need to draw their own conclusions. Oh, and OO is inefficient. It has really bad cache locality. Game programmers move towards "entity systems", redistributing object attributes into arrays which are held together by an ID. You get the in-memory equivalent of a relational database with a star schema (and user-defined datatypes in columns, so it's a bit less primitive than one might think). Sorry for spinning off-topic, if there's no interest I'll take further discussion to private mail. From johannes.waldmann at htwk-leipzig.de Fri Feb 12 12:47:15 2016 From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann) Date: Fri, 12 Feb 2016 13:47:15 +0100 Subject: [Haskell-cafe] -XGADTs changes type for program that does not contain GADT Message-ID: <56BDD453.5030407@htwk-leipzig.de> Dear Cafe, the following type-correct program does not contain GADT syntax. When I activate GADT language pragma, it does no longer typecheck. {-# language GADTs, ScopedTypeVariables #-} data M a b dw :: (b -> b -> b) -> M a b -> M a b -> M a b dw f x y = x data Bar a b s = Bar { this :: M a (M b s), that :: M b (M a s) } f :: forall p q s . (s -> s -> s) -> Bar p q s -> Bar p q s -> Bar p q s f g x y = let -- diff :: forall p . M p s -> M p s -> M p s diff a b = dw g a b in Bar { this = dw diff (this x)(this y) , that = dw diff (that x)(that y) } I can fix this by declaring the type for `diff` as indicated in the comment. Otherwise, `diff` is not polymorphic (enough), as the error message shows. This behaviour is consistent over ghc-7.8,7.10,8-rc, so it's unlikely to be a bug. But it does seem to go against the claim of "conservative extension of HM" (Sect 6.6 of the ICFP'06 paper, Sect 4.9 of MS-CIS-05-26) http://research.microsoft.com/en-us/um/people/simonpj/papers/gadt/ - J.W. From andres at well-typed.com Fri Feb 12 13:05:12 2016 From: andres at well-typed.com (=?UTF-8?Q?Andres_L=C3=B6h?=) Date: Fri, 12 Feb 2016 14:05:12 +0100 Subject: [Haskell-cafe] -XGADTs changes type for program that does not contain GADT In-Reply-To: <56BDD453.5030407@htwk-leipzig.de> References: <56BDD453.5030407@htwk-leipzig.de> Message-ID: Hi. > the following type-correct program does not contain GADT syntax. > When I activate GADT language pragma, it does no longer typecheck. This is because -XGADTs implies -XMonoLocalBinds. See https://ghc.haskell.org/trac/ghc/blog/LetGeneralisationInGhc7 for a longer explanation. Cheers, Andres -- Andres L?h, Haskell Consultant Well-Typed LLP, http://www.well-typed.com Registered in England & Wales, OC335890 250 Ice Wharf, 17 New Wharf Road, London N1 9RF, England From amindfv at gmail.com Fri Feb 12 14:04:08 2016 From: amindfv at gmail.com (amindfv at gmail.com) Date: Fri, 12 Feb 2016 09:04:08 -0500 Subject: [Haskell-cafe] -XGADTs changes type for program that does not contain GADT In-Reply-To: References: <56BDD453.5030407@htwk-leipzig.de> Message-ID: "Implies" is too strong, isn't it? My understanding is -XGADTs turns on -XMonoLocalBinds by default, but you can use -XGADTs with -XNoMonoLocalBinds Tom > El 12 feb 2016, a las 08:05, Andres L?h escribi?: > > Hi. > >> the following type-correct program does not contain GADT syntax. >> When I activate GADT language pragma, it does no longer typecheck. > > This is because -XGADTs implies -XMonoLocalBinds. See > https://ghc.haskell.org/trac/ghc/blog/LetGeneralisationInGhc7 for a > longer explanation. > > Cheers, > Andres > > -- > Andres L?h, Haskell Consultant > Well-Typed LLP, http://www.well-typed.com > > Registered in England & Wales, OC335890 > 250 Ice Wharf, 17 New Wharf Road, London N1 9RF, England > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From ch.howard at zoho.com Fri Feb 12 15:45:18 2016 From: ch.howard at zoho.com (Christopher Howard) Date: Fri, 12 Feb 2016 06:45:18 -0900 Subject: [Haskell-cafe] typeclass for transformation of Euclidean points Message-ID: <56BDFE0E.6050607@zoho.com> Hi. What I'd like to have for a program I am working on is a generic typeclass for objects that can be treated like points on a 2D plane, and a few simple transform functions (e.g., addition, rotation around an origin) which I could combine to make more complex transformations. Of course, it would be trivial to do this myself, but it seems like the sort of thing somebody would have thought of already. Does anybody know of a package providing this? (I didn't see an obvious one when searching with hoogle.) -- http://justonemoremathproblem.com From vandijk.roel at gmail.com Fri Feb 12 16:37:59 2016 From: vandijk.roel at gmail.com (Roel van Dijk) Date: Fri, 12 Feb 2016 17:37:59 +0100 Subject: [Haskell-cafe] typeclass for transformation of Euclidean points In-Reply-To: <56BDFE0E.6050607@zoho.com> References: <56BDFE0E.6050607@zoho.com> Message-ID: You could consider the 'linear' package [1]. Any type that is an instance of the Linear.V2.R2 class could be considered to be a point on a 2D plane. Adding and subtracting vectors can be achieved using the Linear.Vector.Additive class. Linear.Metric.Metric has dot product and length of vectors. The Linear.Matrix module can be used for transformations. Combining transformations is just matrix multiplication. I'm quite happy with the 'linear' package as a whole, but it could use more documentation showing simple operations. Its abstact nature can be a bit daunting. 1 - https://hackage.haskell.org/package/linear 2016-02-12 16:45 GMT+01:00 Christopher Howard : > Hi. What I'd like to have for a program I am working on is a generic > typeclass for objects that can be treated like points on a 2D plane, and a > few simple transform functions (e.g., addition, rotation around an origin) > which I could combine to make more complex transformations. Of course, it > would be trivial to do this myself, but it seems like the sort of thing > somebody would have thought of already. Does anybody know of a package > providing this? (I didn't see an obvious one when searching with hoogle.) > -------------- next part -------------- An HTML attachment was scrubbed... URL: From dct25-561bs at mythic-beasts.com Fri Feb 12 20:40:49 2016 From: dct25-561bs at mythic-beasts.com (David Turner) Date: Fri, 12 Feb 2016 20:40:49 +0000 Subject: [Haskell-cafe] conduit: Inexhaustible source Message-ID: Hi, I've got a conduit thing that yields infinitely many values and never exits, which I've given the type ConduitM () o m Void - a bit like Source m o = ConduitM () o m () except that it can't exit due to the Void. (One side-question: why is Source m o not ConduitM Void o m ()?) I would now like to get the first item it yields; I'm currently using Data.Conduit.List.head but of course this returns a Maybe o in case the upstream thing exits. Is there a way to do this without that Maybe? I can't see anything obvious, but nor can I think of a terribly good reason why not. One thing that I was pondering was a kind of fuse operator with a type like ... ConduitM a b m r1 -> ConduitM b c m r2 -> ConduitM a c m (Either r1 r2) ... which returns the result of whichever thing exits first. Does such a thing exist? Does it even make sense? If it existed, I think I could use it here as it'd specialise to ConduitM () o m Void -> ConduitM o Void m o -> ConduitM () Void m (Either Void o) and of course (Either Void o) is isomorphic to o so I'd be home and dry. Having written this, I'm now also struggling to work out what the thing of type ConduitM o Void m o would be. Maybe I'm going about this all the wrong way, or maybe I'm just confused? Any help greatly appreciated! Cheers, David -------------- next part -------------- An HTML attachment was scrubbed... URL: From danburton.email at gmail.com Sat Feb 13 01:33:10 2016 From: danburton.email at gmail.com (Dan Burton) Date: Fri, 12 Feb 2016 17:33:10 -0800 Subject: [Haskell-cafe] conduit: Inexhaustible source In-Reply-To: References: Message-ID: > > Source m o = ConduitM > () > o m (); why is Source m o not ConduitM > Void > o m ()? I can't think of a really good answer to this, but here's a mediocre answer: you can always "step" a ConduitM that is blocked on trivial input. So the promise of a Source is not that it never blocks, but rather, that it only blocks in such a way that it is trivial to unblock. You may like the Producer type synonym better: type Producer m o = forall i. ConduitM i o m () When you have a Producer m o, it can be instantiated to ConduitM Void o m (), because you can select i = Void. Now for your main question... So the thing about ConduitM composition is that the "upstream result" must be (). If you peel away the ConduitM layer of abstraction and take a look at Data.Conduit.Internal.Pipe, you'll find the operator you're looking for: http://hackage.haskell.org/package/conduit-1.2.6.1/docs/src/Data-Conduit-Internal-Pipe.html#awaitE awaitE :: Pipe l i o u m (Either u i) I'm not quite sure how to surface this into the ConduitM level of abstraction. -- Dan Burton On Fri, Feb 12, 2016 at 12:40 PM, David Turner < dct25-561bs at mythic-beasts.com> wrote: > Hi, > > I've got a conduit thing that yields infinitely many values and never > exits, which I've given the type ConduitM > () > o m Void - a bit like Source m o = ConduitM > () > o m () except that it can't exit due to the Void. > > (One side-question: why is Source m o not ConduitM > Void > o m ()?) > > I would now like to get the first item it yields; I'm currently using > Data.Conduit.List.head but of course this returns a Maybe o in case the > upstream thing exits. Is there a way to do this without that Maybe? I > can't see anything obvious, but nor can I think of a terribly good reason > why not. > > One thing that I was pondering was a kind of fuse operator with a type > like ... > > ConduitM > a > b m r1 -> ConduitM > b > c m r2 -> ConduitM > a > c m (Either r1 r2) > > ... which returns the result of whichever thing exits first. Does such a > thing exist? Does it even make sense? If it existed, I think I could use it > here as it'd specialise to > > ConduitM > () > o m Void -> ConduitM > o > Void m o -> ConduitM > () > Void m (Either Void o) > > and of course (Either Void o) is isomorphic to o so I'd be home and dry. > > Having written this, I'm now also struggling to work out what the thing of > type ConduitM > o > Void m o would be. Maybe I'm going about this all the wrong way, or maybe > I'm just confused? > > Any help greatly appreciated! > > Cheers, > > David > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From rustompmody at gmail.com Sat Feb 13 06:11:46 2016 From: rustompmody at gmail.com (Rustom Mody) Date: Sat, 13 Feb 2016 11:41:46 +0530 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56BD9DF9.2040706@durchholz.org> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BBCF9C.6040101@cs.otago.ac.nz> <56BD9DF9.2040706@durchholz.org> Message-ID: On Fri, Feb 12, 2016 at 2:25 PM, Joachim Durchholz wrote: > Am 12.02.2016 um 05:17 schrieb Rustom Mody: > >> On Thu, Feb 11, 2016 at 6:57 PM, Rustom Mody wrote: >> >> >>> >>> The C version of that is described in this old paper: C in education and >>> software engineering >>> < >>> http://blog.languager.org/2013/02/c-in-education-and-software-engineering.html >>> > >>> >>> >> Whoops pointer-indirection error :-) Sorry >> > > Works now. > > Oh, and Java relevates ease of combining third-party modules, and > deployment automation. The key ingredient for this was Java's mere > recommendation that namespaces be based on domain names, this allowed > libraries to be combined without name conflicts; the other languages don't > have this, and come with horrible linking problems that only make me sad. > > Thanks for the input I would have thought that SML would be the one which had the most sophisticated module-sublanguage. Would be interested to know how SML and Java stack up against each other in that respect. -------------- next part -------------- An HTML attachment was scrubbed... URL: From jo at durchholz.org Sat Feb 13 07:03:37 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Sat, 13 Feb 2016 08:03:37 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BBCF9C.6040101@cs.otago.ac.nz> <56BD9DF9.2040706@durchholz.org> Message-ID: <56BED549.3040208@durchholz.org> Am 13.02.2016 um 07:11 schrieb Rustom Mody: > I would have thought that SML would be the one which had the most > sophisticated module-sublanguage. Would be interested to know how SML and > Java stack up against each other in that respect. I never understood SML's module system. The explanations I found were focused on the "what", and very intricate, but I never found an explanation "why" they were doing it. My impression was that it was quite sophisticated in its possibilities to adapt a module during import, but I was never sure whether SML's notion of module was even similar to that in other languages. The Java module system isn't spectactular, essentially an import establishes visibility and nothing more (adaptation is separate, and limited to type parameters), and you have a hierarchical namespace. The only thing that sets Java apart is that the DNS namespace is used as the basis, and that's not even a language rule, just a recommendation; the fascinating thing is that a mere recommendation was enough to make clear who's responsible for fixing a name conflict, and virtually eliminate name conflicts from the Java world. [Please don't mail directly and CC to Haskell-cafe, this defeats my mailer's "reply to list" function.] From cma at bitemyapp.com Sat Feb 13 07:31:52 2016 From: cma at bitemyapp.com (Christopher Allen) Date: Sat, 13 Feb 2016 01:31:52 -0600 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56BED549.3040208@durchholz.org> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BBCF9C.6040101@cs.otago.ac.nz> <56BD9DF9.2040706@durchholz.org> <56BED549.3040208@durchholz.org> Message-ID: >I never understood SML's module system. [...] but I never found an explanation "why" they were doing it. http://stackoverflow.com/questions/23006951/encoding-standard-ml-modules-in-oo http://homepages.inf.ed.ac.uk/mfourman/teaching/mlCourse/notes/sml-modules.html https://existentialtype.wordpress.com/2011/04/16/modules-matter-most/ https://www.reddit.com/r/haskell/comments/2foggq/why_does_david_turner_say_type_classes_were_a_bad/ckbw3g7 https://www.reddit.com/r/haskell/comments/2foggq/why_does_david_turner_say_type_classes_were_a_bad/ckcusvi?context=1 Some quotes from http://www.cse.unsw.edu.au/~chak/papers/modules-classes.pdf - ML Modules and Haskell Type Classes: A Constructive Comparison 5.1 >ML modules provide proper namespace management, whereas Haskell type classes do not: It is not possible that two different type classes (in the same Haskell module) declare members of the same name. >Signatures and structures in ML may contain all sorts of language constructs, including substructures. Type classes and instances in Haskell 98 may contain only methods; extensions to Haskell 98 also allow type synonyms [6] and data types [5]. However, there exists no extension that allows nested type classes and instances. (Ed. untrue save for the last bit given extent of use of GHC extensions now.) >Signatures in ML are essentially anonymous because named signatures can be removed from the language without losing expressiveness. Haskell type classes cannot be anonymous. >In ML, matching a structure against a signature is performed by comparing the structure and the signature componentwise; the names of the structure and the signature?if present at all?do not matter. This sort of signature matching is often called structural matching. Our Haskell analog of signature matching is verifying whether the type representing a structure is an instance of the type class representing the signature. The name of a class is crucial for this decision. Therefore, we characterize our Haskell analog of signature matching as nominal. >In ML, abstraction is performed by sealing a structure with a translucent or opaque signature. In Haskell, we perform abstraction inside instance declarations through abstract associated type synonyms. ( http://research.microsoft.com/en-us/um/people/simonpj/papers/assoc-types/at-syns.pdf <--- probably mean this paper but I don't totally get how this brings about abstraction) >A sealed structure in ML may look different depending on whether we view its body from inside or outside the signature seal: Inside, more values and types may be visible, some types may be concrete, and some values may have a more polymorphic type than outside. For our Haskell analog, the same set of types and values is visible and a value has the same type, regardless of whether we view the instance from inside or outside. (Hand wobble) 5.2 >Overloading in Haskell is resolved implicitly by the compiler. When type classes are simulated with ML modules, overloading has to be resolved explicitly by the programmer, which leads to awkward and verbose code. >Our current translation scheme is unable to handle constructor classes because there is not direct counterpart of Haskell?s higher-oder types in ML. We consider it as interesting future work to investigate whether an encoding of higher-order types as functors would enable a translation of constructor classes to ML modules. >Type classes in Haskell may be recursive in the sense that a class can be used in a constraint for a method of the same class. We cannot translate such recursive classes to ML because signatures cannot be recursive. >Haskell type classes may contain default definitions for methods. With our approach, such default definitions cannot be translated properly to ML because signatures specify only the types of value components and cannot contain implementations of value components. ---- My two cents: focusing on different priorities WRT "abstraction". Typeclasses started out focusing on ad-hoc polymorphism and making that convenient. ML modules started out focusing on abstraction and modularity. They've both (GHC extensions, applicative module functors) been plucking their way into their respective local maxima in terms of what they can do for both. >From http://www-plan.cs.colorado.edu/diwan/class-papers/ML-doc.pdf in 3.1 "The Modules System" by Harper, the emphasis in the opening paragraph is educative in where the priorities are: >The ability to decompose a large program into a collection of relatively independent modules with well-de fined interfaces is essential to the task of building and maintaining large programs. The ML modules system supplements the core language with constructs to facilitate building and maintaining large programs. >ML's conception of a program unit is that it is a reified environment. >Now the fundamental notion underlying program modularization is that the aim is to partition the environment into chunks that can be manipulated relatively independently of one another. This is not how people think about, talk about, or motivate typeclasses in my experience. I haven't run into anyone fool-hardy enough to suggest a global namespace of unique instances getting provided by the compiler is a vehicle for modularity-via-(abstraction|sealing|etc.) YMMV HTH On Sat, Feb 13, 2016 at 1:03 AM, Joachim Durchholz wrote: > Am 13.02.2016 um 07:11 schrieb Rustom Mody: > >> I would have thought that SML would be the one which had the most >> sophisticated module-sublanguage. Would be interested to know how SML and >> Java stack up against each other in that respect. >> > > I never understood SML's module system. The explanations I found were > focused on the "what", and very intricate, but I never found an explanation > "why" they were doing it. My impression was that it was quite sophisticated > in its possibilities to adapt a module during import, but I was never sure > whether SML's notion of module was even similar to that in other languages. > > The Java module system isn't spectactular, essentially an import > establishes visibility and nothing more (adaptation is separate, and > limited to type parameters), and you have a hierarchical namespace. > The only thing that sets Java apart is that the DNS namespace is used as > the basis, and that's not even a language rule, just a recommendation; the > fascinating thing is that a mere recommendation was enough to make clear > who's responsible for fixing a name conflict, and virtually eliminate name > conflicts from the Java world. > > [Please don't mail directly and CC to Haskell-cafe, this defeats my > mailer's "reply to list" function.] > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From cma at bitemyapp.com Sat Feb 13 08:50:55 2016 From: cma at bitemyapp.com (Christopher Allen) Date: Sat, 13 Feb 2016 02:50:55 -0600 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter Message-ID: Prelude> let myList = [1, 2, 3 :: Integer] Prelude> let myList' = myList ++ undefined Prelude> :t myList myList :: [Integer] Prelude> :t myList' myList' :: (?callStack::GHC.Stack.Types.CallStack) => [Integer] This is on by default and insofar as I've been able to try, it's avoidable in a default GHCi 8.0 REPL session. I'm glad I caught this before our book goes to print in a couple months. We'd managed to avoid talking about implicit parameters in 1,100+ pages of book but now we're forced to acknowledge their existence in the 4th of 32 chapters. This slipped past the radar more stealthily than the earlier stages of BBP did for 7.10. I was hearing about BBP on the GHC Trac pretty early on for months on end. Was the thinking that people still used implicit parameters for anything or taught them? On the one hand, this is a nice change and something I personally attempted (and failed) to make easier in GHC 7.10. The implementation making the types noisy rankles and didn't seem necessary when I investigated it between 7.8 and 7.10. Could you warn us when (educationally relevant?) stuff like this is coming down the pipe before the RC please? Ideally during the design phase. I think this was discussed as part of FTP to avoid future debacles. This isn't just a pedagogical problem, this is a UX problem. The users don't _care_ that call stack information is being carried around. Why would they? It happens without any mention in the types in almost every other programming language. We checked after the previous thread where ($) occurred in the book. ($) is in the second chapter of the book, which is the first chapter of Haskell code. Now we have to hand-wave something completely impossible for them to understand (chapter 2 is expressions, types are chapter 5) or edit ($) out of the book until they can understand it. We can't write it completely out of the book because ($) gets used all over the place and we don't want encountering it to throw them off. --- Chris Allen -------------- next part -------------- An HTML attachment was scrubbed... URL: From jo at durchholz.org Sat Feb 13 09:04:14 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Sat, 13 Feb 2016 10:04:14 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BBCF9C.6040101@cs.otago.ac.nz> <56BD9DF9.2040706@durchholz.org> <56BED549.3040208@durchholz.org> Message-ID: <56BEF18E.5090100@durchholz.org> Am 13.02.2016 um 08:31 schrieb Christopher Allen: > This is not how people think about, talk about, or motivate typeclasses in > my experience. I haven't run into anyone fool-hardy enough to suggest a > global namespace of unique instances getting provided by the compiler is a > vehicle for modularity-via-(abstraction|sealing|etc.) YMMV Well, make me the first one to do that ;-) Not for typeclasses. I suspect that namespaces and visibility should be managed independently of adaptation to the local needs, and I also suspect that both typeclasses and SML modules try to do both, making it hard to understand these aspects in isolation. The quoted paragraphs were a comparison. It seems that the SML folks are about namespace collisions of stuff from within a module. If that's a problem in Haskell, then that's an emarrassing weakness. If the SML folks think that's already "proper namespace management", they are mistaken (sorry folks), you need to deal with cases where module names themselves conflict. It's easy to underestimate the effect. For me, everything I code and vaguely expect to ever become public, I simply put into the org.durchholz namespace. That's my personal DNS name, so whenever I get around to actually publish something, at least I don't have to worry about having to rename uses lay_golden_eggs module because Goose Inc. already took that particular place in the global namespace. Even better, I don't have to worry about contacting everybody who uses my code to update it with the new name. [Please don't answer directly and CC to Haskell-Cafe, that's defeating my mailer's "reply-to-list" feature.] From ollie at ocharles.org.uk Sat Feb 13 09:04:59 2016 From: ollie at ocharles.org.uk (Oliver Charles) Date: Sat, 13 Feb 2016 09:04:59 +0000 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: References: Message-ID: Just a clarification - the presence of that parameter does not say "I use call stack" but rather "I need *a* call stack". This subtle difference means that you do need to know about this due to how stacks work in GHC. If you use error and then don't also add that constraint yourself to your function, youll only see part of the stack. Hence it more than just UX noise - I have a decision to make, and building a call stack gas a cost. Also, is this RC2? I thought this was now changed to use constraint kinds and type alias the implicit parameter behind a nicer API. On Sat, 13 Feb 2016 8:51 am Christopher Allen wrote: > Prelude> let myList = [1, 2, 3 :: Integer] > Prelude> let myList' = myList ++ undefined > Prelude> :t myList > myList :: [Integer] > Prelude> :t myList' > myList' :: (?callStack::GHC.Stack.Types.CallStack) => [Integer] > > This is on by default and insofar as I've been able to try, it's avoidable > in a default GHCi 8.0 REPL session. I'm glad I caught this before our book > goes to print in a couple months. We'd managed to avoid talking about > implicit parameters in 1,100+ pages of book but now we're forced to > acknowledge their existence in the 4th of 32 chapters. > > This slipped past the radar more stealthily than the earlier stages of BBP > did for 7.10. I was hearing about BBP on the GHC Trac pretty early on for > months on end. Was the thinking that people still used implicit parameters > for anything or taught them? On the one hand, this is a nice change and > something I personally attempted (and failed) to make easier in GHC 7.10. > The implementation making the types noisy rankles and didn't seem necessary > when I investigated it between 7.8 and 7.10. > > Could you warn us when (educationally relevant?) stuff like this is coming > down the pipe before the RC please? Ideally during the design phase. I > think this was discussed as part of FTP to avoid future debacles. > > This isn't just a pedagogical problem, this is a UX problem. The users > don't _care_ that call stack information is being carried around. Why would > they? It happens without any mention in the types in almost every other > programming language. > > We checked after the previous thread where ($) occurred in the book. ($) > is in the second chapter of the book, which is the first chapter of Haskell > code. Now we have to hand-wave something completely impossible for them to > understand (chapter 2 is expressions, types are chapter 5) or edit ($) out > of the book until they can understand it. We can't write it completely out > of the book because ($) gets used all over the place and we don't want > encountering it to throw them off. > > > --- Chris Allen > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From cma at bitemyapp.com Sat Feb 13 09:15:30 2016 From: cma at bitemyapp.com (Christopher Allen) Date: Sat, 13 Feb 2016 03:15:30 -0600 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: References: Message-ID: >subtle difference means that you do need to know about this due to how stacks work in GHC. If you use error and then don't also add that constraint yourself to your function, youll only see part of the stack. It is unfortunate that the design forces this implementation detail on users trying to apply a plain old function. I updated my GHC 8.0.1 candidate, got this: $ ghci GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/callen/.ghci Prelude> let myList = [1..5 :: Integer] Prelude> let myList' = myList ++ undefined Prelude> :t myList' myList' :: (?callStack::GHC.Stack.Types.CallStack) => [Integer] > changed to use constraint kinds and type alias the implicit parameter behind a nicer API. Even if this has happened, we're still talking about the fourth chapter which is prior to types, typeclasses, constraints - everything. None of this means anything to a beginner being shown how to use undefined. The book is trying to make sure _anyone_ can learn Haskell, it's not an advanced DSLs book that introduces DataKinds. The implementation is leaking all the way to the fourth chapter of a book for complete beginners. Users will not be sympathetic when the implementation elides information because the user failed to speak to the nasal demons in the correct accent. On Sat, Feb 13, 2016 at 3:04 AM, Oliver Charles wrote: > Just a clarification - the presence of that parameter does not say "I use > call stack" but rather "I need *a* call stack". This subtle difference > means that you do need to know about this due to how stacks work in GHC. If > you use error and then don't also add that constraint yourself to your > function, youll only see part of the stack. Hence it more than just UX > noise - I have a decision to make, and building a call stack gas a cost. > > Also, is this RC2? I thought this was now changed to use constraint kinds > and type alias the implicit parameter behind a nicer API. > > On Sat, 13 Feb 2016 8:51 am Christopher Allen wrote: > >> Prelude> let myList = [1, 2, 3 :: Integer] >> Prelude> let myList' = myList ++ undefined >> Prelude> :t myList >> myList :: [Integer] >> Prelude> :t myList' >> myList' :: (?callStack::GHC.Stack.Types.CallStack) => [Integer] >> >> This is on by default and insofar as I've been able to try, it's >> avoidable in a default GHCi 8.0 REPL session. I'm glad I caught this before >> our book goes to print in a couple months. We'd managed to avoid talking >> about implicit parameters in 1,100+ pages of book but now we're forced to >> acknowledge their existence in the 4th of 32 chapters. >> >> This slipped past the radar more stealthily than the earlier stages of >> BBP did for 7.10. I was hearing about BBP on the GHC Trac pretty early on >> for months on end. Was the thinking that people still used implicit >> parameters for anything or taught them? On the one hand, this is a nice >> change and something I personally attempted (and failed) to make easier in >> GHC 7.10. The implementation making the types noisy rankles and didn't seem >> necessary when I investigated it between 7.8 and 7.10. >> >> Could you warn us when (educationally relevant?) stuff like this is >> coming down the pipe before the RC please? Ideally during the design phase. >> I think this was discussed as part of FTP to avoid future debacles. >> >> This isn't just a pedagogical problem, this is a UX problem. The users >> don't _care_ that call stack information is being carried around. Why would >> they? It happens without any mention in the types in almost every other >> programming language. >> >> We checked after the previous thread where ($) occurred in the book. ($) >> is in the second chapter of the book, which is the first chapter of Haskell >> code. Now we have to hand-wave something completely impossible for them to >> understand (chapter 2 is expressions, types are chapter 5) or edit ($) out >> of the book until they can understand it. We can't write it completely out >> of the book because ($) gets used all over the place and we don't want >> encountering it to throw them off. >> >> >> --- Chris Allen >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From dct25-561bs at mythic-beasts.com Sat Feb 13 09:37:31 2016 From: dct25-561bs at mythic-beasts.com (David Turner) Date: Sat, 13 Feb 2016 09:37:31 +0000 Subject: [Haskell-cafe] conduit: Inexhaustible source In-Reply-To: References: Message-ID: Thanks Dan, some useful pointers there. Looking at the Pipes level, there's ConduitM i o m r = forall b. (r -> Pipe i i o () m b) -> Pipe i i o () m b = forall b. ContT b (Pipe i i o () m) r (not sure if the comparison with ContT is helpful yet...) I see what you mean about the upstream return type u always being () with ConduitM, although it's the r I want to get my hands on, not the u. I think that means a combinator like awaitE can't work in ConduitM as it can't depend on the return type of the upstream ConduitM. Looking at how (=$=) is defined, I tried this: fuseEither :: Monad m => ConduitM a b m u -> ConduitM b c m d -> ConduitM a c m (Either u d) fuseEither (ConduitM left0) (ConduitM right0) = ConduitM $ \rest -> let goRight final left right = case right of HaveOutput p c o -> HaveOutput (recurse p) (c >> final) o NeedInput rp rc -> goLeft rp rc final left Done r2 -> PipeM (final >> return (rest (Right r2))) PipeM mp -> PipeM (liftM recurse mp) Leftover right' i -> goRight final (HaveOutput left final i) right' where recurse = goRight final left goLeft rp rc final left = case left of HaveOutput left' final' o -> goRight final' left' (rp o) NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc) Done r1 -> PipeM (final >> return (rest (Left r1))) PipeM mp -> PipeM (liftM recurse mp) Leftover left' i -> Leftover (recurse left') i where recurse = goLeft rp rc final in goRight (return ()) (left0 Done) (right0 Done) The only difference from (=$=) is the two Done cases: the one in goRight now passes Right r2 back to rest instead of r2 itself, and the one in goLeft passes Left r1 back instead of continuing with another call to goRight. Much to my surprise, this actually compiled! But I've no idea whether there are any bad consequences of this - indeed, I've no real idea what's going on here at all, I just took a punt. Is this horribly broken or is this exactly what I want? Cheers, On 13 February 2016 at 01:33, Dan Burton wrote: > Source m o = ConduitM >> () >> o m (); why is Source m o not ConduitM >> Void >> o m ()? > > > I can't think of a really good answer to this, but here's a mediocre > answer: you can always "step" a ConduitM that is blocked on trivial input. > So the promise of a Source is not that it never blocks, but rather, that it > only blocks in such a way that it is trivial to unblock. > > You may like the Producer type synonym better: > > type Producer m o = forall i. ConduitM i o m () > > When you have a Producer m o, it can be instantiated to ConduitM Void o m > (), because you can select i = Void. > > Now for your main question... > > So the thing about ConduitM composition is that the "upstream result" must > be (). If you peel away the ConduitM layer of abstraction and take a look > at Data.Conduit.Internal.Pipe, you'll find the operator you're looking for: > > > http://hackage.haskell.org/package/conduit-1.2.6.1/docs/src/Data-Conduit-Internal-Pipe.html#awaitE > > awaitE :: Pipe l i o u m (Either u i) > > I'm not quite sure how to surface this into the ConduitM level of > abstraction. > > -- Dan Burton > > On Fri, Feb 12, 2016 at 12:40 PM, David Turner < > dct25-561bs at mythic-beasts.com> wrote: > >> Hi, >> >> I've got a conduit thing that yields infinitely many values and never >> exits, which I've given the type ConduitM >> () >> o m Void - a bit like Source m o = ConduitM >> () >> o m () except that it can't exit due to the Void. >> >> (One side-question: why is Source m o not ConduitM >> Void >> o m ()?) >> >> I would now like to get the first item it yields; I'm currently using >> Data.Conduit.List.head but of course this returns a Maybe o in case the >> upstream thing exits. Is there a way to do this without that Maybe? I >> can't see anything obvious, but nor can I think of a terribly good reason >> why not. >> >> One thing that I was pondering was a kind of fuse operator with a type >> like ... >> >> ConduitM >> a >> b m r1 -> ConduitM >> b >> c m r2 -> ConduitM >> a >> c m (Either r1 r2) >> >> ... which returns the result of whichever thing exits first. Does such a >> thing exist? Does it even make sense? If it existed, I think I could use it >> here as it'd specialise to >> >> ConduitM >> () >> o m Void -> ConduitM >> o >> Void m o -> ConduitM >> () >> Void m (Either Void o) >> >> and of course (Either Void o) is isomorphic to o so I'd be home and dry. >> >> Having written this, I'm now also struggling to work out what the thing >> of type ConduitM >> o >> Void m o would be. Maybe I'm going about this all the wrong way, or >> maybe I'm just confused? >> >> Any help greatly appreciated! >> >> Cheers, >> >> David >> >> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From spam at scientician.net Sat Feb 13 09:41:06 2016 From: spam at scientician.net (Bardur Arantsson) Date: Sat, 13 Feb 2016 10:41:06 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56BED549.3040208@durchholz.org> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BBCF9C.6040101@cs.otago.ac.nz> <56BD9DF9.2040706@durchholz.org> <56BED549.3040208@durchholz.org> Message-ID: On 02/13/2016 08:03 AM, Joachim Durchholz wrote: > Am 13.02.2016 um 07:11 schrieb Rustom Mody: >> I would have thought that SML would be the one which had the most >> sophisticated module-sublanguage. Would be interested to know how SML >> and >> Java stack up against each other in that respect. > > I never understood SML's module system. The explanations I found were > focused on the "what", and very intricate, but I never found an > explanation "why" they were doing it. My impression was that it was > quite sophisticated in its possibilities to adapt a module during > import, but I was never sure whether SML's notion of module was even > similar to that in other languages. > It's _hugely_ more advanced than most module systems out there. AFAIUI O'Caml has a similar system, but I'm not sure it's quite that advanced. Basically it _can_ subsume type classes, but using it for that purpose is unbelievably verbose and it doesn't get you global coherence. They also allow you to *cleanly* separate interface from implementation. (S/O'Ca)ML modules are the one thing I miss about programming in O'Caml relative to Haskell. (Alright, there are a couple of other minor things, but we're probably off-topic enough already :)) > The Java module system isn't spectactular, essentially an import > establishes visibility and nothing more (adaptation is separate, and > limited to type parameters), and you have a hierarchical namespace. It's terrible and basically name-space only. What's even stranger is that it's an *open* namespace (apart from the standard ones, I believe?) which means that I can retroactively add a class in say, org.spring.integration and access package-scope bits of the original org.spring.integration namespace. It's a pretty weird system that seems to be driven by Java's "one-class-per-file" mentality[1]. Disclaimer: Java 9 is getting a new module system, Jigsaw, but I'm not really too familiar with what it actually does, so I won't comment beyond this disclaimer :). > The only thing that sets Java apart is that the DNS namespace is used as > the basis, and that's not even a language rule, just a recommendation; > the fascinating thing is that a mere recommendation was enough to make > clear who's responsible for fixing a name conflict, and virtually > eliminate name conflicts from the Java world. Yes, *this* was a FANTASTIC idea and it's soooo simple once you're aware of it. (No sarcasm intended, btw.) Unfortunately, the Scala people seem to be tiring of the long names and are regressing towards just using top-level names like "play" and "argonaut" and such... :/ > [Please don't mail directly and CC to Haskell-cafe, this defeats my > mailer's "reply to list" function.] Apologies if I'm doing this. I'm using the list through GMANE and cannot help it. [1] Yes, I'm aware that you can actually have multiple classes in a file. Almost nobody does that. Regards, From targen at gmail.com Sat Feb 13 10:39:44 2016 From: targen at gmail.com (=?UTF-8?Q?Manuel_G=C3=B3mez?=) Date: Sat, 13 Feb 2016 06:09:44 -0430 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BBCF9C.6040101@cs.otago.ac.nz> <56BD9DF9.2040706@durchholz.org> <56BED549.3040208@durchholz.org> Message-ID: On Sat, Feb 13, 2016 at 5:11 AM, Bardur Arantsson wrote: > Basically it _can_ subsume type classes, but using it for that purpose > is unbelievably verbose and it doesn't get you global coherence. If it doesn?t get you global coherence, then it does not subsume type classes, as that is most of the reason type classes are useful. From spam at scientician.net Sat Feb 13 11:08:02 2016 From: spam at scientician.net (Bardur Arantsson) Date: Sat, 13 Feb 2016 12:08:02 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BBCF9C.6040101@cs.otago.ac.nz> <56BD9DF9.2040706@durchholz.org> <56BED549.3040208@durchholz.org> Message-ID: On 02/13/2016 11:39 AM, Manuel G?mez wrote: > On Sat, Feb 13, 2016 at 5:11 AM, Bardur Arantsson wrote: >> Basically it _can_ subsume type classes, but using it for that purpose >> is unbelievably verbose and it doesn't get you global coherence. > > If it doesn?t get you global coherence, then it does not subsume type > classes, as that is most of the reason type classes are useful. That's a fair observation, but I meant subsume in a slightly different way, i.e. you can do everything with ML modules that you could possibly do with type classes... and more! But of course we're talking Turing Complete languages so that may be a moot point in terms of "power" wrt. computability (etc.), but it sure isn't in terms of daily practice! ML modules are truly one of the features of O'Caml that I miss most... still I'm using Haskell in preference to O'Caml now, so it can't be _that_ bad, right? :) Btw, technically even Haskell-as-implemented-by-GHC doesn't give you coherent instances because -XIncoherentInstances (and maybe OverlappingInstances?). I know that's _slightly_ unfair, but if we're arguing techincalities... Regards, From jo at durchholz.org Sat Feb 13 11:31:25 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Sat, 13 Feb 2016 12:31:25 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BBCF9C.6040101@cs.otago.ac.nz> <56BD9DF9.2040706@durchholz.org> <56BED549.3040208@durchholz.org> Message-ID: <56BF140D.30504@durchholz.org> Am 13.02.2016 um 10:41 schrieb Bardur Arantsson: > It's terrible and basically name-space only. That's just "do one thing, and do it well". Or, conversely, "just the namespace, look elsewhere for what you think a module system is". I guess the worst problem with SML's module system is that it does so many thing all rolled into one. > What's even stranger is > that it's an *open* namespace (apart from the standard ones, I believe?) > which means that I can retroactively add a class in say, > > org.spring.integration > > and access package-scope bits of the original org.spring.integration > namespace. Yes, but you get into all sorts of trouble when packaging, and all kinds of tools will detect that and your software will be seen as low-quality. Also, you can't do this unintentionally, so it's not a source of bugs. So while possible in theory, it does not happen in practice unless in the most dire circumstances, and even then it's not the workaround people choose because it's too painful. > It's a pretty weird system that seems to be driven by Java's > "one-class-per-file" mentality[1]. Nah, that's unrelated. > Disclaimer: Java 9 is getting a new module system, Jigsaw, but I'm not > really too familiar with what it actually does, so I won't comment > beyond this disclaimer :). Jigsaw is about the ability to define large-scale modules. I doubt it's a good approach, but I guess I'll work with it and see whether that's really going to be the case. The Java culture isn't so much about good theory but about good engineering, so it's quite possible that my fears are unfounded. >> The only thing that sets Java apart is that the DNS namespace is used as >> the basis, and that's not even a language rule, just a recommendation; >> the fascinating thing is that a mere recommendation was enough to make >> clear who's responsible for fixing a name conflict, and virtually >> eliminate name conflicts from the Java world. > > Yes, *this* was a FANTASTIC idea and it's soooo simple once you're aware > of it. (No sarcasm intended, btw.) Agreed, but if you were designing a language in the pre-Java times, the DNS was not the global registry where every programming-related entity would have a globally unique name. Most companies didn't even know what a domain name is, let alone have it registered. Java went public roughly at the time that the Internet^W^W HTTP took off, and I suppose the idea to use domain names as the global namespace was more of a lucky accident because the plan was to make Java the Lingua Franca of browser scripting, and they *had* to have a way to make all those dynamically-loaded modules coexist, and in the WWW, the domain names come naturally. Had Java been planned to become the server language it is today, I doubt they'd have had that idea. > Unfortunately, the Scala people seem to be tiring of the long names and > are regressing towards just using top-level names like "play" and > "argonaut" and such... :/ I think that's mostly exceptions for the really-well-known frameworks. Similar to the "java.*" and "javax.*" namespaces. I can understand why they prefer "play.*" over "com.playframework.*", but I don't really get why they say "argonaut.*" instead of "io.argonaut.*". Weird. OT3H it's not a really serious problem. The DNS as namespace means you have a spot that's guaranteed to be free for your code, and as long as nobody uses a TLD for his package root, it's all fine. Things could become ugly for the Play framework is somebody registers "play" as a new TLD. It would be a clearly a problem for the Play framework, not for the DNS, so at least the responsibilities for fixing the problem will be easy to assign. Or maybe the Playframework guys will get a chance at reserving whatever .play domains would collide with their package names, it's quite possible they'd get heard during the sunrise period of a hypothetical new .play TLD. So... things will muddle through as usual, and the main benefit is that you can choose a DNS-based spot in the namespace and be guaranteed that nobody else can usurp it because you registered that domain. And if somebody publishes code in that part of the namespace anyway, they will get labelled as "misleading" or even "abusive" and will be forced to move elsewhere. > [1] Yes, I'm aware that you can actually have multiple classes in a > file. Almost nobody does that. It's mostly useless because you cannot have multiple public classes in a file, the other classes need to be package-private. And almost nobody uses package-private because the visibility rules around that are complicated, i.e. it is almost never what you want and also bad for maintenance. From spam at scientician.net Sat Feb 13 11:42:48 2016 From: spam at scientician.net (Bardur Arantsson) Date: Sat, 13 Feb 2016 12:42:48 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56BF140D.30504@durchholz.org> References: <56B4CA58.4050101@htwk-leipzig.de> <56B4CCEB.5060406@htwk-leipzig.de> <20160205162651.GA28854@weber> <56B9FAF4.4040109@durchholz.org> <56BBCF9C.6040101@cs.otago.ac.nz> <56BD9DF9.2040706@durchholz.org> <56BED549.3040208@durchholz.org> <56BF140D.30504@durchholz.org> Message-ID: (This is getting waaaaayyy off-topic, so I'll stop after this post.) On 02/13/2016 12:31 PM, Joachim Durchholz wrote: >> Unfortunately, the Scala people seem to be tiring of the long names and >> are regressing towards just using top-level names like "play" and >> "argonaut" and such... :/ > > I think that's mostly exceptions for the really-well-known frameworks. > Similar to the "java.*" and "javax.*" namespaces. > I can understand why they prefer "play.*" over "com.playframework.*", > but I don't really get why they say "argonaut.*" instead of > "io.argonaut.*". Weird. Unfortunately it's not only famous/popular frameworks... but upon reconsideration, actually, I think the problem may be imports being "scoped" in a good-in-theory-but-bad-in-practice way. The issue usually is an inability to refer to things with short names because you have clashing imports. (I won't expand in the interest of brevity. This is off-topic enough already :).) > > OT3H it's not a really serious problem. The DNS as namespace means you > have a spot that's guaranteed to be free for your code, and as long as > nobody uses a TLD for his package root, it's all fine. > Things could become ugly for the Play framework is somebody registers > "play" as a new TLD. It would be a clearly a problem for the Play > framework, not for the DNS, so at least the responsibilities for fixing > the problem will be easy to assign. Or maybe the Playframework guys will > get a chance at reserving whatever .play domains would collide with > their package names, it's quite possible they'd get heard during the > sunrise period of a hypothetical new .play TLD. Well, reserving a name is kind of precondition, but *expiry* of domains could also be bad -- arguably *worse*. I think the main benefit isn't really tied to domain names per se, but that fact that people/companies *tend to* pick names that are slightly different as top-level/next-level/next-level so conflicts would be rare *in practice* even if there wasn't a "have-a-domain-name" requirement -- which in fact there *isn't*; it's still just a convention in Java, but it *is* pervasively followed. Regards, From nicola.gigante at gmail.com Sat Feb 13 11:58:04 2016 From: nicola.gigante at gmail.com (Nicola Gigante) Date: Sat, 13 Feb 2016 12:58:04 +0100 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: References: Message-ID: <52695333-71CE-43AC-A6E6-56275864D9AB@gmail.com> > Il giorno 13 feb 2016, alle ore 10:15, Christopher Allen ha scritto: > > >subtle difference means that you do need to know about this due to how stacks work in GHC. If you use error and then don't also add that constraint yourself to your function, youll only see part of the stack. > > It is unfortunate that the design forces this implementation detail on users trying to apply a plain old function. > > > I updated my GHC 8.0.1 candidate, got this: > > $ ghci > GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for help > Loaded GHCi configuration from /home/callen/.ghci > Prelude> let myList = [1..5 :: Integer] > Prelude> let myList' = myList ++ undefined > Prelude> :t myList' > myList' :: (?callStack::GHC.Stack.Types.CallStack) => [Integer] > > > changed to use constraint kinds and type alias the implicit parameter behind a nicer API. > > Even if this has happened, we're still talking about the fourth chapter which is prior to types, typeclasses, constraints - everything. None of this means anything to a beginner being shown how to use undefined. The book is trying to make sure _anyone_ can learn Haskell, it's not an advanced DSLs book that introduces DataKinds. > > The implementation is leaking all the way to the fourth chapter of a book for complete beginners. Users will not be sympathetic when the implementation elides information because the user failed to speak to the nasal demons in the correct accent. Hi Christopher, I?m following your painful experience preparing the book for GHC 8.0, and I sympathize with you. Just a question: how do you manage the type of simple arithmetic expressions like 1 + 1? I mean, the type contains a constraint there. Prelude> :t 1 + 1 1 + 1 :: Num a => a I suppose that explaining ?Num a =>? by saying ?it says that the type must be a number? is easier because of assonance with the word, but is that really a difference? Note that this situation is much different from the issue about the type of ($): - Teaching ?undefined? to beginners is not essential. It?s use is waaay less common that ($), and it should be especially for beginners. Partial functions should be discouraged from the start, and maybe a slightly more difficult type can be the right way to make people learn to not use it. It?s use comes handy when explaining laziness, maybe. But you could obtain the same effect with a never-ending function, which is also theoretically more affine to the meaning of ?bottom?. - The constraint explicitly mentions ?CallStack? twice. Exactly like ?Num?, I think it?s easy to handwave: ?The 'blahblah =>' part says that the function needs to know the ?call stack?, which is what you see printed when ?undefined? gets evaluated and the program exists?. So while I agree with you that this type is more difficult to explain, I think it?s much less of a problem than the new type of ($). If you don?t agree with any of these points please let me know. Regards, Nicola -------------- next part -------------- An HTML attachment was scrubbed... URL: From doug at cs.dartmouth.edu Sat Feb 13 13:44:09 2016 From: doug at cs.dartmouth.edu (Doug McIlroy) Date: Sat, 13 Feb 2016 08:44:09 -0500 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic Message-ID: <201602131344.u1DDi9ql012039@coolidge.cs.Dartmouth.EDU> > The DNS as namespace means you have a spot that's guaranteed to be free for your code That's fine at the time, but maintainers come and go while software lives on. A name space that depends on who holds the reins and pays the rent seems rather ephemeral. Doug From rustompmody at gmail.com Sat Feb 13 16:54:21 2016 From: rustompmody at gmail.com (Rustom Mody) Date: Sat, 13 Feb 2016 22:24:21 +0530 Subject: [Haskell-cafe] Fwd: New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: <52695333-71CE-43AC-A6E6-56275864D9AB@gmail.com> References: <52695333-71CE-43AC-A6E6-56275864D9AB@gmail.com> Message-ID: On Sat, Feb 13, 2016 at 5:28 PM, Nicola Gigante wrote: > > Il giorno 13 feb 2016, alle ore 10:15, Christopher Allen < > cma at bitemyapp.com> ha scritto: > > >subtle difference means that you do need to know about this due to how > stacks work in GHC. If you use error and then don't also add that > constraint yourself to your function, youll only see part of the stack. > > It is unfortunate that the design forces this implementation detail on > users trying to apply a plain old function. > > > I updated my GHC 8.0.1 candidate, got this: > > $ ghci > GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for help > Loaded GHCi configuration from /home/callen/.ghci > Prelude> let myList = [1..5 :: Integer] > Prelude> let myList' = myList ++ undefined > Prelude> :t myList' > myList' :: (?callStack::GHC.Stack.Types.CallStack) => [Integer] > > > changed to use constraint kinds and type alias the implicit parameter > behind a nicer API. > > Even if this has happened, we're still talking about the fourth chapter > which is prior to types, typeclasses, constraints - everything. None of > this means anything to a beginner being shown how to use undefined. The > book is trying to make sure _anyone_ can learn Haskell, it's not an > advanced DSLs book that introduces DataKinds. > > The implementation is leaking all the way to the fourth chapter of a book > for complete beginners. Users will not be sympathetic when the > implementation elides information because the user failed to speak to the > nasal demons in the correct accent. > > > > Hi Christopher, I?m following your painful experience preparing the book > for GHC 8.0, > and I sympathize with you. > > Just a question: how do you manage the type of simple > arithmetic expressions like 1 + 1? I mean, the type contains a constraint > there. > > Yeah That nails the problem well enough (for me) I use the 25 year old gofer with its simple prelude precisely because Num, Eq, Show etc are too expensive (for me) early in teaching FP And the simple prelude is the typeclass-free prelude > Teaching ?undefined? to beginners is not essential. > Not from where I see. A very basic feature of my teaching is - "Stories types tell" (also patterns tell) - Combined with going between values and types eg What is the type of 2? Int Complementarily Give something whose type is Int? 2 So what is something whose type is a? -------------- next part -------------- An HTML attachment was scrubbed... URL: From eric at seidel.io Sat Feb 13 17:00:08 2016 From: eric at seidel.io (Eric Seidel) Date: Sat, 13 Feb 2016 09:00:08 -0800 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: References: Message-ID: <1455382808.1806145.520298666.7E3F0362@webmail.messagingengine.com> On Sat, Feb 13, 2016, at 01:04, Oliver Charles wrote: > Just a clarification - the presence of that parameter does not say "I use > call stack" but rather "I need *a* call stack". This subtle difference > means that you do need to know about this due to how stacks work in GHC. > If > you use error and then don't also add that constraint yourself to your > function, youll only see part of the stack. Hence it more than just UX > noise - I have a decision to make, and building a call stack gas a cost. > > Also, is this RC2? I thought this was now changed to use constraint kinds > and type alias the implicit parameter behind a nicer API. Yes, RC2 still infers implicit parameter constraints as opposed to HasCallStack constraints. This is a bug, and it should be a simple fix. Eric From eric at seidel.io Sat Feb 13 17:18:07 2016 From: eric at seidel.io (Eric Seidel) Date: Sat, 13 Feb 2016 09:18:07 -0800 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: References: Message-ID: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> Here's what the GHCi session should look like. > $ ghci > GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for help > Loaded GHCi configuration from /home/callen/.ghci > Prelude> let myList = [1..5 :: Integer] > Prelude> let myList' = myList ++ undefined > Prelude> :t myList' > myList' :: HasCallStack => [Integer] If your readers are using :t they must already know about simple types like Integer, [], and, ->, so the new things are HasCallStack and =>. This is how I would explain them. => is just like -> except the compiler fills in the argument by itself. HasCallStack tells the compiler that the expression needs a call-stack because it might crash. So HasCallStack => [Integer] is a [Integer] that might crash and produce a stack-trace. I think the call-stacks are much less scary and confusing than type-classes in general, which you kind of have to deal with as soon as you talk about arithmetic. Eric From ollie at ocharles.org.uk Sat Feb 13 17:37:11 2016 From: ollie at ocharles.org.uk (Oliver Charles) Date: Sat, 13 Feb 2016 17:37:11 +0000 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> References: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> Message-ID: "What's a call stack?" (I don't know what Chris' target audience is though) On Sat, 13 Feb 2016 5:18 pm Eric Seidel wrote: > Here's what the GHCi session should look like. > > > $ ghci > > GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for help > > Loaded GHCi configuration from /home/callen/.ghci > > Prelude> let myList = [1..5 :: Integer] > > Prelude> let myList' = myList ++ undefined > > Prelude> :t myList' > > myList' :: HasCallStack => [Integer] > > If your readers are using :t they must already know about simple types > like Integer, [], and, ->, so the new things are HasCallStack and =>. > This is how I would explain them. > > => is just like -> except the compiler fills in the argument by > itself. > HasCallStack tells the compiler that the expression needs a call-stack > because it might crash. So HasCallStack => [Integer] is a [Integer] > that > might crash and produce a stack-trace. > > I think the call-stacks are much less scary and confusing than > type-classes in general, which you kind of have to deal with as soon as > you talk about arithmetic. > > Eric > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From jo at durchholz.org Sat Feb 13 18:32:15 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Sat, 13 Feb 2016 19:32:15 +0100 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <201602131344.u1DDi9ql012039@coolidge.cs.Dartmouth.EDU> References: <201602131344.u1DDi9ql012039@coolidge.cs.Dartmouth.EDU> Message-ID: <56BF76AF.2050104@durchholz.org> Am 13.02.2016 um 14:44 schrieb Doug McIlroy: >> The DNS as namespace means you have a spot that's guaranteed to be free for your code > > That's fine at the time, but maintainers come and go while software > lives on. A name space that depends on who holds the reins and pays > the rent seems rather ephemeral. Sure, but a project facing this kind of problem usually has more assets of that kind that need to be transferred: public repository ownership, CI passwords, download server passwords, the works. Domain ownership can be transferred along with these. Also, if money strings are an issue, domain names are the cheapest thing on the list, about a dollar per month. A repository server costs more, a CI server farm most. From danburton.email at gmail.com Sat Feb 13 18:33:02 2016 From: danburton.email at gmail.com (Dan Burton) Date: Sat, 13 Feb 2016 10:33:02 -0800 Subject: [Haskell-cafe] conduit: Inexhaustible source In-Reply-To: References: Message-ID: Only you can tell if this is what you want. It doesn't look horribly broken at a glance. Try it out and see! it's the r I want to get my hands on, not the u. Look at the pipe composition operator (>+>) :: Pipe l a b r0 m r1 -> Pipe Void b c r1 m r2 -> Pipe l a c r0 m r2 Here you see that not only do (a b) and (b c) connect to make (a c), but also (r0 m r1) and (r1 m r2) connect to make (r0 m r2). So r1 is the first argument's r, and the second argument's u. If you are writing a Pipe that will sit downstream of another pipe with return type x, then you can get an (Either x i) using awaitE, which will indicate whether the upstream pipe terminated or yielded. -- Dan Burton On Sat, Feb 13, 2016 at 1:37 AM, David Turner wrote: > Thanks Dan, some useful pointers there. > > Looking at the Pipes level, there's > > ConduitM i o m r = forall b. (r -> Pipe i i o () m b) -> Pipe i i o () m b > = forall b. ContT b (Pipe i i o () m) r > > (not sure if the comparison with ContT is helpful yet...) > > I see what you mean about the upstream return type u always being () with > ConduitM, although it's the r I want to get my hands on, not the u. I > think that means a combinator like awaitE can't work in ConduitM as it > can't depend on the return type of the upstream ConduitM. > > Looking at how (=$=) is defined, I tried this: > > fuseEither :: Monad m => ConduitM a b m u -> ConduitM b c m d -> ConduitM > a c m (Either u d) > fuseEither (ConduitM left0) (ConduitM right0) = ConduitM $ \rest -> > let goRight final left right = > case right of > HaveOutput p c o -> HaveOutput (recurse p) (c >> final) o > NeedInput rp rc -> goLeft rp rc final left > Done r2 -> PipeM (final >> return (rest (Right > r2))) > PipeM mp -> PipeM (liftM recurse mp) > Leftover right' i -> goRight final (HaveOutput left final > i) right' > where > recurse = goRight final left > > goLeft rp rc final left = > case left of > HaveOutput left' final' o -> goRight final' left' (rp o) > NeedInput left' lc -> NeedInput (recurse . left') > (recurse . lc) > Done r1 -> PipeM (final >> return (rest > (Left r1))) > PipeM mp -> PipeM (liftM recurse mp) > Leftover left' i -> Leftover (recurse left') i > where > recurse = goLeft rp rc final > in goRight (return ()) (left0 Done) (right0 Done) > > > The only difference from (=$=) is the two Done cases: the one in goRight now > passes Right r2 back to rest instead of r2 itself, and the one in goLeft passes > Left r1 back instead of continuing with another call to goRight. Much to > my surprise, this actually compiled! But I've no idea whether there are any > bad consequences of this - indeed, I've no real idea what's going on here > at all, I just took a punt. > > Is this horribly broken or is this exactly what I want? > > Cheers, > > > On 13 February 2016 at 01:33, Dan Burton > wrote: > >> Source m o = ConduitM >>> () >>> o m (); why is Source m o not ConduitM >>> Void >>> o m ()? >> >> >> I can't think of a really good answer to this, but here's a mediocre >> answer: you can always "step" a ConduitM that is blocked on trivial input. >> So the promise of a Source is not that it never blocks, but rather, that it >> only blocks in such a way that it is trivial to unblock. >> >> You may like the Producer type synonym better: >> >> type Producer m o = forall i. ConduitM i o m () >> >> When you have a Producer m o, it can be instantiated to ConduitM Void o m >> (), because you can select i = Void. >> >> Now for your main question... >> >> So the thing about ConduitM composition is that the "upstream result" >> must be (). If you peel away the ConduitM layer of abstraction and take a >> look at Data.Conduit.Internal.Pipe, you'll find the operator you're looking >> for: >> >> >> http://hackage.haskell.org/package/conduit-1.2.6.1/docs/src/Data-Conduit-Internal-Pipe.html#awaitE >> >> awaitE :: Pipe l i o u m (Either u i) >> >> I'm not quite sure how to surface this into the ConduitM level of >> abstraction. >> >> -- Dan Burton >> >> On Fri, Feb 12, 2016 at 12:40 PM, David Turner < >> dct25-561bs at mythic-beasts.com> wrote: >> >>> Hi, >>> >>> I've got a conduit thing that yields infinitely many values and never >>> exits, which I've given the type ConduitM >>> () >>> o m Void - a bit like Source m o = ConduitM >>> () >>> o m () except that it can't exit due to the Void. >>> >>> (One side-question: why is Source m o not ConduitM >>> Void >>> o m ()?) >>> >>> I would now like to get the first item it yields; I'm currently using >>> Data.Conduit.List.head but of course this returns a Maybe o in case the >>> upstream thing exits. Is there a way to do this without that Maybe? I >>> can't see anything obvious, but nor can I think of a terribly good reason >>> why not. >>> >>> One thing that I was pondering was a kind of fuse operator with a type >>> like ... >>> >>> ConduitM >>> a >>> b m r1 -> ConduitM >>> b >>> c m r2 -> ConduitM >>> a >>> c m (Either r1 r2) >>> >>> ... which returns the result of whichever thing exits first. Does such a >>> thing exist? Does it even make sense? If it existed, I think I could use it >>> here as it'd specialise to >>> >>> ConduitM >>> () >>> o m Void -> ConduitM >>> o >>> Void m o -> ConduitM >>> () >>> Void m (Either Void o) >>> >>> and of course (Either Void o) is isomorphic to o so I'd be home and dry. >>> >>> Having written this, I'm now also struggling to work out what the thing >>> of type ConduitM >>> o >>> Void m o would be. Maybe I'm going about this all the wrong way, or >>> maybe I'm just confused? >>> >>> Any help greatly appreciated! >>> >>> Cheers, >>> >>> David >>> >>> >>> >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> Haskell-Cafe at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> >>> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From will.yager at gmail.com Sat Feb 13 18:33:51 2016 From: will.yager at gmail.com (Will Yager) Date: Sat, 13 Feb 2016 12:33:51 -0600 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> References: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> Message-ID: That looks much better! So if I use "error" in a function "f", I pass "f" to be used in a location without a stack trace, and the error condition occurs, what happens? Incomplete trace? -Will > On Feb 13, 2016, at 11:18, Eric Seidel wrote: > >> Prelude> :t myList' >> myList' :: HasCallStack => [Integer] > From amindfv at gmail.com Sat Feb 13 18:35:00 2016 From: amindfv at gmail.com (amindfv at gmail.com) Date: Sat, 13 Feb 2016 13:35:00 -0500 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: References: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> Message-ID: I don't have a copy of GHC 8 atm to test this with: is an expression like this now illegal? x :: Int x = undefined I.e. do you need to write: x :: HasCallStack => Int x = undefined Tom > El 13 feb 2016, a las 12:37, Oliver Charles escribi?: > > "What's a call stack?" > > (I don't know what Chris' target audience is though) > > >> On Sat, 13 Feb 2016 5:18 pm Eric Seidel wrote: >> Here's what the GHCi session should look like. >> >> > $ ghci >> > GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for help >> > Loaded GHCi configuration from /home/callen/.ghci >> > Prelude> let myList = [1..5 :: Integer] >> > Prelude> let myList' = myList ++ undefined >> > Prelude> :t myList' >> > myList' :: HasCallStack => [Integer] >> >> If your readers are using :t they must already know about simple types >> like Integer, [], and, ->, so the new things are HasCallStack and =>. >> This is how I would explain them. >> >> => is just like -> except the compiler fills in the argument by >> itself. >> HasCallStack tells the compiler that the expression needs a call-stack >> because it might crash. So HasCallStack => [Integer] is a [Integer] >> that >> might crash and produce a stack-trace. >> >> I think the call-stacks are much less scary and confusing than >> type-classes in general, which you kind of have to deal with as soon as >> you talk about arithmetic. >> >> Eric >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: From ben at smart-cactus.org Sat Feb 13 18:43:19 2016 From: ben at smart-cactus.org (Ben Gamari) Date: Sat, 13 Feb 2016 19:43:19 +0100 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: References: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> Message-ID: <877fi88n94.fsf@smart-cactus.org> amindfv at gmail.com writes: > I don't have a copy of GHC 8 atm to test this with: is an expression like this now illegal? > > x :: Int > x = undefined > This is still valid. The change in GHC 8.0 is merely that GHC will infer a CallStack constraint instead of solving it in-place if asked to infer a type for a let binding whose RHS demands a callstack. Cheers, - Ben -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 472 bytes Desc: not available URL: From amindfv at gmail.com Sat Feb 13 18:45:56 2016 From: amindfv at gmail.com (amindfv at gmail.com) Date: Sat, 13 Feb 2016 13:45:56 -0500 Subject: [Haskell-cafe] New type of ($) operator in GHC 8.0 is problematic In-Reply-To: <56BF76AF.2050104@durchholz.org> References: <201602131344.u1DDi9ql012039@coolidge.cs.Dartmouth.EDU> <56BF76AF.2050104@durchholz.org> Message-ID: Can you please fork this to a separate thread? Thanks, Tom > El 13 feb 2016, a las 13:32, Joachim Durchholz escribi?: > > Am 13.02.2016 um 14:44 schrieb Doug McIlroy: >>> The DNS as namespace means you have a spot that's guaranteed to be free for your code >> >> That's fine at the time, but maintainers come and go while software >> lives on. A name space that depends on who holds the reins and pays >> the rent seems rather ephemeral. > > Sure, but a project facing this kind of problem usually has more assets of that kind that need to be transferred: public repository ownership, CI passwords, download server passwords, the works. Domain ownership can be transferred along with these. > > Also, if money strings are an issue, domain names are the cheapest thing on the list, about a dollar per month. A repository server costs more, a CI server farm most. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From eric at seidel.io Sat Feb 13 19:07:04 2016 From: eric at seidel.io (Eric Seidel) Date: Sat, 13 Feb 2016 11:07:04 -0800 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: References: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> Message-ID: <1455390424.1829267.520365562.4D0B7C0A@webmail.messagingengine.com> You'll get an incomplete trace starting at "f". On Sat, Feb 13, 2016, at 10:33, Will Yager wrote: > That looks much better! > > So if I use "error" in a function "f", I pass "f" to be used in a > location without a stack trace, and the error condition occurs, what > happens? Incomplete trace? > > -Will > > > On Feb 13, 2016, at 11:18, Eric Seidel wrote: > > > >> Prelude> :t myList' > >> myList' :: HasCallStack => [Integer] > > From b at chreekat.net Sat Feb 13 19:48:57 2016 From: b at chreekat.net (Bryan Richter) Date: Sat, 13 Feb 2016 11:48:57 -0800 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> References: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> Message-ID: <20160213194857.GC6052@fuzzbomb> On Sat, Feb 13, 2016 at 09:18:07AM -0800, Eric Seidel wrote: > Here's what the GHCi session should look like. > > > $ ghci > > GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for help > > Loaded GHCi configuration from /home/callen/.ghci > > Prelude> let myList = [1..5 :: Integer] > > Prelude> let myList' = myList ++ undefined > > Prelude> :t myList' > > myList' :: HasCallStack => [Integer] What use case is satisfied by providing this information? How does it benefit the Haskell programmer? How do I use it? -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 801 bytes Desc: Digital signature URL: From cma at bitemyapp.com Sat Feb 13 20:52:58 2016 From: cma at bitemyapp.com (Christopher Allen) Date: Sat, 13 Feb 2016 14:52:58 -0600 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: <20160213194857.GC6052@fuzzbomb> References: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> <20160213194857.GC6052@fuzzbomb> Message-ID: Replying to a few here. Gigante: >Just a question: how do you manage the type of simple arithmetic expressions like 1 + 1? I mean, the type contains a constraint there. > Prelude> :t 1 + 1 > 1 + 1 :: Num a => a Earlier versions of the book intentionally juked this or concreted the type of numbers to Integer, but HaskellForMac defenestrated that with the always-on type showing so now we've had an explanation along the lines you suggest for a few months now. We know how to adapt - we've tested the book extensively. What we need is the implementation not to expose irrelevant magic/noise in ways that could leak into the first chapter with Haskell code in it. Seidel: >If your readers are using :t they must already know about simple types like Integer, [], and, ->, so the new things are HasCallStack and =>. You'd bloody think as we're careful when we introduce :t, but we get tickets from people using HaskellForMac[1] that get confused because they are shown the types of expressions too early. Now we're careful in how we introduce _any_ expressions. Fisking your attempt: > => is just like -> except They don't know what either of those things are or what they mean in the second chapter because this is the _first_ chapter with any Haskell code. They're just beginning to see how Haskell code might be kinda like the lambdas in the lambda calculus chapter. > the compiler fills in the argument by We do explain what a compiler and interpreter are, but they won't know what it means for it to fill in an argument. They don't know why it needs to fill in an argument. Where did the argument come from? > HasCallStack tells the compiler How? Why? Why do they need to care? What's a HasCallStack? Keep in mind they don't know types, typeclasses, or anything else. > that the expression needs a call-stack Still don't know what a call, stack, or call-stack are. > because it might crash. Why does that change the type? We can construct bottoms like `let x in x` that crash the program without changing the type. > >So HasCallStack => [Integer] is a [Integer] What makes this even more obnoxious is that when we finally do introduce typeclasses and constraints, we talk about constraining a _type variable_ and now you've baked this magic in they cannot possibly be explained at all in the book. > that might crash and produce a stack-trace First bit they might pick up from context, they don't know what a stack trace is. Bonus round: when you explain things "from first principles", you can't duck the fact that it's actually a call graph when explaining a "stack" trace or call stack. Now you have to explain why/how it gets flattened from one representation into the other. Oliver had it when he said, >"What's a call stack?" They don't know what a stack, a call, or the combination thereof is. We had planned to address these issues in the (much later) chapters that cover profiling and errors. Because that's when they're relevant. This hasn't been relevant the entire span of the book. It _never_ mattered that you didn't get a stack trace from bottoms. In practice, does it suck? Sure! But they're not practitioners yet! I am (I use Haskell for my 9-5 and have done for a year and a half) and it still hasn't mattered to me. The only time I've really wanted a stack trace is when this mechanism would not have been available to me to begin with. Gamari / amindfv > I don't have a copy of GHC 8 atm to test this with: is an expression like this now illegal? > > x :: Int > x = undefined > >This is still valid. The change in GHC 8.0 is merely that GHC will infer >a CallStack constraint instead of solving it in-place if asked to infer >a type for a let binding whose RHS demands a callstack. We have readers use the REPL _a lot_. Not only to load code but also free-standing expressions in the REPL when experimenting and learning. Type assignment in the REPL is noisy and we have to write around some pretty gnarly width limitations (40-60 cols). This breaks the examples where we're combining bottom and type inference to explore how terms and types interact. I am less disturbed by `HasCallStack =>` than I was by the inferred type of ($). I know designing around pedagogical limitations like this is tedious but imagine doing it for 900-1,200 pages (formatting varies) of tutorial and exercises, then getting unpleasant surprises right as the book is about to be done. Sorry about the messy thread all. [1]: http://haskellformac.com/ On Sat, Feb 13, 2016 at 1:48 PM, Bryan Richter wrote: > On Sat, Feb 13, 2016 at 09:18:07AM -0800, Eric Seidel wrote: > > Here's what the GHCi session should look like. > > > > > $ ghci > > > GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for help > > > Loaded GHCi configuration from /home/callen/.ghci > > > Prelude> let myList = [1..5 :: Integer] > > > Prelude> let myList' = myList ++ undefined > > > Prelude> :t myList' > > > myList' :: HasCallStack => [Integer] > > What use case is satisfied by providing this information? How does it > benefit the Haskell programmer? How do I use it? > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From matthewtpickering at gmail.com Sat Feb 13 21:08:49 2016 From: matthewtpickering at gmail.com (Matthew Pickering) Date: Sat, 13 Feb 2016 21:08:49 +0000 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: References: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> <20160213194857.GC6052@fuzzbomb> Message-ID: Maybe it would be better to introduce _ rather than using undefined for holes in programs. This sidesteps this issue, provides useful information to guide the implementation and causes an error when code is compiled so programs aren't unexpectedly partial. It is perhaps not idiomatic to use undefined, even in development these days. It is much easier (imo) to use holes and -fdefer-type-errors. 'undefined' is nasty and has to be used with care; CallStacks exist as a bit of a safety net. I've not read your book but I'm not convinced it should be emphasised so much in the first chapters of an elementary Haskell textbook. On Sat, Feb 13, 2016 at 8:52 PM, Christopher Allen wrote: > Replying to a few here. > > Gigante: > >>Just a question: how do you manage the type of simple arithmetic >> expressions like 1 + 1? I mean, the type contains a constraint there. >> Prelude> :t 1 + 1 >> 1 + 1 :: Num a => a > > Earlier versions of the book intentionally juked this or concreted the type > of numbers to Integer, but HaskellForMac defenestrated that with the > always-on type showing so now we've had an explanation along the lines you > suggest for a few months now. We know how to adapt - we've tested the book > extensively. What we need is the implementation not to expose irrelevant > magic/noise in ways that could leak into the first chapter with Haskell code > in it. > > > Seidel: > >>If your readers are using :t they must already know about simple types > like Integer, [], and, ->, so the new things are HasCallStack and =>. > > You'd bloody think as we're careful when we introduce :t, but we get tickets > from people using HaskellForMac[1] that get confused because they are shown > the types of expressions too early. Now we're careful in how we introduce > _any_ expressions. > > Fisking your attempt: > >> => is just like -> except > > They don't know what either of those things are or what they mean in the > second chapter because this is the _first_ chapter with any Haskell code. > They're just beginning to see how Haskell code might be kinda like the > lambdas in the lambda calculus chapter. > >> the compiler fills in the argument by > > We do explain what a compiler and interpreter are, but they won't know what > it means for it to fill in an argument. They don't know why it needs to fill > in an argument. Where did the argument come from? > >> HasCallStack tells the compiler > > How? Why? Why do they need to care? What's a HasCallStack? Keep in mind they > don't know types, typeclasses, or anything else. > >> that the expression needs a call-stack > > Still don't know what a call, stack, or call-stack are. > >> because it might crash. > > Why does that change the type? We can construct bottoms like `let x in x` > that crash the program without changing the type. > >> >So HasCallStack => [Integer] is a [Integer] > > What makes this even more obnoxious is that when we finally do introduce > typeclasses and constraints, we talk about constraining a _type variable_ > and now you've baked this magic in they cannot possibly be explained at all > in the book. > >> that might crash and produce a stack-trace > > First bit they might pick up from context, they don't know what a stack > trace is. Bonus round: when you explain things "from first principles", you > can't duck the fact that it's actually a call graph when explaining a > "stack" trace or call stack. Now you have to explain why/how it gets > flattened from one representation into the other. > > > Oliver had it when he said, > >>"What's a call stack?" > > They don't know what a stack, a call, or the combination thereof is. We had > planned to address these issues in the (much later) chapters that cover > profiling and errors. Because that's when they're relevant. This hasn't been > relevant the entire span of the book. It _never_ mattered that you didn't > get a stack trace from bottoms. In practice, does it suck? Sure! But they're > not practitioners yet! I am (I use Haskell for my 9-5 and have done for a > year and a half) and it still hasn't mattered to me. The only time I've > really wanted a stack trace is when this mechanism would not have been > available to me to begin with. > > > Gamari / amindfv >> I don't have a copy of GHC 8 atm to test this with: is an expression like >> this now illegal? >> >> x :: Int >> x = undefined >> >>This is still valid. The change in GHC 8.0 is merely that GHC will infer >>a CallStack constraint instead of solving it in-place if asked to infer >>a type for a let binding whose RHS demands a callstack. > > We have readers use the REPL _a lot_. Not only to load code but also > free-standing expressions in the REPL when experimenting and learning. Type > assignment in the REPL is noisy and we have to write around some pretty > gnarly width limitations (40-60 cols). This breaks the examples where we're > combining bottom and type inference to explore how terms and types interact. > > I am less disturbed by `HasCallStack =>` than I was by the inferred type of > ($). > > > I know designing around pedagogical limitations like this is tedious but > imagine doing it for 900-1,200 pages (formatting varies) of tutorial and > exercises, then getting unpleasant surprises right as the book is about to > be done. > > > Sorry about the messy thread all. > > > [1]: http://haskellformac.com/ > > > On Sat, Feb 13, 2016 at 1:48 PM, Bryan Richter wrote: >> >> On Sat, Feb 13, 2016 at 09:18:07AM -0800, Eric Seidel wrote: >> > Here's what the GHCi session should look like. >> > >> > > $ ghci >> > > GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for help >> > > Loaded GHCi configuration from /home/callen/.ghci >> > > Prelude> let myList = [1..5 :: Integer] >> > > Prelude> let myList' = myList ++ undefined >> > > Prelude> :t myList' >> > > myList' :: HasCallStack => [Integer] >> >> What use case is satisfied by providing this information? How does it >> benefit the Haskell programmer? How do I use it? >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> > > > > -- > Chris Allen > Currently working on http://haskellbook.com > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > From cma at bitemyapp.com Sat Feb 13 21:33:12 2016 From: cma at bitemyapp.com (Christopher Allen) Date: Sat, 13 Feb 2016 15:33:12 -0600 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: References: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> <20160213194857.GC6052@fuzzbomb> Message-ID: Holes and bottoms are wildly different. Bottoms are considerably more useful which I think you'd find if you ran down a list of examples and tried both in each circumstance. This would force even more rewriting than present circumstances. >'undefined' is nasty and has to be used with care Ya, we tell them that. We also tell them that programs intended to be executed outside of a learning/development environment should be total (we explain totality and partiality). On Sat, Feb 13, 2016 at 3:08 PM, Matthew Pickering < matthewtpickering at gmail.com> wrote: > Maybe it would be better to introduce _ rather than using undefined > for holes in programs. This sidesteps this issue, provides useful > information to guide the implementation and causes an error when code > is compiled so programs aren't unexpectedly partial. > > It is perhaps not idiomatic to use undefined, even in development > these days. It is much easier (imo) to use holes and > -fdefer-type-errors. > > 'undefined' is nasty and has to be used with care; CallStacks exist as > a bit of a safety net. I've not read your book but I'm not convinced > it should be emphasised so much in the first chapters of an elementary > Haskell textbook. > > On Sat, Feb 13, 2016 at 8:52 PM, Christopher Allen > wrote: > > Replying to a few here. > > > > Gigante: > > > >>Just a question: how do you manage the type of simple arithmetic > >> expressions like 1 + 1? I mean, the type contains a constraint there. > >> Prelude> :t 1 + 1 > >> 1 + 1 :: Num a => a > > > > Earlier versions of the book intentionally juked this or concreted the > type > > of numbers to Integer, but HaskellForMac defenestrated that with the > > always-on type showing so now we've had an explanation along the lines > you > > suggest for a few months now. We know how to adapt - we've tested the > book > > extensively. What we need is the implementation not to expose irrelevant > > magic/noise in ways that could leak into the first chapter with Haskell > code > > in it. > > > > > > Seidel: > > > >>If your readers are using :t they must already know about simple types > > like Integer, [], and, ->, so the new things are HasCallStack and =>. > > > > You'd bloody think as we're careful when we introduce :t, but we get > tickets > > from people using HaskellForMac[1] that get confused because they are > shown > > the types of expressions too early. Now we're careful in how we introduce > > _any_ expressions. > > > > Fisking your attempt: > > > >> => is just like -> except > > > > They don't know what either of those things are or what they mean in the > > second chapter because this is the _first_ chapter with any Haskell code. > > They're just beginning to see how Haskell code might be kinda like the > > lambdas in the lambda calculus chapter. > > > >> the compiler fills in the argument by > > > > We do explain what a compiler and interpreter are, but they won't know > what > > it means for it to fill in an argument. They don't know why it needs to > fill > > in an argument. Where did the argument come from? > > > >> HasCallStack tells the compiler > > > > How? Why? Why do they need to care? What's a HasCallStack? Keep in mind > they > > don't know types, typeclasses, or anything else. > > > >> that the expression needs a call-stack > > > > Still don't know what a call, stack, or call-stack are. > > > >> because it might crash. > > > > Why does that change the type? We can construct bottoms like `let x in x` > > that crash the program without changing the type. > > > >> >So HasCallStack => [Integer] is a [Integer] > > > > What makes this even more obnoxious is that when we finally do introduce > > typeclasses and constraints, we talk about constraining a _type variable_ > > and now you've baked this magic in they cannot possibly be explained at > all > > in the book. > > > >> that might crash and produce a stack-trace > > > > First bit they might pick up from context, they don't know what a stack > > trace is. Bonus round: when you explain things "from first principles", > you > > can't duck the fact that it's actually a call graph when explaining a > > "stack" trace or call stack. Now you have to explain why/how it gets > > flattened from one representation into the other. > > > > > > Oliver had it when he said, > > > >>"What's a call stack?" > > > > They don't know what a stack, a call, or the combination thereof is. We > had > > planned to address these issues in the (much later) chapters that cover > > profiling and errors. Because that's when they're relevant. This hasn't > been > > relevant the entire span of the book. It _never_ mattered that you didn't > > get a stack trace from bottoms. In practice, does it suck? Sure! But > they're > > not practitioners yet! I am (I use Haskell for my 9-5 and have done for a > > year and a half) and it still hasn't mattered to me. The only time I've > > really wanted a stack trace is when this mechanism would not have been > > available to me to begin with. > > > > > > Gamari / amindfv > >> I don't have a copy of GHC 8 atm to test this with: is an expression > like > >> this now illegal? > >> > >> x :: Int > >> x = undefined > >> > >>This is still valid. The change in GHC 8.0 is merely that GHC will infer > >>a CallStack constraint instead of solving it in-place if asked to infer > >>a type for a let binding whose RHS demands a callstack. > > > > We have readers use the REPL _a lot_. Not only to load code but also > > free-standing expressions in the REPL when experimenting and learning. > Type > > assignment in the REPL is noisy and we have to write around some pretty > > gnarly width limitations (40-60 cols). This breaks the examples where > we're > > combining bottom and type inference to explore how terms and types > interact. > > > > I am less disturbed by `HasCallStack =>` than I was by the inferred type > of > > ($). > > > > > > I know designing around pedagogical limitations like this is tedious but > > imagine doing it for 900-1,200 pages (formatting varies) of tutorial and > > exercises, then getting unpleasant surprises right as the book is about > to > > be done. > > > > > > Sorry about the messy thread all. > > > > > > [1]: http://haskellformac.com/ > > > > > > On Sat, Feb 13, 2016 at 1:48 PM, Bryan Richter wrote: > >> > >> On Sat, Feb 13, 2016 at 09:18:07AM -0800, Eric Seidel wrote: > >> > Here's what the GHCi session should look like. > >> > > >> > > $ ghci > >> > > GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for > help > >> > > Loaded GHCi configuration from /home/callen/.ghci > >> > > Prelude> let myList = [1..5 :: Integer] > >> > > Prelude> let myList' = myList ++ undefined > >> > > Prelude> :t myList' > >> > > myList' :: HasCallStack => [Integer] > >> > >> What use case is satisfied by providing this information? How does it > >> benefit the Haskell programmer? How do I use it? > >> > >> _______________________________________________ > >> Haskell-Cafe mailing list > >> Haskell-Cafe at haskell.org > >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > >> > > > > > > > > -- > > Chris Allen > > Currently working on http://haskellbook.com > > > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From cma at bitemyapp.com Sat Feb 13 23:32:47 2016 From: cma at bitemyapp.com (Christopher Allen) Date: Sat, 13 Feb 2016 17:32:47 -0600 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: References: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> <20160213194857.GC6052@fuzzbomb> Message-ID: There's another problem I discovered with HasCallStack. The implicit parameter constraint breaks sharing behavior for examples that use bottom. Observe: $ ghci GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/callen/.ghci Prelude> let myList = [1, 2, id 1] :: [Integer] Prelude> let myList' = myList ++ undefined Prelude> :sprint myList' myList' = _ Prelude> head myList' 1 Prelude> :sprint myList' myList' = _ Prelude> :t myList' myList' :: (?callStack::GHC.Stack.Types.CallStack) => [Integer] Prelude> take 2 myList' [1,2] Prelude> :sprint myList' myList' = _ $ stack ghci Run from outside a project, using implicit global project config Using resolver: lts-5.1 from implicit global project's config file: /home/callen/.stack/global-project/stack.yaml Error parsing targets: The specified targets matched no packages. Perhaps you need to run 'stack init'? Warning: build failed, but optimistically launching GHCi anyway Configuring GHCi with the following packages: GHCi, version 7.10.3: http://www.haskell.org/ghc/ :? for help Ok, modules loaded: none. Prelude> let myList = [1, 2, id 1] :: [Integer] Prelude> let myList' = myList ++ undefined Prelude> :sprint myList' myList' = _ Prelude> head myList' 1 Prelude> :sprint myList' myList' = 1 : _ Prelude> take 2 myList' [1,2] Prelude> :sprint myList' myList' = 1 : 2 : _ Now I have to re-examine everywhere we've used bottoms and :sprint together in the book, which includes the chapters on lists, folds, and non-strictness. And it isn't just about our book, what about all the other learning resources and tutorials? :sprint was hard enough for new people to understand to begin with. It is very disheartening that people do not take this more seriously. On Sat, Feb 13, 2016 at 3:33 PM, Christopher Allen wrote: > Holes and bottoms are wildly different. Bottoms are considerably more > useful which I think you'd find if you ran down a list of examples and > tried both in each circumstance. This would force even more rewriting than > present circumstances. > > >'undefined' is nasty and has to be used with care > > Ya, we tell them that. We also tell them that programs intended to be > executed outside of a learning/development environment should be total (we > explain totality and partiality). > > On Sat, Feb 13, 2016 at 3:08 PM, Matthew Pickering < > matthewtpickering at gmail.com> wrote: > >> Maybe it would be better to introduce _ rather than using undefined >> for holes in programs. This sidesteps this issue, provides useful >> information to guide the implementation and causes an error when code >> is compiled so programs aren't unexpectedly partial. >> >> It is perhaps not idiomatic to use undefined, even in development >> these days. It is much easier (imo) to use holes and >> -fdefer-type-errors. >> >> 'undefined' is nasty and has to be used with care; CallStacks exist as >> a bit of a safety net. I've not read your book but I'm not convinced >> it should be emphasised so much in the first chapters of an elementary >> Haskell textbook. >> >> On Sat, Feb 13, 2016 at 8:52 PM, Christopher Allen >> wrote: >> > Replying to a few here. >> > >> > Gigante: >> > >> >>Just a question: how do you manage the type of simple arithmetic >> >> expressions like 1 + 1? I mean, the type contains a constraint there. >> >> Prelude> :t 1 + 1 >> >> 1 + 1 :: Num a => a >> > >> > Earlier versions of the book intentionally juked this or concreted the >> type >> > of numbers to Integer, but HaskellForMac defenestrated that with the >> > always-on type showing so now we've had an explanation along the lines >> you >> > suggest for a few months now. We know how to adapt - we've tested the >> book >> > extensively. What we need is the implementation not to expose irrelevant >> > magic/noise in ways that could leak into the first chapter with Haskell >> code >> > in it. >> > >> > >> > Seidel: >> > >> >>If your readers are using :t they must already know about simple types >> > like Integer, [], and, ->, so the new things are HasCallStack and =>. >> > >> > You'd bloody think as we're careful when we introduce :t, but we get >> tickets >> > from people using HaskellForMac[1] that get confused because they are >> shown >> > the types of expressions too early. Now we're careful in how we >> introduce >> > _any_ expressions. >> > >> > Fisking your attempt: >> > >> >> => is just like -> except >> > >> > They don't know what either of those things are or what they mean in the >> > second chapter because this is the _first_ chapter with any Haskell >> code. >> > They're just beginning to see how Haskell code might be kinda like the >> > lambdas in the lambda calculus chapter. >> > >> >> the compiler fills in the argument by >> > >> > We do explain what a compiler and interpreter are, but they won't know >> what >> > it means for it to fill in an argument. They don't know why it needs to >> fill >> > in an argument. Where did the argument come from? >> > >> >> HasCallStack tells the compiler >> > >> > How? Why? Why do they need to care? What's a HasCallStack? Keep in mind >> they >> > don't know types, typeclasses, or anything else. >> > >> >> that the expression needs a call-stack >> > >> > Still don't know what a call, stack, or call-stack are. >> > >> >> because it might crash. >> > >> > Why does that change the type? We can construct bottoms like `let x in >> x` >> > that crash the program without changing the type. >> > >> >> >So HasCallStack => [Integer] is a [Integer] >> > >> > What makes this even more obnoxious is that when we finally do introduce >> > typeclasses and constraints, we talk about constraining a _type >> variable_ >> > and now you've baked this magic in they cannot possibly be explained at >> all >> > in the book. >> > >> >> that might crash and produce a stack-trace >> > >> > First bit they might pick up from context, they don't know what a stack >> > trace is. Bonus round: when you explain things "from first principles", >> you >> > can't duck the fact that it's actually a call graph when explaining a >> > "stack" trace or call stack. Now you have to explain why/how it gets >> > flattened from one representation into the other. >> > >> > >> > Oliver had it when he said, >> > >> >>"What's a call stack?" >> > >> > They don't know what a stack, a call, or the combination thereof is. We >> had >> > planned to address these issues in the (much later) chapters that cover >> > profiling and errors. Because that's when they're relevant. This hasn't >> been >> > relevant the entire span of the book. It _never_ mattered that you >> didn't >> > get a stack trace from bottoms. In practice, does it suck? Sure! But >> they're >> > not practitioners yet! I am (I use Haskell for my 9-5 and have done for >> a >> > year and a half) and it still hasn't mattered to me. The only time I've >> > really wanted a stack trace is when this mechanism would not have been >> > available to me to begin with. >> > >> > >> > Gamari / amindfv >> >> I don't have a copy of GHC 8 atm to test this with: is an expression >> like >> >> this now illegal? >> >> >> >> x :: Int >> >> x = undefined >> >> >> >>This is still valid. The change in GHC 8.0 is merely that GHC will infer >> >>a CallStack constraint instead of solving it in-place if asked to infer >> >>a type for a let binding whose RHS demands a callstack. >> > >> > We have readers use the REPL _a lot_. Not only to load code but also >> > free-standing expressions in the REPL when experimenting and learning. >> Type >> > assignment in the REPL is noisy and we have to write around some pretty >> > gnarly width limitations (40-60 cols). This breaks the examples where >> we're >> > combining bottom and type inference to explore how terms and types >> interact. >> > >> > I am less disturbed by `HasCallStack =>` than I was by the inferred >> type of >> > ($). >> > >> > >> > I know designing around pedagogical limitations like this is tedious but >> > imagine doing it for 900-1,200 pages (formatting varies) of tutorial and >> > exercises, then getting unpleasant surprises right as the book is about >> to >> > be done. >> > >> > >> > Sorry about the messy thread all. >> > >> > >> > [1]: http://haskellformac.com/ >> > >> > >> > On Sat, Feb 13, 2016 at 1:48 PM, Bryan Richter wrote: >> >> >> >> On Sat, Feb 13, 2016 at 09:18:07AM -0800, Eric Seidel wrote: >> >> > Here's what the GHCi session should look like. >> >> > >> >> > > $ ghci >> >> > > GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for >> help >> >> > > Loaded GHCi configuration from /home/callen/.ghci >> >> > > Prelude> let myList = [1..5 :: Integer] >> >> > > Prelude> let myList' = myList ++ undefined >> >> > > Prelude> :t myList' >> >> > > myList' :: HasCallStack => [Integer] >> >> >> >> What use case is satisfied by providing this information? How does it >> >> benefit the Haskell programmer? How do I use it? >> >> >> >> _______________________________________________ >> >> Haskell-Cafe mailing list >> >> Haskell-Cafe at haskell.org >> >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> >> > >> > >> > >> > -- >> > Chris Allen >> > Currently working on http://haskellbook.com >> > >> > _______________________________________________ >> > Haskell-Cafe mailing list >> > Haskell-Cafe at haskell.org >> > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> > >> > > > > -- > Chris Allen > Currently working on http://haskellbook.com > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From matthewtpickering at gmail.com Sat Feb 13 23:57:42 2016 From: matthewtpickering at gmail.com (Matthew Pickering) Date: Sat, 13 Feb 2016 23:57:42 +0000 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: References: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> <20160213194857.GC6052@fuzzbomb> Message-ID: Notice that in your example unless "myList" is given an explicit type signature then sharing is also affected. See also this ticket: https://ghc.haskell.org/trac/ghc/ticket/11383 > Could you warn us when (educationally relevant?) stuff like this is coming down the pipe before the RC please? Ideally during the design phase. I think this was discussed as part of FTP to avoid future debacles. The roadmap[1] has a comprehensive list of features which have made it into HEAD. There is also quite a long wiki page[2] for this feature. Is that sufficient? I don't think it's feasible to maintainer a list of parties interested in GHC and notify them whenever anything changes. Matt [1]: https://ghc.haskell.org/trac/ghc/wiki/Status/GHC-8.0.1 [2]: https://ghc.haskell.org/trac/ghc/wiki/ExplicitCallStack/ImplicitLocations > On Sat, Feb 13, 2016 at 3:33 PM, Christopher Allen > wrote: >> >> Holes and bottoms are wildly different. Bottoms are considerably more >> useful which I think you'd find if you ran down a list of examples and tried >> both in each circumstance. This would force even more rewriting than present >> circumstances. >> >> >'undefined' is nasty and has to be used with care >> >> Ya, we tell them that. We also tell them that programs intended to be >> executed outside of a learning/development environment should be total (we >> explain totality and partiality). >> >> On Sat, Feb 13, 2016 at 3:08 PM, Matthew Pickering >> wrote: >>> >>> Maybe it would be better to introduce _ rather than using undefined >>> for holes in programs. This sidesteps this issue, provides useful >>> information to guide the implementation and causes an error when code >>> is compiled so programs aren't unexpectedly partial. >>> >>> It is perhaps not idiomatic to use undefined, even in development >>> these days. It is much easier (imo) to use holes and >>> -fdefer-type-errors. >>> >>> 'undefined' is nasty and has to be used with care; CallStacks exist as >>> a bit of a safety net. I've not read your book but I'm not convinced >>> it should be emphasised so much in the first chapters of an elementary >>> Haskell textbook. >>> >>> On Sat, Feb 13, 2016 at 8:52 PM, Christopher Allen >>> wrote: >>> > Replying to a few here. >>> > >>> > Gigante: >>> > >>> >>Just a question: how do you manage the type of simple arithmetic >>> >> expressions like 1 + 1? I mean, the type contains a constraint there. >>> >> Prelude> :t 1 + 1 >>> >> 1 + 1 :: Num a => a >>> > >>> > Earlier versions of the book intentionally juked this or concreted the >>> > type >>> > of numbers to Integer, but HaskellForMac defenestrated that with the >>> > always-on type showing so now we've had an explanation along the lines >>> > you >>> > suggest for a few months now. We know how to adapt - we've tested the >>> > book >>> > extensively. What we need is the implementation not to expose >>> > irrelevant >>> > magic/noise in ways that could leak into the first chapter with Haskell >>> > code >>> > in it. >>> > >>> > >>> > Seidel: >>> > >>> >>If your readers are using :t they must already know about simple types >>> > like Integer, [], and, ->, so the new things are HasCallStack and =>. >>> > >>> > You'd bloody think as we're careful when we introduce :t, but we get >>> > tickets >>> > from people using HaskellForMac[1] that get confused because they are >>> > shown >>> > the types of expressions too early. Now we're careful in how we >>> > introduce >>> > _any_ expressions. >>> > >>> > Fisking your attempt: >>> > >>> >> => is just like -> except >>> > >>> > They don't know what either of those things are or what they mean in >>> > the >>> > second chapter because this is the _first_ chapter with any Haskell >>> > code. >>> > They're just beginning to see how Haskell code might be kinda like the >>> > lambdas in the lambda calculus chapter. >>> > >>> >> the compiler fills in the argument by >>> > >>> > We do explain what a compiler and interpreter are, but they won't know >>> > what >>> > it means for it to fill in an argument. They don't know why it needs to >>> > fill >>> > in an argument. Where did the argument come from? >>> > >>> >> HasCallStack tells the compiler >>> > >>> > How? Why? Why do they need to care? What's a HasCallStack? Keep in mind >>> > they >>> > don't know types, typeclasses, or anything else. >>> > >>> >> that the expression needs a call-stack >>> > >>> > Still don't know what a call, stack, or call-stack are. >>> > >>> >> because it might crash. >>> > >>> > Why does that change the type? We can construct bottoms like `let x in >>> > x` >>> > that crash the program without changing the type. >>> > >>> >> >So HasCallStack => [Integer] is a [Integer] >>> > >>> > What makes this even more obnoxious is that when we finally do >>> > introduce >>> > typeclasses and constraints, we talk about constraining a _type >>> > variable_ >>> > and now you've baked this magic in they cannot possibly be explained at >>> > all >>> > in the book. >>> > >>> >> that might crash and produce a stack-trace >>> > >>> > First bit they might pick up from context, they don't know what a stack >>> > trace is. Bonus round: when you explain things "from first principles", >>> > you >>> > can't duck the fact that it's actually a call graph when explaining a >>> > "stack" trace or call stack. Now you have to explain why/how it gets >>> > flattened from one representation into the other. >>> > >>> > >>> > Oliver had it when he said, >>> > >>> >>"What's a call stack?" >>> > >>> > They don't know what a stack, a call, or the combination thereof is. We >>> > had >>> > planned to address these issues in the (much later) chapters that cover >>> > profiling and errors. Because that's when they're relevant. This hasn't >>> > been >>> > relevant the entire span of the book. It _never_ mattered that you >>> > didn't >>> > get a stack trace from bottoms. In practice, does it suck? Sure! But >>> > they're >>> > not practitioners yet! I am (I use Haskell for my 9-5 and have done for >>> > a >>> > year and a half) and it still hasn't mattered to me. The only time I've >>> > really wanted a stack trace is when this mechanism would not have been >>> > available to me to begin with. >>> > >>> > >>> > Gamari / amindfv >>> >> I don't have a copy of GHC 8 atm to test this with: is an expression >>> >> like >>> >> this now illegal? >>> >> >>> >> x :: Int >>> >> x = undefined >>> >> >>> >>This is still valid. The change in GHC 8.0 is merely that GHC will >>> >> infer >>> >>a CallStack constraint instead of solving it in-place if asked to infer >>> >>a type for a let binding whose RHS demands a callstack. >>> > >>> > We have readers use the REPL _a lot_. Not only to load code but also >>> > free-standing expressions in the REPL when experimenting and learning. >>> > Type >>> > assignment in the REPL is noisy and we have to write around some pretty >>> > gnarly width limitations (40-60 cols). This breaks the examples where >>> > we're >>> > combining bottom and type inference to explore how terms and types >>> > interact. >>> > >>> > I am less disturbed by `HasCallStack =>` than I was by the inferred >>> > type of >>> > ($). >>> > >>> > >>> > I know designing around pedagogical limitations like this is tedious >>> > but >>> > imagine doing it for 900-1,200 pages (formatting varies) of tutorial >>> > and >>> > exercises, then getting unpleasant surprises right as the book is about >>> > to >>> > be done. >>> > >>> > >>> > Sorry about the messy thread all. >>> > >>> > >>> > [1]: http://haskellformac.com/ >>> > >>> > >>> > On Sat, Feb 13, 2016 at 1:48 PM, Bryan Richter wrote: >>> >> >>> >> On Sat, Feb 13, 2016 at 09:18:07AM -0800, Eric Seidel wrote: >>> >> > Here's what the GHCi session should look like. >>> >> > >>> >> > > $ ghci >>> >> > > GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for >>> >> > > help >>> >> > > Loaded GHCi configuration from /home/callen/.ghci >>> >> > > Prelude> let myList = [1..5 :: Integer] >>> >> > > Prelude> let myList' = myList ++ undefined >>> >> > > Prelude> :t myList' >>> >> > > myList' :: HasCallStack => [Integer] >>> >> >>> >> What use case is satisfied by providing this information? How does it >>> >> benefit the Haskell programmer? How do I use it? >>> >> >>> >> _______________________________________________ >>> >> Haskell-Cafe mailing list >>> >> Haskell-Cafe at haskell.org >>> >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> >> >>> > >>> > >>> > >>> > -- >>> > Chris Allen >>> > Currently working on http://haskellbook.com >>> > >>> > _______________________________________________ >>> > Haskell-Cafe mailing list >>> > Haskell-Cafe at haskell.org >>> > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> > >> >> >> >> >> -- >> Chris Allen >> Currently working on http://haskellbook.com > > > > > -- > Chris Allen > Currently working on http://haskellbook.com From eric at seidel.io Sun Feb 14 00:02:40 2016 From: eric at seidel.io (Eric Seidel) Date: Sat, 13 Feb 2016 16:02:40 -0800 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: References: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> <20160213194857.GC6052@fuzzbomb> Message-ID: <1455408160.1879957.520487290.482C57DF@webmail.messagingengine.com> On Sat, Feb 13, 2016, at 15:32, Christopher Allen wrote: > There's another problem I discovered with HasCallStack. The implicit > parameter constraint breaks sharing behavior for examples that use > bottom. This is a necessary consequence of the implementation of callstack-aware functions as overloaded functions. It's really no different from using a type-class, and is in my opinion the correct behavior. It seems what you really want is a way to prevent GHC from inferring the HasCallStack constraint in the first place. That's doable with an explicit type signature (or even a combinator to wrap the expression), but this isn't a great solution for your book. What I'd suggest instead is to define your own undefined in a Prelude-replacement (or simplification if you will). Something like undefined :: a undefined = withFrozenCallStack emptyCallStack Prelude.undefined should work to remove all traces of CallStacks (including when it blows up). error can be similarly wrapped to avoid having to deal with CallStacks, and $ and the FTP-related functions can be specialized to less-polymorphic versions that are easier to explain to beginners (at least until they're ready to be exposed to the real versions). I'm sorry that this change has caused you trouble. From cma at bitemyapp.com Sun Feb 14 00:49:43 2016 From: cma at bitemyapp.com (Christopher Allen) Date: Sat, 13 Feb 2016 18:49:43 -0600 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: <1455408160.1879957.520487290.482C57DF@webmail.messagingengine.com> References: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> <20160213194857.GC6052@fuzzbomb> <1455408160.1879957.520487290.482C57DF@webmail.messagingengine.com> Message-ID: > What I'd suggest instead is to define your own undefined in a > Prelude-replacement (or simplification if you will). No. Part of the reason for the book is so that people can learn in the environment that they'll use and be equipped to apply what they've learned with minimal surprises. This solution is worse than the others suggested so far. And _again_, it's not just about our book it's about learning resources more generally and what that experience is like for new people. Rust doesn't need to have a beginner's Prelude. Idris doesn't either. In fact, most languages don't and the only one that has pulled it off convincingly is Racket which had less cause to do so than GHC does at this juncture. On Sat, Feb 13, 2016 at 6:02 PM, Eric Seidel wrote: > > On Sat, Feb 13, 2016, at 15:32, Christopher Allen wrote: > > There's another problem I discovered with HasCallStack. The implicit > > parameter constraint breaks sharing behavior for examples that use > > bottom. > > This is a necessary consequence of the implementation of callstack-aware > functions as overloaded functions. It's really no different from using a > type-class, and is in my opinion the correct behavior. > > It seems what you really want is a way to prevent GHC from inferring the > HasCallStack constraint in the first place. That's doable with an > explicit type signature (or even a combinator to wrap the expression), > but this isn't a great solution for your book. > > What I'd suggest instead is to define your own undefined in a > Prelude-replacement (or simplification if you will). Something like > > undefined :: a > undefined = withFrozenCallStack emptyCallStack Prelude.undefined > > should work to remove all traces of CallStacks (including when it blows > up). error can be similarly wrapped to avoid having to deal with > CallStacks, and $ and the FTP-related functions can be specialized to > less-polymorphic versions that are easier to explain to beginners (at > least until they're ready to be exposed to the real versions). > > I'm sorry that this change has caused you trouble. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From eric at seidel.io Sun Feb 14 06:22:47 2016 From: eric at seidel.io (Eric Seidel) Date: Sat, 13 Feb 2016 22:22:47 -0800 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: References: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> <20160213194857.GC6052@fuzzbomb> <1455408160.1879957.520487290.482C57DF@webmail.messagingengine.com> Message-ID: <1455430967.1961959.520620946.7C750C7D@webmail.messagingengine.com> I've put together a patch to prevent GHC from inferring CallStacks for *top-level* expressions. Given that we've hidden the implicit parameter behind a type synonym (and may remove it entirely in the future), I'm less concerned about preserving the expected behavior for implicit parameters. I believe this should address most of your concerns wrt ghci interactions. ghci> let myList = [1, 2, 3 :: Integer] myList :: [Integer] ghci> let myList' = myList ++ undefined myList' :: [Integer] ghci> :t myList myList :: [Integer] ghci> :t myList' myList' :: [Integer] ghci> :sprint myList' myList' = _ ghci> head myList' 1 it :: Integer ghci> :sprint myList' myList' = 1 : _ Note that undefined still takes a CallStack, and thus has a more involved type. ghci> :t undefined undefined :: forall (v :: GHC.Types.Levity) (a :: TYPE v). GHC.Stack.Types.HasCallStack => a But uses of undefined will no longer infect the top-level context with CallStacks, you'll have to request them explicitly. (We need the inference for local binders, so HaskellForMac and ghc-mod could still show CallStacks in tooltips). The patch is awaiting review at https://phabricator.haskell.org/D1912, you're more than welcome to comment. Eric On Sat, Feb 13, 2016, at 16:49, Christopher Allen wrote: > > What I'd suggest instead is to define your own undefined in a > > Prelude-replacement (or simplification if you will). > > No. Part of the reason for the book is so that people can learn in the > environment that they'll use and be equipped to apply what they've > learned > with minimal surprises. This solution is worse than the others suggested > so > far. And _again_, it's not just about our book it's about learning > resources more generally and what that experience is like for new people. > > Rust doesn't need to have a beginner's Prelude. Idris doesn't either. In > fact, most languages don't and the only one that has pulled it off > convincingly is Racket which had less cause to do so than GHC does at > this > juncture. > > On Sat, Feb 13, 2016 at 6:02 PM, Eric Seidel wrote: > > > > > On Sat, Feb 13, 2016, at 15:32, Christopher Allen wrote: > > > There's another problem I discovered with HasCallStack. The implicit > > > parameter constraint breaks sharing behavior for examples that use > > > bottom. > > > > This is a necessary consequence of the implementation of callstack-aware > > functions as overloaded functions. It's really no different from using a > > type-class, and is in my opinion the correct behavior. > > > > It seems what you really want is a way to prevent GHC from inferring the > > HasCallStack constraint in the first place. That's doable with an > > explicit type signature (or even a combinator to wrap the expression), > > but this isn't a great solution for your book. > > > > What I'd suggest instead is to define your own undefined in a > > Prelude-replacement (or simplification if you will). Something like > > > > undefined :: a > > undefined = withFrozenCallStack emptyCallStack Prelude.undefined > > > > should work to remove all traces of CallStacks (including when it blows > > up). error can be similarly wrapped to avoid having to deal with > > CallStacks, and $ and the FTP-related functions can be specialized to > > less-polymorphic versions that are easier to explain to beginners (at > > least until they're ready to be exposed to the real versions). > > > > I'm sorry that this change has caused you trouble. > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > > > > -- > Chris Allen > Currently working on http://haskellbook.com From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sun Feb 14 19:33:48 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sun, 14 Feb 2016 19:33:48 +0000 Subject: [Haskell-cafe] FP Complete developers survey Message-ID: <20160214193348.GC19603@weber> Last year FP Complete ran a large survey of Haskell developers. I can only find a synopsis here https://www.fpcomplete.com/blog/2015/05/thousand-user-haskell-survey but my memory tells me they also had a blog post with a more in-depth analysis of the numbers. I can't find it on their website. Does anyone know where it is, or am I imagining it? Tom From simonpj at microsoft.com Mon Feb 15 10:04:27 2016 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Mon, 15 Feb 2016 10:04:27 +0000 Subject: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter In-Reply-To: References: <1455383887.1809323.520304514.1B4B298C@webmail.messagingengine.com> <20160213194857.GC6052@fuzzbomb> Message-ID: Who isn?t taking it seriously? See https://ghc.haskell.org/trac/ghc/ticket/11573 Simon From: Haskell-Cafe [mailto:haskell-cafe-bounces at haskell.org] On Behalf Of Christopher Allen Sent: 13 February 2016 23:33 To: Matthew Pickering Cc: Haskell Cafe Subject: Re: [Haskell-cafe] New type of expressions containing (error ...) includes noisy implicit parameter There's another problem I discovered with HasCallStack. The implicit parameter constraint breaks sharing behavior for examples that use bottom. Observe: $ ghci GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/callen/.ghci Prelude> let myList = [1, 2, id 1] :: [Integer] Prelude> let myList' = myList ++ undefined Prelude> :sprint myList' myList' = _ Prelude> head myList' 1 Prelude> :sprint myList' myList' = _ Prelude> :t myList' myList' :: (?callStack::GHC.Stack.Types.CallStack) => [Integer] Prelude> take 2 myList' [1,2] Prelude> :sprint myList' myList' = _ $ stack ghci Run from outside a project, using implicit global project config Using resolver: lts-5.1 from implicit global project's config file: /home/callen/.stack/global-project/stack.yaml Error parsing targets: The specified targets matched no packages. Perhaps you need to run 'stack init'? Warning: build failed, but optimistically launching GHCi anyway Configuring GHCi with the following packages: GHCi, version 7.10.3: http://www.haskell.org/ghc/ :? for help Ok, modules loaded: none. Prelude> let myList = [1, 2, id 1] :: [Integer] Prelude> let myList' = myList ++ undefined Prelude> :sprint myList' myList' = _ Prelude> head myList' 1 Prelude> :sprint myList' myList' = 1 : _ Prelude> take 2 myList' [1,2] Prelude> :sprint myList' myList' = 1 : 2 : _ Now I have to re-examine everywhere we've used bottoms and :sprint together in the book, which includes the chapters on lists, folds, and non-strictness. And it isn't just about our book, what about all the other learning resources and tutorials? :sprint was hard enough for new people to understand to begin with. It is very disheartening that people do not take this more seriously. On Sat, Feb 13, 2016 at 3:33 PM, Christopher Allen > wrote: Holes and bottoms are wildly different. Bottoms are considerably more useful which I think you'd find if you ran down a list of examples and tried both in each circumstance. This would force even more rewriting than present circumstances. >'undefined' is nasty and has to be used with care Ya, we tell them that. We also tell them that programs intended to be executed outside of a learning/development environment should be total (we explain totality and partiality). On Sat, Feb 13, 2016 at 3:08 PM, Matthew Pickering > wrote: Maybe it would be better to introduce _ rather than using undefined for holes in programs. This sidesteps this issue, provides useful information to guide the implementation and causes an error when code is compiled so programs aren't unexpectedly partial. It is perhaps not idiomatic to use undefined, even in development these days. It is much easier (imo) to use holes and -fdefer-type-errors. 'undefined' is nasty and has to be used with care; CallStacks exist as a bit of a safety net. I've not read your book but I'm not convinced it should be emphasised so much in the first chapters of an elementary Haskell textbook. On Sat, Feb 13, 2016 at 8:52 PM, Christopher Allen > wrote: > Replying to a few here. > > Gigante: > >>Just a question: how do you manage the type of simple arithmetic >> expressions like 1 + 1? I mean, the type contains a constraint there. >> Prelude> :t 1 + 1 >> 1 + 1 :: Num a => a > > Earlier versions of the book intentionally juked this or concreted the type > of numbers to Integer, but HaskellForMac defenestrated that with the > always-on type showing so now we've had an explanation along the lines you > suggest for a few months now. We know how to adapt - we've tested the book > extensively. What we need is the implementation not to expose irrelevant > magic/noise in ways that could leak into the first chapter with Haskell code > in it. > > > Seidel: > >>If your readers are using :t they must already know about simple types > like Integer, [], and, ->, so the new things are HasCallStack and =>. > > You'd bloody think as we're careful when we introduce :t, but we get tickets > from people using HaskellForMac[1] that get confused because they are shown > the types of expressions too early. Now we're careful in how we introduce > _any_ expressions. > > Fisking your attempt: > >> => is just like -> except > > They don't know what either of those things are or what they mean in the > second chapter because this is the _first_ chapter with any Haskell code. > They're just beginning to see how Haskell code might be kinda like the > lambdas in the lambda calculus chapter. > >> the compiler fills in the argument by > > We do explain what a compiler and interpreter are, but they won't know what > it means for it to fill in an argument. They don't know why it needs to fill > in an argument. Where did the argument come from? > >> HasCallStack tells the compiler > > How? Why? Why do they need to care? What's a HasCallStack? Keep in mind they > don't know types, typeclasses, or anything else. > >> that the expression needs a call-stack > > Still don't know what a call, stack, or call-stack are. > >> because it might crash. > > Why does that change the type? We can construct bottoms like `let x in x` > that crash the program without changing the type. > >> >So HasCallStack => [Integer] is a [Integer] > > What makes this even more obnoxious is that when we finally do introduce > typeclasses and constraints, we talk about constraining a _type variable_ > and now you've baked this magic in they cannot possibly be explained at all > in the book. > >> that might crash and produce a stack-trace > > First bit they might pick up from context, they don't know what a stack > trace is. Bonus round: when you explain things "from first principles", you > can't duck the fact that it's actually a call graph when explaining a > "stack" trace or call stack. Now you have to explain why/how it gets > flattened from one representation into the other. > > > Oliver had it when he said, > >>"What's a call stack?" > > They don't know what a stack, a call, or the combination thereof is. We had > planned to address these issues in the (much later) chapters that cover > profiling and errors. Because that's when they're relevant. This hasn't been > relevant the entire span of the book. It _never_ mattered that you didn't > get a stack trace from bottoms. In practice, does it suck? Sure! But they're > not practitioners yet! I am (I use Haskell for my 9-5 and have done for a > year and a half) and it still hasn't mattered to me. The only time I've > really wanted a stack trace is when this mechanism would not have been > available to me to begin with. > > > Gamari / amindfv >> I don't have a copy of GHC 8 atm to test this with: is an expression like >> this now illegal? >> >> x :: Int >> x = undefined >> >>This is still valid. The change in GHC 8.0 is merely that GHC will infer >>a CallStack constraint instead of solving it in-place if asked to infer >>a type for a let binding whose RHS demands a callstack. > > We have readers use the REPL _a lot_. Not only to load code but also > free-standing expressions in the REPL when experimenting and learning. Type > assignment in the REPL is noisy and we have to write around some pretty > gnarly width limitations (40-60 cols). This breaks the examples where we're > combining bottom and type inference to explore how terms and types interact. > > I am less disturbed by `HasCallStack =>` than I was by the inferred type of > ($). > > > I know designing around pedagogical limitations like this is tedious but > imagine doing it for 900-1,200 pages (formatting varies) of tutorial and > exercises, then getting unpleasant surprises right as the book is about to > be done. > > > Sorry about the messy thread all. > > > [1]: http://haskellformac.com/ > > > On Sat, Feb 13, 2016 at 1:48 PM, Bryan Richter > wrote: >> >> On Sat, Feb 13, 2016 at 09:18:07AM -0800, Eric Seidel wrote: >> > Here's what the GHCi session should look like. >> > >> > > $ ghci >> > > GHCi, version 8.0.0.20160204: http://www.haskell.org/ghc/ :? for help >> > > Loaded GHCi configuration from /home/callen/.ghci >> > > Prelude> let myList = [1..5 :: Integer] >> > > Prelude> let myList' = myList ++ undefined >> > > Prelude> :t myList' >> > > myList' :: HasCallStack => [Integer] >> >> What use case is satisfied by providing this information? How does it >> benefit the Haskell programmer? How do I use it? >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> > > > > -- > Chris Allen > Currently working on http://haskellbook.com > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -- Chris Allen Currently working on http://haskellbook.com -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From doug at cs.dartmouth.edu Mon Feb 15 14:26:06 2016 From: doug at cs.dartmouth.edu (Doug McIlroy) Date: Mon, 15 Feb 2016 09:26:06 -0500 Subject: [Haskell-cafe] Catch-22 at GHC bug wiki. Message-ID: <201602151426.u1FEQ6CI005715@coolidge.cs.Dartmouth.EDU> Having forgotten my login name, I have had to register at the GHC bug wiki under a different name with a different email address. I see no way for me to clean up the mess. Can anyone tell me how to reach the wiki keepers to get help? From doug at cs.dartmouth.edu Mon Feb 15 14:29:38 2016 From: doug at cs.dartmouth.edu (Doug McIlroy) Date: Mon, 15 Feb 2016 09:29:38 -0500 Subject: [Haskell-cafe] problem with GHC bug wiki Message-ID: <201602151429.u1FETcfV005777@coolidge.cs.Dartmouth.EDU> Can anyone tell me how to contact the keepers of the GHC bug wiki about a probem with the wiki--not a GHC ticket? Thanks in advance, Doug From robstewart57 at gmail.com Mon Feb 15 14:29:53 2016 From: robstewart57 at gmail.com (Rob Stewart) Date: Mon, 15 Feb 2016 14:29:53 +0000 Subject: [Haskell-cafe] Catch-22 at GHC bug wiki. In-Reply-To: <201602151426.u1FEQ6CI005715@coolidge.cs.Dartmouth.EDU> References: <201602151426.u1FEQ6CI005715@coolidge.cs.Dartmouth.EDU> Message-ID: On 15 February 2016 at 14:26, Doug McIlroy wrote: > GHC bug wiki Do you mean https://ghc.haskell.org/trac/ghc ? Ask on freenode #ghc , I've had something similar myself. I got tripped up by the case sensitive check on my username. I asked on #ghc, where I was reminded of my username and my password was reset IIRC. From eyeinsky9 at gmail.com Mon Feb 15 16:40:33 2016 From: eyeinsky9 at gmail.com (Carl Eyeinsky) Date: Mon, 15 Feb 2016 17:40:33 +0100 Subject: [Haskell-cafe] FP Complete developers survey In-Reply-To: <20160214193348.GC19603@weber> References: <20160214193348.GC19603@weber> Message-ID: Could it be this: http://www.haskellforall.com/2015/08/state-of-haskell-ecosystem-august-2015.html?m=1 ? (it's not directly related to the survey) On Feb 14, 2016 8:33 PM, "Tom Ellis" < tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > Last year FP Complete ran a large survey of Haskell developers. I can only > find a synopsis here > > https://www.fpcomplete.com/blog/2015/05/thousand-user-haskell-survey > > but my memory tells me they also had a blog post with a more in-depth > analysis of the numbers. I can't find it on their website. Does anyone > know where it is, or am I imagining it? > > Tom > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Mon Feb 15 18:34:38 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Mon, 15 Feb 2016 18:34:38 +0000 Subject: [Haskell-cafe] FP Complete developers survey In-Reply-To: References: <20160214193348.GC19603@weber> Message-ID: <20160215183437.GE19603@weber> Thanks, but I was definitely thinking of something directly in response to the survey. On Mon, Feb 15, 2016 at 05:40:33PM +0100, Carl Eyeinsky wrote: > Could it be this: > http://www.haskellforall.com/2015/08/state-of-haskell-ecosystem-august-2015.html?m=1 > ? (it's not directly related to the survey) > On Feb 14, 2016 8:33 PM, "Tom Ellis" < > tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > > > Last year FP Complete ran a large survey of Haskell developers. I can only > > find a synopsis here > > > > https://www.fpcomplete.com/blog/2015/05/thousand-user-haskell-survey > > > > but my memory tells me they also had a blog post with a more in-depth > > analysis of the numbers. I can't find it on their website. Does anyone > > know where it is, or am I imagining it? > > > > Tom > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From gershomb at gmail.com Tue Feb 16 04:08:55 2016 From: gershomb at gmail.com (Gershom B) Date: Mon, 15 Feb 2016 23:08:55 -0500 Subject: [Haskell-cafe] Catch-22 at GHC bug wiki. In-Reply-To: References: <201602151426.u1FEQ6CI005715@coolidge.cs.Dartmouth.EDU> Message-ID: The first step with something like this is usually to email admin at haskell.org. ?Gershom On February 15, 2016 at 9:30:22 AM, Rob Stewart (robstewart57 at gmail.com) wrote: > On 15 February 2016 at 14:26, Doug McIlroy wrote: > > > GHC bug wiki > > Do you mean https://ghc.haskell.org/trac/ghc ? > > Ask on freenode #ghc , I've had something similar myself. I got > tripped up by the case sensitive check on my username. I asked on > #ghc, where I was reminded of my username and my password was reset > IIRC. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > From clintonmead at gmail.com Tue Feb 16 05:21:09 2016 From: clintonmead at gmail.com (Clinton Mead) Date: Tue, 16 Feb 2016 16:21:09 +1100 Subject: [Haskell-cafe] Generalising Categories - categories of tuples Message-ID: Hi All I've been doing some work on generalising categories, basically so the composition operator (.) works for not just functions, but things like tuples of functions, whilst still retaining type inference. Control.Category is a bit too restrictive for such instances. You can see the details in my blog post here: https://clintonmeadprogramming.wordpress.com/2016/02/16/generalising-categories/ Any comments appreciated, I hope people find it interesting. Also, a quick plug, I'm looking for work, so if there's any Haskell (and/or functional programing) work around Sydney, Australia going I'd be interested. :-) If people really think this is useful, tell me, and I'll try to put it up as a package. Alternatively, if it's already been done, I'd appreciate a pointer in that direction. Regards, Clinton Mead -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at snoyman.com Tue Feb 16 07:15:51 2016 From: michael at snoyman.com (Michael Snoyman) Date: Tue, 16 Feb 2016 09:15:51 +0200 Subject: [Haskell-cafe] FP Complete developers survey In-Reply-To: <20160214193348.GC19603@weber> References: <20160214193348.GC19603@weber> Message-ID: Aaron posted some individual summaries to Reddit, perhaps that's what you're thinking of? https://www.reddit.com/r/haskell/comments/377zyc/72_wouldbe_commercial_haskell_users_what_haskell/ https://www.reddit.com/r/haskell/comments/37cr8k/54_haskell_developers_describe_the_templates/ https://www.reddit.com/r/haskell/comments/37d5xh/286_microsoft_users_windows_and_net_express_their/ https://www.reddit.com/r/haskell/comments/37iwlj/154_professionals_comment_on_desired_improvements/ On Sun, Feb 14, 2016 at 9:33 PM, Tom Ellis < tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > Last year FP Complete ran a large survey of Haskell developers. I can only > find a synopsis here > > https://www.fpcomplete.com/blog/2015/05/thousand-user-haskell-survey > > but my memory tells me they also had a blog post with a more in-depth > analysis of the numbers. I can't find it on their website. Does anyone > know where it is, or am I imagining it? > > Tom > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From R.Paterson at city.ac.uk Tue Feb 16 11:11:20 2016 From: R.Paterson at city.ac.uk (Ross Paterson) Date: Tue, 16 Feb 2016 11:11:20 +0000 Subject: [Haskell-cafe] {Probable Spam} transformers appears to benefit from more inline In-Reply-To: References: Message-ID: <20160216111120.GA2517@city.ac.uk> On Sun, Jan 24, 2016 at 06:21:38PM +0000, Oliver Charles wrote: > I've tried to put some fairly extensive benchmarks in place, which you can find > at https://github.com/ocharles/monad-yield. In that repository is a README.md > file that describes how I have been performing these benchmarks. The benchmarks > are defined over a common interface that each implementation of MonadYield > exports. The benchmarks are defined in "Benchmarks.hs", and the three > implementations are "Transformers.hs" (using transformers from GHC), > "TransformersInline.hs" (using transformers-ocharles from that repository, > which has many more INLINE pragmas) and "Inline.hs" (which doesn't depend on > anything other than base). > > There are three main benchmarks that are ran - one is benchmarking essentially > the cost of ReaderT, the next the cost of StateT, and the last a composition of > ReaderT over StateT over ReaderT. The results of the benchmark can be found > here: https://ocharles.github.io/monad-yield/. > > It seems that the current darcs release of transformers loses every time, but > if I sprinkle {-# INLINE #-} across the definition of lazy state, I get > identical performance to just writing out the lazy state monad by hand. > > I was very surprised to see that I have to pay when I use transformers, and it > seems like this cost can be removed at the cost of slightly larger interface > files. > > Before I submit a patch, I'd love to hear others thoughts. Should {-# INLINE # > -} be necessary? Is there any reason not to add it to every symbol in > transformers? Thanks for this analysis. I've now added INLINE to just about everything, per your suggestion. From david.sorokin at gmail.com Tue Feb 16 12:24:18 2016 From: david.sorokin at gmail.com (David Sorokin) Date: Tue, 16 Feb 2016 15:24:18 +0300 Subject: [Haskell-cafe] {Probable Spam} transformers appears to benefit from more inline In-Reply-To: <20160216111120.GA2517@city.ac.uk> References: <20160216111120.GA2517@city.ac.uk> Message-ID: Ross, In the past I noticed a very similar thing, but only I prefer using the INLINABLE pragma with monad transformers, for the INLINE pragma may lead to the performance degradation in some cases. Thanks, David > 16 ????. 2016 ?., ? 14:11, Ross Paterson ???????(?): > > On Sun, Jan 24, 2016 at 06:21:38PM +0000, Oliver Charles wrote: >> I've tried to put some fairly extensive benchmarks in place, which you can find >> at https://github.com/ocharles/monad-yield. In that repository is a README.md >> file that describes how I have been performing these benchmarks. The benchmarks >> are defined over a common interface that each implementation of MonadYield >> exports. The benchmarks are defined in "Benchmarks.hs", and the three >> implementations are "Transformers.hs" (using transformers from GHC), >> "TransformersInline.hs" (using transformers-ocharles from that repository, >> which has many more INLINE pragmas) and "Inline.hs" (which doesn't depend on >> anything other than base). >> >> There are three main benchmarks that are ran - one is benchmarking essentially >> the cost of ReaderT, the next the cost of StateT, and the last a composition of >> ReaderT over StateT over ReaderT. The results of the benchmark can be found >> here: https://ocharles.github.io/monad-yield/. >> >> It seems that the current darcs release of transformers loses every time, but >> if I sprinkle {-# INLINE #-} across the definition of lazy state, I get >> identical performance to just writing out the lazy state monad by hand. >> >> I was very surprised to see that I have to pay when I use transformers, and it >> seems like this cost can be removed at the cost of slightly larger interface >> files. >> >> Before I submit a patch, I'd love to hear others thoughts. Should {-# INLINE # >> -} be necessary? Is there any reason not to add it to every symbol in >> transformers? > > Thanks for this analysis. I've now added INLINE to just about everything, > per your suggestion. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From takenobu.hs at gmail.com Tue Feb 16 12:53:00 2016 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Tue, 16 Feb 2016 21:53:00 +0900 Subject: [Haskell-cafe] ghc commit and ticket mails Message-ID: Hi cafe, I introduce ghc development information. The ghc developers always have many works as a volunteer. You can know and learn their amazing activities [1][2]. (You can also subscribe mailing lists [3][4].) [1] https://mail.haskell.org/pipermail/ghc-tickets/ [2] https://mail.haskell.org/pipermail/ghc-commits/ [3] https://mail.haskell.org/mailman/listinfo/ghc-commits [4] https://mail.haskell.org/mailman/listinfo/ghc-tickets Regards, Takenobu -------------- next part -------------- An HTML attachment was scrubbed... URL: From P.Achten at cs.ru.nl Tue Feb 16 15:36:19 2016 From: P.Achten at cs.ru.nl (Peter Achten) Date: Tue, 16 Feb 2016 16:36:19 +0100 Subject: [Haskell-cafe] [TFPIE 2016] 1st call for papers Message-ID: <56C341F3.3030702@cs.ru.nl> Trends in Functional Programming in Education (TFPIE 2016) Call for papers https://wiki.science.ru.nl/tfpie/TFPIE2016 The 5th International Workshop on Trends in Functional Programming in Education, TFPIE 2016, will be held on June 7, 2016 at the University of Maryland College Park in the USA. It is co-located with the Symposium on Trends in Functional Programming (TFP 2016) which takes place from June 8 - 10. *** Goal *** The goal of TFPIE is to gather researchers, teachers and professionals that use, or are interested in the use of, functional programming in education. TFPIE aims to be a venue where novel ideas, classroom-tested ideas and work-in-progress on the use of functional programming in education are discussed. The one-day workshop will foster a spirit of open discussion by having a review process for publication after the workshop. The program chair of TFPIE 2016 will screen submissions to ensure that all presentations are within scope and are of interest to participants. Potential presenters are invited to submit an extended abstract (4-6 pages) or a draft paper (up to 16 pages) in EPTCS style. The authors of accepted presentations will have their preprints and their slides made available on the workshop's website/wiki. Visitors to the TFPIE 2016 website/wiki will be able to add comments. This includes presenters who may respond to comments and questions as well as provide pointers to improvements and follow-up work. After the workshop, presenters will be invited to submit (a revised version of) their article for review. The PC will select the best articles for publication in the journal Electronic Proceedings in Theoretical Computer Science (EPTCS). Articles rejected for presentation and extended abstracts will not be formally reviewed by the PC. TFPIE workshops have previously been held in St Andrews, Scotland (2012), Provo Utah, USA (2013), Soesterberg, The Netherlands (2014), and Sophia-Antipolis, France (2015). *** Program Committee *** Stephen Chang at Northeastern University in Massachusetts, USA Marc Feeley at Universit? de Montr?al in Qu?bec, Canada Patricia Johann at Appalachian State University in North Carolina, USA Jay McCarthy at University of Massachusetts Lowell in Massachusetts, USA (Chair) Prabhakar Ragde at University of Waterloo in Ontario, Canada Brent Yorgey at Hendrix College in Arkansas, USA *** Submission Guidelines *** TFPIE 2016 welcomes submissions describing techniques used in the classroom, tools used in and/or developed for the classroom and any creative use of functional programming (FP) to aid education in or outside Computer Science. Topics of interest include, but are not limited to: - FP and beginning CS students - FP and Computational Thinking - FP and Artificial Intelligence - FP in Robotics - FP and Music - Advanced FP for undergraduates - Tools supporting learning FP - FP in graduate education - Engaging students in research using FP - FP in Programming Languages - FP in the high school curriculum - FP as a stepping stone to other CS topics - FP and Philosophy *** Best Lectures *** In addition to papers, we request "best lecture" presentations. What is your best lecture topic in an FP related course? Do you have a fun way to present FP concepts to novices or perhaps an especially interesting presentation of a difficult topic? In either case, please consider sharing it. Best lecture topics will be selected for presentation based on a short abstract describing the lecture and its interest to TFPIE attendees. *** Submission *** Papers and abstracts can be submitted via EasyChair at the following link: https://easychair.org/conferences/?conf=tfpie2016 It is expected at at least one author for each submitted paper will attend the workshop. *** Registration & Local Information *** Please see the TFP site for registration and local information: http://tfp2016.org/ *** Important Dates *** April 27, 2016: Submission deadline for draft TFPIE papers and abstracts May 3, 2016: Notification of acceptance for presentation May 13, 2016: Registration for TFP/TFPIE closes June 7, 2016: Presentations in Maryland, USA July 7, 2016: Full papers for EPTCS proceedings due. September 1, 2016: Notification of acceptance for proceedings September 22, 2016: Camera ready copy due for EPTCS Submission of an abstract implies no obligation to submit a full version; abstracts with no corresponding full versions by the full paper deadline will be considered as withdrawn. From cma at bitemyapp.com Tue Feb 16 19:32:55 2016 From: cma at bitemyapp.com (Christopher Allen) Date: Tue, 16 Feb 2016 13:32:55 -0600 Subject: [Haskell-cafe] Worked up examples of Simon Marlow's code hot-swapping Message-ID: https://twitter.com/raichoo/status/699677135280205826 Mentioned here: https://code.facebook.com/posts/745068642270222/fighting-spam-with-haskell https://phabricator.haskell.org/rGHCbdfefb3b72a71cd0afca6e7766456c0d97c47c86 Are there any out there? Most stuff I've found for this is Plugins or something else. I suggested on Twitter it might be similar to the dynamic linking trick game devs use but I don't really know anything about what Simon specifically did. If anyone could please point to examples or deeper explanation that would be a great help, thank you. --- Chris Allen -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Tue Feb 16 22:33:28 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Tue, 16 Feb 2016 22:33:28 +0000 Subject: [Haskell-cafe] FP Complete developers survey In-Reply-To: References: <20160214193348.GC19603@weber> Message-ID: <20160216223328.GF19603@weber> That's probably it, thanks! On Tue, Feb 16, 2016 at 09:15:51AM +0200, Michael Snoyman wrote: > Aaron posted some individual summaries to Reddit, perhaps that's what > you're thinking of? > > https://www.reddit.com/r/haskell/comments/377zyc/72_wouldbe_commercial_haskell_users_what_haskell/ > https://www.reddit.com/r/haskell/comments/37cr8k/54_haskell_developers_describe_the_templates/ > https://www.reddit.com/r/haskell/comments/37d5xh/286_microsoft_users_windows_and_net_express_their/ > https://www.reddit.com/r/haskell/comments/37iwlj/154_professionals_comment_on_desired_improvements/ > > On Sun, Feb 14, 2016 at 9:33 PM, Tom Ellis < > tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > > > Last year FP Complete ran a large survey of Haskell developers. I can only > > find a synopsis here > > > > https://www.fpcomplete.com/blog/2015/05/thousand-user-haskell-survey > > > > but my memory tells me they also had a blog post with a more in-depth > > analysis of the numbers. I can't find it on their website. Does anyone > > know where it is, or am I imagining it? > > > > Tom > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From vogt.adam at gmail.com Wed Feb 17 04:53:26 2016 From: vogt.adam at gmail.com (adam vogt) Date: Tue, 16 Feb 2016 23:53:26 -0500 Subject: [Haskell-cafe] Generalising Categories - categories of tuples In-Reply-To: References: Message-ID: Hi Clinton, HList has some functions that help with defining something similar: < https://gist.github.com/aavogt/50d5313c99b7224b62dd>. It might be possible to use less classes to define the replicate/zip/map functions needed (by using more GADTs and type families instead) and end up being allowed to define an instance Control.Category.Category HF. Your code will be shorter if you make instance heads more general and use equality constraints (~). I mean that the following instance (from my paste) gets selected as long as the first argument to ($) is a function, and no type families are needed: instance (a ~ a', b ~ b') => Dollar (a -> b) a' b' where f $ x = f x Regards, Adam On Tue, Feb 16, 2016 at 12:21 AM, Clinton Mead wrote: > Hi All > > I've been doing some work on generalising categories, basically so the > composition operator (.) works for not just functions, but things like > tuples of functions, whilst still retaining type inference. > Control.Category is a bit too restrictive for such instances. > > You can see the details in my blog post here: > > > https://clintonmeadprogramming.wordpress.com/2016/02/16/generalising-categories/ > > Any comments appreciated, I hope people find it interesting. Also, a quick > plug, I'm looking for work, so if there's any Haskell (and/or functional > programing) work around Sydney, Australia going I'd be interested. :-) > > If people really think this is useful, tell me, and I'll try to put it up > as a package. Alternatively, if it's already been done, I'd appreciate a > pointer in that direction. > > Regards, > > Clinton Mead > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From clintonmead at gmail.com Wed Feb 17 05:01:02 2016 From: clintonmead at gmail.com (Clinton Mead) Date: Wed, 17 Feb 2016 16:01:02 +1100 Subject: [Haskell-cafe] Generalising Categories - categories of tuples In-Reply-To: References: Message-ID: Hi Adam Thanks for the reply. I'm not sure what you mean however by making the code shorter. Could you show an example that relates to category composition which my code is about, not function application? I considered putting the category arguments in the class head like you have in your example, but as discussed in the blog, I found I'd lose type inference, unless I put in all the equality constraints anyway. Could you perhaps show how I could rewrite the class and the (f1, f2) . (f1', f2') = (f1 . f1', f2 . f2') instance with shorter code? Thanks, Clinton On Wed, Feb 17, 2016 at 3:53 PM, adam vogt wrote: > Hi Clinton, > > HList has some functions that help with defining something similar: < > https://gist.github.com/aavogt/50d5313c99b7224b62dd>. It might be > possible to use less classes to define the replicate/zip/map functions > needed (by using more GADTs and type families instead) and end up being > allowed to define an instance Control.Category.Category HF. > > Your code will be shorter if you make instance heads more general and use > equality constraints (~). I mean that the following instance (from my > paste) gets selected as long as the first argument to ($) is a function, > and no type families are needed: > > instance (a ~ a', b ~ b') => Dollar (a -> b) a' b' > where f $ x = f x > > Regards, > Adam > > > On Tue, Feb 16, 2016 at 12:21 AM, Clinton Mead > wrote: > >> Hi All >> >> I've been doing some work on generalising categories, basically so the >> composition operator (.) works for not just functions, but things like >> tuples of functions, whilst still retaining type inference. >> Control.Category is a bit too restrictive for such instances. >> >> You can see the details in my blog post here: >> >> >> https://clintonmeadprogramming.wordpress.com/2016/02/16/generalising-categories/ >> >> Any comments appreciated, I hope people find it interesting. Also, a >> quick plug, I'm looking for work, so if there's any Haskell (and/or >> functional programing) work around Sydney, Australia going I'd be >> interested. :-) >> >> If people really think this is useful, tell me, and I'll try to put it up >> as a package. Alternatively, if it's already been done, I'd appreciate a >> pointer in that direction. >> >> Regards, >> >> Clinton Mead >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From m.farkasdyck at gmail.com Wed Feb 17 07:02:29 2016 From: m.farkasdyck at gmail.com (M Farkas-Dyck) Date: Tue, 16 Feb 2016 23:02:29 -0800 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers Message-ID: I quietly posted this library to Hackage nearly a year ago, but lately learned that some seeking such a package had difficulty finding it, so i announce it now ? https://hackage.haskell.org/package/filtrable class Functor f => Filtrable f where mapMaybe :: (a -> Maybe b) -> f a -> f b catMaybes :: f (Maybe a) -> f a filter :: (a -> Bool) -> f a -> f a For laws, see docs on Hackage. From mail at joachim-breitner.de Wed Feb 17 08:32:56 2016 From: mail at joachim-breitner.de (Joachim Breitner) Date: Wed, 17 Feb 2016 09:32:56 +0100 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: References: Message-ID: <1455697976.1579.21.camel@joachim-breitner.de> Hi M, Am Dienstag, den 16.02.2016, 23:02 -0800 schrieb M Farkas-Dyck: > I quietly posted this library to Hackage nearly a year ago, but lately > learned that some seeking such a package had difficulty finding it, so > i announce it now ? > > https://hackage.haskell.org/package/filtrable > > class Functor f => Filtrable f where > ????mapMaybe :: (a -> Maybe b) -> f a -> f b > ????catMaybes :: f (Maybe a) -> f a > ????filter :: (a -> Bool) -> f a -> f a > > For laws, see docs on Hackage. You might want to add laws in the style of? If this is also a Foldable, then? ? ?toList . mapMaybe f = mapMapybe f . toList ? ?toList . catMaybes =?catMaybes . toList ? ?toList . filter f =?filter f . toList which would fix the behavior quite tightly. I wonder if these laws (together with a ?well behaved? Foldable) still allow any unexpected behavior. And also whether they follow from your laws (but I don?t think so; mapMaybe could do something mean such as duplicating elements if there is at least one Nothing in the result). Do you plan to add instances for all the other data structures in base that are filtrable? Greetings, Joachim -- Joachim ?nomeata? Breitner ? mail at joachim-breitner.de ? https://www.joachim-breitner.de/ ? XMPP: nomeata at joachim-breitner.de?? OpenPGP-Key: 0xF0FBF51F ? Debian Developer: nomeata at debian.org -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 819 bytes Desc: This is a digitally signed message part URL: From oleg.grenrus at iki.fi Wed Feb 17 08:49:37 2016 From: oleg.grenrus at iki.fi (Oleg Grenrus) Date: Wed, 17 Feb 2016 10:49:37 +0200 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: <1455697976.1579.21.camel@joachim-breitner.de> References: <1455697976.1579.21.camel@joachim-breitner.de> Message-ID: <0BEF6AA3-4BFA-42C5-B8C8-C08D6E6E26B7@iki.fi> Hi M, - I?d also like to see instances for types in containers, unordered-containers, vector and semigroup. - The OtherLicense seems a bit scary (even the contents aren?t), is there a good reason why you don?t use more familiar MIT or BSD3? If you don?t mind I can make a PR for the instances. And one more comment: The law: filter f = mapMaybe (liftA2 (<$) id (guard ? f)) is very hard to understand. filter f = mapMaybe (\x -> if f x then Just x else Nothing) is longer, but IMHO much simpler. Or if you really want to code golf, then maybe: filter f = mapMaybe (mfilter f . Just) - Oleg > On 17 Feb 2016, at 10:32, Joachim Breitner wrote: > > Hi M, > > Am Dienstag, den 16.02.2016, 23:02 -0800 schrieb M Farkas-Dyck: >> I quietly posted this library to Hackage nearly a year ago, but lately >> learned that some seeking such a package had difficulty finding it, so >> i announce it now ? >> >> https://hackage.haskell.org/package/filtrable >> >> class Functor f => Filtrable f where >> mapMaybe :: (a -> Maybe b) -> f a -> f b >> catMaybes :: f (Maybe a) -> f a >> filter :: (a -> Bool) -> f a -> f a >> >> For laws, see docs on Hackage. > > You might want to add laws in the style of > > If this is also a Foldable, then > toList . mapMaybe f = mapMapybe f . toList > toList . catMaybes = catMaybes . toList > toList . filter f = filter f . toList > > which would fix the behavior quite tightly. > > I wonder if these laws (together with a ?well behaved? Foldable) still > allow any unexpected behavior. > > And also whether they follow from your laws (but I don?t think so; > mapMaybe could do something mean such as duplicating elements if there > is at least one Nothing in the result). > > Do you plan to add instances for all the other data structures in base > that are filtrable? > > Greetings, > Joachim > > -- > Joachim ?nomeata? Breitner > mail at joachim-breitner.de ? https://www.joachim-breitner.de/ > XMPP: nomeata at joachim-breitner.de ? OpenPGP-Key: 0xF0FBF51F > Debian Developer: nomeata at debian.org > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 842 bytes Desc: Message signed with OpenPGP using GPGMail URL: From sean.leather at gmail.com Wed Feb 17 08:50:13 2016 From: sean.leather at gmail.com (Sean Leather) Date: Wed, 17 Feb 2016 10:50:13 +0200 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: <1455697976.1579.21.camel@joachim-breitner.de> References: <1455697976.1579.21.camel@joachim-breitner.de> Message-ID: Hi Joachim, On Wed, Feb 17, 2016 at 10:32 AM, Joachim Breitner wrote: > Am Dienstag, den 16.02.2016, 23:02 -0800 schrieb M Farkas-Dyck: > > I quietly posted this library to Hackage nearly a year ago, but lately > > learned that some seeking such a package had difficulty finding it, so > > i announce it now ? > > > > https://hackage.haskell.org/package/filtrable > > > > class Functor f => Filtrable f where > > mapMaybe :: (a -> Maybe b) -> f a -> f b > > catMaybes :: f (Maybe a) -> f a > > filter :: (a -> Bool) -> f a -> f a > > > > For laws, see docs on Hackage. > > You might want to add laws in the style of > > If this is also a Foldable, then > toList . mapMaybe f = mapMapybe f . toList > toList . catMaybes = catMaybes . toList > toList . filter f = filter f . toList > > which would fix the behavior quite tightly. > Why would you specify laws for Filtrable w.r.t. Foldable, when Foldable is not part of the definition? There is at least one potential application for Filtrable for a type that isn't a Foldable: https://github.com/reflex-frp/reflex/pull/44 Regards, Sean -------------- next part -------------- An HTML attachment was scrubbed... URL: From oleg.grenrus at iki.fi Wed Feb 17 08:57:27 2016 From: oleg.grenrus at iki.fi (Oleg Grenrus) Date: Wed, 17 Feb 2016 10:57:27 +0200 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: References: <1455697976.1579.21.camel@joachim-breitner.de> Message-ID: <038E21BF-E8DA-4CD9-80ED-74F0B3D0BFB0@iki.fi> Hi, Sean, I guess that?s why there is a disclaimer: ?If this is **also** a Foldable, then? Another similar example is `Hashable` which doesn?t require things to be `Eq`, yet states the infectivity law. - Oleg > On 17 Feb 2016, at 10:50, Sean Leather wrote: > > Hi Joachim, > > On Wed, Feb 17, 2016 at 10:32 AM, Joachim Breitner wrote: > Am Dienstag, den 16.02.2016, 23:02 -0800 schrieb M Farkas-Dyck: > > I quietly posted this library to Hackage nearly a year ago, but lately > > learned that some seeking such a package had difficulty finding it, so > > i announce it now ? > > > > https://hackage.haskell.org/package/filtrable > > > > class Functor f => Filtrable f where > > mapMaybe :: (a -> Maybe b) -> f a -> f b > > catMaybes :: f (Maybe a) -> f a > > filter :: (a -> Bool) -> f a -> f a > > > > For laws, see docs on Hackage. > > You might want to add laws in the style of > > If this is also a Foldable, then > toList . mapMaybe f = mapMapybe f . toList > toList . catMaybes = catMaybes . toList > toList . filter f = filter f . toList > > which would fix the behavior quite tightly. > > Why would you specify laws for Filtrable w.r.t. Foldable, when Foldable is not part of the definition? > > There is at least one potential application for Filtrable for a type that isn't a Foldable: > > https://github.com/reflex-frp/reflex/pull/44 > > Regards, > Sean > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 842 bytes Desc: Message signed with OpenPGP using GPGMail URL: From slomo at coaxion.net Wed Feb 17 08:59:19 2016 From: slomo at coaxion.net (Sebastian =?ISO-8859-1?Q?Dr=F6ge?=) Date: Wed, 17 Feb 2016 10:59:19 +0200 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: References: Message-ID: <1455699559.2328.169.camel@coaxion.net> On Di, 2016-02-16 at 23:02 -0800, M Farkas-Dyck wrote: > I quietly posted this library to Hackage nearly a year ago, but lately > learned that some seeking such a package had difficulty finding it, so > i announce it now ? > > https://hackage.haskell.org/package/filtrable > > class Functor f => Filtrable f where > ????mapMaybe :: (a -> Maybe b) -> f a -> f b > ????catMaybes :: f (Maybe a) -> f a > ????filter :: (a -> Bool) -> f a -> f a > > For laws, see docs on Hackage. This looks very similar to the Witherable class from https://hackage.haskell.org/package/witherable?: class Traversable t => Witherable t where ? wither :: Applicative f => (a -> f (Maybe b)) -> t a -> f (t b) ? wither f = fmap catMaybes . T.traverse f ? mapMaybe :: (a -> Maybe b) -> t a -> t b ? mapMaybe = mapMaybeOf wither ? catMaybes :: t (Maybe a) -> t a ? catMaybes = catMaybesOf wither ? filterA :: Applicative f => (a -> f Bool) -> t a -> f (t a) ? filterA = filterAOf wither ? filter :: (a -> Bool) -> t a -> t a ? filter = filterOf wither -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 949 bytes Desc: This is a digitally signed message part URL: From fr33domlover at riseup.net Wed Feb 17 10:38:25 2016 From: fr33domlover at riseup.net (fr33domlover) Date: Wed, 17 Feb 2016 12:38:25 +0200 Subject: [Haskell-cafe] Yesod CSRF token Message-ID: Hello, I started a new Yesod web app few days ago. I'm using stack, LTS-5.1, and the yesod-postgres scaffolding. When I try to log in into my new minimal app, I get an error: A valid CSRF token wasn't present in HTTP headers or POST parameters. That's because the POST request doesn't include that token for some reason. But I don't know why. I found a recent PR which removes the CSRF token checking from the scaffolding, but I do want CSRF protection to work. As a Yesod beginner, I'm not sure exactly why the token doesn't get inserted where it should (the Yesod book says yesod-form does insert it, so I assume this is a bug here) and how I can fix that. Even if I inserted the token manually into the login form, what about all the other POST requests my app may use, such as logout? I also found a commit that adds the token to the redirectToPost function in yesod-core, but (1) It's in the most recent release, not in LTS (2) I'm not sure it has anything to do with it because it seems to be some sort of JS based form Anyone knows whether this is a known issue and how to fix it? Thanks! --fr33 From _deepfire at feelingofgreen.ru Wed Feb 17 12:21:08 2016 From: _deepfire at feelingofgreen.ru (Kosyrev Serge) Date: Wed, 17 Feb 2016 15:21:08 +0300 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: <0BEF6AA3-4BFA-42C5-B8C8-C08D6E6E26B7@iki.fi> (sfid-20160217_121551_230986_281BDFFB) (Oleg Grenrus's message of "Wed, 17 Feb 2016 10:49:37 +0200") References: <1455697976.1579.21.camel@joachim-breitner.de> <0BEF6AA3-4BFA-42C5-B8C8-C08D6E6E26B7@iki.fi> Message-ID: <87si0rh6iz.fsf@feelingofgreen.ru> Oleg Grenrus writes: > And one more comment: > > The law: > > filter f = mapMaybe (liftA2 (<$) id (guard ? f)) > > is very hard to understand. > > filter f = mapMaybe (\x -> if f x then Just x else Nothing) Wow, the difference is simply astounding for me. Does this monster liftA2 (<$) id (guard ? f) really stand for \x -> if f x then Just x else Nothing ? Is there really no simpler "compact" representation for this trivial idea in Haskell? -- ? ???????e? / respectfully, ??????? ?????? From mail at joachim-breitner.de Wed Feb 17 12:28:37 2016 From: mail at joachim-breitner.de (Joachim Breitner) Date: Wed, 17 Feb 2016 13:28:37 +0100 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: <87si0rh6iz.fsf@feelingofgreen.ru> References: <1455697976.1579.21.camel@joachim-breitner.de> <0BEF6AA3-4BFA-42C5-B8C8-C08D6E6E26B7@iki.fi> <87si0rh6iz.fsf@feelingofgreen.ru> Message-ID: <1455712117.4955.11.camel@joachim-breitner.de> Hi, Am Mittwoch, den 17.02.2016, 15:21 +0300 schrieb Kosyrev Serge: > Does this monster > > ? liftA2 (<$) id (guard ? f) > > really stand for > > ? \x -> if f x then Just x else Nothing > > ? > > Is there really no simpler "compact" representation for this trivial > idea in Haskell? I vaguely remember a discussion about adding a combinator doing that to the libray, and some googling turned out that there was a proposal 6 years ago by... me:?https://ghc.haskell.org/trac/ghc/ticket/3446 (Well, not quite, the type was ? justIf :: a -> Bool -> Just a and not ? justIf :: a -> (a -> Bool) -> Just a and this shows that there are probably too many variants to warrant an addition of some or all of them to the standard library). The corresponding discussion on the libraries? list discussed some of the variants, and also turned up an even older equivalent proposal by Henning Thielemann? from 12 years ago. Greetings, Joachim ??https://mail.haskell.org/pipermail/libraries/2009-August/012413.html ??https://mail.haskell.org/pipermail/libraries/2004-July/002381.html -- Joachim ?nomeata? Breitner ? mail at joachim-breitner.de ? https://www.joachim-breitner.de/ ? XMPP: nomeata at joachim-breitner.de?? OpenPGP-Key: 0xF0FBF51F ? Debian Developer: nomeata at debian.org -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 819 bytes Desc: This is a digitally signed message part URL: From cma at bitemyapp.com Wed Feb 17 16:30:28 2016 From: cma at bitemyapp.com (Christopher Allen) Date: Wed, 17 Feb 2016 10:30:28 -0600 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: <1455697976.1579.21.camel@joachim-breitner.de> References: <1455697976.1579.21.camel@joachim-breitner.de> Message-ID: >Laws Not for nothing, but there's prior art here for a "filterable" with laws. https://hackage.haskell.org/package/witherable On Wed, Feb 17, 2016 at 2:32 AM, Joachim Breitner wrote: > Hi M, > > Am Dienstag, den 16.02.2016, 23:02 -0800 schrieb M Farkas-Dyck: > > I quietly posted this library to Hackage nearly a year ago, but lately > > learned that some seeking such a package had difficulty finding it, so > > i announce it now ? > > > > https://hackage.haskell.org/package/filtrable > > > > class Functor f => Filtrable f where > > mapMaybe :: (a -> Maybe b) -> f a -> f b > > catMaybes :: f (Maybe a) -> f a > > filter :: (a -> Bool) -> f a -> f a > > > > For laws, see docs on Hackage. > > You might want to add laws in the style of > > If this is also a Foldable, then > toList . mapMaybe f = mapMapybe f . toList > toList . catMaybes = catMaybes . toList > toList . filter f = filter f . toList > > which would fix the behavior quite tightly. > > I wonder if these laws (together with a ?well behaved? Foldable) still > allow any unexpected behavior. > > And also whether they follow from your laws (but I don?t think so; > mapMaybe could do something mean such as duplicating elements if there > is at least one Nothing in the result). > > Do you plan to add instances for all the other data structures in base > that are filtrable? > > Greetings, > Joachim > > -- > Joachim ?nomeata? Breitner > mail at joachim-breitner.de ? https://www.joachim-breitner.de/ > XMPP: nomeata at joachim-breitner.de ? OpenPGP-Key: 0xF0FBF51F > Debian Developer: nomeata at debian.org > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From m.farkasdyck at gmail.com Wed Feb 17 17:16:01 2016 From: m.farkasdyck at gmail.com (M Farkas-Dyck) Date: Wed, 17 Feb 2016 09:16:01 -0800 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: References: Message-ID: On 17/02/2016, Joachim Breitner wrote: > You might want to add laws in the style of > > If this is also a Foldable, then > toList . mapMaybe f = mapMapybe f . toList > toList . catMaybes = catMaybes . toList > toList . filter f = filter f . toList Shall do. > Do you plan to add instances for all the other data structures in base > that are filtrable? Yes, if i missed any, please let me know which ? On 17/02/2016, Oleg Grenrus wrote: > - I?d also like to see instances for types in containers, > unordered-containers, vector and semigroup. I was hoping to have no deps but base... alas, Cabal and Hackage seem to have no good way to have instance deps, so the instances must be in either the package defining the class or the one defining the types which are instances of it. > If you don?t mind I can make a PR for the instances. Feel free to do so for containers and vector at least. I may want this to not transitively depend on unordered-containers ? hashable ? text, but if enough potential users want these instances i'll include them (containers and vector come with GHC so it's not so bad). What types in semigroups would you add instances of? > - The OtherLicense seems a bit scary (even the contents aren?t), > is there a good reason why you don?t use more familiar MIT or BSD3? Too verbose. I might use ISC if it weren't also an OtherLicense... > The law: > > filter f = mapMaybe (liftA2 (<$) id (guard ? f)) > > is very hard to understand. Rewritten. On 17/02/2016, Simon Jakobi wrote: > your package looks very similar to > http://hackage.haskell.org/package/witherable! Witherable has Traversable superclass, but some Filtrable types may not be Traversable. From dave at zednenem.com Wed Feb 17 17:26:01 2016 From: dave at zednenem.com (David Menendez) Date: Wed, 17 Feb 2016 12:26:01 -0500 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: References: Message-ID: On Wed, Feb 17, 2016 at 2:02 AM, M Farkas-Dyck wrote: > I quietly posted this library to Hackage nearly a year ago, but lately > learned that some seeking such a package had difficulty finding it, so > i announce it now ? > > https://hackage.haskell.org/package/filtrable > > class Functor f => Filtrable f where > mapMaybe :: (a -> Maybe b) -> f a -> f b > catMaybes :: f (Maybe a) -> f a > filter :: (a -> Bool) -> f a -> f a > > For laws, see docs on Hackage. > This is something I?ve made for myself once or twice (I called it ?Siftable?). One law I didn?t notice you mention is: mapMaybe f . mapMaybe g = mapMaybe (f <=< g) In other words, mapMaybe is a functor from the Kleisli category over Maybe to Hask. (This may come free from parametricity and mapMaybe Just = id.) -- Dave Menendez -------------- next part -------------- An HTML attachment was scrubbed... URL: From b at chreekat.net Wed Feb 17 17:31:41 2016 From: b at chreekat.net (Bryan Richter) Date: Wed, 17 Feb 2016 09:31:41 -0800 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: References: Message-ID: <20160217173141.GA24947@fuzzbomb> On Wed, Feb 17, 2016 at 09:16:01AM -0800, M Farkas-Dyck wrote: > On 17/02/2016, Oleg Grenrus wrote: > > > - The OtherLicense seems a bit scary (even the contents aren?t), > > is there a good reason why you don?t use more familiar MIT or BSD3? > > Too verbose. I might use ISC if it weren't also an OtherLicense... I appreciate the feeling. My personal favorite is the WTFPL. :) However, you are trading verbosity in one particular reference file for increased obscurity and adoption friction for the library as a whole. They may be more verbose, but MIT and BSD3 are very well understood and accepted, and for the audience for whom they are intended, verbosity is just another term for "completeness". -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 801 bytes Desc: Digital signature URL: From heraldhoi at gmail.com Wed Feb 17 18:14:17 2016 From: heraldhoi at gmail.com (Geraldus) Date: Wed, 17 Feb 2016 18:14:17 +0000 Subject: [Haskell-cafe] Yesod CSRF token In-Reply-To: <20160217103404.59D62BD36B@haskell.org> References: <20160217103404.59D62BD36B@haskell.org> Message-ID: Can you share your code? If you make your POST requests via forms make sure that you generation forms with Yesod functions, in this case it will insert hidden field with CSRF token to resulting form widget automatically. If you sending requests via XHR make sure to use `defaultCsrfMiddleware` from Yesod.Core. Hope this helps. ??, 17 ????. 2016 ?. ? 15:38, fr33domlover : > Hello, > > I started a new Yesod web app few days ago. I'm using stack, LTS-5.1, and > the > yesod-postgres scaffolding. > > When I try to log in into my new minimal app, I get an error: A valid CSRF > token wasn't present in HTTP headers or POST parameters. That's because the > POST request doesn't include that token for some reason. But I don't know > why. > > I found a recent PR which removes the CSRF token checking from the > scaffolding, > but I do want CSRF protection to work. As a Yesod beginner, I'm not sure > exactly why the token doesn't get inserted where it should (the Yesod book > says > yesod-form does insert it, so I assume this is a bug here) and how I can > fix > that. Even if I inserted the token manually into the login form, what > about all > the other POST requests my app may use, such as logout? > > I also found a commit that adds the token to the redirectToPost function in > yesod-core, but > > (1) It's in the most recent release, not in LTS > (2) I'm not sure it has anything to do with it because it seems to be some > sort > of JS based form > > Anyone knows whether this is a known issue and how to fix it? > > > > Thanks! > --fr33 > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From amindfv at gmail.com Wed Feb 17 18:34:53 2016 From: amindfv at gmail.com (amindfv at gmail.com) Date: Wed, 17 Feb 2016 13:34:53 -0500 Subject: [Haskell-cafe] Instance deps (was: [announcement] filtrable: class of filtrable containers) In-Reply-To: References: Message-ID: > El 17 feb 2016, a las 12:16, M Farkas-Dyck escribi?: > >> On 17/02/2016, Joachim Breitner wrote: >> You might want to add laws in the style of >> >> If this is also a Foldable, then >> toList . mapMaybe f = mapMapybe f . toList >> toList . catMaybes = catMaybes . toList >> toList . filter f = filter f . toList > > Shall do. > >> Do you plan to add instances for all the other data structures in base >> that are filtrable? > > Yes, if i missed any, please let me know which ? > >> On 17/02/2016, Oleg Grenrus wrote: >> - I?d also like to see instances for types in containers, >> unordered-containers, vector and semigroup. > > I was hoping to have no deps but base... alas, Cabal and Hackage seem > to have no good way to have instance deps, so the instances must be in > either the package defining the class or the one defining the types > which are instances of it. Are there any existing proposals for a solution to this? Tom > >> If you don?t mind I can make a PR for the instances. > > Feel free to do so for containers and vector at least. I may want this > to not transitively depend on unordered-containers ? hashable ? text, > but if enough potential users want these instances i'll include them > (containers and vector come with GHC so it's not so bad). What types > in semigroups would you add instances of? > >> - The OtherLicense seems a bit scary (even the contents aren?t), >> is there a good reason why you don?t use more familiar MIT or BSD3? > > Too verbose. I might use ISC if it weren't also an OtherLicense... > >> The law: >> >> filter f = mapMaybe (liftA2 (<$) id (guard ? f)) >> >> is very hard to understand. > > Rewritten. > >> On 17/02/2016, Simon Jakobi wrote: >> your package looks very similar to >> http://hackage.haskell.org/package/witherable! > > Witherable has Traversable superclass, but some Filtrable types may > not be Traversable. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From oleg.grenrus at iki.fi Wed Feb 17 19:47:25 2016 From: oleg.grenrus at iki.fi (Oleg Grenrus) Date: Wed, 17 Feb 2016 21:47:25 +0200 Subject: [Haskell-cafe] Instance deps (was: [announcement] filtrable: class of filtrable containers) In-Reply-To: References: Message-ID: <317A9A1F-2545-4D54-9457-D382D6C593A7@iki.fi> There are discussions once in a while: https://www.reddit.com/r/haskell/comments/2rajq1/is_there_anything_planned_to_solve_the_orphan/ https://www.reddit.com/r/haskell/comments/1id0p7/backpack_retrofitting_haskell_with_interfaces/cb3eb2n I?m not sure what?s the story with backpack, way or another it would need to solve instance problem. - Oleg > On 17 Feb 2016, at 20:34, amindfv at gmail.com wrote: > > > >> El 17 feb 2016, a las 12:16, M Farkas-Dyck escribi?: >> >>> On 17/02/2016, Joachim Breitner wrote: >>> You might want to add laws in the style of >>> >>> If this is also a Foldable, then >>> toList . mapMaybe f = mapMapybe f . toList >>> toList . catMaybes = catMaybes . toList >>> toList . filter f = filter f . toList >> >> Shall do. >> >>> Do you plan to add instances for all the other data structures in base >>> that are filtrable? >> >> Yes, if i missed any, please let me know which ? >> >>> On 17/02/2016, Oleg Grenrus wrote: >>> - I?d also like to see instances for types in containers, >>> unordered-containers, vector and semigroup. >> >> I was hoping to have no deps but base... alas, Cabal and Hackage seem >> to have no good way to have instance deps, so the instances must be in >> either the package defining the class or the one defining the types >> which are instances of it. > > Are there any existing proposals for a solution to this? > > Tom > > >> >>> If you don?t mind I can make a PR for the instances. >> >> Feel free to do so for containers and vector at least. I may want this >> to not transitively depend on unordered-containers ? hashable ? text, >> but if enough potential users want these instances i'll include them >> (containers and vector come with GHC so it's not so bad). What types >> in semigroups would you add instances of? >> >>> - The OtherLicense seems a bit scary (even the contents aren?t), >>> is there a good reason why you don?t use more familiar MIT or BSD3? >> >> Too verbose. I might use ISC if it weren't also an OtherLicense... >> >>> The law: >>> >>> filter f = mapMaybe (liftA2 (<$) id (guard ? f)) >>> >>> is very hard to understand. >> >> Rewritten. >> >>> On 17/02/2016, Simon Jakobi wrote: >>> your package looks very similar to >>> http://hackage.haskell.org/package/witherable! >> >> Witherable has Traversable superclass, but some Filtrable types may >> not be Traversable. >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 842 bytes Desc: Message signed with OpenPGP using GPGMail URL: From vogt.adam at gmail.com Wed Feb 17 20:16:16 2016 From: vogt.adam at gmail.com (adam vogt) Date: Wed, 17 Feb 2016 15:16:16 -0500 Subject: [Haskell-cafe] Generalising Categories - categories of tuples In-Reply-To: References: Message-ID: Hi Clinton, https://gist.github.com/aavogt/d8beff1f30432f5cda4f gets around the type inference problem I think you ran into. I'm not so sure that it's better, since that SameKs constraint is about as complicated as the type families you need in your version. Regards, Adam On Wed, Feb 17, 2016 at 12:01 AM, Clinton Mead wrote: > Hi Adam > > Thanks for the reply. I'm not sure what you mean however by making the > code shorter. Could you show an example that relates to category > composition which my code is about, not function application? > > I considered putting the category arguments in the class head like you > have in your example, but as discussed in the blog, I found I'd lose type > inference, unless I put in all the equality constraints anyway. > > Could you perhaps show how I could rewrite the class and the (f1, f2) . > (f1', f2') = (f1 . f1', f2 . f2') instance with shorter code? > > Thanks, > > Clinton > > On Wed, Feb 17, 2016 at 3:53 PM, adam vogt wrote: > >> Hi Clinton, >> >> HList has some functions that help with defining something similar: < >> https://gist.github.com/aavogt/50d5313c99b7224b62dd>. It might be >> possible to use less classes to define the replicate/zip/map functions >> needed (by using more GADTs and type families instead) and end up being >> allowed to define an instance Control.Category.Category HF. >> >> Your code will be shorter if you make instance heads more general and use >> equality constraints (~). I mean that the following instance (from my >> paste) gets selected as long as the first argument to ($) is a function, >> and no type families are needed: >> >> instance (a ~ a', b ~ b') => Dollar (a -> b) a' b' >> where f $ x = f x >> >> Regards, >> Adam >> >> >> On Tue, Feb 16, 2016 at 12:21 AM, Clinton Mead >> wrote: >> >>> Hi All >>> >>> I've been doing some work on generalising categories, basically so the >>> composition operator (.) works for not just functions, but things like >>> tuples of functions, whilst still retaining type inference. >>> Control.Category is a bit too restrictive for such instances. >>> >>> You can see the details in my blog post here: >>> >>> >>> https://clintonmeadprogramming.wordpress.com/2016/02/16/generalising-categories/ >>> >>> Any comments appreciated, I hope people find it interesting. Also, a >>> quick plug, I'm looking for work, so if there's any Haskell (and/or >>> functional programing) work around Sydney, Australia going I'd be >>> interested. :-) >>> >>> If people really think this is useful, tell me, and I'll try to put it >>> up as a package. Alternatively, if it's already been done, I'd appreciate a >>> pointer in that direction. >>> >>> Regards, >>> >>> Clinton Mead >>> >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> Haskell-Cafe at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> >>> >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From gershomb at gmail.com Wed Feb 17 20:25:29 2016 From: gershomb at gmail.com (Gershom B) Date: Wed, 17 Feb 2016 15:25:29 -0500 Subject: [Haskell-cafe] Haskell.org Committee Financial Statement 2015 Message-ID: Dear Haskellers, The Haskell.org Committee [1] manages funds for haskell.org and oversees haskell.org infrastructure. The funds available to Haskell.org generally come from two sources: 1) Mentor payments from the Google Summer of Code program. 2) Since the end of 2013, occasional donations [2] from the Haskell community at large. Our funds are held by Software in the Public Interest, a 501(c)3 US non-profit, through which we also accept donations. In return for its services, SPI receives 5% of donations to Haskell.org. According to our charter, "Each year, the committee will post a statement of the haskell.org assets, and the transactions for that year." Included in this message is a brief statement of Haskell.org assets over the period 31 December 2014 - 31 December 2015. Note that our expenses are nearly entirely hosting, with a small overhead incurred by SPI and payment processing. The bulk of our income this year, over which we did minimal fundraising, is $7,000 in mentor payments from google summer of code 2014 (mentor payments for 2015 have not yet been received). Hosting fees are down from years past, as we have migrated more of our infrastructure away from Hetzner and to Rackspace, which donates to us free hosting. 1. Income and Expenses Total income over 2014: 7751.46 Total expenses over 2014: 892.03 ---- Net income over 2014: 6859.43 3. Total Balance Balance as of 31 December 2014: 26,422.91 Balance as of 31 December 2015: 33,547.34 Note: As of December 2015, we have a moved a large chunk of our balance out of the SPI-held account and to a new account set up directly under the control of Haskell.Org, as Haskell.Org is now registered as a nonprofit 501(c)(3). [1] https://wiki.haskell.org/Haskell.org_committee [2] https://wiki.haskell.org/Donate_to_Haskell.org Best, Gershom Bazerman for the Haskell.org Committee From ttuegel at gmail.com Wed Feb 17 20:40:22 2016 From: ttuegel at gmail.com (Thomas Tuegel) Date: Wed, 17 Feb 2016 14:40:22 -0600 Subject: [Haskell-cafe] Generalising Categories - categories of tuples In-Reply-To: References: Message-ID: On Mon, Feb 15, 2016 at 11:21 PM, Clinton Mead wrote: > If people really think this is useful, tell me, and I'll try to put it up as > a package. Alternatively, if it's already been done, I'd appreciate a > pointer in that direction. You may be interested in something I have been working on along the same lines [1]. I was more immediately concerned with implementing a notion of subcategories (so, restriction rather than extension), but I think it would be relatively simple to implement product categories on top of what I have. Type inference is not usually a problem with it, but there is some manual dictionary (proof) passing internally. [1]. https://github.com/ttuegel/recategorize Regards, Tom From fr33domlover at riseup.net Wed Feb 17 22:08:04 2016 From: fr33domlover at riseup.net (fr33domlover) Date: Thu, 18 Feb 2016 00:08:04 +0200 Subject: [Haskell-cafe] Yesod CSRF token In-Reply-To: References: <20160217103404.59D62BD36B@haskell.org> Message-ID: On Wed, 17 Feb 2016 18:14:17 +0000 Geraldus wrote: > Can you share your code? > > If you make your POST requests via forms make sure that you generation > forms with Yesod functions, in this case it will insert hidden field with > CSRF token to resulting form widget automatically. If you sending requests > via XHR make sure to use `defaultCsrfMiddleware` from Yesod.Core. > > Hope this helps. > > ??, 17 ????. 2016 ?. ? 15:38, fr33domlover : I'm using yesod-auth-hashdb. The default login form. And I'm using defaultCsrfMiddleware, it's used by default in the scaffolding template. --fr33 From david.feuer at gmail.com Wed Feb 17 22:21:25 2016 From: david.feuer at gmail.com (David Feuer) Date: Wed, 17 Feb 2016 17:21:25 -0500 Subject: [Haskell-cafe] Closed classes Message-ID: I was thinking about ~two notions of "closed class" yesterday, and I'm curious if anyone's done any work on either concept. In each case, the class definition is followed by *all* of its instances, and the instances are checked *in order* (rather than based on specificity and OVERLAPS/OVERLAPPABLE pragmas). No backtracking: If the instance head matches, GHC commits to it. Associated types are treated as closed type families, and would work just the same (I don't think any significant extension to the closed type family mechanism would be required). This seems to make a very nice parallel to the usual open classes with open associated types. And it lets you combine overlapping instances with associated types without (I believe) risking type safety. Backtracking: GHC does not commit to the instance until it has satisfied the instance constraints. This lets instance writers offer multiple alternative instance constraints. Associated types would be a good bit trickier. One option would be to require all instances with the same head to share a type/data instance. The other (much more invasive) option would be to allow the instance chosen to guide the type selection, which would push the backtracking into the type checker. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gershomb at gmail.com Wed Feb 17 22:22:25 2016 From: gershomb at gmail.com (Gershom B) Date: Wed, 17 Feb 2016 17:22:25 -0500 Subject: [Haskell-cafe] Haskell.org Committee Financial Statement 2015 In-Reply-To: References: Message-ID: Apologies, slight amendment to our closing balance due to a mistranscription on my part (I had given our jan balance). 1. Income and Expenses Total income over 2014: 7751.46 Total expenses over 2014: 892.03 ---- Net income over 2014: 6859.43 2. Total Balance Balance as of 31 December 2014: 26,422.91 Balance as of 31 December 2015: 33,282.34 --Gershom On Wed, Feb 17, 2016 at 3:25 PM, Gershom B wrote: > Dear Haskellers, > > The Haskell.org Committee [1] manages funds for haskell.org and > oversees haskell.org infrastructure. > > The funds available to Haskell.org generally come from two sources: 1) > Mentor payments from the Google Summer of Code program. 2) Since the > end of 2013, occasional donations [2] from the Haskell community at > large. Our funds are held by Software in the Public Interest, a > 501(c)3 US non-profit, through which we also accept donations. In > return for its services, SPI receives 5% of donations to Haskell.org. > > According to our charter, "Each year, the committee will post a > statement of the haskell.org assets, and the transactions for that > year." > > Included in this message is a brief statement of Haskell.org assets > over the period 31 December 2014 - 31 December 2015. Note that our > expenses are nearly entirely hosting, with a small overhead incurred > by SPI and payment processing. The bulk of our income this year, over > which we did minimal fundraising, is $7,000 in mentor payments from > google summer of code 2014 (mentor payments for 2015 have not yet been > received). Hosting fees are down from years past, as we have migrated > more of our infrastructure away from Hetzner and to Rackspace, which > donates to us free hosting. > > 1. Income and Expenses > Total income over 2014: 7751.46 > Total expenses over 2014: 892.03 > ---- > Net income over 2014: 6859.43 > > 3. Total Balance > Balance as of 31 December 2014: 26,422.91 > Balance as of 31 December 2015: 33,547.34 > > Note: As of December 2015, we have a moved a large chunk of our > balance out of the SPI-held account and to a new account set up > directly under the control of Haskell.Org, as Haskell.Org is now > registered as a nonprofit 501(c)(3). > > [1] https://wiki.haskell.org/Haskell.org_committee > [2] https://wiki.haskell.org/Donate_to_Haskell.org > > Best, > Gershom Bazerman > for the Haskell.org Committee From m.farkasdyck at gmail.com Thu Feb 18 00:06:52 2016 From: m.farkasdyck at gmail.com (M Farkas-Dyck) Date: Wed, 17 Feb 2016 16:06:52 -0800 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: <20160217173141.GA24947@fuzzbomb> References: <20160217173141.GA24947@fuzzbomb> Message-ID: On 17/02/2016, Bryan Richter wrote: > They may be more verbose, but MIT and BSD3 are very well understood > and accepted, and for the audience for whom they are intended, > verbosity is just another term for "completeness". Yeah, i may as well release it under BSD3; it's all a farce as far as i care. Done. From imantc at gmail.com Thu Feb 18 00:21:41 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 18 Feb 2016 01:21:41 +0100 Subject: [Haskell-cafe] Closed classes In-Reply-To: References: Message-ID: This would be very useful indeed. Can closed type families not be used to achieve the same result even now, already? I tried to use type families recently to explicitly pick an (otherwise overlapping) instance in specified order but could not figure out, how. If someone could give a complete simple example of primary intended use of closed type families with class instances, this would help a lot. -------------- next part -------------- An HTML attachment was scrubbed... URL: From m.farkasdyck at gmail.com Thu Feb 18 00:21:47 2016 From: m.farkasdyck at gmail.com (M Farkas-Dyck) Date: Wed, 17 Feb 2016 16:21:47 -0800 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: References: Message-ID: On 17/02/2016, David Menendez wrote: > One law I didn?t notice you mention is: > > mapMaybe f . mapMaybe g = mapMaybe (f <=< g) Good call, added! If someone proves some law to be reducible to the others i'll delete it. From m.farkasdyck at gmail.com Thu Feb 18 02:38:34 2016 From: m.farkasdyck at gmail.com (M Farkas-Dyck) Date: Wed, 17 Feb 2016 18:38:34 -0800 Subject: [Haskell-cafe] Instance deps (was: [announcement] filtrable: class of filtrable containers) In-Reply-To: References: Message-ID: 2 options readily come to mind: ? For each pair of packages (P, Q) where either has potential instances of a class in the other, we define these as orphans in yet another package R and tell this somehow in the cabal files of P and Q. If any package transitively depends on both P and Q it automatically sees the instance in R wherever all its types are in scope. Potential problem: quadratically many packages needed ? We can mark some deps Qs in the cabal file of package P as only needed to define instances of their classes for our types or for their types for our classes. If a package which depends on P would not otherwise transitively depend on Q, these instances and dependencies are ignored. From monkleyon at googlemail.com Thu Feb 18 02:57:36 2016 From: monkleyon at googlemail.com (martin) Date: Thu, 18 Feb 2016 03:57:36 +0100 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: References: Message-ID: <56C53320.9040700@gmail.com> The only need for the functor requirement is in the default definition of mapMaybe - so why not drop it? I would also suggest you add (modulo better names) partition :: (a -> Bool) -> f a -> (f a , f a) partitionWith :: (a -> Either b c) -> f a -> (f b, f c) catEithers :: f (Either b c) -> (f b, f c) lefts :: f (Either b c) -> f b rights :: f (Either b c) -> f c I think the class would still be equivalent to your current one, but more useful. On 2016-02-17 08:02, M Farkas-Dyck wrote: > I quietly posted this library to Hackage nearly a year ago, but lately > learned that some seeking such a package had difficulty finding it, so > i announce it now ? > > https://hackage.haskell.org/package/filtrable > > class Functor f => Filtrable f where > mapMaybe :: (a -> Maybe b) -> f a -> f b > catMaybes :: f (Maybe a) -> f a > filter :: (a -> Bool) -> f a -> f a > > For laws, see docs on Hackage. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From david.feuer at gmail.com Thu Feb 18 03:44:52 2016 From: david.feuer at gmail.com (David Feuer) Date: Wed, 17 Feb 2016 22:44:52 -0500 Subject: [Haskell-cafe] Closed classes In-Reply-To: References: Message-ID: Yes, closed type families *can* be used to achieve the same result even now, but it tends to be fairly verbose. There are a number of minor variations in how it can be done, but here's one example: {-# LANGUAGE TypeFamilies, DataKinds, MultiParamTypeClasses, FlexibleInstances, FlexibleInstances, ScopedTypeVariables, UndecidableInstances #-} import Data.Proxy class Closed a b where fun :: a -> b -> Int -- Names for the instances data InstanceChoice = ChooseFirst | ChooseSecond | IgnoreBoth -- Determine which instance should be used type family Choose a b where Choose Int y = 'ChooseFirst Choose x Int = 'ChooseSecond Choose x y = 'IgnoreBoth -- Auxiliary class with instance-choice parameter class Closed' (choice :: InstanceChoice) a b where fun' :: proxy choice -> a -> b -> Int -- The actual instances instance Closed' 'ChooseFirst Int y where fun' _ x _ = x instance Closed' 'ChooseSecond x Int where fun' _ _ y = y instance Closed' 'IgnoreBoth x y where fun' _ _ _ = 0 -- Note that ScopedTypeVariables is necessary to make this typecheck. instance (choice ~ Choose a b, Closed' choice a b) => Closed a b where fun = fun' (Proxy :: Proxy choice) Then > fun (3 :: Int) 'a' 3 > fun 'a' (4 :: Int) 4 > fun 'a' 'b' 0 On Wed, Feb 17, 2016 at 7:21 PM, Imants Cekusins wrote: > This would be very useful indeed. > > Can closed type families not be used to achieve the same result even now, > already? > > I tried to use type families recently to explicitly pick an (otherwise > overlapping) instance in specified order but could not figure out, how. > > If someone could give a complete simple example of primary intended use of > closed type families with class instances, this would help a lot. > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From twhitehead at gmail.com Thu Feb 18 03:59:57 2016 From: twhitehead at gmail.com (Tyson Whitehead) Date: Wed, 17 Feb 2016 22:59:57 -0500 Subject: [Haskell-cafe] GHC worker/wrapper on multiple return values Message-ID: <56C541BD.40200@gmail.com> Recently discovered GHC generates sub-optimal code when you have - two levels of loops in the IO monad - the inner loop doesn't do that much work - the outer loop does a lot of work From dumping core I believe the issue is the worker/wrapper transformation doesn't produce return value unboxing (from the inner loop to the outer in this case) when there are multiple return values (as you windup with the IO monad due to passing around the State# RealWorld behind the scenes). Here is some simple code that demonstrates the issue. With a single return value {-# LANGUAGE BangPatterns #-} module Main (main) where main :: IO () main = do let a = l1 0 100000000 print a l1 :: Int -> Int -> Int l1 !a !n = case n>0 of True -> let m = l2 0 n 3 in l1 (a+m) (n-1) False -> a l2 :: Int -> Int -> Int -> Int l2 !a !n !m = case m>0 of True -> l2 (a+n) (n-1) (m-1) False -> a you get nice clean core that performs no allocations and runs beautifully. Doing the same thing within the IO monad (effectively lifting the return value above into a unboxed tupple) {-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-} module Main (main) where main :: IO () main = do a <- l1 0 100000000 print a l1 :: Int -> Int -> IO Int l1 !a !n = do case n>0 of True -> do m <- l2 0 n 3 l1 (a+m) (n-1) False -> return a l2 :: Int -> Int -> Int -> IO Int l2 !a !n !m = do case m>0 of True -> l2 (a+n) (n-1) (m-1) False -> return a you don't get boxing and unboxing the return value between l1 and l2. This has quite a dramatic effect when l2 doesn't do the that much work (massive amounts of additional memory allocation and a 2x slow down). $ time ./Simple-pure 14999999850000000 51,912 bytes allocated in the heap ... real 0m0.322s ... $ time ./Simple-io 14999999850000000 1,600,051,936 bytes allocated in the heap ... real 0m0.634s Should I open a ticket against GHC about this issue? Possibly it wouldn't be that hard to get the work/wrapper stuff to work its unboxing magic on multiple return values too? Cheers! -Tyson [*] https://gist.github.com/twhitehead/5744eee28bcde85b9fa4 From david.feuer at gmail.com Thu Feb 18 04:06:41 2016 From: david.feuer at gmail.com (David Feuer) Date: Wed, 17 Feb 2016 23:06:41 -0500 Subject: [Haskell-cafe] Closed classes In-Reply-To: References: Message-ID: For the sake of completeness, I'd love to be able to write this, instead, as {-# LANGUAGE ClosedClasses #-} -- The "closed" keyword indicates that -- only instances in this module will be -- permitted. closed class Closed a b where fun :: a -> b -> Int -- Necessarily in the same module, and in -- this order. Ideally, other definitions would -- be allowed to appear between them. -- The "closed" keyword is a reminder of -- order-dependence. closed instance Closed Int y where fun x _ = x closed instance Closed x Int where fun _ y = y closed instance Closed x y where fun _ _ = 0 On Wed, Feb 17, 2016 at 10:44 PM, David Feuer wrote: > Yes, closed type families *can* be used to achieve the same result even > now, but it tends to be fairly verbose. There are a number of minor > variations in how it can be done, but here's one example: > > {-# LANGUAGE TypeFamilies, DataKinds, MultiParamTypeClasses, > FlexibleInstances, FlexibleInstances, ScopedTypeVariables, > UndecidableInstances #-} > import Data.Proxy > > class Closed a b where > fun :: a -> b -> Int > > -- Names for the instances > data InstanceChoice = ChooseFirst | ChooseSecond | IgnoreBoth > > -- Determine which instance should be used > type family Choose a b where > Choose Int y = 'ChooseFirst > Choose x Int = 'ChooseSecond > Choose x y = 'IgnoreBoth > > -- Auxiliary class with instance-choice parameter > class Closed' (choice :: InstanceChoice) a b where > fun' :: proxy choice -> a -> b -> Int > > -- The actual instances > instance Closed' 'ChooseFirst Int y where fun' _ x _ = x > instance Closed' 'ChooseSecond x Int where fun' _ _ y = y > instance Closed' 'IgnoreBoth x y where fun' _ _ _ = 0 > > -- Note that ScopedTypeVariables is necessary to make this typecheck. > instance (choice ~ Choose a b, Closed' choice a b) => Closed a b where > fun = fun' (Proxy :: Proxy choice) > > Then > > > fun (3 :: Int) 'a' > 3 > > fun 'a' (4 :: Int) > 4 > > fun 'a' 'b' > 0 > > > > On Wed, Feb 17, 2016 at 7:21 PM, Imants Cekusins wrote: > >> This would be very useful indeed. >> >> Can closed type families not be used to achieve the same result even now, >> already? >> >> I tried to use type families recently to explicitly pick an (otherwise >> overlapping) instance in specified order but could not figure out, how. >> >> If someone could give a complete simple example of primary intended use >> of closed type families with class instances, this would help a lot. >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From eric at seidel.io Thu Feb 18 05:34:56 2016 From: eric at seidel.io (Eric Seidel) Date: Wed, 17 Feb 2016 21:34:56 -0800 Subject: [Haskell-cafe] Closed classes In-Reply-To: References: Message-ID: <1455773696.2936942.524565346.02253155@webmail.messagingengine.com> The work on instance chains[1] seems related, but I'm not very familiar with it, so it might just be superficial. [1]: http://web.cecs.pdx.edu/~mpj/pubs/instancechains.pdf On Wed, Feb 17, 2016, at 14:21, David Feuer wrote: > I was thinking about ~two notions of "closed class" yesterday, and I'm > curious if anyone's done any work on either concept. In each case, the > class definition is followed by *all* of its instances, and the instances > are checked *in order* (rather than based on specificity and > OVERLAPS/OVERLAPPABLE pragmas). > > No backtracking: > > If the instance head matches, GHC commits to it. Associated types are > treated as closed type families, and would work just the same (I don't > think any significant extension to the closed type family mechanism would > be required). This seems to make a very nice parallel to the usual open > classes with open associated types. And it lets you combine overlapping > instances with associated types without (I believe) risking type safety. > > Backtracking: > > GHC does not commit to the instance until it has satisfied the instance > constraints. This lets instance writers offer multiple alternative > instance > constraints. Associated types would be a good bit trickier. One option > would be to require all instances with the same head to share a type/data > instance. The other (much more invasive) option would be to allow the > instance chosen to guide the type selection, which would push the > backtracking into the type checker. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From lambda.fairy at gmail.com Thu Feb 18 06:03:23 2016 From: lambda.fairy at gmail.com (Chris Wong) Date: Thu, 18 Feb 2016 17:03:23 +1100 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: <56C53320.9040700@gmail.com> References: <56C53320.9040700@gmail.com> Message-ID: On Thu, Feb 18, 2016 at 1:57 PM, martin wrote: > The only need for the functor requirement is in the default definition > of mapMaybe - so why not drop it? Since fmap can be defined in terms of mapMaybe: fmap f = mapMaybe (Just . f) Filtrable should imply Functor in the same way that Traversable implies Foldable. -- Chris Wong (https://lambda.xyz) "I had not the vaguest idea what this meant and when I could not remember the words, my tutor threw the book at my head, which did not stimulate my intellect in any way." -- Bertrand Russell From m.farkasdyck at gmail.com Thu Feb 18 07:01:58 2016 From: m.farkasdyck at gmail.com (M Farkas-Dyck) Date: Wed, 17 Feb 2016 23:01:58 -0800 Subject: [Haskell-cafe] [announcement] filtrable: class of filtrable containers In-Reply-To: References: <56C53320.9040700@gmail.com> Message-ID: On 17/02/2016, Chris Wong wrote: > On Thu, Feb 18, 2016 at 1:57 PM, martin wrote: >> The only need for the functor requirement is in the default definition >> of mapMaybe - so why not drop it? > > Since fmap can be defined in terms of mapMaybe: > > fmap f = mapMaybe (Just . f) > > Filtrable should imply Functor in the same way that Traversable > implies Foldable. I think the notion is to make mapMaybe not a class method, and rather define it on its own: mapMaybe f :: (Functor f, Filtrable f) => (a -> Maybe b) -> f a -> f b mapMaybe f = catMaybes . fmap f I like this idea, but worry what the laws would be... From clintonmead at gmail.com Thu Feb 18 08:06:59 2016 From: clintonmead at gmail.com (Clinton Mead) Date: Thu, 18 Feb 2016 19:06:59 +1100 Subject: [Haskell-cafe] Closed classes In-Reply-To: References: Message-ID: The backtracking approach would be useful. It would be nice to say: instance (A t) => C t where ... instance (B t) => C t where ... in the case where you can define a C instance if you've already got a B instance or an A instance. Indeed (aside from efficiency) you don't really care which one. Yes, this means if someone else defines and instance of A somewhere else in the program then suddenly you're silently calling a different instance. Indeed you could be using different instances in different parts of the program. But as long as they have the same effect that shouldn't be an issue. If they have different effects it's likely one is wrong anyway. For (perhaps a silly) example: class DrawRhombus drawerT where drawRhombus :: drawerT -> Sidelength -> Angle -> Shape class DrawRectangle drawerT where drawRectangle :: drawerT -> Sidelength -> Sidelength -> Shape class DrawSquare t where drawSquare :: drawerT -> Sidelength -> Shape instance (DrawRhombus drawerT) => DrawSquare drawerT where drawSquare d l = drawRhombus d l (Angle 0) instance (DrawRectangle drawerT) => DrawSquare drawerT where drawSquare d l = drawRectangle d l l On Thu, Feb 18, 2016 at 9:21 AM, David Feuer wrote: > I was thinking about ~two notions of "closed class" yesterday, and I'm > curious if anyone's done any work on either concept. In each case, the > class definition is followed by *all* of its instances, and the instances > are checked *in order* (rather than based on specificity and > OVERLAPS/OVERLAPPABLE pragmas). > > No backtracking: > > If the instance head matches, GHC commits to it. Associated types are > treated as closed type families, and would work just the same (I don't > think any significant extension to the closed type family mechanism would > be required). This seems to make a very nice parallel to the usual open > classes with open associated types. And it lets you combine overlapping > instances with associated types without (I believe) risking type safety. > > Backtracking: > > GHC does not commit to the instance until it has satisfied the instance > constraints. This lets instance writers offer multiple alternative instance > constraints. Associated types would be a good bit trickier. One option > would be to require all instances with the same head to share a type/data > instance. The other (much more invasive) option would be to allow the > instance chosen to guide the type selection, which would push the > backtracking into the type checker. > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Thu Feb 18 09:22:59 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 18 Feb 2016 10:22:59 +0100 Subject: [Haskell-cafe] Closed classes In-Reply-To: References: Message-ID: David, thank you very much for the examples. They are very clear. Would it be difficult to post the first one (working in current setup) on Wiki? either https://wiki.haskell.org/GHC/Type_families or https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/type-families.html ? expanding your and Clinton's suggestions, here is one more version. Not sure if this may work however this may be intuitive to C#, Java users: -- Names for the instances data InstanceChoice = ChooseFirst | ChooseSecond | IgnoreBoth -- Determine which instance should be used type family Choose a b where Choose Int y = 'ChooseFirst Choose x Int = 'ChooseSecond Choose x y = 'IgnoreBoth class Closed a b where fun :: a -> b -> Int instance (Choose Int y) => Closed Int y where fun x _ = x instance (Choose x Int) => Closed x Int where fun _ y = y instance (Choose x y) => Closed x y where fun _ _ = 0 the differences: no need to use new keyword "closed" no need for new language pragma non-type family instances may still be defined instances may be defined in other modules (if possible:) multiple type families may be used with the same class. Instance constraint would hint, which (if any) type family to apply in selecting an instance how does this sound? From imantc at gmail.com Thu Feb 18 09:38:24 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 18 Feb 2016 10:38:24 +0100 Subject: [Haskell-cafe] Closed classes In-Reply-To: References: Message-ID: .. and one more option: -- Enum order specifies the order instances are tried data InstanceChoice = ChooseFirst | ChooseSecond | IgnoreBoth deriving Enum type family Choose a b where Choose Int y = ChooseFirst Choose x Int = ChooseSecond Choose x y = IgnoreBoth class (Choose a b) => Closed a b where fun :: a -> b -> Int instance Closed Int y where fun x _ = x instance Closed x Int where fun _ y = y instance Closed x y where fun _ _ = 0 From haskell at ibotty.net Thu Feb 18 10:43:44 2016 From: haskell at ibotty.net (Tobias Florek) Date: Thu, 18 Feb 2016 11:43:44 +0100 Subject: [Haskell-cafe] Closed classes In-Reply-To: References: Message-ID: <20160218104344.16642.93327@piano> Hi. For consistency reasons, I'd love to write the following, possibly even omiting the closed keyword. > {-# LANGUAGE ClosedClasses #-} > closed class Closed a b where > fun :: a -> b -> Int > instance Closed Int y where fun x _ = x > instance Closed x Int where fun _ y = y > instance Closed x y where fun _ _ = 0 I guess, that's already bikeshedding. Cheers, Tobias Florek From wojtek at power.com.pl Thu Feb 18 14:25:48 2016 From: wojtek at power.com.pl (=?UTF-8?Q?Wojtek_Narczy=c5=84ski?=) Date: Thu, 18 Feb 2016 15:25:48 +0100 Subject: [Haskell-cafe] STM unperformance Message-ID: <56C5D46C.9050503@power.com.pl> Dear list, I create four haskell threads, each performs disjoint STM transactions. The more system threads I add, the slower the program runs. With four system threads the performance is 14% of the nonparallel run. What is going on? $ ghc -v Glasgow Haskell Compiler, Version 7.10.3, stage 2 booted by GHC version 7.8.4 $ ghc -O2 -threaded test-stm.hs $ time ./test-stm +RTS -N1 real 1.843s $ time ./test-stm +RTS -N2 real 7.469s $ time ./test-stm +RTS -N3 real 9.640s $ time ./test-stm +RTS -N4 real 13.144s $ cat test-stm.hs {-# LANGUAGE ScopedTypeVariables #-} import Control.Monad import Control.Concurrent import Control.Concurrent.STM import Control.Concurrent.STM.Stats import System.IO.Unsafe -- Copied from GHC docs children :: MVar [MVar ()] children = unsafePerformIO (newMVar []) waitForChildren :: IO () waitForChildren = do cs <- takeMVar children case cs of [] -> return () m:ms -> do putMVar children ms takeMVar m waitForChildren forkChild :: IO () -> IO ThreadId forkChild io = do mvar <- newEmptyMVar childs <- takeMVar children putMVar children (mvar:childs) forkFinally io (\_ -> putMVar mvar ()) -- Test case main = do forkChild $ newTVarIO 0 >>= incrManyTimes "thread1" forkChild $ newTVarIO 0 >>= incrManyTimes "thread2" forkChild $ newTVarIO 0 >>= incrManyTimes "thread3" forkChild $ newTVarIO 0 >>= incrManyTimes "thread4" waitForChildren dumpSTMStats -- Confirms no conflicts incrManyTimes :: String -> TVar Int -> IO () incrManyTimes l = incrRec (1000000 :: Int) where incrRec n v | n == 0 = pure () | otherwise = trackNamedSTM l (modifyTVar v (+1)) >> incrRec (n-1) v -- Wojtek From anselm.scholl at tu-harburg.de Thu Feb 18 15:00:59 2016 From: anselm.scholl at tu-harburg.de (Jonas Scholl) Date: Thu, 18 Feb 2016 16:00:59 +0100 Subject: [Haskell-cafe] STM unperformance In-Reply-To: <56C5D46C.9050503@power.com.pl> References: <56C5D46C.9050503@power.com.pl> Message-ID: <56C5DCAB.2050705@tu-harburg.de> On 02/18/2016 03:25 PM, Wojtek Narczy?ski wrote: > Dear list, > > I create four haskell threads, each performs disjoint STM transactions. > The more system threads I add, the slower the program runs. With four > system threads the performance is 14% of the nonparallel run. > > What is going on? > > $ ghc -v > Glasgow Haskell Compiler, Version 7.10.3, stage 2 booted by GHC version > 7.8.4 > > $ ghc -O2 -threaded test-stm.hs > > $ time ./test-stm +RTS -N1 > real 1.843s > > $ time ./test-stm +RTS -N2 > real 7.469s > > $ time ./test-stm +RTS -N3 > real 9.640s > > $ time ./test-stm +RTS -N4 > real 13.144s > > $ cat test-stm.hs > {-# LANGUAGE ScopedTypeVariables #-} > > import Control.Monad > import Control.Concurrent > import Control.Concurrent.STM > import Control.Concurrent.STM.Stats > import System.IO.Unsafe > > -- Copied from GHC docs > > children :: MVar [MVar ()] > children = unsafePerformIO (newMVar []) > > waitForChildren :: IO () > waitForChildren = do > cs <- takeMVar children > case cs of > [] -> return () > m:ms -> do > putMVar children ms > takeMVar m > waitForChildren > > forkChild :: IO () -> IO ThreadId > forkChild io = do > mvar <- newEmptyMVar > childs <- takeMVar children > putMVar children (mvar:childs) > forkFinally io (\_ -> putMVar mvar ()) > > -- Test case > > main = do > forkChild $ newTVarIO 0 >>= incrManyTimes "thread1" > forkChild $ newTVarIO 0 >>= incrManyTimes "thread2" > forkChild $ newTVarIO 0 >>= incrManyTimes "thread3" > forkChild $ newTVarIO 0 >>= incrManyTimes "thread4" > waitForChildren > dumpSTMStats -- Confirms no conflicts > > incrManyTimes :: String -> TVar Int -> IO () > incrManyTimes l = incrRec (1000000 :: Int) where > incrRec n v | n == 0 = pure () > | otherwise = trackNamedSTM l (modifyTVar v (+1)) >> > incrRec (n-1) v > While your code does not contain any conflicts, the stm-stats library seems to contain some. Replacing trackNamedSTM with atomically speeds things up quite a bit, so most of the time is lost in the library. A short look at the code of the library shows that it uses atomicModifyIORef on some global IORef holding a map of the statistics. And your stm transactions are really short, thus that IORef is under high pressure. Now atomicModifyIORef works by reading the old value, computing the new one and then doing an atomic swap, if the IORef still contains the old value. So if the value changed, the new value has to be read, computed, and so on... Now you have four threads doing tiny transactions and then updating this IORef, interfering with each other. If I make the transaction longer by doing 1000 increments in one transaction and then doing only 1000 transactions, the code scales like one would expect. -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 473 bytes Desc: OpenPGP digital signature URL: From david.feuer at gmail.com Thu Feb 18 15:05:03 2016 From: david.feuer at gmail.com (David Feuer) Date: Thu, 18 Feb 2016 10:05:03 -0500 Subject: [Haskell-cafe] Closed classes In-Reply-To: <20160218104344.16642.93327@piano> References: <20160218104344.16642.93327@piano> Message-ID: That is more consistent, but it leaves no room to intersperse auxiliary definitions, which strikes me as unfortunate for practical reasons. On Feb 18, 2016 5:43 AM, "Tobias Florek" wrote: > Hi. > > For consistency reasons, I'd love to write the following, possibly even > omiting the closed keyword. > > > {-# LANGUAGE ClosedClasses #-} > > closed class Closed a b where > > fun :: a -> b -> Int > > instance Closed Int y where fun x _ = x > > instance Closed x Int where fun _ y = y > > instance Closed x y where fun _ _ = 0 > > I guess, that's already bikeshedding. > > Cheers, > Tobias Florek > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From twhitehead at gmail.com Thu Feb 18 15:48:33 2016 From: twhitehead at gmail.com (Tyson Whitehead) Date: Thu, 18 Feb 2016 07:48:33 -0800 (PST) Subject: [Haskell-cafe] GHC worker/wrapper on multiple return values In-Reply-To: <56C541BD.40200@gmail.com> References: <56C541BD.40200@gmail.com> Message-ID: <2c238fa1-4337-4d82-87a6-919b79fb65c3@googlegroups.com> On Wednesday, 17 February 2016 23:00:07 UTC-5, Tyson Whitehead wrote: > > ... Doing the same thing within the IO monad (effectively lifting the > return value above into a unboxed tupple) > > ... > > you don't get boxing and unboxing the return value between l1 and l2. > This has quite a dramatic effect when l2 doesn't do the that much work > (massive amounts of additional memory allocation and a 2x slow down). > That of course should have read "Doing the same thing within the IO monad (...) you get boxing and unboxing of the return value between l1 and l2..." (i.e., no "don't"). -------------- next part -------------- An HTML attachment was scrubbed... URL: From wojtek at power.com.pl Thu Feb 18 16:59:04 2016 From: wojtek at power.com.pl (=?UTF-8?Q?Wojtek_Narczy=c5=84ski?=) Date: Thu, 18 Feb 2016 17:59:04 +0100 Subject: [Haskell-cafe] STM unperformance In-Reply-To: <56C5DCAB.2050705@tu-harburg.de> References: <56C5D46C.9050503@power.com.pl> <56C5DCAB.2050705@tu-harburg.de> Message-ID: <56C5F858.1050400@power.com.pl> On 18.02.2016 16:00, Jonas Scholl wrote: > While your code does not contain any conflicts, the stm-stats library > seems to contain some. Replacing trackNamedSTM with atomically speeds > things up quite a bit, so most of the time is lost in the library. A > short look at the code of the library shows that it uses > atomicModifyIORef on some global IORef holding a map of the statistics. Yes, the instrumentation was the culprit. Thank you! I'm trying to come up with a (Ord a, Hashable a) => STM (Set a), internally partitioned for reduced contention. Looks like my code for the Set itself was right, but my code for testing it was ...four transactions, inserting one milion elements each. This coudn't have worked well, I don't know why it worked at all. Now that I switched to four million transactions, inserting one element each, things work much better. Perhaps not great, as the 1 OS thread case is still the fastest, but 4 OS threads are much faster on the partitioned set then on its unpartitioned counterpart. Overall, inserting transactionally four milion Ints into a Set in one second ain't bad at all. Counting them afterwards takes much longer... -- Wojtek From johnw at newartisans.com Thu Feb 18 18:15:44 2016 From: johnw at newartisans.com (John Wiegley) Date: Thu, 18 Feb 2016 10:15:44 -0800 Subject: [Haskell-cafe] Call for Haskell.org committee self-nominations Message-ID: Dear Haskellers, It is time to put out the call for new volunteers to the haskell.org committee. We have one member due for retirement since this past October: Gershom Bazerman. The committee would like to thank him for his excellent service. To nominate yourself, please send an email to committee at haskell.org by March 4, 2016. The retiring members are eligible to re-nominate themselves. Please feel free to include any information about yourself that you think will help us to make a decision. Being a member of the committee does not necessarily require a significant amount of time, but committee members should aim to be responsive during discussions when the committee is called upon to make a decision. Strong leadership, communication, and judgement are very important characteristics for committee members. The role is about setting policy, providing direction/guidance for Haskell.org infrastructure, planning for the long term, and being fiscally responsible with the Haskell.org funds (and donations). As overseers for policy regarding the open source side of Haskell, committee members must also be able to set aside personal or business related bias and make decisions with the good of the open source Haskell community in mind. More details about the committee's roles and responsibilities are on https://wiki.haskell.org/Haskell.org_committee If you have any questions about the process, please feel free to e-mail us at committee at haskell.org, or contact one of us individually. Thank you, -- John Wiegley GPG fingerprint = 4710 CF98 AF9B 327B B80F http://newartisans.com 60E1 46C4 BD1A 7AC1 4BA2 -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 629 bytes Desc: not available URL: From david.feuer at gmail.com Thu Feb 18 22:16:04 2016 From: david.feuer at gmail.com (David Feuer) Date: Thu, 18 Feb 2016 17:16:04 -0500 Subject: [Haskell-cafe] Closed classes In-Reply-To: <1455773696.2936942.524565346.02253155@webmail.messagingengine.com> References: <1455773696.2936942.524565346.02253155@webmail.messagingengine.com> Message-ID: It seems *highly* related, and, to my untrained eye, very carefully considered indeed. Unfortunately, based on the fact that its website has not updated since 2010, it appears that the entire HASP project has died a quiet death. One thing that's not clear to me is whether the instance chain approach (including explicit failure and backtracking) can interact well with associated types. My understanding is that backtracking in instance resolution cannot be allowed to infect unification, on pain of impossibly bad performance. Thus I imagine there would have to be some restrictions on the use of associated types in instance and/or class contexts; I don't know if it would be possible to make that work out cleanly and flexibly. On Thu, Feb 18, 2016 at 12:34 AM, Eric Seidel wrote: > The work on instance chains[1] seems related, but I'm not very familiar > with it, so it might just be superficial. > > [1]: http://web.cecs.pdx.edu/~mpj/pubs/instancechains.pdf > > On Wed, Feb 17, 2016, at 14:21, David Feuer wrote: > > I was thinking about ~two notions of "closed class" yesterday, and I'm > > curious if anyone's done any work on either concept. In each case, the > > class definition is followed by *all* of its instances, and the instances > > are checked *in order* (rather than based on specificity and > > OVERLAPS/OVERLAPPABLE pragmas). > > > > No backtracking: > > > > If the instance head matches, GHC commits to it. Associated types are > > treated as closed type families, and would work just the same (I don't > > think any significant extension to the closed type family mechanism would > > be required). This seems to make a very nice parallel to the usual open > > classes with open associated types. And it lets you combine overlapping > > instances with associated types without (I believe) risking type safety. > > > > Backtracking: > > > > GHC does not commit to the instance until it has satisfied the instance > > constraints. This lets instance writers offer multiple alternative > > instance > > constraints. Associated types would be a good bit trickier. One option > > would be to require all instances with the same head to share a type/data > > instance. The other (much more invasive) option would be to allow the > > instance chosen to guide the type selection, which would push the > > backtracking into the type checker. > > _______________________________________________ > > Haskell-Cafe mailing list > > Haskell-Cafe at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From rpglover64 at gmail.com Thu Feb 18 23:22:43 2016 From: rpglover64 at gmail.com (Alex Rozenshteyn) Date: Thu, 18 Feb 2016 23:22:43 +0000 Subject: [Haskell-cafe] Confusing behavior in Haskell networking libraries Message-ID: I was trying to write a web scraper, so I used scalpel . The website I wanted to scrape blocks my IP (I run a tor exit node), so I decided to use proxychains (specifically, version 3.1-6 according to Debian). I ran into the following weird behavior: if I tell proxychains to run dns through the proxy, things are fine, but if I tell it to run dns in the clear or the URL I'm trying to connect to is an IP address (e.g. manually resolved), I always get timeouts (much faster than I should). (don't resolve dns over the proxy) % proxychains stack exec -- test-scalpel "http://ifconfig.co" ProxyChains-3.1 (http://proxychains.sf.net) |R-chain|-<>-201.175.94.245:38746-<><>-188.113.88.193:80-<--timeout (resolve dns over the proxy) % proxychains stack exec -- test-scalpel "http://ifconfig.co" ProxyChains-3.1 (http://proxychains.sf.net) |DNS-request| ifconfig.co |R-chain|-<>-201.175.111.245:10000-<><>-4.2.2.2:53-<><>-OK |DNS-response| ifconfig.co is 188.113.88.193 |R-chain|-<>-201.175.111.245:10000-<><>-188.113.88.193:80-<><>-OK (resolve dns over proxy, but use an IP to avoid actually doing it) % proxychains stack exec -- test-scalpel "http://188.113.88.193" ProxyChains-3.1 (http://proxychains.sf.net) |R-chain|-<>-201.175.111.245:10000-<><>-188.113.88.193:80-<--timeout curl does not have this behavior: % proxychains stack exec -- curl "http://188.113.88.193" ProxyChains-3.1 (http://proxychains.sf.net) |R-chain|-<>-201.172.16.131:55599-<><>-188.113.88.193:80-<><>-OK % proxychains stack exec -- curl "http://ifconfig.co" ProxyChains-3.1 (http://proxychains.sf.net) |DNS-request| ifconfig.co |R-chain|-<>-201.172.17.231:10000-<><>-4.2.2.2:53-<><>-OK |DNS-response| ifconfig.co is 188.113.88.193 |R-chain|-<>-201.172.17.231:10000-<><>-188.113.88.193:80-<><>-OK % vim proxychains.conf # to change the setting % proxychains stack exec -- curl "http://ifconfig.co" ProxyChains-3.1 (http://proxychains.sf.net) |R-chain|-<>-201.172.16.131:55599-<><>-188.113.88.193:80-<><>-OK wget and aria2c also behave like curl. wreq behaves like scalpel: % proxychains stack exec -- test-wreq "http://188.113.88.193" ProxyChains-3.1 (http://proxychains.sf.net) |R-chain|-<>-201.172.17.231:10000-<><>-188.113.88.193:80-<--timeout HTTP (the Haskell package) behaves differently than all the rest, failing to connect even where the rest succeed: % proxychains stack exec -- test-http "http://ifconfig.co" ProxyChains-3.1 (http://proxychains.sf.net) |DNS-request| ifconfig.co |R-chain|-<>-201.175.94.245:38746-<><>-4.2.2.2:53-<><>-OK |DNS-response| ifconfig.co is 188.113.88.193 |R-chain|-<>-201.175.94.245:38746-<><>-188.113.88.193:80-<--timeout Gists of the programs I ran: https://gist.github.com/rpglover64/f668ed372c63e271cf15 Anyone have any idea what's going on? -------------- next part -------------- An HTML attachment was scrubbed... URL: From jeffbrown.the at gmail.com Fri Feb 19 02:50:26 2016 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Thu, 18 Feb 2016 18:50:26 -0800 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? Message-ID: I use FGL, which (roughly) defines type Gr a b as a graph on nodes of type a and edges of type b. Suppose you wanted a graph that described which people own which hamsters, knowing only their name. You would have to make node and edge types like this: data GraphNode = Person String | Hamster String data GraphEdge = Has where the strings represent their names. Suppose then you wanted to write a function that, given a person, returns the names of all their hamsters. To make sure the call makes sense, the function would have to first check that the input is in fact a person. Since persons and hamsters are both constructors of the same type, you can't let Haskell's robust, beautiful type-checking system distinguish them for you; you've got to write something like "case n of Person _ -> True; _ -> False". Is there some way around writing such manual checks? -- Jeffrey Benjamin Brown -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Fri Feb 19 04:36:59 2016 From: fa-ml at ariis.it (Francesco Ariis) Date: Fri, 19 Feb 2016 05:36:59 +0100 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: References: Message-ID: <20160219043659.GA1339@casa.casa> On Thu, Feb 18, 2016 at 06:50:26PM -0800, Jeffrey Brown wrote: > Suppose then you wanted to write a function that, given a person, returns > the names of all their hamsters. To make sure the call makes sense, the > function would have to first check that the input is in fact a person. > Since persons and hamsters are both constructors of the same type, you > can't let Haskell's robust, beautiful type-checking system distinguish them > for you; you've got to write something like "case n of Person _ -> True; _ > -> False". > > Is there some way around writing such manual checks? Hello Jeffrey, have you considered using Phantom types [1]? [1] https://wiki.haskell.org/Phantom_type#Simple_examples From jeffbrown.the at gmail.com Fri Feb 19 05:28:24 2016 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Thu, 18 Feb 2016 21:28:24 -0800 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: <20160219043659.GA1339@casa.casa> References: <20160219043659.GA1339@casa.casa> Message-ID: I had not! I'm not seeing how such a solution would work. The nodes in a graph all have to have the same type. If the phantom parameter distinguished two nodes, they could not be used together. But maybe you see something there that I don't? On Thu, Feb 18, 2016 at 8:36 PM, Francesco Ariis wrote: > On Thu, Feb 18, 2016 at 06:50:26PM -0800, Jeffrey Brown wrote: > > Suppose then you wanted to write a function that, given a person, returns > > the names of all their hamsters. To make sure the call makes sense, the > > function would have to first check that the input is in fact a person. > > Since persons and hamsters are both constructors of the same type, you > > can't let Haskell's robust, beautiful type-checking system distinguish > them > > for you; you've got to write something like "case n of Person _ -> True; > _ > > -> False". > > > > Is there some way around writing such manual checks? > > Hello Jeffrey, > have you considered using Phantom types [1]? > > [1] https://wiki.haskell.org/Phantom_type#Simple_examples > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -- Jeffrey Benjamin Brown -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Fri Feb 19 06:29:48 2016 From: fa-ml at ariis.it (Francesco Ariis) Date: Fri, 19 Feb 2016 07:29:48 +0100 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: References: <20160219043659.GA1339@casa.casa> Message-ID: <20160219062948.GA3493@casa.casa> On Thu, Feb 18, 2016 at 09:28:24PM -0800, Jeffrey Brown wrote: > I had not! > > I'm not seeing how such a solution would work. The nodes in a graph all > have to have the same type. If the phantom parameter distinguished two > nodes, they could not be used together. > > But maybe you see something there that I don't? Argh, indeed you are correct. Maybe it can be worked around with existential quantification like this? {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ExistentialQuantification #-} data Person = Person data Hamster = Hamster data GraphNode a = P String -- hide these | H String -- coll. of vertices data HumHamGraph = forall c . Test c => Gr [(c, c)] findCritters :: HumHamGraph -> GraphNode Person -> GraphNode Hamster findCritters = undefined class Test a where name :: a -> String instance Test (GraphNode Person) where name (P s) = s instance Test (GraphNode Hamster) where name (H s) = s toast = [(P "a,ga", H "beta"), (H "cas", P "cds")] For sure it looks ugly :s From b at chreekat.net Fri Feb 19 06:55:47 2016 From: b at chreekat.net (Bryan Richter) Date: Thu, 18 Feb 2016 22:55:47 -0800 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: References: Message-ID: <20160219065547.GG24947@fuzzbomb> On Thu, Feb 18, 2016 at 06:50:26PM -0800, Jeffrey Brown wrote: > I use FGL, which (roughly) defines type Gr a b as a graph on nodes of type > a and edges of type b. > > Suppose you wanted a graph that described which people own which hamsters, > knowing only their name. You would have to make node and edge types like > this: > data GraphNode = Person String | Hamster String > data GraphEdge = Has > where the strings represent their names. > > Suppose then you wanted to write a function that, given a person, returns > the names of all their hamsters. To make sure the call makes sense, the > function would have to first check that the input is in fact a person. > Since persons and hamsters are both constructors of the same type, Actually, I think the problem is that "String" is the same type as "String". Maybe this? data GraphNode = NodePerson Person | NodeHamster Hamster Then you can expose an API that just accepts a Person, and let the find-function take care of constructing the proper start value (i.e. a NodePerson). personHamsters :: MyGraph -> Person -> [Hamster] personHamsters g p = ... where startNode = NodePerson p Still, you'll have to do case evaluation at *some* point, right? If you have two types of nodes, and you're zooming around the graph, you'll have to stop and dereference each node to know what to do next. At least by hiding the details behind the API, your search function will be total. -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 801 bytes Desc: Digital signature URL: From johannes.waldmann at htwk-leipzig.de Fri Feb 19 11:07:14 2016 From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann) Date: Fri, 19 Feb 2016 12:07:14 +0100 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? Message-ID: <56C6F762.8010908@htwk-leipzig.de> > .. a graph that described which people own which hamsters, This is a bipartite graph, or, a relation. You want a type like data Rel src tgt a = Rel { fore :: ! ( M.Map src (M.Map tgt a) ) , back :: ! ( M.Map tgt (M.Map src a) ) } where src = People, tgt = Hamster, and a = Bool. In general, a could be some extra weight information. - J.W. cf. https://gitlab.imn.htwk-leipzig.de/waldmann/pure-matchbox/blob/master/src/Matchbox/Relation.hs From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Fri Feb 19 11:25:48 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Fri, 19 Feb 2016 11:25:48 +0000 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: <56C6F762.8010908@htwk-leipzig.de> References: <56C6F762.8010908@htwk-leipzig.de> Message-ID: <20160219112548.GB27912@weber> On Fri, Feb 19, 2016 at 12:07:14PM +0100, Johannes Waldmann wrote: > > .. a graph that described which people own which hamsters, > > This is a bipartite graph, or, a relation. You want a type like > > data Rel src tgt a = > Rel { fore :: ! ( M.Map src (M.Map tgt a) ) > , back :: ! ( M.Map tgt (M.Map src a) ) > } > > where src = People, tgt = Hamster, and a = Bool. I agree. FGL seems inappropriate to model people owning hamsters because you genuinely want to reflect the difference between people and hamsters by having two different node types. From volothamp at gmail.com Fri Feb 19 11:33:50 2016 From: volothamp at gmail.com (Luca Molteni) Date: Fri, 19 Feb 2016 11:33:50 +0000 Subject: [Haskell-cafe] Haskell ITA meetup in Florence, Italy (2016-03-26) Message-ID: Hello everyone I'd like to announce that on March 26 (2016-03-26) we're going to host the third meetup of the Haskell ITA user group (http://www.haskell-ita.it/) near Florence, Italy. This time we're going to focus more on the practical part rather than the talks, we're going to form some little group in order to create some small project or contribute to some open source library (Stack was proposed, but any suggestion is welcome). It's important if you decide to attend that you have the development environment already configured, you can use this guide (in italian) to do it: http://haskell-ita.it/2015/01/Installare_Haskell/ There will be people from all Italy, and we'll use the italian language during all the event. Here's the link for the registration: https://metooo.io/e/haskell-day-firenze Italian version will follow --- Iscrivetevi qui: https://metooo.io/e/haskell-day-firenze Questo ? il terzo evento del gruppo dei programmatori Haskell Italiani. A differenza dei due precedenti, vogliamo concentrarci un po' pi? sull'aspetto pratico, quindi ci saranno un sacco di occasioni di sperimentare la programmazione funzionale pura direttamente sul proprio portatile. La proposta ? di fare dei gruppetti di lavoro ristretti (2-6 persone, ideale 3-4) per lavorare su qualcosa di concreto, approfondire la conoscenza del linguaggio attraverso il confronto e divertirsi un po'. ? importante avere gi? l'ambiente preparato seguendo questa guida: http://haskell-ita.it/2015/01/Installare_Haskell/ Il numero e quali talk al mattino ? ancora da decidere e qualsiasi proposta ? benvenuta, maggiori informazioni sul nostro sito: http://haskell-ita.it/2016/02/organizzazione-meetup-marzo-2016/ L.M. -------------- next part -------------- An HTML attachment was scrubbed... URL: From _deepfire at feelingofgreen.ru Fri Feb 19 12:06:42 2016 From: _deepfire at feelingofgreen.ru (Kosyrev Serge) Date: Fri, 19 Feb 2016 15:06:42 +0300 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: (sfid-20160219_061650_956214_D8C33F85) (Jeffrey Brown's message of "Thu, 18 Feb 2016 18:50:26 -0800") References: Message-ID: <87oabc29bh.fsf@feelingofgreen.ru> Jeffrey Brown writes: > I use FGL, which (roughly) defines type Gr a b as a graph on nodes of > type a and edges of type b. > > Suppose you wanted a graph that described which people own which > hamsters, knowing only their name. You would have to make node and > edge types like this: > data GraphNode = Person String | Hamster String > data GraphEdge = Has > where the strings represent their names. > > Suppose then you wanted to write a function that, given a person, > returns the names of all their hamsters. To make sure the call makes > sense, the function would have to first check that the input is in > fact a person. Since persons and hamsters are both constructors of the > same type, you can't let Haskell's robust, beautiful type-checking > system distinguish them for you; you've got to write something like > "case n of Person _ -> True; _ -> False". I'll allow myself to rephrase what Tom Ellis already said more strongly. Type systems are tools for making invalid values unrepresentable. If you find yourself in a situation where a certain solution doesn't allow you to do that -- keep looking. -- ? ???????e? / respectfully, ??????? ?????? From _deepfire at feelingofgreen.ru Fri Feb 19 12:07:59 2016 From: _deepfire at feelingofgreen.ru (Kosyrev Serge) Date: Fri, 19 Feb 2016 15:07:59 +0300 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: <20160219112548.GB27912@weber> (sfid-20160219_145156_132579_5257A67D) (Tom Ellis's message of "Fri, 19 Feb 2016 11:25:48 +0000") References: <56C6F762.8010908@htwk-leipzig.de> <20160219112548.GB27912@weber> Message-ID: <87k2m0299c.fsf@feelingofgreen.ru> Tom Ellis writes: > I agree. FGL seems inappropriate to model people owning hamsters because > you genuinely want to reflect the difference between people and hamsters by > having two different node types. What would you propose instead? -- ? ???????e? / respectfully, ??????? ?????? From chneukirchen at gmail.com Fri Feb 19 12:10:02 2016 From: chneukirchen at gmail.com (Christian Neukirchen) Date: Fri, 19 Feb 2016 13:10:02 +0100 Subject: [Haskell-cafe] Munich Haskell Meeting, 2015-02-23 @ 19:30 Message-ID: <87bn7ckijp.fsf@gmail.com> Dear all, Next week, our monthly Munich Haskell Meeting will take place again on Tuesday, February 23 at Cafe Puck at 19h30. For details see here: http://chneukirchen.github.io/haskell-munich.de/dates 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-feb-2016/ Everybody is welcome! cu, -- Christian Neukirchen http://chneukirchen.org From Andrew.Butterfield at scss.tcd.ie Fri Feb 19 12:21:15 2016 From: Andrew.Butterfield at scss.tcd.ie (butrfeld) Date: Fri, 19 Feb 2016 12:21:15 +0000 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: <87oabc29bh.fsf@feelingofgreen.ru> References: <87oabc29bh.fsf@feelingofgreen.ru> Message-ID: <77474B6C-879A-43AE-A8EC-58333E905AB8@scss.tcd.ie> What you need is a Relation, not a Graph with nodes all of the same type! For me the problem below is most easily solved using Data.Map either use Map Person [Hamster] or Map Hamster [Person] to get the most general relations (many-many) If every Hamster has at most one owner, use Map Hamster Person > Jeffrey Brown writes: >> I use FGL, which (roughly) defines type Gr a b as a graph on nodes of >> type a and edges of type b. >> >> Suppose you wanted a graph that described which people own which >> hamsters, knowing only their name. You would have to make node and >> edge types like this: >> data GraphNode = Person String | Hamster String >> data GraphEdge = Has >> where the strings represent their names. >> >> Suppose then you wanted to write a function that, given a person, >> returns the names of all their hamsters. To make sure the call makes >> sense, the function would have to first check that the input is in >> fact a person. Since persons and hamsters are both constructors of the >> same type, you can't let Haskell's robust, beautiful type-checking >> system distinguish them for you; you've got to write something like >> "case n of Person _ -> True; _ -> False". > Andrew Butterfield School of Computer Science & Statistics Trinity College Dublin 2, Ireland From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Fri Feb 19 12:29:53 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Fri, 19 Feb 2016 12:29:53 +0000 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: <87k2m0299c.fsf@feelingofgreen.ru> References: <56C6F762.8010908@htwk-leipzig.de> <20160219112548.GB27912@weber> <87k2m0299c.fsf@feelingofgreen.ru> Message-ID: <20160219122952.GC27912@weber> On Fri, Feb 19, 2016 at 03:07:59PM +0300, Kosyrev Serge wrote: > Tom Ellis writes: > > I agree. FGL seems inappropriate to model people owning hamsters because > > you genuinely want to reflect the difference between people and hamsters by > > having two different node types. > > What would you propose instead? If I were utterly insane I would propose that FGL be extended with higher-typed indexes, so instead of Gr :: * -> * -> * we would have Gr :: (k -> *) -> (k -> k -> *) -> * Then Hamster and Person would be the only inhabitants of some kind k, and you can could choose two different types to represent them, and four different types to represent the (directed) edges between them. I would guess that most of the FGL implementation would carry over to this setting with no change to its structure. However, unless Jeffrey has a hard requirement to use something FGL-like, Johannes and Andrew's suggestions will probably be fine. Tom From skosyrev at ptsecurity.com Fri Feb 19 14:06:57 2016 From: skosyrev at ptsecurity.com (Kosyrev Serge) Date: Fri, 19 Feb 2016 17:06:57 +0300 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: <20160219122952.GC27912@weber> (sfid-20160219_155602_188727_F1BD0C25) (Tom Ellis's message of "Fri, 19 Feb 2016 12:29:53 +0000") References: <56C6F762.8010908@htwk-leipzig.de> <20160219112548.GB27912@weber> <87k2m0299c.fsf@feelingofgreen.ru> <20160219122952.GC27912@weber> Message-ID: <87k2m0dcam.fsf@ptsecurity.com> Adding Richard to CC. Tom Ellis writes: > On Fri, Feb 19, 2016 at 03:07:59PM +0300, Kosyrev Serge wrote: >> Tom Ellis writes: >> > I agree. FGL seems inappropriate to model people owning hamsters because >> > you genuinely want to reflect the difference between people and hamsters by >> > having two different node types. >> >> What would you propose instead? > > If I were utterly insane I would propose that FGL be extended with > higher-typed indexes, so instead of > > Gr :: * -> * -> * > > we would have > > Gr :: (k -> *) -> (k -> k -> *) -> * > > Then Hamster and Person would be the only inhabitants of some kind k, and > you can could choose two different types to represent them, and four > different types to represent the (directed) edges between them. Richard, is something like this possible with what is in GHC 8? Or would DataKinds already be sufficient for this? -- ? ???????e? / respectfully, ??????? ?????? From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Fri Feb 19 14:18:02 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Fri, 19 Feb 2016 14:18:02 +0000 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: <87k2m0dcam.fsf@ptsecurity.com> References: <56C6F762.8010908@htwk-leipzig.de> <20160219112548.GB27912@weber> <87k2m0299c.fsf@feelingofgreen.ru> <20160219122952.GC27912@weber> <87k2m0dcam.fsf@ptsecurity.com> Message-ID: <20160219141802.GD27912@weber> On Fri, Feb 19, 2016 at 05:06:57PM +0300, Kosyrev Serge wrote: > Tom Ellis writes: > > On Fri, Feb 19, 2016 at 03:07:59PM +0300, Kosyrev Serge wrote: > >> Tom Ellis writes: > >> > I agree. FGL seems inappropriate to model people owning hamsters because > >> > you genuinely want to reflect the difference between people and hamsters by > >> > having two different node types. > >> > >> What would you propose instead? > > > > If I were utterly insane I would propose that FGL be extended with > > higher-typed indexes, so instead of > > > > Gr :: * -> * -> * > > > > we would have > > > > Gr :: (k -> *) -> (k -> k -> *) -> * > > > > Then Hamster and Person would be the only inhabitants of some kind k, and > > you can could choose two different types to represent them, and four > > different types to represent the (directed) edges between them. > > Richard, is something like this possible with what is in GHC 8? > > Or would DataKinds already be sufficient for this? GADTs and DataKinds already suffice for this. Programming like this is possible but not especially syntactically convenient, and FGL would have to be changed throughout, of course. (Thanks to Andras Kovacs for introducing me to this lovely world of higher-kinded indexed types) Tom From jeffbrown.the at gmail.com Fri Feb 19 20:12:23 2016 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Fri, 19 Feb 2016 12:12:23 -0800 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: <20160219141802.GD27912@weber> References: <56C6F762.8010908@htwk-leipzig.de> <20160219112548.GB27912@weber> <87k2m0299c.fsf@feelingofgreen.ru> <20160219122952.GC27912@weber> <87k2m0dcam.fsf@ptsecurity.com> <20160219141802.GD27912@weber> Message-ID: Francesco, using existentials looks promising! I'll work on it. Perhaps people owning hamsters is more easily represented with maps, at least in an economy in which every hamster has exactly one owner. Here is a nearly identical example that surely requires a graph: data GraphNode = Person String | Hamster String data GraphEdge = Owns -- people own hamsters | Friend -- any two GraphNodes can be friends If you used maps for this kind of information, you would have a lot of copies of the same thing. If you changed someone's name, you would have to search through each map to find every instance of it. In a graph, by contrast, you would just change it in the one place that it is represented. Moreover, with maps there's the risk of indicating someone owns a hamster that does not exist. You have to keep some kind of master record of which hamsters are available, and check each map against it. In a graph, a hamster that does not exist is not represented, and so cannot be linked to. Bryan Richter wrote; > Maybe this? > > data GraphNode = NodePerson Person | NodeHamster Hamster That's what I was already doing! I feel validated. On Fri, Feb 19, 2016 at 6:18 AM, Tom Ellis < tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > On Fri, Feb 19, 2016 at 05:06:57PM +0300, Kosyrev Serge wrote: > > Tom Ellis writes: > > > On Fri, Feb 19, 2016 at 03:07:59PM +0300, Kosyrev Serge wrote: > > >> Tom Ellis writes: > > >> > I agree. FGL seems inappropriate to model people owning hamsters > because > > >> > you genuinely want to reflect the difference between people and > hamsters by > > >> > having two different node types. > > >> > > >> What would you propose instead? > > > > > > If I were utterly insane I would propose that FGL be extended with > > > higher-typed indexes, so instead of > > > > > > Gr :: * -> * -> * > > > > > > we would have > > > > > > Gr :: (k -> *) -> (k -> k -> *) -> * > > > > > > Then Hamster and Person would be the only inhabitants of some kind k, > and > > > you can could choose two different types to represent them, and four > > > different types to represent the (directed) edges between them. > > > > Richard, is something like this possible with what is in GHC 8? > > > > Or would DataKinds already be sufficient for this? > > GADTs and DataKinds already suffice for this. Programming like this is > possible but not especially syntactically convenient, and FGL would have to > be changed throughout, of course. > > (Thanks to Andras Kovacs for introducing me to this lovely world of > higher-kinded indexed types) > > Tom > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -- Jeffrey Benjamin Brown -------------- next part -------------- An HTML attachment was scrubbed... URL: From gesh at gesh.uni.cx Fri Feb 19 22:12:22 2016 From: gesh at gesh.uni.cx (Gesh) Date: Sat, 20 Feb 2016 00:12:22 +0200 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: <20160219205411.GA18544@casa.casa> References: <20160219043659.GA1339@casa.casa> <20160219205411.GA18544@casa.casa> Message-ID: <3BA1C77C-86D0-4CBC-B97B-53145C998FF0@gesh.uni.cx> On February 19, 2016 10:54:11 PM GMT+02:00, Francesco Ariis wrote: >hey Gesh, > >you are right (not able to compile it atm too, but it looks >correct and way elegant). >Maybe post it in the Ml to help OP? > >ciao ciao >F > > >On Fri, Feb 19, 2016 at 04:59:56PM +0200, Gesh wrote: >> I'm away from compiler at the moment, but... >> Shouldn't this work? >> > {-# LANGUAGE GADTs #-} >> > data NodeS = HamsterS | PersonS >> > data NodeP a where >> > Hamster :: String -> NodeP HamsterS >> > Person :: String -> NodeP PersonS >> > data Node = forall a. NodeP a >> > type Graph = Gr Node... >> > hamsters :: NodeP PersonS -> ... >> >> Basically the idea of that you reify the choice of constructor to the >type level, permitting static restriction of the constructors used. >> >> HTH, >> Gesh Oops, meant to send to list. From jeffbrown.the at gmail.com Sat Feb 20 09:46:25 2016 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Sat, 20 Feb 2016 01:46:25 -0800 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: <3BA1C77C-86D0-4CBC-B97B-53145C998FF0@gesh.uni.cx> References: <20160219043659.GA1339@casa.casa> <20160219205411.GA18544@casa.casa> <3BA1C77C-86D0-4CBC-B97B-53145C998FF0@gesh.uni.cx> Message-ID: After further study I believe existentials are not (at least alone) enough to solve the problem. They do allow a heterogeneous graph type to be defined and populated: :set -XExistentialQuantification import Data.Graph.Inductive import Data.Maybe as Maybe data ShowBox = forall s. Show s => SB s instance Show ShowBox where show (SB x) = "SB: " ++ show x type ExQuantGraph = Gr ShowBox String let g = insNode (0, SB 1) $ insNode (1, SB 'a') $ empty :: ExQuantGraph And once you've loaded those ShowBoxes, you can retrieve them: getSB :: ExQuantGraph -> Node -> ShowBox getSB g n = Maybe.fromJust $ lab g n But you can't unwrap them. The following: getInt :: ShowBox -> Int getInt (SB i) = i will not compile, because it cannot infer that i is an Int: todo/existentials.hs:19:21: Couldn't match expected type ?Int? with actual type ?s? ?s? is a rigid type variable bound by a pattern with constructor SB :: forall s. Show s => s -> ShowBox, in an equation for ?getInt? at todo/existentials.hs:19:13 Relevant bindings include i :: s (bound at todo/existentials.hs:19:16) In the expression: i In an equation for ?getInt?: getInt (SB i) = i Failed, modules loaded: none. On Fri, Feb 19, 2016 at 2:12 PM, Gesh wrote: > On February 19, 2016 10:54:11 PM GMT+02:00, Francesco Ariis < > fa-ml at ariis.it> wrote: > >hey Gesh, > > > >you are right (not able to compile it atm too, but it looks > >correct and way elegant). > >Maybe post it in the Ml to help OP? > > > >ciao ciao > >F > > > > > >On Fri, Feb 19, 2016 at 04:59:56PM +0200, Gesh wrote: > >> I'm away from compiler at the moment, but... > >> Shouldn't this work? > >> > {-# LANGUAGE GADTs #-} > >> > data NodeS = HamsterS | PersonS > >> > data NodeP a where > >> > Hamster :: String -> NodeP HamsterS > >> > Person :: String -> NodeP PersonS > >> > data Node = forall a. NodeP a > >> > type Graph = Gr Node... > >> > hamsters :: NodeP PersonS -> ... > >> > >> Basically the idea of that you reify the choice of constructor to the > >type level, permitting static restriction of the constructors used. > >> > >> HTH, > >> Gesh > > Oops, meant to send to list. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -- Jeffrey Benjamin Brown -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sat Feb 20 09:56:51 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sat, 20 Feb 2016 09:56:51 +0000 Subject: [Haskell-cafe] Compile times and separate compilation Message-ID: <20160220095651.GK27912@weber> Random thought about compile times: could separate compilation be made even more fine-grained by taking it to the level of individual top-level identifiers, rather than modules? This would probably help slow recompiles a lot. Tom From colinpauladams at gmail.com Sat Feb 20 10:04:05 2016 From: colinpauladams at gmail.com (Colin Adams) Date: Sat, 20 Feb 2016 10:04:05 +0000 Subject: [Haskell-cafe] Compile times and separate compilation In-Reply-To: <20160220095651.GK27912@weber> References: <20160220095651.GK27912@weber> Message-ID: s/slow/speed/ ? On 20 February 2016 at 09:56, Tom Ellis < tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > Random thought about compile times: could separate compilation be made even > more fine-grained by taking it to the level of individual top-level > identifiers, rather than modules? This would probably help slow recompiles > a lot. > > Tom > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sat Feb 20 10:12:54 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sat, 20 Feb 2016 10:12:54 +0000 Subject: [Haskell-cafe] Compile times and separate compilation In-Reply-To: References: <20160220095651.GK27912@weber> Message-ID: <20160220101254.GL27912@weber> "Help *with* slow compiles (by speeding them up)" or "Help *speed up* slow complies" On Sat, Feb 20, 2016 at 10:04:05AM +0000, Colin Adams wrote: > s/slow/speed/ ? > > On 20 February 2016 at 09:56, Tom Ellis < > tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: > > > Random thought about compile times: could separate compilation be made even > > more fine-grained by taking it to the level of individual top-level > > identifiers, rather than modules? This would probably help slow recompiles > > a lot. From _deepfire at feelingofgreen.ru Sat Feb 20 12:18:28 2016 From: _deepfire at feelingofgreen.ru (Kosyrev Serge) Date: Sat, 20 Feb 2016 15:18:28 +0300 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: (sfid-20160220_131331_641295_78772C49) (Jeffrey Brown's message of "Sat, 20 Feb 2016 01:46:25 -0800") References: <20160219043659.GA1339@casa.casa> <20160219205411.GA18544@casa.casa> <3BA1C77C-86D0-4CBC-B97B-53145C998FF0@gesh.uni.cx> Message-ID: <874md3bmnf.fsf@feelingofgreen.ru> Jeffrey Brown writes: > After further study I believe existentials are not (at least alone) > enough to solve the problem. .. > getInt :: ShowBox -> Int > getInt (SB i) = i > > will not compile, because it cannot infer that i is an Int: You take a value of an existentially quantified type (which means it can be anything at all, absent some extra context) and *proclaim* it is an integer. On what grounds should the compiler accept your optimistic restriction? -- ? ???????e? / respectfully, ??????? ?????? From manny at fpcomplete.com Sat Feb 20 13:51:20 2016 From: manny at fpcomplete.com (Emanuel Borsboom) Date: Sat, 20 Feb 2016 13:51:20 +0000 Subject: [Haskell-cafe] ANN: stack-1.0.4 Message-ID: See haskellstack.org for installation and upgrade instructions. Major changes: - Some notable changes in stack init: - Overall it should now be able to initialize almost all existing cabal packages out of the box as long as the package itself is consistently defined. - Choose the best possible snapshot and add extra dependencies on top of a snapshot resolver rather than a compiler resolver - #1583 - Automatically omit a package (--omit-packages) when it is compiler incompatible or when there are packages with conflicting dependency requirements - #1674 . - Some more changes for a better user experience. Please refer to the doc guide for details. - Add support for hpack, alternative package description format #1679 Other enhancements: - Docker: pass ~/.ssh and SSH auth socket into container, so that git repos work #1358 . - Docker: strip suffix from docker ?version. #1653 - Docker: pass USER and PWD environment bariables into container. - On each run, stack will test the stack root directory (~/.stack), and the project and package work directories (.stack-work) for whether they are owned by the current user and abort if they are not. This precaution can be disabled with the --allow-different-user flag or allow-different-user option in the global config (~/.stack/config.yaml). #471 - Added stack clean --full option for full working dir cleanup. - YAML config: support Zip archives. - Redownload build plan if parsing fails #1702 . - Give mustache templates access to a ?year? tag #1716 . - Have ?stack ghci? warn about module name aliasing. - Add ?stack ghci ?load-local-deps?. - Build Setup.hs with -rtsopts #1687 . - stack init accepts a list of directories. - Add flag infos to DependencyPlanFailures (for better error output in case of flags) #713 - stack new --bare complains for overwrites, and add --force option #1597 . Bug fixes: - Previously, stack ghci would fail with cannot satisfy -package-id when the implicit build step changes the package key of some dependency. - Fix: Building with ghcjs: ?ghc-pkg: Prelude.chr: bad argument: 2980338? #1665 . - Fix running test / bench with --profile / --trace. - Fix: build progress counter is no longer visible #1685 . - Use ?-RTS? w/ profiling to allow extra args #1772 . - Fix withUnpackedTarball7z to find name of srcDir after unpacking (fixes stack setup fails for ghcjs project on windows) #1774 . - Add space before auto-generated bench opts (makes profiling options work uniformly for applications and benchmark suites) #1771 . - Don?t try to find plugin if it resembles flag. - Setup.hs changes cause package dirtiness #1711 . - Send ?stack templates? output to stdout #1792 . ------------------------------ Thanks to all our contributors for this release: - Aaron Wolf @wolftune - Artem Chernyak @achernyak - Dan Aloni @da-x - Daniel Gasienica @gasi - Emanuel Borsboom @borsboom - Erik Stevenson @narrative - Gauthier Segay @smoothdeveloper - Greg Weber @gregwebs - Gr?goire D?trez @gdetrez - Harendra Kumar @harendra-kumar - Mark Karpov @mrkkrp - Martin Kolinek - Matt Gambogi @gambogi - Michael Sloan @mgsloan - Michael Snoyman @snoyberg - Oleg Grenrus @phadej - Eldar Yakupov @panamiga - Prayag Verma @pra85 - Simon Hengel @sol - Simon Jakobi @sjakobi - Tristan Webb @drwebb - Yves Par?s @YPares And thanks also to the 150+ contributors to past releases! ? -------------- next part -------------- An HTML attachment was scrubbed... URL: From amindfv at gmail.com Sat Feb 20 17:55:40 2016 From: amindfv at gmail.com (amindfv at gmail.com) Date: Sat, 20 Feb 2016 12:55:40 -0500 Subject: [Haskell-cafe] Compile times and separate compilation In-Reply-To: <20160220101254.GL27912@weber> References: <20160220095651.GK27912@weber> <20160220101254.GL27912@weber> Message-ID: <64242B7E-F528-48B1-9427-1BC7A8DE8E29@gmail.com> In my experience at least, the time spent compiling value-level things is dwarfed by type-level computation and template haskell (e.g. creating lenses), which I wouldn't expect this would help. (My experience is backed up by a recent study on compile times of Haskell 98 code from old ghc versions to new -- for H98, compile times have stayed stable). If someone wants to work on this, though, I definitely wouldn't want to discourage them! It would still be helpful. Tom > El 20 feb 2016, a las 05:12, Tom Ellis escribi?: > > "Help *with* slow compiles (by speeding them up)" or "Help *speed up* slow > complies" > >> On Sat, Feb 20, 2016 at 10:04:05AM +0000, Colin Adams wrote: >> s/slow/speed/ ? >> >> On 20 February 2016 at 09:56, Tom Ellis < >> tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk> wrote: >> >>> Random thought about compile times: could separate compilation be made even >>> more fine-grained by taking it to the level of individual top-level >>> identifiers, rather than modules? This would probably help slow recompiles >>> a lot. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From jeffbrown.the at gmail.com Sat Feb 20 19:18:50 2016 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Sat, 20 Feb 2016 11:18:50 -0800 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: <874md3bmnf.fsf@feelingofgreen.ru> References: <20160219043659.GA1339@casa.casa> <20160219205411.GA18544@casa.casa> <3BA1C77C-86D0-4CBC-B97B-53145C998FF0@gesh.uni.cx> <874md3bmnf.fsf@feelingofgreen.ru> Message-ID: Yes, that is my point. Existentials cannot be unwrapped. On Sat, Feb 20, 2016 at 4:18 AM, Kosyrev Serge <_deepfire at feelingofgreen.ru> wrote: > Jeffrey Brown writes: > > After further study I believe existentials are not (at least alone) > > enough to solve the problem. > .. > > getInt :: ShowBox -> Int > > getInt (SB i) = i > > > > will not compile, because it cannot infer that i is an Int: > > You take a value of an existentially quantified type (which means it > can be anything at all, absent some extra context) and *proclaim* it > is an integer. > > On what grounds should the compiler accept your optimistic restriction? > > -- > ? ???????e? / respectfully, > ??????? ?????? > -- Jeffrey Benjamin Brown -------------- next part -------------- An HTML attachment was scrubbed... URL: From edwards.benj at gmail.com Sat Feb 20 19:59:05 2016 From: edwards.benj at gmail.com (Benjamin Edwards) Date: Sat, 20 Feb 2016 19:59:05 +0000 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: References: <20160219043659.GA1339@casa.casa> <20160219205411.GA18544@casa.casa> <3BA1C77C-86D0-4CBC-B97B-53145C998FF0@gesh.uni.cx> <874md3bmnf.fsf@feelingofgreen.ru> Message-ID: if you are willing to have a closed universe, you can pattern match on a gadt to do do the unpacking On Sat, 20 Feb 2016 at 19:19 Jeffrey Brown wrote: > Yes, that is my point. Existentials cannot be unwrapped. > > On Sat, Feb 20, 2016 at 4:18 AM, Kosyrev Serge < > _deepfire at feelingofgreen.ru> wrote: > >> Jeffrey Brown writes: >> > After further study I believe existentials are not (at least alone) >> > enough to solve the problem. >> .. >> > getInt :: ShowBox -> Int >> > getInt (SB i) = i >> > >> > will not compile, because it cannot infer that i is an Int: >> >> You take a value of an existentially quantified type (which means it >> can be anything at all, absent some extra context) and *proclaim* it >> is an integer. >> >> On what grounds should the compiler accept your optimistic restriction? >> >> -- >> ? ???????e? / respectfully, >> ??????? ?????? >> > > > > -- > Jeffrey Benjamin Brown > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From jeffbrown.the at gmail.com Sat Feb 20 21:16:32 2016 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Sat, 20 Feb 2016 13:16:32 -0800 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: References: <20160219043659.GA1339@casa.casa> <20160219205411.GA18544@casa.casa> <3BA1C77C-86D0-4CBC-B97B-53145C998FF0@gesh.uni.cx> <874md3bmnf.fsf@feelingofgreen.ru> Message-ID: Interesting! I have two questions. (1) Given that Graph is of kind * -> * -> *, rather than (* -> *) -> * -> *, how can I use a GADT? The first graph using existentials defined earlier in this thread looked like: data Box = forall s. Show s => Box s type ExQuantGraph = Gr Box String If instead I use a GADT: data Box' a where Bi :: Int -> Box' Int Bs :: String -> Box' String then I can't define a graph on type G = Gr Box' String because Box is not a concrete type. I could specify (Box a) for some a, but then I lose the polymorphism that was the purpose of the GADT. (2) Would a GADT be better than what I'm already doing? Currently I define a Mindmap[1] as a graph where the nodes are a wrapper type called Expr ("expression"): type Mindmap = Gr Expr _ -- the edge type is irrelevant data Expr = Str String | Fl Float | Tplt [String] | Rel | Coll | RelSpecExpr RelVarSpec deriving(Show,Read,Eq,Ord) I do a lot of pattern matching on those constructors. If I used a GADT I would still be pattern matching on constructors. So do GADTs offer some advantage? [1] https://github.com/JeffreyBenjaminBrown/digraphs-with-text/blob/master/src/Dwt/Graph.hs On Sat, Feb 20, 2016 at 11:59 AM, Benjamin Edwards wrote: > if you are willing to have a closed universe, you can pattern match on a > gadt to do do the unpacking > > On Sat, 20 Feb 2016 at 19:19 Jeffrey Brown > wrote: > >> Yes, that is my point. Existentials cannot be unwrapped. >> >> On Sat, Feb 20, 2016 at 4:18 AM, Kosyrev Serge < >> _deepfire at feelingofgreen.ru> wrote: >> >>> Jeffrey Brown writes: >>> > After further study I believe existentials are not (at least alone) >>> > enough to solve the problem. >>> .. >>> > getInt :: ShowBox -> Int >>> > getInt (SB i) = i >>> > >>> > will not compile, because it cannot infer that i is an Int: >>> >>> You take a value of an existentially quantified type (which means it >>> can be anything at all, absent some extra context) and *proclaim* it >>> is an integer. >>> >>> On what grounds should the compiler accept your optimistic restriction? >>> >>> -- >>> ? ???????e? / respectfully, >>> ??????? ?????? >>> >> >> >> >> -- >> Jeffrey Benjamin Brown >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> > -- Jeffrey Benjamin Brown -------------- next part -------------- An HTML attachment was scrubbed... URL: From parsonsmatt at gmail.com Sat Feb 20 22:00:29 2016 From: parsonsmatt at gmail.com (Matt) Date: Sat, 20 Feb 2016 17:00:29 -0500 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: References: <20160219043659.GA1339@casa.casa> <20160219205411.GA18544@casa.casa> <3BA1C77C-86D0-4CBC-B97B-53145C998FF0@gesh.uni.cx> <874md3bmnf.fsf@feelingofgreen.ru> Message-ID: The pattern I've seen is: data Some f where Some :: f a -> Some f type G = Gr (Some Box') String Ordinarily you lose the information about the `a`, but when you have a GADT, that allows you to recover type information. So you can match on: f :: Some Box' -> String f (Some (Bi i)) = show (i + 1) f (Some (Bs s)) = s Matt Parsons On Sat, Feb 20, 2016 at 4:16 PM, Jeffrey Brown wrote: > Interesting! I have two questions. > > (1) Given that Graph is of kind * -> * -> *, rather than (* -> *) -> * -> > *, how can I use a GADT? The first graph using existentials defined earlier > in this thread looked like: > > data Box = forall s. Show s => Box s > type ExQuantGraph = Gr Box String > > If instead I use a GADT: > > data Box' a where > Bi :: Int -> Box' Int > Bs :: String -> Box' String > > then I can't define a graph on > > type G = Gr Box' String > > because Box is not a concrete type. I could specify (Box a) for some a, > but then I lose the polymorphism that was the purpose of the GADT. > > (2) Would a GADT be better than what I'm already doing? Currently I define > a Mindmap[1] as a graph where the nodes are a wrapper type called Expr > ("expression"): > > type Mindmap = Gr Expr _ -- the edge type is irrelevant > data Expr = Str String | Fl Float > | Tplt [String] | Rel | Coll > | RelSpecExpr RelVarSpec deriving(Show,Read,Eq,Ord) > > I do a lot of pattern matching on those constructors. If I used a GADT I > would still be pattern matching on constructors. So do GADTs offer some > advantage? > > [1] > https://github.com/JeffreyBenjaminBrown/digraphs-with-text/blob/master/src/Dwt/Graph.hs > > On Sat, Feb 20, 2016 at 11:59 AM, Benjamin Edwards > wrote: > >> if you are willing to have a closed universe, you can pattern match on a >> gadt to do do the unpacking >> >> On Sat, 20 Feb 2016 at 19:19 Jeffrey Brown >> wrote: >> >>> Yes, that is my point. Existentials cannot be unwrapped. >>> >>> On Sat, Feb 20, 2016 at 4:18 AM, Kosyrev Serge < >>> _deepfire at feelingofgreen.ru> wrote: >>> >>>> Jeffrey Brown writes: >>>> > After further study I believe existentials are not (at least alone) >>>> > enough to solve the problem. >>>> .. >>>> > getInt :: ShowBox -> Int >>>> > getInt (SB i) = i >>>> > >>>> > will not compile, because it cannot infer that i is an Int: >>>> >>>> You take a value of an existentially quantified type (which means it >>>> can be anything at all, absent some extra context) and *proclaim* it >>>> is an integer. >>>> >>>> On what grounds should the compiler accept your optimistic restriction? >>>> >>>> -- >>>> ? ???????e? / respectfully, >>>> ??????? ?????? >>>> >>> >>> >>> >>> -- >>> Jeffrey Benjamin Brown >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> Haskell-Cafe at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> >> > > > -- > Jeffrey Benjamin Brown > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From jeffbrown.the at gmail.com Sun Feb 21 02:27:06 2016 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Sat, 20 Feb 2016 18:27:06 -0800 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: References: <20160219043659.GA1339@casa.casa> <20160219205411.GA18544@casa.casa> <3BA1C77C-86D0-4CBC-B97B-53145C998FF0@gesh.uni.cx> <874md3bmnf.fsf@feelingofgreen.ru> Message-ID: Clever! That answers my first question, but still leaves me unmotivated. Would GADTs allow me to offload some kind of work onto the compiler that I currently have to do myself? On Sat, Feb 20, 2016 at 2:00 PM, Matt wrote: > The pattern I've seen is: > > data Some f where > Some :: f a -> Some f > > type G = Gr (Some Box') String > > Ordinarily you lose the information about the `a`, but when you have a > GADT, that allows you to recover type information. So you can match on: > > f :: Some Box' -> String > f (Some (Bi i)) = show (i + 1) > f (Some (Bs s)) = s > > Matt Parsons > > On Sat, Feb 20, 2016 at 4:16 PM, Jeffrey Brown > wrote: > >> Interesting! I have two questions. >> >> (1) Given that Graph is of kind * -> * -> *, rather than (* -> *) -> * -> >> *, how can I use a GADT? The first graph using existentials defined earlier >> in this thread looked like: >> >> data Box = forall s. Show s => Box s >> type ExQuantGraph = Gr Box String >> >> If instead I use a GADT: >> >> data Box' a where >> Bi :: Int -> Box' Int >> Bs :: String -> Box' String >> >> then I can't define a graph on >> >> type G = Gr Box' String >> >> because Box is not a concrete type. I could specify (Box a) for some a, >> but then I lose the polymorphism that was the purpose of the GADT. >> >> (2) Would a GADT be better than what I'm already doing? Currently I >> define a Mindmap[1] as a graph where the nodes are a wrapper type called >> Expr ("expression"): >> >> type Mindmap = Gr Expr _ -- the edge type is irrelevant >> data Expr = Str String | Fl Float >> | Tplt [String] | Rel | Coll >> | RelSpecExpr RelVarSpec deriving(Show,Read,Eq,Ord) >> >> I do a lot of pattern matching on those constructors. If I used a GADT I >> would still be pattern matching on constructors. So do GADTs offer some >> advantage? >> >> [1] >> https://github.com/JeffreyBenjaminBrown/digraphs-with-text/blob/master/src/Dwt/Graph.hs >> >> On Sat, Feb 20, 2016 at 11:59 AM, Benjamin Edwards < >> edwards.benj at gmail.com> wrote: >> >>> if you are willing to have a closed universe, you can pattern match on a >>> gadt to do do the unpacking >>> >>> On Sat, 20 Feb 2016 at 19:19 Jeffrey Brown >>> wrote: >>> >>>> Yes, that is my point. Existentials cannot be unwrapped. >>>> >>>> On Sat, Feb 20, 2016 at 4:18 AM, Kosyrev Serge < >>>> _deepfire at feelingofgreen.ru> wrote: >>>> >>>>> Jeffrey Brown writes: >>>>> > After further study I believe existentials are not (at least alone) >>>>> > enough to solve the problem. >>>>> .. >>>>> > getInt :: ShowBox -> Int >>>>> > getInt (SB i) = i >>>>> > >>>>> > will not compile, because it cannot infer that i is an Int: >>>>> >>>>> You take a value of an existentially quantified type (which means it >>>>> can be anything at all, absent some extra context) and *proclaim* it >>>>> is an integer. >>>>> >>>>> On what grounds should the compiler accept your optimistic restriction? >>>>> >>>>> -- >>>>> ? ???????e? / respectfully, >>>>> ??????? ?????? >>>>> >>>> >>>> >>>> >>>> -- >>>> Jeffrey Benjamin Brown >>>> _______________________________________________ >>>> Haskell-Cafe mailing list >>>> Haskell-Cafe at haskell.org >>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>>> >>> >> >> >> -- >> Jeffrey Benjamin Brown >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> > -- Jeffrey Benjamin Brown -------------- next part -------------- An HTML attachment was scrubbed... URL: From edwards.benj at gmail.com Sun Feb 21 11:30:09 2016 From: edwards.benj at gmail.com (Benjamin Edwards) Date: Sun, 21 Feb 2016 11:30:09 +0000 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: References: <20160219043659.GA1339@casa.casa> <20160219205411.GA18544@casa.casa> <3BA1C77C-86D0-4CBC-B97B-53145C998FF0@gesh.uni.cx> <874md3bmnf.fsf@feelingofgreen.ru> Message-ID: Sorry Jeffrey, I haven't been following the thread too closely, I just threw that out there as a way to recover an existential type through pattern matching. It's a cool feature of GADTs. I'm not sure it necessarily gets you too much in your specific problem. On Sun, 21 Feb 2016 at 02:27 Jeffrey Brown wrote: > Clever! That answers my first question, but still leaves me unmotivated. > Would GADTs allow me to offload some kind of work onto the compiler that I > currently have to do myself? > > On Sat, Feb 20, 2016 at 2:00 PM, Matt wrote: > >> The pattern I've seen is: >> >> data Some f where >> Some :: f a -> Some f >> >> type G = Gr (Some Box') String >> >> Ordinarily you lose the information about the `a`, but when you have a >> GADT, that allows you to recover type information. So you can match on: >> >> f :: Some Box' -> String >> f (Some (Bi i)) = show (i + 1) >> f (Some (Bs s)) = s >> >> Matt Parsons >> >> On Sat, Feb 20, 2016 at 4:16 PM, Jeffrey Brown >> wrote: >> >>> Interesting! I have two questions. >>> >>> (1) Given that Graph is of kind * -> * -> *, rather than (* -> *) -> * >>> -> *, how can I use a GADT? The first graph using existentials defined >>> earlier in this thread looked like: >>> >>> data Box = forall s. Show s => Box s >>> type ExQuantGraph = Gr Box String >>> >>> If instead I use a GADT: >>> >>> data Box' a where >>> Bi :: Int -> Box' Int >>> Bs :: String -> Box' String >>> >>> then I can't define a graph on >>> >>> type G = Gr Box' String >>> >>> because Box is not a concrete type. I could specify (Box a) for some a, >>> but then I lose the polymorphism that was the purpose of the GADT. >>> >>> (2) Would a GADT be better than what I'm already doing? Currently I >>> define a Mindmap[1] as a graph where the nodes are a wrapper type called >>> Expr ("expression"): >>> >>> type Mindmap = Gr Expr _ -- the edge type is irrelevant >>> data Expr = Str String | Fl Float >>> | Tplt [String] | Rel | Coll >>> | RelSpecExpr RelVarSpec deriving(Show,Read,Eq,Ord) >>> >>> I do a lot of pattern matching on those constructors. If I used a GADT I >>> would still be pattern matching on constructors. So do GADTs offer some >>> advantage? >>> >>> [1] >>> https://github.com/JeffreyBenjaminBrown/digraphs-with-text/blob/master/src/Dwt/Graph.hs >>> >>> On Sat, Feb 20, 2016 at 11:59 AM, Benjamin Edwards < >>> edwards.benj at gmail.com> wrote: >>> >>>> if you are willing to have a closed universe, you can pattern match on >>>> a gadt to do do the unpacking >>>> >>>> On Sat, 20 Feb 2016 at 19:19 Jeffrey Brown >>>> wrote: >>>> >>>>> Yes, that is my point. Existentials cannot be unwrapped. >>>>> >>>>> On Sat, Feb 20, 2016 at 4:18 AM, Kosyrev Serge < >>>>> _deepfire at feelingofgreen.ru> wrote: >>>>> >>>>>> Jeffrey Brown writes: >>>>>> > After further study I believe existentials are not (at least alone) >>>>>> > enough to solve the problem. >>>>>> .. >>>>>> > getInt :: ShowBox -> Int >>>>>> > getInt (SB i) = i >>>>>> > >>>>>> > will not compile, because it cannot infer that i is an Int: >>>>>> >>>>>> You take a value of an existentially quantified type (which means it >>>>>> can be anything at all, absent some extra context) and *proclaim* it >>>>>> is an integer. >>>>>> >>>>>> On what grounds should the compiler accept your optimistic >>>>>> restriction? >>>>>> >>>>>> -- >>>>>> ? ???????e? / respectfully, >>>>>> ??????? ?????? >>>>>> >>>>> >>>>> >>>>> >>>>> -- >>>>> Jeffrey Benjamin Brown >>>>> _______________________________________________ >>>>> Haskell-Cafe mailing list >>>>> Haskell-Cafe at haskell.org >>>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>>>> >>>> >>> >>> >>> -- >>> Jeffrey Benjamin Brown >>> >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> Haskell-Cafe at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> >>> >> > > > -- > Jeffrey Benjamin Brown > -------------- next part -------------- An HTML attachment was scrubbed... URL: From benno.fuenfstueck at gmail.com Sun Feb 21 11:53:41 2016 From: benno.fuenfstueck at gmail.com (=?UTF-8?B?QmVubm8gRsO8bmZzdMO8Y2s=?=) Date: Sun, 21 Feb 2016 11:53:41 +0000 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: References: <20160219043659.GA1339@casa.casa> <20160219205411.GA18544@casa.casa> <3BA1C77C-86D0-4CBC-B97B-53145C998FF0@gesh.uni.cx> <874md3bmnf.fsf@feelingofgreen.ru> Message-ID: Hi Jeffrey, what you want to do is not possible with the graph type that you say FGL provides. FGL simply requires that all node types have to be equal, so it can't preserve the information that your graph is biparite, no matter what language features you use to define the node type. Benno Benjamin Edwards schrieb am So., 21. Feb. 2016 um 12:30 Uhr: > Sorry Jeffrey, I haven't been following the thread too closely, I just > threw that out there as a way to recover an existential type through > pattern matching. It's a cool feature of GADTs. I'm not sure it necessarily > gets you too much in your specific problem. > > On Sun, 21 Feb 2016 at 02:27 Jeffrey Brown > wrote: > >> Clever! That answers my first question, but still leaves me unmotivated. >> Would GADTs allow me to offload some kind of work onto the compiler that I >> currently have to do myself? >> >> On Sat, Feb 20, 2016 at 2:00 PM, Matt wrote: >> >>> The pattern I've seen is: >>> >>> data Some f where >>> Some :: f a -> Some f >>> >>> type G = Gr (Some Box') String >>> >>> Ordinarily you lose the information about the `a`, but when you have a >>> GADT, that allows you to recover type information. So you can match on: >>> >>> f :: Some Box' -> String >>> f (Some (Bi i)) = show (i + 1) >>> f (Some (Bs s)) = s >>> >>> Matt Parsons >>> >>> On Sat, Feb 20, 2016 at 4:16 PM, Jeffrey Brown >>> wrote: >>> >>>> Interesting! I have two questions. >>>> >>>> (1) Given that Graph is of kind * -> * -> *, rather than (* -> *) -> * >>>> -> *, how can I use a GADT? The first graph using existentials defined >>>> earlier in this thread looked like: >>>> >>>> data Box = forall s. Show s => Box s >>>> type ExQuantGraph = Gr Box String >>>> >>>> If instead I use a GADT: >>>> >>>> data Box' a where >>>> Bi :: Int -> Box' Int >>>> Bs :: String -> Box' String >>>> >>>> then I can't define a graph on >>>> >>>> type G = Gr Box' String >>>> >>>> because Box is not a concrete type. I could specify (Box a) for some a, >>>> but then I lose the polymorphism that was the purpose of the GADT. >>>> >>>> (2) Would a GADT be better than what I'm already doing? Currently I >>>> define a Mindmap[1] as a graph where the nodes are a wrapper type called >>>> Expr ("expression"): >>>> >>>> type Mindmap = Gr Expr _ -- the edge type is irrelevant >>>> data Expr = Str String | Fl Float >>>> | Tplt [String] | Rel | Coll >>>> | RelSpecExpr RelVarSpec deriving(Show,Read,Eq,Ord) >>>> >>>> I do a lot of pattern matching on those constructors. If I used a GADT >>>> I would still be pattern matching on constructors. So do GADTs offer some >>>> advantage? >>>> >>>> [1] >>>> https://github.com/JeffreyBenjaminBrown/digraphs-with-text/blob/master/src/Dwt/Graph.hs >>>> >>>> On Sat, Feb 20, 2016 at 11:59 AM, Benjamin Edwards < >>>> edwards.benj at gmail.com> wrote: >>>> >>>>> if you are willing to have a closed universe, you can pattern match on >>>>> a gadt to do do the unpacking >>>>> >>>>> On Sat, 20 Feb 2016 at 19:19 Jeffrey Brown >>>>> wrote: >>>>> >>>>>> Yes, that is my point. Existentials cannot be unwrapped. >>>>>> >>>>>> On Sat, Feb 20, 2016 at 4:18 AM, Kosyrev Serge < >>>>>> _deepfire at feelingofgreen.ru> wrote: >>>>>> >>>>>>> Jeffrey Brown writes: >>>>>>> > After further study I believe existentials are not (at least alone) >>>>>>> > enough to solve the problem. >>>>>>> .. >>>>>>> > getInt :: ShowBox -> Int >>>>>>> > getInt (SB i) = i >>>>>>> > >>>>>>> > will not compile, because it cannot infer that i is an Int: >>>>>>> >>>>>>> You take a value of an existentially quantified type (which means it >>>>>>> can be anything at all, absent some extra context) and *proclaim* it >>>>>>> is an integer. >>>>>>> >>>>>>> On what grounds should the compiler accept your optimistic >>>>>>> restriction? >>>>>>> >>>>>>> -- >>>>>>> ? ???????e? / respectfully, >>>>>>> ??????? ?????? >>>>>>> >>>>>> >>>>>> >>>>>> >>>>>> -- >>>>>> Jeffrey Benjamin Brown >>>>>> _______________________________________________ >>>>>> Haskell-Cafe mailing list >>>>>> Haskell-Cafe at haskell.org >>>>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>>>>> >>>>> >>>> >>>> >>>> -- >>>> Jeffrey Benjamin Brown >>>> >>>> _______________________________________________ >>>> Haskell-Cafe mailing list >>>> Haskell-Cafe at haskell.org >>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>>> >>>> >>> >> >> >> -- >> Jeffrey Benjamin Brown >> > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From corentin.dupont at gmail.com Sun Feb 21 23:19:40 2016 From: corentin.dupont at gmail.com (Corentin Dupont) Date: Mon, 22 Feb 2016 00:19:40 +0100 Subject: [Haskell-cafe] Haskell ITA meetup in Florence, Italy (2016-03-26) In-Reply-To: References: Message-ID: Great! Glad to hear from that and thanks for organizing. I might be able to come... 2016-02-19 12:33 GMT+01:00 Luca Molteni : > Hello everyone > > I'd like to announce that on March 26 (2016-03-26) we're going to host the > third meetup of the Haskell ITA user group (http://www.haskell-ita.it/) > near Florence, Italy. > > This time we're going to focus more on the practical part rather than the > talks, we're going to form some little group in order to create some small > project or contribute to some open source library (Stack was proposed, but > any suggestion is welcome). > It's important if you decide to attend that you have the development > environment already configured, you can use this guide (in italian) to do > it: > > http://haskell-ita.it/2015/01/Installare_Haskell/ > > There will be people from all Italy, and we'll use the italian language > during all the event. > > Here's the link for the registration: > > https://metooo.io/e/haskell-day-firenze > > Italian version will follow > > --- > > Iscrivetevi qui: > https://metooo.io/e/haskell-day-firenze > > Questo ? il terzo evento del gruppo dei programmatori Haskell Italiani. A > differenza dei due precedenti, vogliamo concentrarci un po' pi? > sull'aspetto pratico, quindi ci saranno un sacco di occasioni di > sperimentare la programmazione funzionale pura direttamente sul proprio > portatile. La proposta ? di fare dei gruppetti di lavoro ristretti (2-6 > persone, ideale 3-4) per lavorare su qualcosa di concreto, approfondire la > conoscenza del linguaggio attraverso il confronto e divertirsi un po'. ? > importante avere gi? l'ambiente preparato seguendo questa guida: > > http://haskell-ita.it/2015/01/Installare_Haskell/ > > Il numero e quali talk al mattino ? ancora da decidere e qualsiasi > proposta ? benvenuta, maggiori informazioni sul nostro sito: > > http://haskell-ita.it/2016/02/organizzazione-meetup-marzo-2016/ > > L.M. > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From sajeebfive5 at gmail.com Mon Feb 22 05:07:43 2016 From: sajeebfive5 at gmail.com (sajeeb Bhm) Date: Mon, 22 Feb 2016 11:07:43 +0600 Subject: [Haskell-cafe] funny comics about Monad Message-ID: check this one! -------------- next part -------------- A non-text attachment was scrubbed... Name: akar32.jpg Type: image/jpeg Size: 98676 bytes Desc: not available URL: From jo at durchholz.org Mon Feb 22 06:02:48 2016 From: jo at durchholz.org (Joachim Durchholz) Date: Mon, 22 Feb 2016 07:02:48 +0100 Subject: [Haskell-cafe] funny comics about Monad In-Reply-To: References: Message-ID: <56CAA488.7080005@durchholz.org> Am 22.02.2016 um 06:07 schrieb sajeeb Bhm: > check this one! Heh. Nice one. Though. Well. My answer would be: "Associativity for X1 op X2 op ... op Xn where the Xi need not have the same type, for suitably defined op". There. Easy. The task was to "explain", not "apply to a formal system" which would have required formalism. From volothamp at gmail.com Mon Feb 22 10:05:33 2016 From: volothamp at gmail.com (Luca Molteni) Date: Mon, 22 Feb 2016 10:05:33 +0000 Subject: [Haskell-cafe] Haskell ITA meetup in Florence, Italy (2016-03-26) In-Reply-To: References: Message-ID: On Mon, Feb 22, 2016 at 12:19 AM Corentin Dupont wrote: > Great! Glad to hear from that and thanks for organizing. > I might be able to come... > That's great thanks. Pardon the spamming, but you may be interested in the italian mailing list too (https://groups.google.com/forum/#!forum/haskell_ita) Cheers L.M. -------------- next part -------------- An HTML attachment was scrubbed... URL: From dek5 at yandex.ru Mon Feb 22 11:40:39 2016 From: dek5 at yandex.ru (dek5 at yandex.ru) Date: Mon, 22 Feb 2016 12:40:39 +0100 Subject: [Haskell-cafe] Fw: new important message Message-ID: <0000801f8880$06161288$c5d7fe62$@yandex.ru> Hello! New message, please read dek5 at yandex.ru -------------- next part -------------- An HTML attachment was scrubbed... URL: From wojtek at power.com.pl Mon Feb 22 14:33:23 2016 From: wojtek at power.com.pl (=?UTF-8?Q?Wojtek_Narczy=c5=84ski?=) Date: Mon, 22 Feb 2016 15:33:23 +0100 Subject: [Haskell-cafe] Compile times and separate compilation In-Reply-To: <20160220095651.GK27912@weber> References: <20160220095651.GK27912@weber> Message-ID: <56CB1C33.7080606@power.com.pl> On 20.02.2016 10:56, Tom Ellis wrote: > Random thought about compile times: could separate compilation be made even > more fine-grained by taking it to the level of individual top-level > identifiers, rather than modules? This would probably help slow recompiles > a lot. > > Well, what about inlining? I presume you are using the -j switch. Try NVMe, if you haven't already. -- Wojtek From johannes.waldmann at htwk-leipzig.de Mon Feb 22 21:27:08 2016 From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann) Date: Mon, 22 Feb 2016 22:27:08 +0100 Subject: [Haskell-cafe] Compile times and separate compilation Message-ID: <56CB7D2C.7010409@htwk-leipzig.de> > I presume you are using the -j switch. Does it really help? I recently found that for travis builds, it is used by default (first surprise) but it's faster when it's turned off (second surprise). https://ghc.haskell.org/trac/ghc/ticket/10818#comment:15 - J. From capn.freako at gmail.com Tue Feb 23 03:32:00 2016 From: capn.freako at gmail.com (David Banas) Date: Mon, 22 Feb 2016 19:32:00 -0800 Subject: [Haskell-cafe] Typeclassopedia exercises - my own answers published. Message-ID: <97A53555-8A51-4ADA-9736-58E9D19FEE08@gmail.com> Hi all, I?ve published my own answers to some of the exercises in Brent Yorgey?s Typeclassopedia: Github hosted HTML preview: http://htmlpreview.github.io/?https://github.com/capn-freako/Haskell_Misc/blob/v0.5/Typeclassopedia/Typeclassopedia.html Github source repository: https://github.com/capn-freako/Haskell_Misc/tree/v0.5/Typeclassopedia Thanks to Conal Elliott and Phil Ruffwind for their help. -db From diaz.carrete at gmail.com Tue Feb 23 08:29:37 2016 From: diaz.carrete at gmail.com (=?UTF-8?Q?Daniel_D=C3=ADaz?=) Date: Tue, 23 Feb 2016 00:29:37 -0800 (PST) Subject: [Haskell-cafe] Playing with OverloadedLabels in GHC 8 RC2, how to do this? Message-ID: <79ca24dd-c2ea-4759-be0d-cdf844e972b7@googlegroups.com> Hi all, I'm playing with the OverloadedLabels extension in GHC 8 RC2. I have been able to define simple record accessors, like in this gist: https://gist.github.com/danidiaz/3b9a6865686c777f328c After realizing than with OverloadedLabels a single symbol can be used to extract two different types from the same record, I tried to define an instance that says: "if a symbol can be used to extract an string from my record, then it can also be used to extract that a Text value". Here's my attempt (using a dummy Text type): {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MagicHash #-} module Main where import GHC.OverloadedLabels import GHC.Prim newtype Text = Text { getText :: String } deriving Show data Person = Person { _id :: Int , _name :: String } instance IsLabel "name" (Person -> String) where fromLabel _ = _name instance IsLabel symbol (Person -> String) => IsLabel symbol (Person -> Text) where fromLabel _ = Text . fromLabel (proxy# :: (Proxy# (Person -> String))) person :: Person person = Person 123 "Horace" main :: IO () main = do print (#name person :: String) print (#name person :: Text) Bu this doesn't work. The error I get is puzzling: ? Expected kind ?Proxy# ((->) Person String)?, but ?proxy# :: Proxy# (Person -> String)? has kind ?Proxy# (Person -> String)? ? In the first argument of ?fromLabel?, namely ?(proxy# :: Proxy# (Person -> String))? Is this a bug? What is going on here? -------------- next part -------------- An HTML attachment was scrubbed... URL: From adam at well-typed.com Tue Feb 23 09:16:14 2016 From: adam at well-typed.com (Adam Gundry) Date: Tue, 23 Feb 2016 09:16:14 +0000 Subject: [Haskell-cafe] Playing with OverloadedLabels in GHC 8 RC2, how to do this? In-Reply-To: <79ca24dd-c2ea-4759-be0d-cdf844e972b7@googlegroups.com> References: <79ca24dd-c2ea-4759-be0d-cdf844e972b7@googlegroups.com> Message-ID: <56CC235E.8010000@well-typed.com> Hi, The type of `fromLabel` is forall (x :: Symbol) a . IsLabel x a => Proxy# x -> a where `x` represents the text of the label, so rather than applying it to (proxy# :: (Proxy# (Person -> String))) you need to apply it to (proxy# :: Proxy# symbol) and you will need to turn on the ScopedTypeVariables extension (so that `symbol` refers to the variable bound in the class instance). With that change, your program works. That's a truly atrocious error message though. It's marginally better if you enable -fprint-explicit-kinds: ? Expected kind ?Proxy# GHC.Types.Symbol ((->) Person String)?, but ?proxy# :: Proxy# (Person -> String)? has kind ?Proxy# * (Person -> String)? This shows the real problem, namely that you have `Proxy# *` instead of `Proxy# Symbol`. However, `Proxy# Symbol ((->) Person String)` is blatantly ill-kinded, so the error message doesn't make much sense. I suggest you file a GHC ticket, if there isn't a suitable one already. Hope this helps, Adam On 23/02/16 08:29, Daniel D?az wrote: > Hi all, > > I'm playing with the OverloadedLabels extension in GHC 8 RC2. I have > been able to define simple record accessors, like in this > gist: https://gist.github.com/danidiaz/3b9a6865686c777f328c > > After realizing than with OverloadedLabels a single symbol can be used > to extract two different types from the same record, I tried to define > an instance that says: "if a symbol can be used to extract an string > from my record, then it can also be used to extract that a Text value". > > Here's my attempt (using a dummy Text type): > > {-# LANGUAGE OverloadedLabels #-} > {-# LANGUAGE DataKinds #-} > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE FlexibleContexts #-} > {-# LANGUAGE UndecidableInstances #-} > {-# LANGUAGE MultiParamTypeClasses #-} > {-# LANGUAGE MagicHash #-} > module Main where > > import GHC.OverloadedLabels > import GHC.Prim > > newtype Text = Text { getText :: String } deriving Show > > data Person = Person { _id :: Int , _name :: String } > > instance IsLabel "name" (Person -> String) where > fromLabel _ = _name > > instance IsLabel symbol (Person -> String) => IsLabel symbol (Person > -> Text) where > fromLabel _ = Text . fromLabel (proxy# :: (Proxy# (Person -> > String))) > > person :: Person > person = Person 123 "Horace" > > main :: IO () > main = do > print (#name person :: String) > print (#name person :: Text) > > > Bu this doesn't work. The error I get is puzzling: > > ? Expected kind ?Proxy# ((->) Person String)?, > but ?proxy# :: Proxy# (Person -> String)? has kind ?Proxy# > (Person -> String)? > ? In the first argument of ?fromLabel?, namely > ?(proxy# :: Proxy# (Person -> String))? > > > Is this a bug? What is going on here? -- Adam Gundry, Haskell Consultant Well-Typed LLP, http://www.well-typed.com/ From diaz.carrete at gmail.com Tue Feb 23 22:07:17 2016 From: diaz.carrete at gmail.com (=?UTF-8?Q?Daniel_D=C3=ADaz?=) Date: Tue, 23 Feb 2016 14:07:17 -0800 (PST) Subject: [Haskell-cafe] Playing with OverloadedLabels in GHC 8 RC2, how to do this? In-Reply-To: <56CC235E.8010000@well-typed.com> References: <79ca24dd-c2ea-4759-be0d-cdf844e972b7@googlegroups.com> <56CC235E.8010000@well-typed.com> Message-ID: <3500ba48-6b27-4752-b993-c3e6647071f2@googlegroups.com> It works, thanks! I was wondering: if I define a bunch of records in a module, how to make this the behaviour for all records in the module, without much boilerplate and without affecting any records elsewhere? One possible solution would be to define a empty type class that will not be exported: class Marker r and the following instance: instance (Marker r,IsLabel symbol (r -> String)) => IsLabel symbol (r -> Text) where fromLabel _ = Text . fromLabel (proxy# :: (Proxy# symbol)) And make every record in the module an instance of Marker: instance Marker Person I'm not sure if there's a simpler way. Even if we don't export the fields directly, another way to employ OverloadedLabels (OverloadedRecordFields, once it arrives) is for giving default implementations of public interfaces, in combination with DefaultSignatures. A not very useful example: class Named r where name :: r -> String default name :: IsLabel "name" (r -> String) => r -> String name = #name instance Named Person On Tuesday, February 23, 2016 at 10:16:21 AM UTC+1, Adam Gundry wrote: > > Hi, > > The type of `fromLabel` is > > forall (x :: Symbol) a . IsLabel x a => Proxy# x -> a > > where `x` represents the text of the label, so rather than applying it to > > (proxy# :: (Proxy# (Person -> String))) > > you need to apply it to > > (proxy# :: Proxy# symbol) > > and you will need to turn on the ScopedTypeVariables extension (so that > `symbol` refers to the variable bound in the class instance). With that > change, your program works. > > That's a truly atrocious error message though. It's marginally better if > you enable -fprint-explicit-kinds: > > ? Expected kind ?Proxy# GHC.Types.Symbol ((->) Person String)?, > but ?proxy# :: Proxy# (Person -> String)? has kind > ?Proxy# * (Person -> String)? > > This shows the real problem, namely that you have `Proxy# *` instead of > `Proxy# Symbol`. However, `Proxy# Symbol ((->) Person String)` is > blatantly ill-kinded, so the error message doesn't make much sense. I > suggest you file a GHC ticket, if there isn't a suitable one already. > > Hope this helps, > > Adam > > > On 23/02/16 08:29, Daniel D?az wrote: > > Hi all, > > > > I'm playing with the OverloadedLabels extension in GHC 8 RC2. I have > > been able to define simple record accessors, like in this > > gist: https://gist.github.com/danidiaz/3b9a6865686c777f328c > > > > After realizing than with OverloadedLabels a single symbol can be used > > to extract two different types from the same record, I tried to define > > an instance that says: "if a symbol can be used to extract an string > > from my record, then it can also be used to extract that a Text value". > > > > Here's my attempt (using a dummy Text type): > > > > {-# LANGUAGE OverloadedLabels #-} > > {-# LANGUAGE DataKinds #-} > > {-# LANGUAGE FlexibleInstances #-} > > {-# LANGUAGE FlexibleContexts #-} > > {-# LANGUAGE UndecidableInstances #-} > > {-# LANGUAGE MultiParamTypeClasses #-} > > {-# LANGUAGE MagicHash #-} > > module Main where > > > > import GHC.OverloadedLabels > > import GHC.Prim > > > > newtype Text = Text { getText :: String } deriving Show > > > > data Person = Person { _id :: Int , _name :: String } > > > > instance IsLabel "name" (Person -> String) where > > fromLabel _ = _name > > > > instance IsLabel symbol (Person -> String) => IsLabel symbol (Person > > -> Text) where > > fromLabel _ = Text . fromLabel (proxy# :: (Proxy# (Person -> > > String))) > > > > person :: Person > > person = Person 123 "Horace" > > > > main :: IO () > > main = do > > print (#name person :: String) > > print (#name person :: Text) > > > > > > Bu this doesn't work. The error I get is puzzling: > > > > ? Expected kind ?Proxy# ((->) Person String)?, > > but ?proxy# :: Proxy# (Person -> String)? has kind ?Proxy# > > (Person -> String)? > > ? In the first argument of ?fromLabel?, namely > > ?(proxy# :: Proxy# (Person -> String))? > > > > > > Is this a bug? What is going on here? > > > -- > Adam Gundry, Haskell Consultant > Well-Typed LLP, http://www.well-typed.com/ > _______________________________________________ > Haskell-Cafe mailing list > Haskel... at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From dave.laing.80 at gmail.com Wed Feb 24 11:06:55 2016 From: dave.laing.80 at gmail.com (David Laing) Date: Wed, 24 Feb 2016 21:06:55 +1000 Subject: [Haskell-cafe] Free and cofree Message-ID: Hi all, A little while back I gave a talk at YOW Lambda Jam and wrote some posts on combing free monads and cofree comonads (inspired by some posts by Ed Kmett and Dan Piponi). I shared them on reddit, but recently realised that there might be some folks on this list who might be interested in the material. For those interested people, it's all here: http://dlaing.org/cofun/ The "coming soon" posts will turn up eventually, although not until I'm done preparing my proposal for this year's Lambda Jam :) Cheers, Dave -------------- next part -------------- An HTML attachment was scrubbed... URL: From k-bx at k-bx.com Wed Feb 24 15:47:00 2016 From: k-bx at k-bx.com (Kostiantyn Rybnikov) Date: Wed, 24 Feb 2016 17:47:00 +0200 Subject: [Haskell-cafe] Hedis 0.7.0 release warning Message-ID: Hi! I've released hedis 0.7.0 with one change which might affect some of you, so I thought it makes sense to notify cafe. To fix the issue #23 [0] we decided that it's ok to sacrifice pipelining between runRedis calls, so from now on, there won't be pipelining in that scenario. I want to thank Kirill Zaborsky for the fix in pr #45 [1] Best regards, Kostia [0]: https://github.com/informatikr/hedis/issues/23 [1]: https://github.com/informatikr/hedis/pull/45 -------------- next part -------------- An HTML attachment was scrubbed... URL: From victorsmiller at gmail.com Wed Feb 24 16:23:23 2016 From: victorsmiller at gmail.com (Victor Miller) Date: Wed, 24 Feb 2016 11:23:23 -0500 Subject: [Haskell-cafe] Local mirrors of hackage Message-ID: I have a computer that I work on which isn't directly connected to the internet, that I want to use Haskell on. In order to do that I want a local version of hackage. I was previously able to do this using mirror_hackage.py, but since hackage 2 came around this no longer works. Doing this would involve running something on a computer that *is* attached to the internet, and then transferring a bunch of files over to the other computer. Can someone point me to a recipe for doing this? Victor From matthewtpickering at gmail.com Wed Feb 24 16:27:44 2016 From: matthewtpickering at gmail.com (Matthew Pickering) Date: Wed, 24 Feb 2016 16:27:44 +0000 Subject: [Haskell-cafe] Local mirrors of hackage In-Reply-To: References: Message-ID: Hello Victor, It is easily possible with a small shell script. Here is another discussion about the same topic - https://mail.haskell.org/pipermail/ghc-devs/2015-September/009958.html Matt On Wed, Feb 24, 2016 at 4:23 PM, Victor Miller wrote: > I have a computer that I work on which isn't directly connected to the > internet, that I want to use Haskell on. In order to do that I want a > local version of hackage. I was previously able to do this using > mirror_hackage.py, but since hackage 2 came around this no longer > works. Doing this would involve running something on a computer that > *is* attached to the internet, and then transferring a bunch of files > over to the other computer. Can someone point me to a recipe for > doing this? > > Victor > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From roma at ro-che.info Wed Feb 24 16:36:57 2016 From: roma at ro-che.info (Roman Cheplyaka) Date: Wed, 24 Feb 2016 18:36:57 +0200 Subject: [Haskell-cafe] Local mirrors of hackage In-Reply-To: References: Message-ID: <56CDDC29.9050809@ro-che.info> On 02/24/2016 06:23 PM, Victor Miller wrote: > I have a computer that I work on which isn't directly connected to the > internet, that I want to use Haskell on. In order to do that I want a > local version of hackage. I was previously able to do this using > mirror_hackage.py, but since hackage 2 came around this no longer > works. Doing this would involve running something on a computer that > *is* attached to the internet, and then transferring a bunch of files > over to the other computer. Can someone point me to a recipe for > doing this? I don't know how exactly you want to use Haskell on your computer, but if you know in advance which packages you'll need, you can download only those packages (and their versions) and place them into cabal or stack cache directory. That will be much more efficient than mirroring whole of hackage. Roman From victorsmiller at gmail.com Wed Feb 24 16:55:22 2016 From: victorsmiller at gmail.com (Victor Miller) Date: Wed, 24 Feb 2016 11:55:22 -0500 Subject: [Haskell-cafe] installing the Haskell Platform on Redhat without admin access Message-ID: I'd like to install the latest version of the Haskell Platform for my own use on a redhat system. I don't have admin access so I can't run "sudo yum" as outlined on the haskell.org download page. How can I do this? Victor From cma at bitemyapp.com Wed Feb 24 16:56:22 2016 From: cma at bitemyapp.com (Chris Allen) Date: Wed, 24 Feb 2016 10:56:22 -0600 Subject: [Haskell-cafe] installing the Haskell Platform on Redhat without admin access In-Reply-To: References: Message-ID: <56CDE0B6.2070904@bitemyapp.com> You could use Stack, which I don't believe requires root. http://haskellstack.org On 02/24/2016 10:55 AM, Victor Miller wrote: > I'd like to install the latest version of the Haskell Platform for my > own use on a redhat system. I don't have admin access so I can't run > "sudo yum" as outlined on the haskell.org download page. How can I do > this? > > Victor > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From johnw at newartisans.com Wed Feb 24 18:16:10 2016 From: johnw at newartisans.com (John Wiegley) Date: Wed, 24 Feb 2016 10:16:10 -0800 Subject: [Haskell-cafe] Local mirrors of hackage In-Reply-To: (Victor Miller's message of "Wed, 24 Feb 2016 11:23:23 -0500") References: Message-ID: >>>>> Victor Miller writes: > I have a computer that I work on which isn't directly connected to the > internet, that I want to use Haskell on. In order to do that I want a local > version of hackage. I was previously able to do this using > mirror_hackage.py, but since hackage 2 came around this no longer works. > Doing this would involve running something on a computer that *is* attached > to the internet, and then transferring a bunch of files over to the other > computer. Can someone point me to a recipe for doing this? I wrote https://github.com/jwiegley/hackage-mirror to do just this, with relatively high performance for incremental updates. Also, if you're ever a Nix user, you can modify the core Haskell builder to reference whatever directory you mirror to first, before reaching out to the Internet for tarballs. I've been using this effectively for several years now. -- John Wiegley GPG fingerprint = 4710 CF98 AF9B 327B B80F http://newartisans.com 60E1 46C4 BD1A 7AC1 4BA2 From bhurt at spnz.org Wed Feb 24 19:11:14 2016 From: bhurt at spnz.org (Brian Hurt) Date: Wed, 24 Feb 2016 14:11:14 -0500 Subject: [Haskell-cafe] Problems with attoparsec (or maybe URI.ByteString) Message-ID: What I'm trying to do is write a function with the signature: data Urls = Txt Text.Text | Url Text.Text URI.URI deriving (Show) parseUrls :: Text.Text -> Either String [ Urls ] parseUrls text = ... Given a text block, it finds all the URLs, and breaks things into either URLs, or blocks of text which are not URLs. The full text is attached, for those who are interested. But the problem I'm hitting is using the Attoparsec parser URI.ByteString exports. When I do: *Base.DetectURL AP> AP.parseOnly (URI.uriParser URI.laxURIParserOptions) " http://foo/bar" Right (...) So, that works. But when I add a single space on the end of the string: *Base.DetectURL AP> AP.parseOnly (URI.uriParser URI.laxURIParserOptions) " http://foo/bar " Left "Failed reading: MalformedPath" It fails. Note that this isn't a problem with parseOnly- the real code looks like: parseAllUris :: AP.Parser (Bldr.Builder, [ Urls ]) parseAllUris = msum [ aUri, noUri, finished ] where finished = return (mempty, []) aUri = do (txt, url) <- AP.match $ URI.uriParser URI.laxURIParserOptions (bldr, us) <- msum [ noUri, finished ] return $ (mempty, (Url (E.decodeUtf8 txt) url : prependText bldr us)) noUri = do c <- AP.anyChar (bldr, us) <- parseAllUris return $ ((Bldr.charUtf8 c) `mappend` bldr, us) And this has the problem as well- parsing a URL with anything following it fails, and it doesn't detect any URLs. The parseOnly is just the easy way to demonstrate it. So, my question is, is there some way in attoparsec to tell it to just parse as much as makes sense, and leave the rest? Alternatively, is this a problem with the way URI.ByteString module constructed it's parser, and a different parser could work? Or, worst of all, is this a problem with the way that URIs are defined and no conforming parser will work? Thanks. Brian -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: DetectURL.hs Type: text/x-haskell Size: 1901 bytes Desc: not available URL: From cma at bitemyapp.com Wed Feb 24 19:17:12 2016 From: cma at bitemyapp.com (Chris Allen) Date: Wed, 24 Feb 2016 13:17:12 -0600 Subject: [Haskell-cafe] Problems with attoparsec (or maybe URI.ByteString) In-Reply-To: References: Message-ID: <56CE01B8.7070507@bitemyapp.com> It's an issue with uri-bytestring, it's being overly strict/annoying. Cf. https://github.com/Soostone/uri-bytestring/blob/master/src/URI/ByteString/Internal.hs#L207-L209 Particularly: endOfInput Otherwise you could many1/some/try that bugger to do what you want. On 02/24/2016 01:11 PM, Brian Hurt wrote: > > What I'm trying to do is write a function with the signature: > > data Urls = > Txt Text.Text > | Url Text.Text URI.URI > deriving (Show) > > parseUrls :: Text.Text -> Either String [ Urls ] > parseUrls text = ... > > Given a text block, it finds all the URLs, and breaks things into > either URLs, or blocks of text which are not URLs. The full text is > attached, for those who are interested. But the problem I'm hitting > is using the Attoparsec parser URI.ByteString exports. When I do: > > *Base.DetectURL AP> AP.parseOnly (URI.uriParser > URI.laxURIParserOptions) "http://foo/bar" > Right (...) > > So, that works. But when I add a single space on the end of the string: > > *Base.DetectURL AP> AP.parseOnly (URI.uriParser > URI.laxURIParserOptions) "http://foo/bar " > Left "Failed reading: MalformedPath" > > It fails. Note that this isn't a problem with parseOnly- the real > code looks like: > > parseAllUris :: AP.Parser (Bldr.Builder, [ Urls ]) > parseAllUris = msum [ aUri, noUri, finished ] > where > finished = return (mempty, []) > aUri = do > (txt, url) <- AP.match $ > URI.uriParser URI.laxURIParserOptions > (bldr, us) <- msum [ noUri, finished ] > return $ (mempty, (Url (E.decodeUtf8 txt) url > : prependText bldr us)) > noUri = do > c <- AP.anyChar > (bldr, us) <- parseAllUris > return $ ((Bldr.charUtf8 c) `mappend` bldr, us) > > And this has the problem as well- parsing a URL with anything > following it fails, and it doesn't detect any URLs. The parseOnly is > just the easy way to demonstrate it. > > So, my question is, is there some way in attoparsec to tell it to just > parse as much as makes sense, and leave the rest? Alternatively, is > this a problem with the way URI.ByteString module constructed it's > parser, and a different parser could work? Or, worst of all, is this > a problem with the way that URIs are defined and no conforming parser > will work? > > Thanks. > > Brian > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe -------------- next part -------------- An HTML attachment was scrubbed... URL: From victorsmiller at gmail.com Wed Feb 24 19:37:13 2016 From: victorsmiller at gmail.com (Victor Miller) Date: Wed, 24 Feb 2016 14:37:13 -0500 Subject: [Haskell-cafe] Local mirrors of hackage In-Reply-To: References: Message-ID: John, Thanks very much. Victor On Wed, Feb 24, 2016 at 1:16 PM, John Wiegley wrote: >>>>>> Victor Miller writes: > >> I have a computer that I work on which isn't directly connected to the >> internet, that I want to use Haskell on. In order to do that I want a local >> version of hackage. I was previously able to do this using >> mirror_hackage.py, but since hackage 2 came around this no longer works. >> Doing this would involve running something on a computer that *is* attached >> to the internet, and then transferring a bunch of files over to the other >> computer. Can someone point me to a recipe for doing this? > > I wrote https://github.com/jwiegley/hackage-mirror to do just this, with > relatively high performance for incremental updates. > > Also, if you're ever a Nix user, you can modify the core Haskell builder to > reference whatever directory you mirror to first, before reaching out to the > Internet for tarballs. I've been using this effectively for several years now. > > -- > John Wiegley GPG fingerprint = 4710 CF98 AF9B 327B B80F > http://newartisans.com 60E1 46C4 BD1A 7AC1 4BA2 From noteed at gmail.com Wed Feb 24 20:24:16 2016 From: noteed at gmail.com (Vo Minh Thu) Date: Wed, 24 Feb 2016 21:24:16 +0100 Subject: [Haskell-cafe] Local mirrors of hackage In-Reply-To: References: Message-ID: Here is a script that I use. The whole mirror can also be downloaded through rsync if that helps. https://github.com/noteed/nginx-hackage 2016-02-24 20:37 GMT+01:00 Victor Miller : > John, Thanks very much. > > Victor > > On Wed, Feb 24, 2016 at 1:16 PM, John Wiegley wrote: >>>>>>> Victor Miller writes: >> >>> I have a computer that I work on which isn't directly connected to the >>> internet, that I want to use Haskell on. In order to do that I want a local >>> version of hackage. I was previously able to do this using >>> mirror_hackage.py, but since hackage 2 came around this no longer works. >>> Doing this would involve running something on a computer that *is* attached >>> to the internet, and then transferring a bunch of files over to the other >>> computer. Can someone point me to a recipe for doing this? >> >> I wrote https://github.com/jwiegley/hackage-mirror to do just this, with >> relatively high performance for incremental updates. >> >> Also, if you're ever a Nix user, you can modify the core Haskell builder to >> reference whatever directory you mirror to first, before reaching out to the >> Internet for tarballs. I've been using this effectively for several years now. >> >> -- >> John Wiegley GPG fingerprint = 4710 CF98 AF9B 327B B80F >> http://newartisans.com 60E1 46C4 BD1A 7AC1 4BA2 > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe From jeffbrown.the at gmail.com Wed Feb 24 20:51:11 2016 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Wed, 24 Feb 2016 12:51:11 -0800 Subject: [Haskell-cafe] Manual type-checking in graphs: Avoidable? In-Reply-To: References: <20160219043659.GA1339@casa.casa> <20160219205411.GA18544@casa.casa> <3BA1C77C-86D0-4CBC-B97B-53145C998FF0@gesh.uni.cx> <874md3bmnf.fsf@feelingofgreen.ru> Message-ID: It is possible! Off-list, Matt Parsons explained how to do it. With his permission I have copied that email below: On Sat, Feb 20, 2016 at 9:14 PM, Matt wrote: > Phantom types can help disambiguate: > > data Hamster > data Person > > data Node a where > HNode :: String -> Node Hamster > PNode :: String -> Node Person > > type G = Gr (Some Node) String > > Your API functions will have the type: > > getPersonHamsters :: Node Person -> [Node Hamster] > getPersonHamsters (PNode personName) = ... > > Since the only way to construct a `Node Person` is with the `PNode` > constructor, you don't even have to check for the `HNode` constructor, and > it's a type error to provide it to the function. > > You'll need to wrap in `Some` to store in the graph and unwrap/pattern > match on the `Some` to get the data back out. This'll provide some > additional safety by constraining surface area of the less-strongly-typed > interface, but it won't take care of it entirely. > > Matt Parsons > > On Sat, Feb 20, 2016 at 9:27 PM, Jeffrey Brown > wrote: > >> Clever! That answers my first question, but still leaves me unmotivated. >> Would GADTs allow me to offload some kind of work onto the compiler that I >> currently have to do myself? >> >> On Sat, Feb 20, 2016 at 2:00 PM, Matt wrote: >> >>> The pattern I've seen is: >>> >>> data Some f where >>> Some :: f a -> Some f >>> >>> type G = Gr (Some Box') String >>> >>> Ordinarily you lose the information about the `a`, but when you have a >>> GADT, that allows you to recover type information. So you can match on: >>> >>> f :: Some Box' -> String >>> f (Some (Bi i)) = show (i + 1) >>> f (Some (Bs s)) = s >>> >>> Matt Parsons >>> >>> On Sat, Feb 20, 2016 at 4:16 PM, Jeffrey Brown >>> wrote: >>> >>>> Interesting! I have two questions. >>>> >>>> (1) Given that Graph is of kind * -> * -> *, rather than (* -> *) -> * >>>> -> *, how can I use a GADT? The first graph using existentials defined >>>> earlier in this thread looked like: >>>> >>>> data Box = forall s. Show s => Box s >>>> type ExQuantGraph = Gr Box String >>>> >>>> If instead I use a GADT: >>>> >>>> data Box' a where >>>> Bi :: Int -> Box' Int >>>> Bs :: String -> Box' String >>>> >>>> then I can't define a graph on >>>> >>>> type G = Gr Box' String >>>> >>>> because Box is not a concrete type. I could specify (Box a) for some a, >>>> but then I lose the polymorphism that was the purpose of the GADT. >>>> >>>> (2) Would a GADT be better than what I'm already doing? Currently I >>>> define a Mindmap[1] as a graph where the nodes are a wrapper type called >>>> Expr ("expression"): >>>> >>>> type Mindmap = Gr Expr _ -- the edge type is irrelevant >>>> data Expr = Str String | Fl Float >>>> | Tplt [String] | Rel | Coll >>>> | RelSpecExpr RelVarSpec deriving(Show,Read,Eq,Ord) >>>> >>>> I do a lot of pattern matching on those constructors. If I used a GADT >>>> I would still be pattern matching on constructors. So do GADTs offer some >>>> advantage? >>>> >>>> [1] >>>> https://github.com/JeffreyBenjaminBrown/digraphs-with-text/blob/master/src/Dwt/Graph.hs >>>> >>>> On Sat, Feb 20, 2016 at 11:59 AM, Benjamin Edwards < >>>> edwards.benj at gmail.com> wrote: >>>> >>>>> if you are willing to have a closed universe, you can pattern match on >>>>> a gadt to do do the unpacking >>>>> >>>>> On Sat, 20 Feb 2016 at 19:19 Jeffrey Brown >>>>> wrote: >>>>> >>>>>> Yes, that is my point. Existentials cannot be unwrapped. >>>>>> >>>>>> On Sat, Feb 20, 2016 at 4:18 AM, Kosyrev Serge < >>>>>> _deepfire at feelingofgreen.ru> wrote: >>>>>> >>>>>>> Jeffrey Brown writes: >>>>>>> > After further study I believe existentials are not (at least alone) >>>>>>> > enough to solve the problem. >>>>>>> .. >>>>>>> > getInt :: ShowBox -> Int >>>>>>> > getInt (SB i) = i >>>>>>> > >>>>>>> > will not compile, because it cannot infer that i is an Int: >>>>>>> >>>>>>> You take a value of an existentially quantified type (which means it >>>>>>> can be anything at all, absent some extra context) and *proclaim* it >>>>>>> is an integer. >>>>>>> >>>>>>> On what grounds should the compiler accept your optimistic >>>>>>> restriction? >>>>>>> >>>>>>> -- >>>>>>> ? ???????e? / respectfully, >>>>>>> ??????? ?????? >>>>>>> >>>>>> >>>>>> >>>>>> >>>>>> -- >>>>>> Jeffrey Benjamin Brown >>>>>> _______________________________________________ >>>>>> Haskell-Cafe mailing list >>>>>> Haskell-Cafe at haskell.org >>>>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>>>>> >>>>> >>>> >>>> >>>> -- >>>> Jeffrey Benjamin Brown >>>> >>>> _______________________________________________ >>>> Haskell-Cafe mailing list >>>> Haskell-Cafe at haskell.org >>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>>> >>>> >>> >> >> >> -- >> Jeffrey Benjamin Brown >> > > -- Jeffrey Benjamin Brown -------------- next part -------------- An HTML attachment was scrubbed... URL: From victorsmiller at gmail.com Wed Feb 24 21:31:08 2016 From: victorsmiller at gmail.com (Victor Miller) Date: Wed, 24 Feb 2016 16:31:08 -0500 Subject: [Haskell-cafe] Local mirrors of hackage In-Reply-To: References: Message-ID: John, Thanks very much for hackage-mirror. I'm running it now and it appears to be working as advertised. Thanks to everyone else who responded. Victor On Wed, Feb 24, 2016 at 1:16 PM, John Wiegley wrote: > >>>>> Victor Miller writes: > > > I have a computer that I work on which isn't directly connected to the > > internet, that I want to use Haskell on. In order to do that I want a > local > > version of hackage. I was previously able to do this using > > mirror_hackage.py, but since hackage 2 came around this no longer works. > > Doing this would involve running something on a computer that *is* > attached > > to the internet, and then transferring a bunch of files over to the other > > computer. Can someone point me to a recipe for doing this? > > I wrote https://github.com/jwiegley/hackage-mirror to do just this, with > relatively high performance for incremental updates. > > Also, if you're ever a Nix user, you can modify the core Haskell builder to > reference whatever directory you mirror to first, before reaching out to > the > Internet for tarballs. I've been using this effectively for several years > now. > > -- > John Wiegley GPG fingerprint = 4710 CF98 AF9B 327B B80F > http://newartisans.com 60E1 46C4 BD1A 7AC1 4BA2 > -------------- next part -------------- An HTML attachment was scrubbed... URL: From johnw at newartisans.com Wed Feb 24 21:45:55 2016 From: johnw at newartisans.com (John Wiegley) Date: Wed, 24 Feb 2016 13:45:55 -0800 Subject: [Haskell-cafe] Local mirrors of hackage In-Reply-To: (Victor Miller's message of "Wed, 24 Feb 2016 16:31:08 -0500") References: Message-ID: >>>>> Victor Miller writes: > John, Thanks very much for hackage-mirror. I'm running it now and it appears > to be working as advertised. Thanks to everyone else who responded. I committed a fix very recently to the 'pipes' branch that you may need, since there is one package on Hackage that is missing and thus cannot be downloaded. -- John Wiegley GPG fingerprint = 4710 CF98 AF9B 327B B80F http://newartisans.com 60E1 46C4 BD1A 7AC1 4BA2 From diaz.carrete at gmail.com Thu Feb 25 00:12:17 2016 From: diaz.carrete at gmail.com (=?UTF-8?Q?Daniel_D=C3=ADaz?=) Date: Wed, 24 Feb 2016 16:12:17 -0800 (PST) Subject: [Haskell-cafe] Playing with OverloadedLabels in GHC 8 RC2, how to do this? In-Reply-To: <56CC235E.8010000@well-typed.com> References: <79ca24dd-c2ea-4759-be0d-cdf844e972b7@googlegroups.com> <56CC235E.8010000@well-typed.com> Message-ID: I wonder if is there is some way of making the labels "transitive". For example, if I have a record embedded in another record, it would be nice if the labels of the embedded record worked for the enclosing record as well, assuming there's no ambiguity. Here's an attempt. Consider this "strengthened" version of IsLabel that uses functional dependencies. Only certain fields will be able to have instances: class IsLabel symbol (a -> b) => IsUnambiguousLabel symbol a b | symbol -> a b, a b -> symbol, symbol a -> b, symbol b -> a and then this instance (IsUnambiguousLabel symbol1 a b, IsUnambiguousLabel symbol2 b c) => IsLabel symbol2 (a -> c) where fromLabel _ = fromLabel (proxy# :: (Proxy# symbol2)) . fromLabel (proxy# :: (Proxy# symbol1)) But it doesn't work. GHC complains angrily about overlapping instances. On Tuesday, February 23, 2016 at 10:16:21 AM UTC+1, Adam Gundry wrote: > > Hi, > > The type of `fromLabel` is > > forall (x :: Symbol) a . IsLabel x a => Proxy# x -> a > > where `x` represents the text of the label, so rather than applying it to > > (proxy# :: (Proxy# (Person -> String))) > > you need to apply it to > > (proxy# :: Proxy# symbol) > > and you will need to turn on the ScopedTypeVariables extension (so that > `symbol` refers to the variable bound in the class instance). With that > change, your program works. > > That's a truly atrocious error message though. It's marginally better if > you enable -fprint-explicit-kinds: > > ? Expected kind ?Proxy# GHC.Types.Symbol ((->) Person String)?, > but ?proxy# :: Proxy# (Person -> String)? has kind > ?Proxy# * (Person -> String)? > > This shows the real problem, namely that you have `Proxy# *` instead of > `Proxy# Symbol`. However, `Proxy# Symbol ((->) Person String)` is > blatantly ill-kinded, so the error message doesn't make much sense. I > suggest you file a GHC ticket, if there isn't a suitable one already. > > Hope this helps, > > Adam > > > On 23/02/16 08:29, Daniel D?az wrote: > > Hi all, > > > > I'm playing with the OverloadedLabels extension in GHC 8 RC2. I have > > been able to define simple record accessors, like in this > > gist: https://gist.github.com/danidiaz/3b9a6865686c777f328c > > > > After realizing than with OverloadedLabels a single symbol can be used > > to extract two different types from the same record, I tried to define > > an instance that says: "if a symbol can be used to extract an string > > from my record, then it can also be used to extract that a Text value". > > > > Here's my attempt (using a dummy Text type): > > > > {-# LANGUAGE OverloadedLabels #-} > > {-# LANGUAGE DataKinds #-} > > {-# LANGUAGE FlexibleInstances #-} > > {-# LANGUAGE FlexibleContexts #-} > > {-# LANGUAGE UndecidableInstances #-} > > {-# LANGUAGE MultiParamTypeClasses #-} > > {-# LANGUAGE MagicHash #-} > > module Main where > > > > import GHC.OverloadedLabels > > import GHC.Prim > > > > newtype Text = Text { getText :: String } deriving Show > > > > data Person = Person { _id :: Int , _name :: String } > > > > instance IsLabel "name" (Person -> String) where > > fromLabel _ = _name > > > > instance IsLabel symbol (Person -> String) => IsLabel symbol (Person > > -> Text) where > > fromLabel _ = Text . fromLabel (proxy# :: (Proxy# (Person -> > > String))) > > > > person :: Person > > person = Person 123 "Horace" > > > > main :: IO () > > main = do > > print (#name person :: String) > > print (#name person :: Text) > > > > > > Bu this doesn't work. The error I get is puzzling: > > > > ? Expected kind ?Proxy# ((->) Person String)?, > > but ?proxy# :: Proxy# (Person -> String)? has kind ?Proxy# > > (Person -> String)? > > ? In the first argument of ?fromLabel?, namely > > ?(proxy# :: Proxy# (Person -> String))? > > > > > > Is this a bug? What is going on here? > > > -- > Adam Gundry, Haskell Consultant > Well-Typed LLP, http://www.well-typed.com/ > _______________________________________________ > Haskell-Cafe mailing list > Haskel... at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Thu Feb 25 01:42:27 2016 From: david.feuer at gmail.com (David Feuer) Date: Wed, 24 Feb 2016 20:42:27 -0500 Subject: [Haskell-cafe] Is there a nice place for extra stuff for Category? In-Reply-To: References: Message-ID: 1. An explanation of a monoid as a category with exactly one object newtype Cat c a = Cat {getCat :: c a a} instance Category c => Monoid (c a) newtype Mon m a b = Mon {getMon :: m} instance Monoid m => Category (Mon m) --This would be more precisely written -- data Mon m a b where -- Mon :: m -> Mon a a -- but that hurts performance without seeming to offer much in return 2. newtype Op c a b = Op {getOp :: c b a} instance Category c => Category (Op c) instance Bifunctor c => Bifunctor (Op c) instance Bifunctor c => Functor (Op c a) instance Profunctor c => Contravariant (Op c a) I see that Control.Category.Dual in the categories package offers a version of this last defined as *data* for some reason. -------------- next part -------------- An HTML attachment was scrubbed... URL: From mitchellwrosen at gmail.com Thu Feb 25 02:49:36 2016 From: mitchellwrosen at gmail.com (Mitchell Rosen) Date: Wed, 24 Feb 2016 18:49:36 -0800 (PST) Subject: [Haskell-cafe] Overlapping instances Message-ID: Consider this "list membership" typeclass and two overlapping instances: class Elem (x :: k) (xs :: [k]) instance {-# OVERLAPS #-} Elem x (x ': xs) instance {-# OVERLAPS #-} Elem x xs => Elem x (y ': xs) The inductive style is satisfying, but I'm struggling to understand exactly how GHC can pick one instance over the other. How is a constraint like Elem Int [Int] solved? Certainly the Elem x (x ': xs) instance matches, with x = Int and xs = []. But, the second instance is also equally valid with x = Int, y = Int, xs = []. Even though *if *the second instance is chosen, the context cannot be satisfied (no instance for Elem x []), it's my understanding that GHC will not backtrack once it picks an instance. And because both instances look valid to me, I don't understand why this code does not require IncoherentInstances. Thanks. -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Thu Feb 25 03:07:47 2016 From: david.feuer at gmail.com (David Feuer) Date: Wed, 24 Feb 2016 22:07:47 -0500 Subject: [Haskell-cafe] Fwd: Re: Overlapping instances In-Reply-To: References: Message-ID: Oddly, this message was rejected by the system. Trying again. ---------- Forwarded message ---------- From: "David Feuer" Date: Feb 24, 2016 10:04 PM Subject: Re: [Haskell-cafe] Overlapping instances To: "Mitchell Rosen" Cc: "Haskell-cafe" It's possible that GHC will backtrack with overlapping enabled (I can't remember, and overlapping instances give me hives) but it doesn't have here. The first instance is "more specific" than the second because the type variable x appears twice. On Feb 24, 2016 9:49 PM, "Mitchell Rosen" wrote: > Consider this "list membership" typeclass and two overlapping instances: > > class Elem (x :: k) (xs :: [k]) > > instance {-# OVERLAPS #-} Elem x (x ': xs) > instance {-# OVERLAPS #-} Elem x xs => Elem x (y ': xs) > > The inductive style is satisfying, but I'm struggling to understand > exactly how GHC can pick one instance over the other. > > How is a constraint like Elem Int [Int] solved? Certainly the Elem x (x > ': xs) instance matches, with x = Int and xs = []. But, the second > instance is also equally valid with x = Int, y = Int, xs = []. Even > though *if *the second instance is chosen, the context cannot be > satisfied (no instance for Elem x []), it's my understanding that GHC > will not backtrack once it picks an instance. And because both instances > look valid to me, I don't understand why this code does not require > IncoherentInstances. > > Thanks. > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mitchellwrosen at gmail.com Thu Feb 25 03:12:21 2016 From: mitchellwrosen at gmail.com (Mitchell Rosen) Date: Wed, 24 Feb 2016 19:12:21 -0800 (PST) Subject: [Haskell-cafe] Fwd: Re: Overlapping instances In-Reply-To: References: Message-ID: I see. I did know about the specificity rule, but somehow it escaped me that the extra y := x substitution required for the second instance to match means that the first instance *is* more specific. Thanks! PS - why do overlapping instances give you hives? Did you mean incoherent instances? On Wednesday, February 24, 2016 at 7:07:54 PM UTC-8, David Feuer wrote: > > Oddly, this message was rejected by the system. Trying again. > ---------- Forwarded message ---------- > From: "David Feuer" > > Date: Feb 24, 2016 10:04 PM > Subject: Re: [Haskell-cafe] Overlapping instances > To: "Mitchell Rosen" > > Cc: "Haskell-cafe" > > > It's possible that GHC will backtrack with overlapping enabled (I can't > remember, and overlapping instances give me hives) but it doesn't have > here. The first instance is "more specific" than the second because the > type variable x appears twice. > On Feb 24, 2016 9:49 PM, "Mitchell Rosen" > wrote: > >> Consider this "list membership" typeclass and two overlapping instances: >> >> class Elem (x :: k) (xs :: [k]) >> >> instance {-# OVERLAPS #-} Elem x (x ': xs) >> instance {-# OVERLAPS #-} Elem x xs => Elem x (y ': xs) >> >> The inductive style is satisfying, but I'm struggling to understand >> exactly how GHC can pick one instance over the other. >> >> How is a constraint like Elem Int [Int] solved? Certainly the Elem x (x >> ': xs) instance matches, with x = Int and xs = []. But, the second >> instance is also equally valid with x = Int, y = Int, xs = []. Even >> though *if *the second instance is chosen, the context cannot be >> satisfied (no instance for Elem x []), it's my understanding that GHC >> will not backtrack once it picks an instance. And because both instances >> look valid to me, I don't understand why this code does not require >> IncoherentInstances. >> >> Thanks. >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskel... at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Thu Feb 25 06:59:48 2016 From: david.feuer at gmail.com (David Feuer) Date: Thu, 25 Feb 2016 01:59:48 -0500 Subject: [Haskell-cafe] Fwd: Re: Overlapping instances In-Reply-To: References: Message-ID: No, I refuse to believe that incoherent instances are actually supported. The documentation must be lying. Overlapping instances are too complicated for me to really trust. More annoyingly, their existence anywhere violates some nice properties that would otherwise hold. For instance, from instance C a => C (Maybe a) along with C (Maybe Int) you'd like to be able to conclude that C Int but you can't, because maybe there's a special instance for C (Maybe Int) somewhere. Overlapping instances also work fairly badly with associated types. On Feb 24, 2016 10:12 PM, "Mitchell Rosen" wrote: > I see. I did know about the specificity rule, but somehow it escaped me > that the extra y := x substitution required for the second instance to > match means that the first instance *is* more specific. > > Thanks! > > PS - why do overlapping instances give you hives? Did you mean incoherent > instances? > > On Wednesday, February 24, 2016 at 7:07:54 PM UTC-8, David Feuer wrote: >> >> Oddly, this message was rejected by the system. Trying again. >> ---------- Forwarded message ---------- >> From: "David Feuer" >> Date: Feb 24, 2016 10:04 PM >> Subject: Re: [Haskell-cafe] Overlapping instances >> To: "Mitchell Rosen" >> Cc: "Haskell-cafe" >> >> It's possible that GHC will backtrack with overlapping enabled (I can't >> remember, and overlapping instances give me hives) but it doesn't have >> here. The first instance is "more specific" than the second because the >> type variable x appears twice. >> On Feb 24, 2016 9:49 PM, "Mitchell Rosen" wrote: >> >>> Consider this "list membership" typeclass and two overlapping instances: >>> >>> class Elem (x :: k) (xs :: [k]) >>> >>> instance {-# OVERLAPS #-} Elem x (x ': xs) >>> instance {-# OVERLAPS #-} Elem x xs => Elem x (y ': xs) >>> >>> The inductive style is satisfying, but I'm struggling to understand >>> exactly how GHC can pick one instance over the other. >>> >>> How is a constraint like Elem Int [Int] solved? Certainly the Elem x (x >>> ': xs) instance matches, with x = Int and xs = []. But, the second >>> instance is also equally valid with x = Int, y = Int, xs = []. Even >>> though *if *the second instance is chosen, the context cannot be >>> satisfied (no instance for Elem x []), it's my understanding that GHC >>> will not backtrack once it picks an instance. And because both instances >>> look valid to me, I don't understand why this code does not require >>> IncoherentInstances. >>> >>> Thanks. >>> >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> Haskel... at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> >>> -------------- next part -------------- An HTML attachment was scrubbed... URL: From alpmestan at gmail.com Thu Feb 25 17:50:11 2016 From: alpmestan at gmail.com (Alp Mestanogullari) Date: Thu, 25 Feb 2016 18:50:11 +0100 Subject: [Haskell-cafe] [ANN] sparkle: native Apache Spark applications in Haskell Message-ID: Hello -cafe! Recently at Tweag I/O we've been working on sparkle, a library for writing (distributed) Apache Spark applications directly in Haskell! We have published a blog post introducing the project (and some of its challenges) here: http://www.tweag.io/blog/haskell-meets-large-scale-distributed-analytics The corresponding repository lives at https://github.com/tweag/sparkle While this is still early stage work, we can already write non-trivial Spark applications in Haskell and have them run accross an entire cluster. We obviously do not cover the whole Spark API yet (very, very far from that) but would be glad to already get some feedback. Cheers -- Alp Mestanogullari -------------- next part -------------- An HTML attachment was scrubbed... URL: From maydwell at gmail.com Thu Feb 25 23:56:11 2016 From: maydwell at gmail.com (Lyndon Maydwell) Date: Fri, 26 Feb 2016 10:56:11 +1100 Subject: [Haskell-cafe] [ANN] sparkle: native Apache Spark applications in Haskell In-Reply-To: References: Message-ID: Hi Alp, Just wanted to say that there's interest here in Melbourne in Spark+Haskell too and we'll definitely be trying this out to see what it's like. One of the problems that some of the more exotic language-bindings to spark have is that while they include RDD support, they lack a language-idiomatic interpretation of DataFrames. Does Sparkle attempt to tackle this? Many thanks to Tweag I/O for doing this. It must have been a lot of work! Regards, - Lyndon On Fri, Feb 26, 2016 at 4:50 AM, Alp Mestanogullari wrote: > Hello -cafe! > > Recently at Tweag I/O we've been working on sparkle, a library for writing > (distributed) Apache Spark applications directly in Haskell! > > We have published a blog post introducing the project (and some of its > challenges) here: > http://www.tweag.io/blog/haskell-meets-large-scale-distributed-analytics > > The corresponding repository lives at https://github.com/tweag/sparkle > > While this is still early stage work, we can already write non-trivial > Spark applications in Haskell and have them run accross an entire cluster. > We obviously do not cover the whole Spark API yet (very, very far from > that) but would be glad to already get some feedback. > > Cheers > > -- > Alp Mestanogullari > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ivanperezdominguez at gmail.com Fri Feb 26 07:24:09 2016 From: ivanperezdominguez at gmail.com (Ivan Perez) Date: Fri, 26 Feb 2016 07:24:09 +0000 Subject: [Haskell-cafe] Haskell Symposium 2016 CFP? Message-ID: Hi Caf? Is there going to be a Haskell Symposium this year? I haven't been able to find the call for papers. Best regards Ivan -------------- next part -------------- An HTML attachment was scrubbed... URL: From atze at uu.nl Fri Feb 26 14:00:14 2016 From: atze at uu.nl (Atze Dijkstra) Date: Fri, 26 Feb 2016 15:00:14 +0100 Subject: [Haskell-cafe] ANNOUNCE: Applied Functional Programming (AFP) Summerschool 4-15 July 2016, Utrecht, Netherlands Message-ID: =========== AFP Summerschool 2016 =========== Applied Functional Programming (AFP) Summerschool July 4-15, 2016 Utrecht University, Department of Information and Computing Sciences Utrecht, The Netherlands Summerschool & registration website: http://www.utrechtsummerschool.nl/courses/science/applied-functional-programming-in-haskell AFP website : http://www.cs.uu.nl/wiki/USCS contact : Uscs-afp at lists.science.uu.nl *** The 2016 edition of the Applied Functional Programming (AFP) Summerschool in Utrecht, Netherlands will be held from 4-15 July 2016. The summerschool teaches Haskell on both beginners and advanced levels via lectures and lab exercises. More info can be found via the references above, included here is a summary from the summerschool info: ``Typed functional programming languages allow for the development of robust, concise programs in a short amount of time. The key advantages are higher-order functions as an abstraction mechanism, and an advanced type system for safety and re usability. This course explores Haskell, a state-of-the-art functional programming language, together with some of its theoretical background, such as typed lambda calculi, referential transparency, Damas-Milner type inference, type level programming, and functional design patterns. We will combine this with applications of functional programming, concentrating on topics such as language processing, building graphical user interfaces, networking, databases, and programming for the web. The goal of the course is not just to teach the programming language and underlying theory, but also to learn about the Haskell community and to get hands-on experience by doing lab exercises or a Haskell project of your own.'' The summerschool is organised and given by the Software Technology group (http://www.uu.nl/en/research/software-systems/software-technology) within the Department of Information and Computing Sciences (http://www.uu.nl/en/organisation/department-of-information-and- computing-sciences), a group which in the departmental research evaluation over the past years was singled out by ``...the functional programming activities are known to be world leading in their domain.'' *** regards, - Atze - Atze Dijkstra, Department of Information and Computing Sciences. /|\ Utrecht University, PO Box 80089, 3508 TB Utrecht, Netherlands. / | \ Tel.: +31-30-2534118/1454 | WWW : http://www.cs.uu.nl/~atze . /--| \ Fax : +31-30-2513971 .... | Email: atze at uu.nl ............... / |___\ From atzeus at gmail.com Fri Feb 26 14:59:15 2016 From: atzeus at gmail.com (Atze van der Ploeg) Date: Fri, 26 Feb 2016 15:59:15 +0100 Subject: [Haskell-cafe] Haskell Symposium 2016 CFP? In-Reply-To: References: Message-ID: I think you're a bit early. The chair this year is Geoffrey Mainland (in CC). Since the call for papers is not available yet, I'm guessing no early track this year? Cheers, Atze On Feb 26, 2016 8:24 AM, "Ivan Perez" wrote: > Hi Caf? > > Is there going to be a Haskell Symposium this year? > > I haven't been able to find the call for papers. > > Best regards > > Ivan > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From adam at well-typed.com Fri Feb 26 22:08:45 2016 From: adam at well-typed.com (Adam Gundry) Date: Fri, 26 Feb 2016 22:08:45 +0000 Subject: [Haskell-cafe] Playing with OverloadedLabels in GHC 8 RC2, how to do this? In-Reply-To: <3500ba48-6b27-4752-b993-c3e6647071f2@googlegroups.com> References: <79ca24dd-c2ea-4759-be0d-cdf844e972b7@googlegroups.com> <56CC235E.8010000@well-typed.com> <3500ba48-6b27-4752-b993-c3e6647071f2@googlegroups.com> Message-ID: <56D0CCED.9030205@well-typed.com> On 23/02/16 22:07, Daniel D?az wrote: > I was wondering: if I define a bunch of records in a module, how to make > this the behaviour for all records in the module, without much > boilerplate and without affecting any records elsewhere? > > One possible solution would be to define a empty type class that will > not be exported: > > class Marker r > > and the following instance: > > instance (Marker r,IsLabel symbol (r -> String)) => IsLabel symbol > (r -> Text) where > fromLabel _ = Text . fromLabel (proxy# :: (Proxy# symbol)) Unfortunately this will overlap with any fields defined elsewhere that return Text, which is perhaps not ideal. > And make every record in the module an instance of Marker: > > instance Marker Person > > I'm not sure if there's a simpler way. I think ultimately we want to pick a single IsLabel instance for the function space, to be defined in base. That will create a standard way to use overloaded labels with records. This is discussed a bit on the wiki [1]. Probably the instance should delegate to another class that captures which fields belong to which records. Unfortunately there are some design trade-offs, so it's not entirely clear what this instance should look like. The plan is to experiment with the options in 8.0 and try to commit to something in a future GHC release. > Even if we don't export the fields directly, another way to employ > OverloadedLabels (OverloadedRecordFields, once it arrives) is for giving > default implementations of public interfaces, in combination with > DefaultSignatures. A not very useful example: > > class Named r where > name :: r -> String > default name :: IsLabel "name" (r -> String) => r -> String > name = #name > > instance Named Person Thanks, this is an interesting use case that hadn't occurred to me. All the best, Adam [1] https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/MagicClasses#Backtooverloadedlabels -- Adam Gundry, Haskell Consultant Well-Typed LLP, http://www.well-typed.com/ From adam at well-typed.com Fri Feb 26 22:24:37 2016 From: adam at well-typed.com (Adam Gundry) Date: Fri, 26 Feb 2016 22:24:37 +0000 Subject: [Haskell-cafe] Playing with OverloadedLabels in GHC 8 RC2, how to do this? In-Reply-To: References: <79ca24dd-c2ea-4759-be0d-cdf844e972b7@googlegroups.com> <56CC235E.8010000@well-typed.com> Message-ID: <56D0D0A5.4030203@well-typed.com> On 25/02/16 00:12, Daniel D?az wrote: > I wonder if is there is some way of making the labels "transitive". For > example, if I have a record embedded in another record, it would be nice > if the labels of the embedded record worked for the enclosing record as > well, assuming there's no ambiguity. Sadly I think transitivity is going to be hard to achieve, without endless overlapping instance problems, because it's not clear how to make type inference determine the "in-between" type. > Here's an attempt. Consider this "strengthened" version of IsLabel that > uses functional dependencies. Only certain fields will be able to have > instances: > > class IsLabel symbol (a -> b) => IsUnambiguousLabel symbol a b | > symbol -> a b, a b -> symbol, symbol a -> b, symbol b -> a > > and then this > > instance (IsUnambiguousLabel symbol1 a b, IsUnambiguousLabel symbol2 > b c) => IsLabel symbol2 (a -> c) where > fromLabel _ = fromLabel (proxy# :: (Proxy# symbol2)) . fromLabel > (proxy# :: (Proxy# symbol1)) > > But it doesn't work. GHC complains angrily about overlapping instances. It took me a while to understand that the overlap is actually between the instance being defined, and one of its own superclasses. You can resolve it by giving a type signature to one of the `fromLabel` occurrences, thereby fixing the intermediate variable. But I've not been able to get much further... All the best, Adam > On Tuesday, February 23, 2016 at 10:16:21 AM UTC+1, Adam Gundry wrote: > > Hi, > > The type of `fromLabel` is > > forall (x :: Symbol) a . IsLabel x a => Proxy# x -> a > > where `x` represents the text of the label, so rather than applying > it to > > (proxy# :: (Proxy# (Person -> String))) > > you need to apply it to > > (proxy# :: Proxy# symbol) > > and you will need to turn on the ScopedTypeVariables extension (so that > `symbol` refers to the variable bound in the class instance). With that > change, your program works. > > That's a truly atrocious error message though. It's marginally > better if > you enable -fprint-explicit-kinds: > > ? Expected kind ?Proxy# GHC.Types.Symbol ((->) Person String)?, > but ?proxy# :: Proxy# (Person -> String)? has kind > ?Proxy# * (Person -> String)? > > This shows the real problem, namely that you have `Proxy# *` instead of > `Proxy# Symbol`. However, `Proxy# Symbol ((->) Person String)` is > blatantly ill-kinded, so the error message doesn't make much sense. I > suggest you file a GHC ticket, if there isn't a suitable one already. > > Hope this helps, > > Adam > > > On 23/02/16 08:29, Daniel D?az wrote: > > Hi all, > > > > I'm playing with the OverloadedLabels extension in GHC 8 RC2. I have > > been able to define simple record accessors, like in this > > gist: https://gist.github.com/danidiaz/3b9a6865686c777f328c > > > > > After realizing than with OverloadedLabels a single symbol can be > used > > to extract two different types from the same record, I tried to > define > > an instance that says: "if a symbol can be used to extract an string > > from my record, then it can also be used to extract that a Text > value". > > > > Here's my attempt (using a dummy Text type): > > > > {-# LANGUAGE OverloadedLabels #-} > > {-# LANGUAGE DataKinds #-} > > {-# LANGUAGE FlexibleInstances #-} > > {-# LANGUAGE FlexibleContexts #-} > > {-# LANGUAGE UndecidableInstances #-} > > {-# LANGUAGE MultiParamTypeClasses #-} > > {-# LANGUAGE MagicHash #-} > > module Main where > > > > import GHC.OverloadedLabels > > import GHC.Prim > > > > newtype Text = Text { getText :: String } deriving Show > > > > data Person = Person { _id :: Int , _name :: String } > > > > instance IsLabel "name" (Person -> String) where > > fromLabel _ = _name > > > > instance IsLabel symbol (Person -> String) => IsLabel symbol > (Person > > -> Text) where > > fromLabel _ = Text . fromLabel (proxy# :: (Proxy# (Person -> > > String))) > > > > person :: Person > > person = Person 123 "Horace" > > > > main :: IO () > > main = do > > print (#name person :: String) > > print (#name person :: Text) > > > > > > Bu this doesn't work. The error I get is puzzling: > > > > ? Expected kind ?Proxy# ((->) Person String)?, > > but ?proxy# :: Proxy# (Person -> String)? has kind > ?Proxy# > > (Person -> String)? > > ? In the first argument of ?fromLabel?, namely > > ?(proxy# :: Proxy# (Person -> String))? > > > > > > Is this a bug? What is going on here? -- Adam Gundry, Haskell Consultant Well-Typed LLP, http://www.well-typed.com/ From jeffbrown.the at gmail.com Sat Feb 27 04:08:29 2016 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Fri, 26 Feb 2016 20:08:29 -0800 Subject: [Haskell-cafe] The 13-line example in Text.Megaparsec.Expr Message-ID: At the bottom of the Hackage documentation for Text.Megaparsec.Expr [1] is a 13-line demonstration program. It includes no import statements. I added the ones I could deduce, which produced this: import Text.Megaparsec import Text.Megaparsec.Expr import Text.Megaparsec.Lexer (symbol,integer) parens = between (symbol "(") (symbol ")") expr = makeExprParser term table "expression" term = parens expr <|> integer "term" table = [ [ prefix "-" negate , prefix "+" id ] , [ postfix "++" (+1) ] , [ binary "*" (*) , binary "/" div ] , [ binary "+" (+) , binary "-" (-) ] ] binary name f = InfixL (reservedOp name >> return f) prefix name f = Prefix (reservedOp name >> return f) postfix name f = Postfix (reservedOp name >> return f) That still won't compile, because GHC does not know what reservedOp means. Does reservedOp refer to something that no longer exists, or have I just not found it? [1] https://hackage.haskell.org/package/megaparsec-4.4.0/docs/Text-Megaparsec-Expr.html -- Jeffrey Benjamin Brown -------------- next part -------------- An HTML attachment was scrubbed... URL: From will.yager at gmail.com Sat Feb 27 04:20:13 2016 From: will.yager at gmail.com (William Yager) Date: Fri, 26 Feb 2016 22:20:13 -0600 Subject: [Haskell-cafe] The 13-line example in Text.Megaparsec.Expr In-Reply-To: References: Message-ID: https://hackage.haskell.org/package/parsec-3.1.9/docs/Text-Parsec-Token.html#v:reservedOp ? --Will On Fri, Feb 26, 2016 at 10:08 PM, Jeffrey Brown wrote: > > That still won't compile, because GHC does not know what reservedOp means. > Does reservedOp refer to something that no longer exists, or have I just > not found it? > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From jeffbrown.the at gmail.com Sat Feb 27 06:05:31 2016 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Fri, 26 Feb 2016 22:05:31 -0800 Subject: [Haskell-cafe] The 13-line example in Text.Megaparsec.Expr In-Reply-To: References: Message-ID: Thanks, Will. I had tried that, and got a lot of errors like this: example.hs:20:26: Couldn't match type ?Char? with ?()? Expected type: [()] Actual type: [Char] In the first argument of ?symbol?, namely ?"("? In the first argument of ?between?, namely ?(symbol "(")? In the expression: between (symbol "(") (symbol ")") On Fri, Feb 26, 2016 at 8:20 PM, William Yager wrote: > > https://hackage.haskell.org/package/parsec-3.1.9/docs/Text-Parsec-Token.html#v:reservedOp > ? > > --Will > > On Fri, Feb 26, 2016 at 10:08 PM, Jeffrey Brown > wrote: > >> >> That still won't compile, because GHC does not know what reservedOp >> means. Does reservedOp refer to something that no longer exists, or have I >> just not found it? >> >> -- Jeffrey Benjamin Brown -------------- next part -------------- An HTML attachment was scrubbed... URL: From jeffbrown.the at gmail.com Sat Feb 27 06:10:29 2016 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Fri, 26 Feb 2016 22:10:29 -0800 Subject: [Haskell-cafe] The 13-line example in Text.Megaparsec.Expr In-Reply-To: References: Message-ID: In my previous email I perhaps should have also reported a second type of error: example.hs:26:21: Couldn't match expected type ?Text.Parsec.Token.GenTokenParser s0 u0 m0? with actual type ?[Char]? In the first argument of ?prefix?, namely ?"-"? In the expression: prefix "-" negate In the expression: [prefix "-" negate, prefix "+" id] On Fri, Feb 26, 2016 at 10:05 PM, Jeffrey Brown wrote: > Thanks, Will. I had tried that, and got a lot of errors like this: > > example.hs:20:26: > Couldn't match type ?Char? with ?()? > Expected type: [()] > Actual type: [Char] > In the first argument of ?symbol?, namely ?"("? > In the first argument of ?between?, namely ?(symbol "(")? > In the expression: between (symbol "(") (symbol ")") > > > On Fri, Feb 26, 2016 at 8:20 PM, William Yager > wrote: > >> >> https://hackage.haskell.org/package/parsec-3.1.9/docs/Text-Parsec-Token.html#v:reservedOp >> ? >> >> --Will >> >> On Fri, Feb 26, 2016 at 10:08 PM, Jeffrey Brown >> wrote: >> >>> >>> That still won't compile, because GHC does not know what reservedOp >>> means. Does reservedOp refer to something that no longer exists, or have I >>> just not found it? >>> >>> > > > -- > Jeffrey Benjamin Brown > -- Jeffrey Benjamin Brown -------------- next part -------------- An HTML attachment was scrubbed... URL: From ozgurakgun at gmail.com Sat Feb 27 17:04:27 2016 From: ozgurakgun at gmail.com (=?UTF-8?B?w5Z6Z8O8ciBBa2fDvG4=?=) Date: Sat, 27 Feb 2016 17:04:27 +0000 Subject: [Haskell-cafe] The 13-line example in Text.Megaparsec.Expr In-Reply-To: References: Message-ID: Hi. On 27 February 2016 at 04:20, William Yager wrote: > > https://hackage.haskell.org/package/parsec-3.1.9/docs/Text-Parsec-Token.html#v:reservedOp > ? > If I understand it correctly, Jeffrey is asking about using Megaparsec, and this link is to the parsec combinator with the same name. I am very surprised to find out that Megaparsec does not provide[*] the same combinator. Especially since they keep the same example! [*] At least it is not listed here: http://hackage.haskell.org/package/megaparsec-4.4.0/docs/doc-index-All.html -- ?zg?r Akg?n -------------- next part -------------- An HTML attachment was scrubbed... URL: From alpmestan at gmail.com Sun Feb 28 10:14:23 2016 From: alpmestan at gmail.com (Alp Mestanogullari) Date: Sun, 28 Feb 2016 11:14:23 +0100 Subject: [Haskell-cafe] [ANN] sparkle: native Apache Spark applications in Haskell In-Reply-To: References: Message-ID: Hello Lyndon, Glad to hear this is of interest to you. Let us know if you have any kind of feedback -- just keep in mind we only cover a ridiculous fraction of the Spark API at the moment, but this can easily be expanded. The implementation of the Spark classes/methods that we have can be a guide for implementing ones that are not there yet. Regarding data frames, well, as a haskeller, Spark's data frame impl feels a bit unsafe to me as the type (which is just 'DataFrame') doesn't indicate how many columns there are or what type the values stored in those columns have. But Spark provides a bunch of algorithms that use those data frames so if you happen to need one of those algorithms, you can quickly expose it to Haskell and then wrap it all in a type-safe and haskell-y way once you've made sure everything works. This all means that, at the moment, sparkle doesn't do anything smart there. If you have any idea/suggestion, we're all ears though! On Fri, Feb 26, 2016 at 12:56 AM, Lyndon Maydwell wrote: > Hi Alp, > > > Just wanted to say that there's interest here in Melbourne in > Spark+Haskell too and we'll definitely be trying this out to see what it's > like. > > One of the problems that some of the more exotic language-bindings to > spark have is that while they include RDD support, they lack a > language-idiomatic interpretation of DataFrames. Does Sparkle attempt to > tackle this? > > > Many thanks to Tweag I/O for doing this. It must have been a lot of work! > > > Regards, > > - Lyndon > > On Fri, Feb 26, 2016 at 4:50 AM, Alp Mestanogullari > wrote: > >> Hello -cafe! >> >> Recently at Tweag I/O we've been working on sparkle, a library for >> writing (distributed) Apache Spark applications directly in Haskell! >> >> We have published a blog post introducing the project (and some of its >> challenges) here: >> http://www.tweag.io/blog/haskell-meets-large-scale-distributed-analytics >> >> The corresponding repository lives at https://github.com/tweag/sparkle >> >> While this is still early stage work, we can already write non-trivial >> Spark applications in Haskell and have them run accross an entire cluster. >> We obviously do not cover the whole Spark API yet (very, very far from >> that) but would be glad to already get some feedback. >> >> Cheers >> >> -- >> Alp Mestanogullari >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> > -- Alp Mestanogullari -------------- next part -------------- An HTML attachment was scrubbed... URL: From vogt.adam at gmail.com Sun Feb 28 14:38:26 2016 From: vogt.adam at gmail.com (adam vogt) Date: Sun, 28 Feb 2016 09:38:26 -0500 Subject: [Haskell-cafe] Playing with OverloadedLabels in GHC 8 RC2, how to do this? In-Reply-To: References: <79ca24dd-c2ea-4759-be0d-cdf844e972b7@googlegroups.com> <56CC235E.8010000@well-typed.com> Message-ID: Hi Daniel, One way to get around your problem is to make a list of all paths through the given records, then filter that list to contain only the fields that match with the last label and result type: https://gist.github.com/aavogt/c206c45362ed2115f392 I'm not sure that "filtering by result type" is a good idea, at least at this point, because it doesn't work well when you have type variables in the record or result type. Part of the problem seems to be that Data.Type.Equality.== gets stuck when it sees type variables: I think what is really needed in that case is a way to ask if (a ~ b) would be a type error. Regards, Adam On Wed, Feb 24, 2016 at 7:12 PM, Daniel D?az wrote: > I wonder if is there is some way of making the labels "transitive". For > example, if I have a record embedded in another record, it would be nice if > the labels of the embedded record worked for the enclosing record as well, > assuming there's no ambiguity. > > Here's an attempt. Consider this "strengthened" version of IsLabel that > uses functional dependencies. Only certain fields will be able to have > instances: > > class IsLabel symbol (a -> b) => IsUnambiguousLabel symbol a b | symbol -> > a b, a b -> symbol, symbol a -> b, symbol b -> a > > > and then this > > instance (IsUnambiguousLabel symbol1 a b, IsUnambiguousLabel symbol2 b c) > => IsLabel symbol2 (a -> c) where > fromLabel _ = fromLabel (proxy# :: (Proxy# symbol2)) . fromLabel > (proxy# :: (Proxy# symbol1)) > > > But it doesn't work. GHC complains angrily about overlapping instances. > > On Tuesday, February 23, 2016 at 10:16:21 AM UTC+1, Adam Gundry wrote: >> >> Hi, >> >> The type of `fromLabel` is >> >> forall (x :: Symbol) a . IsLabel x a => Proxy# x -> a >> >> where `x` represents the text of the label, so rather than applying it to >> >> (proxy# :: (Proxy# (Person -> String))) >> >> you need to apply it to >> >> (proxy# :: Proxy# symbol) >> >> and you will need to turn on the ScopedTypeVariables extension (so that >> `symbol` refers to the variable bound in the class instance). With that >> change, your program works. >> >> That's a truly atrocious error message though. It's marginally better if >> you enable -fprint-explicit-kinds: >> >> ? Expected kind ?Proxy# GHC.Types.Symbol ((->) Person String)?, >> but ?proxy# :: Proxy# (Person -> String)? has kind >> ?Proxy# * (Person -> String)? >> >> This shows the real problem, namely that you have `Proxy# *` instead of >> `Proxy# Symbol`. However, `Proxy# Symbol ((->) Person String)` is >> blatantly ill-kinded, so the error message doesn't make much sense. I >> suggest you file a GHC ticket, if there isn't a suitable one already. >> >> Hope this helps, >> >> Adam >> >> >> On 23/02/16 08:29, Daniel D?az wrote: >> > Hi all, >> > >> > I'm playing with the OverloadedLabels extension in GHC 8 RC2. I have >> > been able to define simple record accessors, like in this >> > gist: https://gist.github.com/danidiaz/3b9a6865686c777f328c >> > >> > After realizing than with OverloadedLabels a single symbol can be used >> > to extract two different types from the same record, I tried to define >> > an instance that says: "if a symbol can be used to extract an string >> > from my record, then it can also be used to extract that a Text value". >> > >> > Here's my attempt (using a dummy Text type): >> > >> > {-# LANGUAGE OverloadedLabels #-} >> > {-# LANGUAGE DataKinds #-} >> > {-# LANGUAGE FlexibleInstances #-} >> > {-# LANGUAGE FlexibleContexts #-} >> > {-# LANGUAGE UndecidableInstances #-} >> > {-# LANGUAGE MultiParamTypeClasses #-} >> > {-# LANGUAGE MagicHash #-} >> > module Main where >> > >> > import GHC.OverloadedLabels >> > import GHC.Prim >> > >> > newtype Text = Text { getText :: String } deriving Show >> > >> > data Person = Person { _id :: Int , _name :: String } >> > >> > instance IsLabel "name" (Person -> String) where >> > fromLabel _ = _name >> > >> > instance IsLabel symbol (Person -> String) => IsLabel symbol >> (Person >> > -> Text) where >> > fromLabel _ = Text . fromLabel (proxy# :: (Proxy# (Person -> >> > String))) >> > >> > person :: Person >> > person = Person 123 "Horace" >> > >> > main :: IO () >> > main = do >> > print (#name person :: String) >> > print (#name person :: Text) >> > >> > >> > Bu this doesn't work. The error I get is puzzling: >> > >> > ? Expected kind ?Proxy# ((->) Person String)?, >> > but ?proxy# :: Proxy# (Person -> String)? has kind ?Proxy# >> > (Person -> String)? >> > ? In the first argument of ?fromLabel?, namely >> > ?(proxy# :: Proxy# (Person -> String))? >> > >> > >> > Is this a bug? What is going on here? >> >> >> -- >> Adam Gundry, Haskell Consultant >> Well-Typed LLP, http://www.well-typed.com/ >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskel... at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From wojtek at power.com.pl Sun Feb 28 17:22:05 2016 From: wojtek at power.com.pl (=?UTF-8?Q?Wojtek_Narczy=c5=84ski?=) Date: Sun, 28 Feb 2016 18:22:05 +0100 Subject: [Haskell-cafe] Compile times and separate compilation In-Reply-To: <56CB7D2C.7010409@htwk-leipzig.de> References: <56CB7D2C.7010409@htwk-leipzig.de> Message-ID: <56D32CBD.9030802@power.com.pl> On 22.02.2016 22:27, Johannes Waldmann wrote: >> I presume you are using the -j switch. > Does it really help? I recently found that for travis builds, > it is used by default (first surprise) > but it's faster when it's turned off (second surprise). > > https://ghc.haskell.org/trac/ghc/ticket/10818#comment:15 > > I meant ghc -j, not cabal -j. It does work very well. I did the following test. wojtek at Desktop2016:~/src/tpdb-1.2.0/src$ time ghc -j -fforce-recomp TPDB/*.hs TPDB/XTC/*.hs TPDB/DP/*.hs TPDB/CPF/Proof/*.hs TPDB/Data/*.hs TPDB/Plain/*.hs TPDB/Xml/*.hs [24 of 24] Compiling TPDB.Mirror ( TPDB/Mirror.hs, TPDB/Mirror.o ) real 0m1.221s user 0m2.416s sys 0m0.604s wojtek at Desktop2016:~/src/tpdb-1.2.0/src$ time ghc -fforce-recomp TPDB/*.hs TPDB/XTC/*.hs TPDB/DP/*.hs TPDB/CPF/Proof/*.hs TPDB/Data/*.hs TPDB/Plain/*.hs TPDB/Xml/*.hs [24 of 24] Compiling TPDB.Mirror ( TPDB/Mirror.hs, TPDB/Mirror.o ) real 0m1.791s user 0m1.660s sys 0m0.060s wojtek at Desktop2016:~/src/tpdb-1.2.0$ time cabal build -j [24 of 24] Compiling TPDB.CPF.Proof.Util ( src/TPDB/CPF/Proof/Util.hs, dist/build/TPDB/CPF/Proof/Util.o ) real 0m5.544s user 0m10.912s sys 0m2.628s Something is indeed wrong, either cabal is misusing ghc, or you are misusing cabal. This package is not a good test case for parallel build, it is too small. -- Wojtek From aditya.siram at gmail.com Sun Feb 28 19:19:06 2016 From: aditya.siram at gmail.com (aditya siram) Date: Sun, 28 Feb 2016 13:19:06 -0600 Subject: [Haskell-cafe] FLTKHS - GHCi help Message-ID: Hi all, I am the author of FLTKHS (http://github.com/deech/fltkhs) which aims to make it easy to install, write and deploy a native GUI application in pure Haskell. It is already able to build static executables on Linux, *BSD and OSX (Yosemite & El Capitan). However a smooth GHCi experience across platforms is still lacking due to some outstanding issues that I am unable to figure it out. I have written up the issues in the documentation [1]. I could use some help specifically with running a REPL with a C++ shared library in GHC 7.10.3. It works fine in 7.8.4. This is documented in the section titiled "GHCi (Linux, *BSD & OSX Yosemite)" in the link below. There is also a mysterious GHCi error on Windows that I can't seem to figure out. It is documented in "GHCi (Windows only)" section. Any help or pointers are appreciated. Thanks! -deech [1] http://hackage.haskell.org/package/fltkhs/docs/Graphics-UI-FLTK-LowLevel-FLTKHS.html#g:3 -------------- next part -------------- An HTML attachment was scrubbed... URL: From benno.fuenfstueck at gmail.com Sun Feb 28 20:25:40 2016 From: benno.fuenfstueck at gmail.com (=?UTF-8?B?QmVubm8gRsO8bmZzdMO8Y2s=?=) Date: Sun, 28 Feb 2016 20:25:40 +0000 Subject: [Haskell-cafe] Compile times and separate compilation In-Reply-To: <56D32CBD.9030802@power.com.pl> References: <56CB7D2C.7010409@htwk-leipzig.de> <56D32CBD.9030802@power.com.pl> Message-ID: I think there's a problem with the number of cores that they report: the vms/containers report 16 cores, while they only have 2. Perhaps -j2 would work better? Wojtek Narczy?ski schrieb am So., 28. Feb. 2016 18:22: > On 22.02.2016 22:27, Johannes Waldmann wrote: > >> I presume you are using the -j switch. > > Does it really help? I recently found that for travis builds, > > it is used by default (first surprise) > > but it's faster when it's turned off (second surprise). > > > > https://ghc.haskell.org/trac/ghc/ticket/10818#comment:15 > > > > > > I meant ghc -j, not cabal -j. It does work very well. > > I did the following test. > > wojtek at Desktop2016:~/src/tpdb-1.2.0/src$ time ghc -j -fforce-recomp > TPDB/*.hs TPDB/XTC/*.hs TPDB/DP/*.hs TPDB/CPF/Proof/*.hs TPDB/Data/*.hs > TPDB/Plain/*.hs TPDB/Xml/*.hs > [24 of 24] Compiling TPDB.Mirror ( TPDB/Mirror.hs, TPDB/Mirror.o ) > real 0m1.221s > user 0m2.416s > sys 0m0.604s > > wojtek at Desktop2016:~/src/tpdb-1.2.0/src$ time ghc -fforce-recomp > TPDB/*.hs TPDB/XTC/*.hs TPDB/DP/*.hs TPDB/CPF/Proof/*.hs TPDB/Data/*.hs > TPDB/Plain/*.hs TPDB/Xml/*.hs > [24 of 24] Compiling TPDB.Mirror ( TPDB/Mirror.hs, TPDB/Mirror.o ) > real 0m1.791s > user 0m1.660s > sys 0m0.060s > > wojtek at Desktop2016:~/src/tpdb-1.2.0$ time cabal build -j > [24 of 24] Compiling TPDB.CPF.Proof.Util ( src/TPDB/CPF/Proof/Util.hs, > dist/build/TPDB/CPF/Proof/Util.o ) > real 0m5.544s > user 0m10.912s > sys 0m2.628s > > Something is indeed wrong, either cabal is misusing ghc, or you are > misusing cabal. > > This package is not a good test case for parallel build, it is too small. > > -- > Wojtek > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From kfollesdal at gmail.com Sun Feb 28 21:00:42 2016 From: kfollesdal at gmail.com (=?utf-8?Q?Kristoffer_F=C3=B8llesdal?=) Date: Sun, 28 Feb 2016 22:00:42 +0100 Subject: [Haskell-cafe] Functional dependencies and overloading of operation Message-ID: <84F1908D-05B0-4EAE-9CB7-50847BD65344@gmail.com> I am trying to use Functional dependencies to overload a operation on Vector space and its basis (Use the Vector spaces module Math.Algebras.VectorSpace ). I have tried to mimic the example for matrices and vectors from https://wiki.haskell.org/Functional_dependencies . I have tried different ways of defining classes and instances, but I do not get it to work. What I want is to have the ?same? function for these cases: operation :: a -> a -> Vect k a operation :: a -> Vect k a -> Vect k a operation :: Vect k a -> a -> Vect k a operation :: Vect k a -> Vect k a -> Vect k a Her are som sample code to illustrate what I want. Do anybody have an idea to how to solve it? {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} import Math.Algebras.VectorSpace linearExtension :: (Eq k, Num k, Ord a) => (a -> a -> Vect k a) -> Vect k a -> Vect k a -> Vect k a linearExtension f xs ys = linear (\x -> linear (f x) ys) xs data Tree t = Root t [Tree t] deriving(Eq, Show, Ord) op :: (Eq k, Num k, Ord t) => Tree t -> Tree t -> Vect k (Tree t) op x y = return x <+> return y opA :: (Eq k, Num k, Ord t) => Vect k (Tree t) -> Vect k (Tree t) -> Vect k (Tree t) opA = linearExtension op class Operation a b c | a b -> c where (<.>) :: a -> b -> c instance (Ord t) => Operation (Tree t) (Tree t) (Vect k (Tree t)) where (<.>)= op instance (Ord t) => Operation (Vect k (Tree t)) (Vect k (Tree t)) (Vect k (Tree t)) where (<.>) = opA instance (Ord t) => Operation (Tree t) (Vect k (Tree t)) (Vect k (Tree t)) where (<.>) x = opA (return x) instance (Ord t) => Operation (Vect k (Tree t)) (Tree t) (Vect k (Tree t)) where (<.>) x y = opA x (return y) -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sun Feb 28 21:11:20 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sun, 28 Feb 2016 21:11:20 +0000 Subject: [Haskell-cafe] Functional dependencies and overloading of operation In-Reply-To: <84F1908D-05B0-4EAE-9CB7-50847BD65344@gmail.com> References: <84F1908D-05B0-4EAE-9CB7-50847BD65344@gmail.com> Message-ID: <20160228211120.GB23479@weber> On Sun, Feb 28, 2016 at 10:00:42PM +0100, Kristoffer F?llesdal wrote: > I am trying to use Functional dependencies to overload a operation on > Vector space and its basis [...] > operation :: a -> a -> Vect k a > operation :: a -> Vect k a -> Vect k a > operation :: Vect k a -> a -> Vect k a > operation :: Vect k a -> Vect k a -> Vect k a This is unlikely to be a good idea in practice. Is there a good reason you can't use four different names for these operations? From hjgtuyl at chello.nl Sun Feb 28 21:22:42 2016 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Sun, 28 Feb 2016 22:22:42 +0100 Subject: [Haskell-cafe] FLTKHS - GHCi help In-Reply-To: References: Message-ID: On Sun, 28 Feb 2016 20:19:06 +0100, aditya siram wrote: : > There is also a mysterious GHCi error on Windows that I can't seem to > figure out. It is documented in "GHCi (Windows only)" section. : This is something I encountered when trying to get wxHaskell to run. You need UUID.dll (in you application directory); there were other DLLs that I needed as well, they are mentioned at the WxHaskell/Windows page[0]. The page also describes where to find the DLLs. Another way to get the DLLs, is to download one of the wxInstall packages from SourceForge[1]; the DLLs are in the directory "DLLs" (you can safely delete wxc.dll). The wxInstall-Achelanne packages are for GCC 5.2.0, which is installed when you install GHC 7.10.3, the wxInstall-Abriline packages are for earlier GCCs/GHCs. The bitness is important for libstdc++-6.dll Regards, Henk-Jan van Tuyl [0] https://wiki.haskell.org/WxHaskell/Windows#DLLs [1] https://sourceforge.net/projects/wxhaskell/files/wxInstall/ -- 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://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From jake.waksbaum at gmail.com Sun Feb 28 21:40:06 2016 From: jake.waksbaum at gmail.com (Jake) Date: Sun, 28 Feb 2016 21:40:06 +0000 Subject: [Haskell-cafe] Infer Nat type from Integer argument Message-ID: {-# LANGUAGE DataKinds, KindSignatures, ScopedTypeVariables, GADTs, AllowAmbiguousTypes #-} import GHC.TypeLits import Data.Proxy import Data.Type.Equality data NatString (n :: Nat) = NatString String deriving Show showNS :: KnownNat n => NatString n -> (String, Integer) showNS b@(NatString s) = (s, natVal b) In this example, we use NatString like this: > showNS (NatString "hey" :: NatString 4) -- ("hey", 4) We can then dynamically make NatStrings from Integers. For example, we can read an Integer from stdin and use it to create a NatString main :: IO () main = do i <- readLn case someNatVal i of Just (SomeNat (p :: Proxy n)) -> let ns :: NatString n ns = NatString "hello!" in print $ showNS NatString However, if I have trouble when I try to refactor out the middle part to create a function with type forall n. KnownNat n => Integer -> Bar n. I use sameNat to convince the compiler that the Nat we get from the Integer is the same type as the the type n of the output. fromN :: forall n. KnownNat n => Integer -> NatString n fromN i = case someNatVal i of Just (SomeNat p) -> case sameNat p (Proxy :: Proxy n) of Just (Refl) -> let ns :: NatString n ns = NatString "hello!" in ns This compiles, but if you try and use it the compiler complains. > showNS (fromN 3) -- No instance for (KnownNat n0) arising from a use of ?showNS? If we manually add the type annotation, everything is fine, but that kind of defeats the entire purpose. > showNS (fromN 3 :: NatString 3) -- ("hello!",3) Strangely enough, when the NatString is immediately consumed instead of being returned, the compiler does its job and infers the correct type. showFromN :: Integer -> (String, Integer) showFromN i = case someNatVal i of Just (SomeNat (p :: Proxy n)) -> let ns :: NatString n ns = NatString "hello!" in showNS ns > showFromN 3 -- ("hello!", 3) Clearly the intermediate value of ns inside of showFromN has a type NatString 3 because showNS is using that fact. How can I make the compiler infer that fromN 3 :: NatString 3 separately? -------------- next part -------------- An HTML attachment was scrubbed... URL: From jake.waksbaum at gmail.com Sun Feb 28 21:42:23 2016 From: jake.waksbaum at gmail.com (Jake) Date: Sun, 28 Feb 2016 21:42:23 +0000 Subject: [Haskell-cafe] Infer Nat type from Integer argument In-Reply-To: References: Message-ID: Sorry I left out some important information. I'm trying to understand how to write a function that takes an Integer and produces a value with a Nat corresponding to that Integer, such that the compiler can infer the type. The whole example based on http://www.howtobuildsoftware.com/index.php/how-do/hUF/haskell-dependent-type-can-i-have-an-unknown-knownnat : On Sun, Feb 28, 2016 at 4:40 PM Jake wrote: > {-# LANGUAGE DataKinds, KindSignatures, ScopedTypeVariables, GADTs, > AllowAmbiguousTypes #-} > > import GHC.TypeLits > import Data.Proxy > import Data.Type.Equality > > data NatString (n :: Nat) = NatString String deriving Show > > showNS :: KnownNat n => NatString n -> (String, Integer) > showNS b@(NatString s) = (s, natVal b) > > In this example, we use NatString like this: > > > showNS (NatString "hey" :: NatString 4) > -- ("hey", 4) > > We can then dynamically make NatStrings from Integers. For example, we can > read an Integer from stdin and use it to create a NatString > > main :: IO () > main = do > i <- readLn > case someNatVal i of > Just (SomeNat (p :: Proxy n)) -> > let ns :: NatString n > ns = NatString "hello!" > in print $ showNS NatString > > However, if I have trouble when I try to refactor out the middle part to > create a function with type forall n. KnownNat n => Integer -> Bar n. > I use sameNat to convince the compiler that the Nat we get from the > Integer is the same type as the the type n of the output. > > fromN :: forall n. KnownNat n => Integer -> NatString n > fromN i = > case someNatVal i of > Just (SomeNat p) -> > case sameNat p (Proxy :: Proxy n) of > Just (Refl) -> > let ns :: NatString n > ns = NatString "hello!" in ns > > This compiles, but if you try and use it the compiler complains. > > > showNS (fromN 3) > -- No instance for (KnownNat n0) arising from a use of ?showNS? > > If we manually add the type annotation, everything is fine, but that kind > of defeats the entire purpose. > > > showNS (fromN 3 :: NatString 3) > -- ("hello!",3) > > Strangely enough, when the NatString is immediately consumed instead of > being returned, the compiler does its job and infers the correct type. > > showFromN :: Integer -> (String, Integer) > showFromN i = > case someNatVal i of > Just (SomeNat (p :: Proxy n)) -> > let ns :: NatString n > ns = NatString "hello!" in showNS ns > > > showFromN 3 > -- ("hello!", 3) > > Clearly the intermediate value of ns inside of showFromN has a type > NatString 3 because showNS is using that fact. > How can I make the compiler infer that fromN 3 :: NatString 3 separately? > -------------- next part -------------- An HTML attachment was scrubbed... URL: From vogt.adam at gmail.com Sun Feb 28 22:42:33 2016 From: vogt.adam at gmail.com (adam vogt) Date: Sun, 28 Feb 2016 17:42:33 -0500 Subject: [Haskell-cafe] Infer Nat type from Integer argument In-Reply-To: References: Message-ID: Hi Jake, I think your problem is that the type signature for fromN lets the caller of fromN decide what n should be, when it has to be the other way around. Two ways to express that are: 1. make `fromN :: Integer -> SomeNatString`, making use of GADTs/ ExistentialQuantification (in the same way that SomeNat does): data SomeNatString where SomeNatString :: KnownNat n => NatString n -> SomeNatString 2. use RankNTypes to express the same thing without adding a constructor, but at the cost of needing to write a type signature and continuation passing style code: fromN :: Integer -> (forall n. KnownNat n => Proxy n -> r) -> r fromN i f = case someNatVal i of Just n -> f n Regards, Adam On Sun, Feb 28, 2016 at 4:40 PM, Jake wrote: > {-# LANGUAGE DataKinds, KindSignatures, ScopedTypeVariables, GADTs, > AllowAmbiguousTypes #-} > > import GHC.TypeLits > import Data.Proxy > import Data.Type.Equality > > data NatString (n :: Nat) = NatString String deriving Show > > showNS :: KnownNat n => NatString n -> (String, Integer) > showNS b@(NatString s) = (s, natVal b) > > In this example, we use NatString like this: > > > showNS (NatString "hey" :: NatString 4) > -- ("hey", 4) > > We can then dynamically make NatStrings from Integers. For example, we can > read an Integer from stdin and use it to create a NatString > > main :: IO () > main = do > i <- readLn > case someNatVal i of > Just (SomeNat (p :: Proxy n)) -> > let ns :: NatString n > ns = NatString "hello!" > in print $ showNS NatString > > However, if I have trouble when I try to refactor out the middle part to > create a function with type forall n. KnownNat n => Integer -> Bar n. > I use sameNat to convince the compiler that the Nat we get from the > Integer is the same type as the the type n of the output. > > fromN :: forall n. KnownNat n => Integer -> NatString n > fromN i = > case someNatVal i of > Just (SomeNat p) -> > case sameNat p (Proxy :: Proxy n) of > Just (Refl) -> > let ns :: NatString n > ns = NatString "hello!" in ns > > This compiles, but if you try and use it the compiler complains. > > > showNS (fromN 3) > -- No instance for (KnownNat n0) arising from a use of ?showNS? > > If we manually add the type annotation, everything is fine, but that kind > of defeats the entire purpose. > > > showNS (fromN 3 :: NatString 3) > -- ("hello!",3) > > Strangely enough, when the NatString is immediately consumed instead of > being returned, the compiler does its job and infers the correct type. > > showFromN :: Integer -> (String, Integer) > showFromN i = > case someNatVal i of > Just (SomeNat (p :: Proxy n)) -> > let ns :: NatString n > ns = NatString "hello!" in showNS ns > > > showFromN 3 > -- ("hello!", 3) > > Clearly the intermediate value of ns inside of showFromN has a type > NatString 3 because showNS is using that fact. > How can I make the compiler infer that fromN 3 :: NatString 3 separately? > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From yoyoyonny at gmail.com Sun Feb 28 23:20:24 2016 From: yoyoyonny at gmail.com (Jonne Ransijn) Date: Mon, 29 Feb 2016 00:20:24 +0100 Subject: [Haskell-cafe] Question: Do block precedence Message-ID: Dear Haskell-Cafe mailing list people (?) I've been writing parenthesis around do blocks since forever now, but I don't get why they are necessary. I can't seem to come up with a program where they are necessary. Am I missing something or are parenthesis around do blocks nececairy for no reason? Since parsing 'do' blocks as if they have parenthesis around them doesn't seem to break any code, why not do so? when (doBlocksNeedParenthesis) do putStrLn "This code is invalid." when (doBlocksNeedParenthesis) $ do putStrLn "This code is valid." when (doBlocksHaveInvisibleParenthesis) do putStrLn "These are equal v" when (doBlocksHaveInvisibleParenthesis) (do putStrLn "These are equal ^") -------------- next part -------------- An HTML attachment was scrubbed... URL: From parsonsmatt at gmail.com Sun Feb 28 23:33:53 2016 From: parsonsmatt at gmail.com (Matt) Date: Sun, 28 Feb 2016 18:33:53 -0500 Subject: [Haskell-cafe] Question: Do block precedence In-Reply-To: References: Message-ID: This has come up before as 'ArgumentDo': mailing list thread: Proposal: ArgumentDo Relevant Phabricator ticket Reddit discussion Some people like it, though enough don't that the extension was abandoned. Matt Parsons On Sun, Feb 28, 2016 at 6:20 PM, Jonne Ransijn wrote: > Dear Haskell-Cafe mailing list people (?) > I've been writing parenthesis around do blocks since forever now, but I > don't get why they are necessary. I can't seem to come up with a program > where they are necessary. Am I missing something or are parenthesis around > do blocks nececairy for no reason? Since parsing 'do' blocks as if they > have parenthesis around them doesn't seem to break any code, why not do so? > > when (doBlocksNeedParenthesis) do putStrLn "This code is invalid." > > when (doBlocksNeedParenthesis) $ do putStrLn "This code is valid." > > when (doBlocksHaveInvisibleParenthesis) do putStrLn "These are equal v" > > when (doBlocksHaveInvisibleParenthesis) (do putStrLn "These are equal > ^") > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Sun Feb 28 23:37:30 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Sun, 28 Feb 2016 23:37:30 +0000 Subject: [Haskell-cafe] Question: Do block precedence In-Reply-To: References: Message-ID: <20160228233730.GD23479@weber> On Sun, Feb 28, 2016 at 06:33:53PM -0500, Matt wrote: > This has come up before as 'ArgumentDo': > > > mailing list thread: Proposal: ArgumentDo > > Relevant Phabricator ticket > Reddit discussion > > > Some people like it, though enough don't that the extension was abandoned. I don't particularly like it, and I don't think I would use it, but what's the argument against it being admitted as an extension? There are far more hairy extensions in GHC already. Tom From ttuegel at gmail.com Mon Feb 29 00:22:37 2016 From: ttuegel at gmail.com (Thomas Tuegel) Date: Sun, 28 Feb 2016 18:22:37 -0600 Subject: [Haskell-cafe] Question: Do block precedence In-Reply-To: References: Message-ID: On Sun, Feb 28, 2016 at 5:20 PM, Jonne Ransijn wrote: > Dear Haskell-Cafe mailing list people (?) > I've been writing parenthesis around do blocks since forever now, but I > don't get why they are necessary. I can't seem to come up with a program > where they are necessary. Am I missing something or are parenthesis around > do blocks nececairy for no reason? Since parsing 'do' blocks as if they have > parenthesis around them doesn't seem to break any code, why not do so? > > when (doBlocksNeedParenthesis) do putStrLn "This code is invalid." > > when (doBlocksNeedParenthesis) $ do putStrLn "This code is valid." > > when (doBlocksHaveInvisibleParenthesis) do putStrLn "These are equal v" > > when (doBlocksHaveInvisibleParenthesis) (do putStrLn "These are equal > ^") This syntax can be ambiguous; consider: > (flip when) do putStrLn "Where do the parentheses go?" True I admit this is contrived; we could choose to put parentheses around a do-block only if it is the terminal argument. There is a case that is completely unambiguous: > (flip when) do { putStrLn "Braces might as well be parentheses." } True Certainly, I don't see why this shouldn't parse. Regards, Tom From yoyoyonny at gmail.com Mon Feb 29 00:27:54 2016 From: yoyoyonny at gmail.com (Jonne Ransijn) Date: Mon, 29 Feb 2016 01:27:54 +0100 Subject: [Haskell-cafe] Question: Do block precedence In-Reply-To: References: Message-ID: I would imagine > (flip when) do putStrLn "Where do the parentheses go?" True should be parsed as > (flip when) (do { putStrLn "Where do the parentheses go?"; True; }) -------------- next part -------------- An HTML attachment was scrubbed... URL: From yoyoyonny at gmail.com Mon Feb 29 00:50:29 2016 From: yoyoyonny at gmail.com (Jonne Ransijn) Date: Mon, 29 Feb 2016 01:50:29 +0100 Subject: [Haskell-cafe] Question: Do block precedence In-Reply-To: References: Message-ID: Possible future suggestion: Add a `InlineStatements` language pragma which puts implicit parenthesis around `if-then-else`, `case-of` and `do` blocks, See: http://pastebin.com/T7L6GyBu (Permanent pastebin) for a example program. On Mon, Feb 29, 2016 at 1:22 AM, Thomas Tuegel wrote: > On Sun, Feb 28, 2016 at 5:20 PM, Jonne Ransijn > wrote: > > Dear Haskell-Cafe mailing list people (?) > > I've been writing parenthesis around do blocks since forever now, but I > > don't get why they are necessary. I can't seem to come up with a program > > where they are necessary. Am I missing something or are parenthesis > around > > do blocks nececairy for no reason? Since parsing 'do' blocks as if they > have > > parenthesis around them doesn't seem to break any code, why not do so? > > > > when (doBlocksNeedParenthesis) do putStrLn "This code is invalid." > > > > when (doBlocksNeedParenthesis) $ do putStrLn "This code is valid." > > > > when (doBlocksHaveInvisibleParenthesis) do putStrLn "These are equal > v" > > > > when (doBlocksHaveInvisibleParenthesis) (do putStrLn "These are equal > > ^") > > This syntax can be ambiguous; consider: > > > (flip when) do putStrLn "Where do the parentheses go?" True > > I admit this is contrived; we could choose to put parentheses around a > do-block only if it is the terminal argument. There is a case that is > completely unambiguous: > > > (flip when) do { putStrLn "Braces might as well be parentheses." } True > > Certainly, I don't see why this shouldn't parse. > > Regards, > Tom > -------------- next part -------------- An HTML attachment was scrubbed... URL: From jake.waksbaum at gmail.com Mon Feb 29 01:42:04 2016 From: jake.waksbaum at gmail.com (Jake) Date: Mon, 29 Feb 2016 01:42:04 +0000 Subject: [Haskell-cafe] Infer Nat type from Integer argument In-Reply-To: References: Message-ID: Thanks for the help! So In both solutions, the goal is to "hide" the n so that the caller doesn't determine it, right? I think I understand why that's necessary: because given a function with type signature fromN :: forall n. KnownNat n => Integer -> NatString n it looks like n is free to be determined, even though n will/should be decided based on the Integer argument. Is there any way to signal that to the compiler without the extra overhead? On Sun, Feb 28, 2016 at 5:42 PM adam vogt wrote: > Hi Jake, > > I think your problem is that the type signature for fromN lets the caller > of fromN decide what n should be, when it has to be the other way around. > Two ways to express that are: > > 1. make `fromN :: Integer -> SomeNatString`, making use of GADTs/ > ExistentialQuantification (in the same way that SomeNat does): > > data SomeNatString where > SomeNatString :: KnownNat n => NatString n -> SomeNatString > > 2. use RankNTypes to express the same thing without adding a constructor, > but at the cost of needing to write a type signature and continuation > passing style code: > > fromN :: Integer -> (forall n. KnownNat n => Proxy n -> r) -> r > fromN i f = case someNatVal i of Just n -> f n > > Regards, > Adam > > On Sun, Feb 28, 2016 at 4:40 PM, Jake wrote: > >> {-# LANGUAGE DataKinds, KindSignatures, ScopedTypeVariables, GADTs, >> AllowAmbiguousTypes #-} >> >> import GHC.TypeLits >> import Data.Proxy >> import Data.Type.Equality >> >> data NatString (n :: Nat) = NatString String deriving Show >> >> showNS :: KnownNat n => NatString n -> (String, Integer) >> showNS b@(NatString s) = (s, natVal b) >> >> In this example, we use NatString like this: >> >> > showNS (NatString "hey" :: NatString 4) >> -- ("hey", 4) >> >> We can then dynamically make NatStrings from Integers. For example, we >> can read an Integer from stdin and use it to create a NatString >> >> main :: IO () >> main = do >> i <- readLn >> case someNatVal i of >> Just (SomeNat (p :: Proxy n)) -> >> let ns :: NatString n >> ns = NatString "hello!" >> in print $ showNS NatString >> >> However, if I have trouble when I try to refactor out the middle part to >> create a function with type forall n. KnownNat n => Integer -> Bar n. >> I use sameNat to convince the compiler that the Nat we get from the >> Integer is the same type as the the type n of the output. >> >> fromN :: forall n. KnownNat n => Integer -> NatString n >> fromN i = >> case someNatVal i of >> Just (SomeNat p) -> >> case sameNat p (Proxy :: Proxy n) of >> Just (Refl) -> >> let ns :: NatString n >> ns = NatString "hello!" in ns >> >> This compiles, but if you try and use it the compiler complains. >> >> > showNS (fromN 3) >> -- No instance for (KnownNat n0) arising from a use of ?showNS? >> >> If we manually add the type annotation, everything is fine, but that kind >> of defeats the entire purpose. >> >> > showNS (fromN 3 :: NatString 3) >> -- ("hello!",3) >> >> Strangely enough, when the NatString is immediately consumed instead of >> being returned, the compiler does its job and infers the correct type. >> >> showFromN :: Integer -> (String, Integer) >> showFromN i = >> case someNatVal i of >> Just (SomeNat (p :: Proxy n)) -> >> let ns :: NatString n >> ns = NatString "hello!" in showNS ns >> >> > showFromN 3 >> -- ("hello!", 3) >> >> Clearly the intermediate value of ns inside of showFromN has a type >> NatString 3 because showNS is using that fact. >> How can I make the compiler infer that fromN 3 :: NatString 3 separately? >> >> _______________________________________________ >> Haskell-Cafe mailing list >> Haskell-Cafe at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From kfollesdal at gmail.com Mon Feb 29 08:08:01 2016 From: kfollesdal at gmail.com (=?utf-8?Q?Kristoffer_F=C3=B8llesdal?=) Date: Mon, 29 Feb 2016 09:08:01 +0100 Subject: [Haskell-cafe] Functional dependencies and overloading of operation In-Reply-To: References: Message-ID: <67AAC7E7-9D1D-44AB-AB75-1D96FA061242@gmail.com> Internally in programs I will use the specific functions for each case. But I want some ?syntactic sugar? for this functions when doing direct calculations in for example ghci. It will be more user friendly for direct interaction not to have four different functions that in practice do the same thing. Kristoffer > Date: Sun, 28 Feb 2016 21:11:20 +0000 > From: Tom Ellis > > To: haskell-cafe at haskell.org > Subject: Re: [Haskell-cafe] Functional dependencies and overloading of > operation > Message-ID: <20160228211120.GB23479 at weber> > Content-Type: text/plain; charset=iso-8859-1 > > On Sun, Feb 28, 2016 at 10:00:42PM +0100, Kristoffer F?llesdal wrote: >> I am trying to use Functional dependencies to overload a operation on >> Vector space and its basis > [...] >> operation :: a -> a -> Vect k a >> operation :: a -> Vect k a -> Vect k a >> operation :: Vect k a -> a -> Vect k a >> operation :: Vect k a -> Vect k a -> Vect k a > > This is unlikely to be a good idea in practice. Is there a good reason you > can't use four different names for these operations? > > Date: Sun, 28 Feb 2016 22:00:42 +0100 > From: Kristoffer F?llesdal > > To: haskell-cafe at haskell.org > Subject: [Haskell-cafe] Functional dependencies and overloading of > operation > Message-ID: <84F1908D-05B0-4EAE-9CB7-50847BD65344 at gmail.com > > Content-Type: text/plain; charset="utf-8" > > I am trying to use Functional dependencies to overload a operation on Vector space and its basis (Use the Vector spaces module Math.Algebras.VectorSpace >). I have tried to mimic the example for matrices and vectors from https://wiki.haskell.org/Functional_dependencies >. > I have tried different ways of defining classes and instances, but I do not get it to work. > > What I want is to have the ?same? function for these cases: > > operation :: a -> a -> Vect k a > operation :: a -> Vect k a -> Vect k a > operation :: Vect k a -> a -> Vect k a > operation :: Vect k a -> Vect k a -> Vect k a > > Her are som sample code to illustrate what I want. Do anybody have an idea to how to solve it? > > {-# LANGUAGE MultiParamTypeClasses #-} > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE FunctionalDependencies #-} > > import Math.Algebras.VectorSpace > > linearExtension :: (Eq k, Num k, Ord a) > => (a -> a -> Vect k a) -> Vect k a -> Vect k a -> Vect k a > linearExtension f xs ys = linear (\x -> linear (f x) ys) xs > > data Tree t = Root t [Tree t] deriving(Eq, Show, Ord) > > op :: (Eq k, Num k, Ord t) => Tree t -> Tree t -> Vect k (Tree t) > op x y = return x <+> return y > > opA :: (Eq k, Num k, Ord t) => Vect k (Tree t) -> Vect k (Tree t) -> Vect k (Tree t) > opA = linearExtension op > > class Operation a b c | a b -> c where > (<.>) :: a -> b -> c > > instance (Ord t) => Operation (Tree t) (Tree t) (Vect k (Tree t)) where > (<.>)= op > > instance (Ord t) => Operation (Vect k (Tree t)) (Vect k (Tree t)) (Vect k (Tree t)) where > (<.>) = opA > > instance (Ord t) => Operation (Tree t) (Vect k (Tree t)) (Vect k (Tree t)) where > (<.>) x = opA (return x) > > instance (Ord t) => Operation (Vect k (Tree t)) (Tree t) (Vect k (Tree t)) where > (<.>) x y = opA x (return y) > -------------- next part -------------- > An HTML attachment was scrubbed... > URL: > -------------- next part -------------- An HTML attachment was scrubbed... URL: From stephen.tetley at gmail.com Mon Feb 29 08:22:52 2016 From: stephen.tetley at gmail.com (Stephen Tetley) Date: Mon, 29 Feb 2016 08:22:52 +0000 Subject: [Haskell-cafe] The 13-line example in Text.Megaparsec.Expr In-Reply-To: References: Message-ID: Megaparsec does away with Parsec's LanguageDef machinery (which provides reservedOp). This is a double edge sword - as Megaparsec's author notes Parsec lexers (i.e LanguageDef based lexers) are inflexible especially if you need whitespace sensitive parsing; but they are very handy for the simple case of whitespace insensitive parsing. For the expression parser, Megaparsec's documentation is wrong[*] and probably it should use symbol rather than reservedOp. Note that symbol is slightly different in Megaparsec as it's a plain combinator (rather than one instantiated from a first class module as in Parsec) so it takes two args rather than one. [*] Well, likely wrong - I haven't got round to using Megaparsec yet. On 27 February 2016 at 17:04, ?zg?r Akg?n wrote: > Hi. > > On 27 February 2016 at 04:20, William Yager wrote: >> >> >> https://hackage.haskell.org/package/parsec-3.1.9/docs/Text-Parsec-Token.html#v:reservedOp >> ? > > > If I understand it correctly, Jeffrey is asking about using Megaparsec, and > this link is to the parsec combinator with the same name. > > I am very surprised to find out that Megaparsec does not provide[*] the same > combinator. Especially since they keep the same example! > > [*] At least it is not listed here: > http://hackage.haskell.org/package/megaparsec-4.4.0/docs/doc-index-All.html > > > -- > ?zg?r Akg?n > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > From ozgurakgun at gmail.com Mon Feb 29 10:05:11 2016 From: ozgurakgun at gmail.com (=?UTF-8?B?w5Z6Z8O8ciBBa2fDvG4=?=) Date: Mon, 29 Feb 2016 10:05:11 +0000 Subject: [Haskell-cafe] The 13-line example in Text.Megaparsec.Expr In-Reply-To: References: Message-ID: On 29 February 2016 at 08:22, Stephen Tetley wrote: > > For the expression parser, Megaparsec's documentation is wrong[*] and > probably it should use symbol rather than reservedOp. Note that symbol > is slightly different in Megaparsec as it's a plain combinator (rather > than one instantiated from a first class module as in Parsec) so it > takes two args rather than one. > > > [*] Well, likely wrong - I haven't got round to using Megaparsec yet. > You are right: https://github.com/mrkkrp/megaparsec/commit/750adb7c70392c3195eda12d816f4a1a2305321e -- ?zg?r Akg?n -------------- next part -------------- An HTML attachment was scrubbed... URL: From wojtek at power.com.pl Mon Feb 29 19:07:37 2016 From: wojtek at power.com.pl (=?UTF-8?Q?Wojtek_Narczy=c5=84ski?=) Date: Mon, 29 Feb 2016 20:07:37 +0100 Subject: [Haskell-cafe] Compile times and separate compilation In-Reply-To: References: <56CB7D2C.7010409@htwk-leipzig.de> <56D32CBD.9030802@power.com.pl> Message-ID: <56D496F9.6030801@power.com.pl> On 28.02.2016 21:25, Benno F?nfst?ck wrote: > > I think there's a problem with the number of cores that they report: > the vms/containers report 16 cores, while they only have 2. Perhaps > -j2 would work better? > > Yes :-) cabal build -j1 ....... 7.989s cabal build -j4 ....... 4.736s (I have 4 cores) cabal build -j16 ... 40.510s Today I realized I forgot -O2 yesterday, which cabal uses, I guess. Now cabal does not look that bad. ghc -O2 -j .......... 3.835s ghc -O2 ............. 6.462s -- Wojtek From tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk Mon Feb 29 19:25:21 2016 From: tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk (Tom Ellis) Date: Mon, 29 Feb 2016 19:25:21 +0000 Subject: [Haskell-cafe] Functional dependencies and overloading of operation In-Reply-To: <67AAC7E7-9D1D-44AB-AB75-1D96FA061242@gmail.com> References: <67AAC7E7-9D1D-44AB-AB75-1D96FA061242@gmail.com> Message-ID: <20160229192521.GE23479@weber> On Mon, Feb 29, 2016 at 09:08:01AM +0100, Kristoffer F?llesdal wrote: > Internally in programs I will use the specific functions for each case. > But I want some ?syntactic sugar? for this functions when doing direct > calculations in for example ghci. It will be more user friendly for > direct interaction not to have four different functions that in practice > do the same thing. It's a reasonable desire, but I think losing type inference is going to lose you more than you gain. From hesselink at gmail.com Mon Feb 29 19:39:38 2016 From: hesselink at gmail.com (Erik Hesselink) Date: Mon, 29 Feb 2016 20:39:38 +0100 Subject: [Haskell-cafe] Functional dependencies and overloading of operation In-Reply-To: <84F1908D-05B0-4EAE-9CB7-50847BD65344@gmail.com> References: <84F1908D-05B0-4EAE-9CB7-50847BD65344@gmail.com> Message-ID: In the future you might get more responses if you also post the error message. I pasted your code, commented out the external stuff, and got: ? Illegal instance declaration for ?Operation (Tree t) (Tree t) (Vect k (Tree t))? The coverage condition fails in class ?Operation? for functional dependency: ?a b -> c? Reason: lhs types ?Tree t?, ?Tree t? do not jointly determine rhs type ?Vect k (Tree t)? Un-determined variable: k ? In the instance declaration for ?Operation (Tree t) (Tree t) (Vect k (Tree t))? So it's saying that, while you state with `a b -> c` that types `a` and `b` together determine `c`, this is not the case for the `(Tree t) (Tree t)` instance, since they don't determine what type variable `k` should be. I don't know the package or domain you're working with, but that might help you get further. Erik On 28 February 2016 at 22:00, Kristoffer F?llesdal wrote: > I am trying to use Functional dependencies to overload a operation on > Vector space and its basis (Use the Vector spaces module > Math.Algebras.VectorSpace). I have tried to mimic the example for matrices > and vectors from https://wiki.haskell.org/Functional_dependencies. > I have tried different ways of defining classes and instances, but I do not > get it to work. > > What I want is to have the ?same? function for these cases: > > operation :: a -> a -> Vect k a > operation :: a -> Vect k a -> Vect k a > operation :: Vect k a -> a -> Vect k a > operation :: Vect k a -> Vect k a -> Vect k a > > Her are som sample code to illustrate what I want. Do anybody have an idea > to how to solve it? > > {-# LANGUAGE MultiParamTypeClasses #-} > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE FunctionalDependencies #-} > > import Math.Algebras.VectorSpace > > linearExtension :: (Eq k, Num k, Ord a) > => (a -> a -> Vect k a) -> Vect k a -> Vect k a -> Vect k a > linearExtension f xs ys = linear (\x -> linear (f x) ys) xs > > data Tree t = Root t [Tree t] deriving(Eq, Show, Ord) > > op :: (Eq k, Num k, Ord t) => Tree t -> Tree t -> Vect k (Tree t) > op x y = return x <+> return y > > opA :: (Eq k, Num k, Ord t) => Vect k (Tree t) -> Vect k (Tree t) -> Vect k > (Tree t) > opA = linearExtension op > > class Operation a b c | a b -> c where > (<.>) :: a -> b -> c > > instance (Ord t) => Operation (Tree t) (Tree t) (Vect k (Tree t)) where > (<.>)= op > > instance (Ord t) => Operation (Vect k (Tree t)) (Vect k (Tree t)) (Vect k > (Tree t)) where > (<.>) = opA > > instance (Ord t) => Operation (Tree t) (Vect k (Tree t)) (Vect k (Tree t)) > where > (<.>) x = opA (return x) > > instance (Ord t) => Operation (Vect k (Tree t)) (Tree t) (Vect k (Tree t)) > where > (<.>) x y = opA x (return y) > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > From adam at well-typed.com Mon Feb 29 20:14:06 2016 From: adam at well-typed.com (Adam Gundry) Date: Mon, 29 Feb 2016 20:14:06 +0000 Subject: [Haskell-cafe] Infer Nat type from Integer argument In-Reply-To: References: Message-ID: <56D4A68E.80108@well-typed.com> Hi Jake, On 29/02/16 01:42, Jake wrote: > So In both solutions, the goal is to "hide" the n so that the caller > doesn't determine it, right? > > I think I understand why that's necessary: because given a function with > type signature > > fromN :: forall n. KnownNat n => Integer -> NatString n > > it looks like n is free to be determined, even though n will/should be > decided based on the Integer argument. Exactly. > Is there any way to signal that > to the compiler without the extra overhead? Not in GHC Haskell, unfortunately. Some compilers/languages introduce existential types using a separate quantifier "exists", dual to "forall", for exactly this purpose. For example, UHC [1] supports such types. However, existentials complicate type inference, which is why GHC requires the use of an explicit existential datatype (or the higher-rank encoding) instead. Hope this helps, (another) Adam [1] http://foswiki.cs.uu.nl/foswiki/Ehc/UhcUserDocumentation#A_3.6_Existential_types > On Sun, Feb 28, 2016 at 5:42 PM adam vogt > wrote: > > Hi Jake, > > I think your problem is that the type signature for fromN lets the > caller of fromN decide what n should be, when it has to be the other > way around. Two ways to express that are: > > 1. make `fromN :: Integer -> SomeNatString`, making use of GADTs/ > ExistentialQuantification (in the same way that SomeNat does): > > data SomeNatString where > SomeNatString :: KnownNat n => NatString n -> SomeNatString > > 2. use RankNTypes to express the same thing without adding a > constructor, but at the cost of needing to write a type signature > and continuation passing style code: > > fromN :: Integer -> (forall n. KnownNat n => Proxy n -> r) -> r > fromN i f = case someNatVal i of Just n -> f n > > Regards, > Adam -- Adam Gundry, Haskell Consultant Well-Typed LLP, http://www.well-typed.com/ From vogt.adam at gmail.com Mon Feb 29 20:36:28 2016 From: vogt.adam at gmail.com (adam vogt) Date: Mon, 29 Feb 2016 15:36:28 -0500 Subject: [Haskell-cafe] Functional dependencies and overloading of operation In-Reply-To: <84F1908D-05B0-4EAE-9CB7-50847BD65344@gmail.com> References: <84F1908D-05B0-4EAE-9CB7-50847BD65344@gmail.com> Message-ID: On Sun, Feb 28, 2016 at 4:00 PM, Kristoffer F?llesdal wrote: > What I want is to have the ?same? function for these cases: > > operation :: a -> a -> Vect k a > operation :: a -> Vect k a -> Vect k a > operation :: Vect k a -> a -> Vect k a > operation :: Vect k a -> Vect k a -> Vect k a > You might be able to write it in terms of a function that can take either of these signatures ensureVect :: a -> Vect k a ensureVect :: Vect k a -> Vect k a -- then you can write operation x y = ensureVect x `opA` ensureVect y I have something close to that here < https://gist.github.com/aavogt/3b295008fbcde2ea88dd>, except it uses Maybe. The example wouldn't work with (+) and numeric literals [there could be an instance Num a => Num (Maybe a), after all], and I think it's likely that the code you want to write will run into the same problem. Regards, Adam -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcin.jan.mrotek at gmail.com Mon Feb 29 22:11:10 2016 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Mon, 29 Feb 2016 23:11:10 +0100 Subject: [Haskell-cafe] Infer Nat type from Integer argument In-Reply-To: <56D4A68E.80108@well-typed.com> References: <56D4A68E.80108@well-typed.com> Message-ID: Hello, Have you tried using the package https://hackage.haskell.org/package/reflection ? It won't directly help you with: fromN :: forall n. KnownNat n => Integer -> NatString n but it does provide a function: reifyNat :: forall r. Integer -> (forall n. KnownNat n => Proxy n -> r) -> r which could help you if you'd manage to turn your function inside out, so that the `n` parameter doesn't escape the callback. Best regards, Marcin Mrotek