From tkoster at gmail.com Thu Oct 1 00:50:34 2015 From: tkoster at gmail.com (Thomas Koster) Date: Thu, 1 Oct 2015 10:50:34 +1000 Subject: [Haskell-beginners] Haskell package maturity In-Reply-To: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> References: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> Message-ID: Andrew, On 29 September 2015 at 01:15, Andrew Bernard wrote: > Since starting to look on Hackage for packages for such vital things as > queues and algorithms, I am surprised to see very low numbers of downloads > for packages that seem to me to be vitally important. > > Overall I am > puzzled about this. I am trying to establish what packages to use in my > coding and there seems to be little indication of what to choose, and how to > assess code maturity. What am I missing? I suggest simply asking the list. You should get a few opinions, especially for "vital" packages, as long as you are precise about what you need. If you're lucky, sometimes the actual authors/maintainers will respond. If you're even luckier, you might get a response from one the champions of our community. Most of these opinions should come with some reasoning/justification. Sure, they're just anecdotes, but the commentary can be far more useful for making a decision than the relative number of downloads. -- Thomas Koster From mike_k_houghton at yahoo.co.uk Sat Oct 3 09:12:20 2015 From: mike_k_houghton at yahoo.co.uk (Mike Houghton) Date: Sat, 3 Oct 2015 10:12:20 +0100 Subject: [Haskell-beginners] Parsing keywords Message-ID: <04288BFE-7886-4A8B-876C-0879EC77EF3C@yahoo.co.uk> Hi, What is the idiomatic way of parsing keywords, in a case agnostic fashion, for a ?mini-language?? For example I?m creating some structured text? project{ env{ } setup{ } run{ } } that has ?project?, ?env?, ?setup? and ?run? as keywords and I want to parse in such a way that ?PROJECT?, ?ProJect? etc are all recognised as the keyword ?project? similarly for ?env? etc. I?m using monadic rather than applicative parsing. Many Thanks Mike From fa-ml at ariis.it Sat Oct 3 09:21:38 2015 From: fa-ml at ariis.it (Francesco Ariis) Date: Sat, 3 Oct 2015 11:21:38 +0200 Subject: [Haskell-beginners] Parsing keywords In-Reply-To: <04288BFE-7886-4A8B-876C-0879EC77EF3C@yahoo.co.uk> References: <04288BFE-7886-4A8B-876C-0879EC77EF3C@yahoo.co.uk> Message-ID: <20151003092138.GA13458@casa.casa> On Sat, Oct 03, 2015 at 10:12:20AM +0100, Mike Houghton wrote: > Hi, > > What is the idiomatic way of parsing keywords, in a case agnostic > fashion, for a ?mini-language?? I lifted this from `Text.ParserCombinators.Parsec.Rfc2234` and used it in a project of mine (lentil). ciString s = mapM ciChar s "case insensitive string" where ciChar :: Char -> ParIssue Char ciChar c = char (C.toLower c) <|> char (C.toUpper c) This assumes you are using Parsec parsing library. From mike_k_houghton at yahoo.co.uk Sun Oct 4 15:18:17 2015 From: mike_k_houghton at yahoo.co.uk (Mike Houghton) Date: Sun, 4 Oct 2015 16:18:17 +0100 Subject: [Haskell-beginners] File download using wreq. Message-ID: Hi, Please can someone explain how,using the wreq package, I can download and save a binary file? Say the file is at the end of http://x.y.z/files/myfile.jpg and it is a jpeg and no authentication is needed. I just want to 1. Check that the URL is syntactically correct - flag and error if not 2. If the URL is syntactically ok then download the file using GET. 3. Check that the response code is 200 and if so save the file 3a. if the response code is not 200 then delegate to an error handling function or some simple idiomatic way of error handling. Thanks once again. Mike From mike_k_houghton at yahoo.co.uk Sun Oct 4 15:25:09 2015 From: mike_k_houghton at yahoo.co.uk (Mike Houghton) Date: Sun, 4 Oct 2015 16:25:09 +0100 Subject: [Haskell-beginners] Parsing keywords In-Reply-To: <20151003092138.GA13458@casa.casa> References: <04288BFE-7886-4A8B-876C-0879EC77EF3C@yahoo.co.uk> <20151003092138.GA13458@casa.casa> Message-ID: <493E57B4-321A-46B3-BC97-AA135635C994@yahoo.co.uk> Thanks. I?ll try that. Mike > On 3 Oct 2015, at 10:21, Francesco Ariis wrote: > > On Sat, Oct 03, 2015 at 10:12:20AM +0100, Mike Houghton wrote: >> Hi, >> >> What is the idiomatic way of parsing keywords, in a case agnostic >> fashion, for a ?mini-language?? > > I lifted this from `Text.ParserCombinators.Parsec.Rfc2234` and used it > in a project of mine (lentil). > > > ciString s = mapM ciChar s "case insensitive string" > where > ciChar :: Char -> ParIssue Char > ciChar c = char (C.toLower c) <|> char (C.toUpper c) > > This assumes you are using Parsec parsing library. > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From k-bx at k-bx.com Mon Oct 5 08:18:43 2015 From: k-bx at k-bx.com (Kostiantyn Rybnikov) Date: Mon, 5 Oct 2015 11:18:43 +0300 Subject: [Haskell-beginners] File download using wreq. In-Reply-To: References: Message-ID: Hi Mike, First, if you don't know how wreq acts when it gets invalid url ? I suggest just launching repl and checking that out. I'll show how to do that using haskell stack tool : ? ~ stack install wreq ... ? ~ stack ghci Run from outside a project, using implicit global config Using resolver: lts-3.5 from global config file: /Users/kb/.stack/global/stack.yaml Configuring GHCi with the following packages: GHCi, version 7.10.2: http://www.haskell.org/ghc/ :? for help ? import Network.Wreq ? get "nonvalid" *** Exception: InvalidUrlException "nonvalid" "Invalid URL" You see, it throws InvalidUrlException upon request, which you can catch and render an error. Now, to get content, as per tutorial, just do: ? import Control.Lens ? res <- get "http://i.imgur.com/f0IKpky.png" ? res ^. responseBody ... (long binary response goes into your output) ... That's it. Last thing I should mention ? errors which can be thrown are all just HttpException type. Go and see possible ones , some of which you might want to handle specifically, while others just in a generic "something bad happened" error. Hope this helps. On Sun, Oct 4, 2015 at 6:18 PM, Mike Houghton wrote: > Hi, > > Please can someone explain how,using the wreq package, I can download and > save a binary file? > Say the file is at the end of > http://x.y.z/files/myfile.jpg > > and it is a jpeg and no authentication is needed. > > I just want to > > 1. Check that the URL is syntactically correct - flag and error if not > 2. If the URL is syntactically ok then download the file using GET. > 3. Check that the response code is 200 and if so save the file > 3a. if the response code is not 200 then delegate to an error handling > function or some simple idiomatic way of error handling. > > > Thanks once again. > > Mike > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From k-bx at k-bx.com Mon Oct 5 08:21:31 2015 From: k-bx at k-bx.com (Kostiantyn Rybnikov) Date: Mon, 5 Oct 2015 11:21:31 +0300 Subject: [Haskell-beginners] File download using wreq. In-Reply-To: References: Message-ID: Just few more things which might help: ? res ^. responseStatus Status {statusCode = 200, statusMessage = "OK"} ? :t res ^. responseStatus res ^. responseStatus :: Status ? :i Status data Status = Network.HTTP.Types.Status.Status {Network.HTTP.Types.Status.statusCode :: Int, Network.HTTP.Types.Status.statusMessage :: Data.ByteString.Internal.ByteString} -- Defined in ?Network.HTTP.Types.Status? instance Enum Status -- Defined in ?Network.HTTP.Types.Status? instance Eq Status -- Defined in ?Network.HTTP.Types.Status? instance Ord Status -- Defined in ?Network.HTTP.Types.Status? instance Show Status -- Defined in ?Network.HTTP.Types.Status? You can see how to get the status, where it comes from. So you can just do "if res ^. responseStatus /= status200 then ...". Cheers. On Sun, Oct 4, 2015 at 6:18 PM, Mike Houghton wrote: > Hi, > > Please can someone explain how,using the wreq package, I can download and > save a binary file? > Say the file is at the end of > http://x.y.z/files/myfile.jpg > > and it is a jpeg and no authentication is needed. > > I just want to > > 1. Check that the URL is syntactically correct - flag and error if not > 2. If the URL is syntactically ok then download the file using GET. > 3. Check that the response code is 200 and if so save the file > 3a. if the response code is not 200 then delegate to an error handling > function or some simple idiomatic way of error handling. > > > Thanks once again. > > Mike > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mlang at delysid.org Mon Oct 5 10:06:14 2015 From: mlang at delysid.org (Mario Lang) Date: Mon, 05 Oct 2015 12:06:14 +0200 Subject: [Haskell-beginners] Adding Either around a List monad? Message-ID: <87zizxvdd5.fsf@fx.delysid.org> Hi. Consider this structure: vs :: Rational -> [Input] -> [[Output]] vs _ [] = return [] vs l (x:xs) = pms l x >>= \pm -> (pm :) <$> vs (l - dur pm) xs pms :: Rational -> Input -> [Output] pms l x = [x, x+1, x+2, ...] -- Just an example, not real code. -- in reality, l is used to determine -- the result of pms. This is basically traverse, but with a state (l) added to it. So without the state, vs could be written as vs = traverse pms Now, I want to add Either e to this, like: vs :: Rational -> [Input] -> Either e [[Output]] pms :: Rational -> Input -> Either e [Output] However, I have no idea how to implement vs. Interestingly, adding Either e to vs without changing the code lets it compile, but it gives me the wrong result: vs :: Rational -> [Input] -> Either e [[Output]] vs _ [] = return [] vs l (x:xs) = pms l x >>= \pm -> (pm :) <$> vs (l - pm) xs Since I am in the Either monad now, >>= does not do non-determinism, it simply unwraps the Either from pms. I have to admit, I dont fully understand why this compiles, and what exactly it does wrong. I only see from testing that the results can't be right. On IRC, Gurkenglas suggested to use the State monad, like this: vs :: Rational -> [Input] -> Either e [[Output]] vs l = `evalStateT l` . mapM v where v x = do l <- get pm <- lift $ pms l x put (l - dur pm) return pm This compiles, but also yields unexpected results. I have invested several hours now trying to add Either around this algorithm, so that I can emit hard failures. I am sort of frustrated and out of ideas. Somehow, I can't figure out what these transformations actually change in behaviour. I am being told, by quite experienced Haskell programmers, that this is supposed to be correct, but my testing tells me otherwise. So before I just give up on this, could someone please have a look and let me know if I have missed something obvious? -- CYa, ????? From edwards.benj at gmail.com Mon Oct 5 13:21:30 2015 From: edwards.benj at gmail.com (Benjamin Edwards) Date: Mon, 05 Oct 2015 13:21:30 +0000 Subject: [Haskell-beginners] Adding Either around a List monad? In-Reply-To: <87zizxvdd5.fsf@fx.delysid.org> References: <87zizxvdd5.fsf@fx.delysid.org> Message-ID: If you want to use monad transformers and have Either e [a] as the result type then you need Either to be the inner monad and List to be the outer monad. If you look at the types of EitherT (from the either package) and ListT from transformers this should hopefully make sense. Then you would keep the same impl as you have now, only you would need to "run" the ListT computation to yield Either e [a]. Anything that you would like to do inside of the inner Error monad will need to lifted inside of it using lift. Does that help you at all? Ben On Mon, 5 Oct 2015 at 11:06 Mario Lang wrote: > Hi. > > Consider this structure: > > vs :: Rational -> [Input] -> [[Output]] > vs _ [] = return [] > vs l (x:xs) = pms l x >>= \pm -> (pm :) <$> vs (l - dur pm) xs > > pms :: Rational -> Input -> [Output] > pms l x = [x, x+1, x+2, ...] -- Just an example, not real code. > -- in reality, l is used to determine > -- the result of pms. > > This is basically traverse, but with a state (l) added to it. > So without the state, vs could be written as > > vs = traverse pms > > Now, I want to add Either e to this, like: > > vs :: Rational -> [Input] -> Either e [[Output]] > pms :: Rational -> Input -> Either e [Output] > > However, I have no idea how to implement vs. > > Interestingly, adding Either e to vs without changing the code lets it > compile, but it gives me the wrong result: > > vs :: Rational -> [Input] -> Either e [[Output]] > vs _ [] = return [] > vs l (x:xs) = pms l x >>= \pm -> (pm :) <$> vs (l - pm) xs > > Since I am in the Either monad now, >>= does not do non-determinism, it > simply unwraps the Either from pms. I have to admit, I dont fully > understand why this compiles, and what exactly it does wrong. I only > see from testing that the results can't be right. > > On IRC, Gurkenglas suggested to use the State monad, like this: > > vs :: Rational -> [Input] -> Either e [[Output]] > vs l = `evalStateT l` . mapM v where > v x = do l <- get > pm <- lift $ pms l x > put (l - dur pm) > return pm > > This compiles, but also yields unexpected results. > > I have invested several hours now trying to add Either around this > algorithm, so that I can emit hard failures. I am sort of frustrated > and out of ideas. Somehow, I can't figure out what these > transformations actually change in behaviour. I am being told, by quite > experienced Haskell programmers, that this is supposed to be correct, > but my testing tells me otherwise. So before I just give up on this, > could someone please have a look and let me know if I have missed > something obvious? > > -- > CYa, > ????? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From edwards.benj at gmail.com Mon Oct 5 13:35:32 2015 From: edwards.benj at gmail.com (Benjamin Edwards) Date: Mon, 05 Oct 2015 13:35:32 +0000 Subject: [Haskell-beginners] Adding Either around a List monad? In-Reply-To: References: <87zizxvdd5.fsf@fx.delysid.org> Message-ID: Or in fact, are you just asking about a much simpler problem: traverse :: (a -> f b) -> t a -> f (t b) So instantiating f a to Either String [Int] (but Int could be anything) and t a to [Int] then: f :: Int -> Either String [Int] f = Right . pure . (*6) This would yield what you would expect. If you had a more complicated function that potentially used Left "ERROR", you could short circuit the computation. Ben On Mon, 5 Oct 2015 at 14:21 Benjamin Edwards wrote: > If you want to use monad transformers and have Either e [a] as the result > type then you need Either to be the inner monad and List to be the outer > monad. If you look at the types of EitherT (from the either package) and > ListT from transformers this should hopefully make sense. Then you would > keep the same impl as you have now, only you would need to "run" the ListT > computation to yield Either e [a]. Anything that you would like to do > inside of the inner Error monad will need to lifted inside of it using > lift. Does that help you at all? > > Ben > > On Mon, 5 Oct 2015 at 11:06 Mario Lang wrote: > >> Hi. >> >> Consider this structure: >> >> vs :: Rational -> [Input] -> [[Output]] >> vs _ [] = return [] >> vs l (x:xs) = pms l x >>= \pm -> (pm :) <$> vs (l - dur pm) xs >> >> pms :: Rational -> Input -> [Output] >> pms l x = [x, x+1, x+2, ...] -- Just an example, not real code. >> -- in reality, l is used to determine >> -- the result of pms. >> >> This is basically traverse, but with a state (l) added to it. >> So without the state, vs could be written as >> >> vs = traverse pms >> >> Now, I want to add Either e to this, like: >> >> vs :: Rational -> [Input] -> Either e [[Output]] >> pms :: Rational -> Input -> Either e [Output] >> >> However, I have no idea how to implement vs. >> >> Interestingly, adding Either e to vs without changing the code lets it >> compile, but it gives me the wrong result: >> >> vs :: Rational -> [Input] -> Either e [[Output]] >> vs _ [] = return [] >> vs l (x:xs) = pms l x >>= \pm -> (pm :) <$> vs (l - pm) xs >> >> Since I am in the Either monad now, >>= does not do non-determinism, it >> simply unwraps the Either from pms. I have to admit, I dont fully >> understand why this compiles, and what exactly it does wrong. I only >> see from testing that the results can't be right. >> >> On IRC, Gurkenglas suggested to use the State monad, like this: >> >> vs :: Rational -> [Input] -> Either e [[Output]] >> vs l = `evalStateT l` . mapM v where >> v x = do l <- get >> pm <- lift $ pms l x >> put (l - dur pm) >> return pm >> >> This compiles, but also yields unexpected results. >> >> I have invested several hours now trying to add Either around this >> algorithm, so that I can emit hard failures. I am sort of frustrated >> and out of ideas. Somehow, I can't figure out what these >> transformations actually change in behaviour. I am being told, by quite >> experienced Haskell programmers, that this is supposed to be correct, >> but my testing tells me otherwise. So before I just give up on this, >> could someone please have a look and let me know if I have missed >> something obvious? >> >> -- >> CYa, >> ????? >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mike_k_houghton at yahoo.co.uk Mon Oct 5 15:03:39 2015 From: mike_k_houghton at yahoo.co.uk (Mike Houghton) Date: Mon, 5 Oct 2015 16:03:39 +0100 Subject: [Haskell-beginners] File download using wreq. In-Reply-To: References: Message-ID: <9D9B9020-9E93-4A60-AB9F-4664C67F173D@yahoo.co.uk> Thank you. I?ll work through what you?ve written. > On 5 Oct 2015, at 09:21, Kostiantyn Rybnikov wrote: > > Just few more things which might help: > > ? res ^. responseStatus > Status {statusCode = 200, statusMessage = "OK"} > ? :t res ^. responseStatus > res ^. responseStatus :: Status > ? :i Status > data Status > = Network.HTTP.Types.Status.Status {Network.HTTP.Types.Status.statusCode :: Int, > Network.HTTP.Types.Status.statusMessage :: Data.ByteString.Internal.ByteString} > -- Defined in ?Network.HTTP.Types.Status? > instance Enum Status -- Defined in ?Network.HTTP.Types.Status? > instance Eq Status -- Defined in ?Network.HTTP.Types.Status? > instance Ord Status -- Defined in ?Network.HTTP.Types.Status? > instance Show Status -- Defined in ?Network.HTTP.Types.Status? > > You can see how to get the status, where it comes from. So you can just do "if res ^. responseStatus /= status200 then ...". > > Cheers. > > On Sun, Oct 4, 2015 at 6:18 PM, Mike Houghton > wrote: > Hi, > > Please can someone explain how,using the wreq package, I can download and save a binary file? > Say the file is at the end of > http://x.y.z/files/myfile.jpg > > and it is a jpeg and no authentication is needed. > > I just want to > > 1. Check that the URL is syntactically correct - flag and error if not > 2. If the URL is syntactically ok then download the file using GET. > 3. Check that the response code is 200 and if so save the file > 3a. if the response code is not 200 then delegate to an error handling function or some simple idiomatic way of error handling. > > > Thanks once again. > > Mike > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners -------------- next part -------------- An HTML attachment was scrubbed... URL: From mlang at delysid.org Mon Oct 5 23:10:10 2015 From: mlang at delysid.org (Mario Lang) Date: Tue, 06 Oct 2015 01:10:10 +0200 Subject: [Haskell-beginners] Adding Either around a List monad? In-Reply-To: (Benjamin Edwards's message of "Mon, 05 Oct 2015 13:21:30 +0000") References: <87zizxvdd5.fsf@fx.delysid.org> Message-ID: <87y4fgap4d.fsf@fx.delysid.org> Benjamin Edwards writes: > If you want to use monad transformers and have Either e [a] as the result > type then you need Either to be the inner monad and List to be the outer > monad. If you look at the types of EitherT (from the either package) and > ListT from transformers this should hopefully make sense. Then you would > keep the same impl as you have now, only you would need to "run" the ListT > computation to yield Either e [a]. Anything that you would like to do > inside of the inner Error monad will need to lifted inside of it using > lift. Does that help you at all? Hmm, sort of, and also not :-) I finally managed to rewrite vs, however, I used either to handle Either: vs :: Music.Dur -> AmbiguousVoice -> Either e [Voice] vs _ [] = return [[]] vs l (x:xs) = either Left f $ pms l x where f pms = fmap concat $ sequence $ pms >>= \pm -> return $ either Left (\pmss -> Right $ (pm :) <$> pmss) (vs (l - dur pm) xs) It doesn't particularily look pretty, but I am rather relieved I finally managed to make that change. Took me roughly 4 attempts, a lot of asking, and a few hours of playing around. On the positive side, I have learnt a lot. However, I wonder if there is a more idiomatic way of doing what I do above. Took me a long time to realize there is a concat missing. I guess this is the result of sequence being used to collapse the Eithers. Thanks for helping by providing input. > Ben > > On Mon, 5 Oct 2015 at 11:06 Mario Lang wrote: > >> Hi. >> >> Consider this structure: >> >> vs :: Rational -> [Input] -> [[Output]] >> vs _ [] = return [] >> vs l (x:xs) = pms l x >>= \pm -> (pm :) <$> vs (l - dur pm) xs >> >> pms :: Rational -> Input -> [Output] >> pms l x = [x, x+1, x+2, ...] -- Just an example, not real code. >> -- in reality, l is used to determine >> -- the result of pms. >> >> This is basically traverse, but with a state (l) added to it. >> So without the state, vs could be written as >> >> vs = traverse pms >> >> Now, I want to add Either e to this, like: >> >> vs :: Rational -> [Input] -> Either e [[Output]] >> pms :: Rational -> Input -> Either e [Output] >> >> However, I have no idea how to implement vs. >> >> Interestingly, adding Either e to vs without changing the code lets it >> compile, but it gives me the wrong result: >> >> vs :: Rational -> [Input] -> Either e [[Output]] >> vs _ [] = return [] >> vs l (x:xs) = pms l x >>= \pm -> (pm :) <$> vs (l - pm) xs >> >> Since I am in the Either monad now, >>= does not do non-determinism, it >> simply unwraps the Either from pms. I have to admit, I dont fully >> understand why this compiles, and what exactly it does wrong. I only >> see from testing that the results can't be right. >> >> On IRC, Gurkenglas suggested to use the State monad, like this: >> >> vs :: Rational -> [Input] -> Either e [[Output]] >> vs l = `evalStateT l` . mapM v where >> v x = do l <- get >> pm <- lift $ pms l x >> put (l - dur pm) >> return pm >> >> This compiles, but also yields unexpected results. >> >> I have invested several hours now trying to add Either around this >> algorithm, so that I can emit hard failures. I am sort of frustrated >> and out of ideas. Somehow, I can't figure out what these >> transformations actually change in behaviour. I am being told, by quite >> experienced Haskell programmers, that this is supposed to be correct, >> but my testing tells me otherwise. So before I just give up on this, >> could someone please have a look and let me know if I have missed >> something obvious? >> >> -- >> CYa, >> ????? >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners -- CYa, ????? | Debian Developer .''`. | Get my public key via finger mlang/key at db.debian.org : :' : | 1024D/7FC1A0854909BCCDBE6C102DDFFC022A6B113E44 `. `' `- From chak at justtesting.org Fri Oct 9 00:21:42 2015 From: chak at justtesting.org (Manuel M T Chakravarty) Date: Fri, 9 Oct 2015 11:21:42 +1100 Subject: [Haskell-beginners] =?utf-8?q?Learning_Haskell_=E2=80=94_a_new_tu?= =?utf-8?q?torial?= Message-ID: For those getting started with Haskell, you might like to have a look at our new Haskell tutorial ?Learning Haskell?: http://learn.hfm.io/ It features a mix of text and screencasts and will be extended over time. There is a bit on the background at http://blog.haskellformac.com/blog/learning-haskell Enjoy! Manuel From strombrg at gmail.com Sat Oct 10 18:45:03 2015 From: strombrg at gmail.com (Dan Stromberg) Date: Sat, 10 Oct 2015 11:45:03 -0700 Subject: [Haskell-beginners] Reading a list of null-terminated filenames from stdin? Message-ID: If I want to read a list of filenames, each terminated with a nul byte, from stdin (kind of like xargs -0), what's the best way to do that in Haskell? Or am I swimming against the current to do anything but newline-termination? Google's top hit is: https://downloads.haskell.org/~ghc/7.6.1/docs/html/libraries/bytestring-0.10.0.0/Data-ByteString.html ...but I don't see anything about nul termination there. I checked the top ~5 hits, and didn't find much. I also checked https://www.haskell.org/hoogle/?hoogle=Lines The goal is to be able to operate on filenames that contain newlines, but it's not that end of the world if that isn't very practical. Thanks! -- Dan Stromberg -------------- next part -------------- An HTML attachment was scrubbed... URL: From karl at karlv.net Sat Oct 10 19:14:52 2015 From: karl at karlv.net (Karl Voelker) Date: Sat, 10 Oct 2015 12:14:52 -0700 Subject: [Haskell-beginners] Reading a list of null-terminated filenames from stdin? In-Reply-To: References: Message-ID: <00060E32-A9C1-458F-81D9-B07E917BB231@karlv.net> > On Oct 10, 2015, at 11:45 AM, Dan Stromberg wrote: > > If I want to read a list of filenames, each terminated with a nul byte, from stdin (kind of like xargs -0), what's the best way to do that in Haskell? Or am I swimming against the current to do anything but newline-termination? It looks like all the stdin-specific functions are line-oriented, but you can use "Data.ByteString.hGet stdin?. http://hackage.haskell.org/package/bytestring-0.10.6.0/docs/Data-ByteString.html#g:29 > Google's top hit is: > https://downloads.haskell.org/~ghc/7.6.1/docs/html/libraries/bytestring-0.10.0.0/Data-ByteString.html > ...but I don't see anything about nul termination there. I checked the top ~5 hits, and didn't find much. I don?t think it matters in this case, but you should be aware that Google does not always find the most recent results when it comes to Hackage packages. (See my link above.) -Karl From strombrg at gmail.com Sat Oct 10 19:40:26 2015 From: strombrg at gmail.com (Dan Stromberg) Date: Sat, 10 Oct 2015 12:40:26 -0700 Subject: [Haskell-beginners] Reading a list of null-terminated filenames from stdin? In-Reply-To: <00060E32-A9C1-458F-81D9-B07E917BB231@karlv.net> References: <00060E32-A9C1-458F-81D9-B07E917BB231@karlv.net> Message-ID: First off, thanks for your response. On Sat, Oct 10, 2015 at 12:14 PM, Karl Voelker wrote: > > On Oct 10, 2015, at 11:45 AM, Dan Stromberg wrote: > > > > If I want to read a list of filenames, each terminated with a nul byte, > from stdin (kind of like xargs -0), what's the best way to do that in > Haskell? Or am I swimming against the current to do anything but > newline-termination? > > It looks like all the stdin-specific functions are line-oriented, but you > can use "Data.ByteString.hGet stdin?. > > > http://hackage.haskell.org/package/bytestring-0.10.6.0/docs/Data-ByteString.html#g:29 I'm very much a Haskell newb, but does Data.ByteString.hGet stdin read a fixed (maximum) number of bytes, rather than a nul terminated sequence of bytes? > Google's top hit is: > > > https://downloads.haskell.org/~ghc/7.6.1/docs/html/libraries/bytestring-0.10.0.0/Data-ByteString.html > > ...but I don't see anything about nul termination there. I checked the > top ~5 hits, and didn't find much. > > I don?t think it matters in this case, but you should be aware that Google > does not always find the most recent results when it comes to Hackage > packages. (See my link above. > I'll keep that in mind. Thanks. -- Dan Stromberg -------------- next part -------------- An HTML attachment was scrubbed... URL: From karl at karlv.net Sat Oct 10 19:45:36 2015 From: karl at karlv.net (Karl Voelker) Date: Sat, 10 Oct 2015 12:45:36 -0700 Subject: [Haskell-beginners] Reading a list of null-terminated filenames from stdin? In-Reply-To: References: <00060E32-A9C1-458F-81D9-B07E917BB231@karlv.net> Message-ID: > On Oct 10, 2015, at 12:40 PM, Dan Stromberg wrote: > I'm very much a Haskell newb, but does Data.ByteString.hGet stdin read a fixed (maximum) number of bytes, rather than a nul terminated sequence of bytes? Yes, you?d have to write some code to look for nuls yourself. Or, if the input is small enough that you don?t mind reading it all into memory at once, use hGetContents. -Karl From ramin.honary at gmail.com Sat Oct 10 21:03:07 2015 From: ramin.honary at gmail.com (ramin.honary at gmail.com) Date: Sat, 10 Oct 2015 16:03:07 -0500 Subject: [Haskell-beginners] ramin.honary@gmail.com has indicated you're a friend. Accept? Message-ID: <0.0.2DC.78C.1D1039DF2A1E0BC.2DBB@mail6.infoaxe.net> Hi, ramin.honary at gmail.com wants to follow you. ****** Is ramin.honary at gmail.com you friend? ****** If Yes please follow the link below: http://invites.infoaxe.net/signup_e.html?fullname=&email=beginners at haskell.org&invitername=Ramin&inviterid=38619668&userid=0&token=0&emailmasterid=d6b57bf0-9662-4b75-b935-f44fa95812a0&from=ramin.honary at gmail.com&template=invite_reg_b&test=AA&src=txt_yes If No please follow the link below: http://invites.infoaxe.net/signup_e.html?fullname=&email=beginners at haskell.org&invitername=Ramin&inviterid=38619668&userid=0&token=0&emailmasterid=d6b57bf0-9662-4b75-b935-f44fa95812a0&from=ramin.honary at gmail.com&template=invite_reg_b&test=AA&src=txt_no Follow the link below to remove yourself from all such emails http://invites.infoaxe.net/uns_inviter.jsp?email=beginners at haskell.org&iid=d6b57bf0-9662-4b75-b935-f44fa95812a0&from=ramin.honary at gmail.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From andrew.bernard at gmail.com Sun Oct 11 05:01:17 2015 From: andrew.bernard at gmail.com (Andrew Bernard) Date: Sun, 11 Oct 2015 16:01:17 +1100 Subject: [Haskell-beginners] Reading a list of null-terminated filenames from stdin? In-Reply-To: References: Message-ID: <66E1CC00-1FF9-452D-A947-CABCA8A07D4A@gmail.com> Hi Dan, On what operating system can filenames contain newlines? Andrew > On 11 Oct 2015, at 05:45, Dan Stromberg wrote: > > The goal is to be able to operate on filenames that contain newlines, but it's not that end of the world if that isn't very practical. From allbery.b at gmail.com Sun Oct 11 05:13:38 2015 From: allbery.b at gmail.com (Brandon Allbery) Date: Sun, 11 Oct 2015 01:13:38 -0400 Subject: [Haskell-beginners] Reading a list of null-terminated filenames from stdin? In-Reply-To: <66E1CC00-1FF9-452D-A947-CABCA8A07D4A@gmail.com> References: <66E1CC00-1FF9-452D-A947-CABCA8A07D4A@gmail.com> Message-ID: On Sun, Oct 11, 2015 at 1:01 AM, Andrew Bernard wrote: > On what operating system can filenames contain newlines? Any unixlike system. You would need to quote the newline from the shell, but it is perfectly valid. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From rustompmody at gmail.com Sun Oct 11 05:28:28 2015 From: rustompmody at gmail.com (Rustom Mody) Date: Sun, 11 Oct 2015 10:58:28 +0530 Subject: [Haskell-beginners] Reading a list of null-terminated filenames from stdin? In-Reply-To: References: <66E1CC00-1FF9-452D-A947-CABCA8A07D4A@gmail.com> Message-ID: On Sun, Oct 11, 2015 at 10:43 AM, Brandon Allbery wrote: > On Sun, Oct 11, 2015 at 1:01 AM, Andrew Bernard > wrote: > >> On what operating system can filenames contain newlines? > > > Any unixlike system. You would need to quote the newline from the shell, > but it is perfectly valid. > Valid... Ok Perfectly?? Here's a counter view http://www.dwheeler.com/essays/fixing-unix-linux-filenames.html Summary: Funny chars in filenames is a feature close to a bug in *Nix filesystems So my advice for this would be: - If you have better things to do dont bother - if for some reason you do need to bother, respect Postel's law and allow it out more reluctantly than in -------------- next part -------------- An HTML attachment was scrubbed... URL: From andrew.bernard at gmail.com Sun Oct 11 06:24:40 2015 From: andrew.bernard at gmail.com (Andrew Bernard) Date: Sun, 11 Oct 2015 17:24:40 +1100 Subject: [Haskell-beginners] Reading a list of null-terminated filenames from stdin? In-Reply-To: References: <66E1CC00-1FF9-452D-A947-CABCA8A07D4A@gmail.com> Message-ID: <44472AE7-3054-4D23-9864-7B51EAFC5123@gmail.com> Hi Brandon, It may be valid, but it is just asking for trouble with many tools and utilities and scripts. Funny, I had to check re UNIX. I have been programming UNIX systems for over thirty years and never even imagined a newline in a filename! Would the OP say why he needs to use newlines in filenames? Something best avoided. I suppose this is not a Haskell matter, but one does have to ask. Andrew > On 11 Oct 2015, at 16:13, Brandon Allbery wrote: > > > Any unixlike system. You would need to quote the newline from the shell, but it is perfectly valid. From hanche at math.ntnu.no Sun Oct 11 09:22:34 2015 From: hanche at math.ntnu.no (Harald Hanche-Olsen) Date: Sun, 11 Oct 2015 11:22:34 +0200 Subject: [Haskell-beginners] Reading a list of null-terminated filenames from stdin? In-Reply-To: <44472AE7-3054-4D23-9864-7B51EAFC5123@gmail.com> References: <66E1CC00-1FF9-452D-A947-CABCA8A07D4A@gmail.com> <44472AE7-3054-4D23-9864-7B51EAFC5123@gmail.com> Message-ID: <561A2A5A.5030303@math.ntnu.no> Andrew Bernard wrote: > Hi Brandon, > > It may be valid, but it is just asking for trouble with many tools and utilities and scripts. Funny, I had to check re UNIX. I have been programming UNIX systems for over thirty years and never even imagined a newline in a filename! > > Would the OP say why he needs to use newlines in filenames? Something best avoided. I suppose this is not a Haskell matter, but one does have to ask. The OP must speak for himself, but as far as I am concerned, no reasonable person uses newlines in filenames, ever. However, the possibility is there, and it may happen that someone unreasonable has created a filename with a newline in it. This may become a security issue if, for example, someone creates a file named "/tmp/foo /etc/passwd bar.log" and a careless system person runs a script as root to remove all files named *.log from /tmp/ and subdirectories. find /tmp -name '*.log' -print | xargs rm is an insanely reckless way to do it, which in this case would cause the removal of the password file. Much better: find /tmp -name '*.log' -type f -print0 | xargs -0 rm or even better: find /tmp -name '*.log' -type f -exec rm {} + In summary, if you have to encode a list of filenames in a byte stream, doing it with zero terminated is the correct way to do it. ? Harald From imantc at gmail.com Sun Oct 11 09:33:50 2015 From: imantc at gmail.com (Imants Cekusins) Date: Sun, 11 Oct 2015 11:33:50 +0200 Subject: [Haskell-beginners] Reading a list of null-terminated filenames from stdin? In-Reply-To: <561A2A5A.5030303@math.ntnu.no> References: <66E1CC00-1FF9-452D-A947-CABCA8A07D4A@gmail.com> <44472AE7-3054-4D23-9864-7B51EAFC5123@gmail.com> <561A2A5A.5030303@math.ntnu.no> Message-ID: why not base64 encode input text to produce file names: https://en.wikipedia.org/wiki/Base64#Filenames The encoded file names would be less likely to cause problem. You could get the original text input by decoding the file name. From hanche at math.ntnu.no Sun Oct 11 09:38:11 2015 From: hanche at math.ntnu.no (Harald Hanche-Olsen) Date: Sun, 11 Oct 2015 11:38:11 +0200 Subject: [Haskell-beginners] Reading a list of null-terminated filenames from stdin? In-Reply-To: References: <66E1CC00-1FF9-452D-A947-CABCA8A07D4A@gmail.com> <44472AE7-3054-4D23-9864-7B51EAFC5123@gmail.com> <561A2A5A.5030303@math.ntnu.no> Message-ID: <561A2E03.5030908@math.ntnu.no> Imants Cekusins wrote: > why not base64 encode input text to produce file names: > > https://en.wikipedia.org/wiki/Base64#Filenames An intriguing idea, but sometimes you just have to accept what the upstream program provides. ? Harald From michael at snoyman.com Sun Oct 11 09:45:23 2015 From: michael at snoyman.com (Michael Snoyman) Date: Sun, 11 Oct 2015 12:45:23 +0300 Subject: [Haskell-beginners] Reading a list of null-terminated filenames from stdin? In-Reply-To: References: Message-ID: On Sat, Oct 10, 2015 at 9:45 PM, Dan Stromberg wrote: > > If I want to read a list of filenames, each terminated with a nul byte, > from stdin (kind of like xargs -0), what's the best way to do that in > Haskell? Or am I swimming against the current to do anything but > newline-termination? > > Google's top hit is: > > https://downloads.haskell.org/~ghc/7.6.1/docs/html/libraries/bytestring-0.10.0.0/Data-ByteString.html > ...but I don't see anything about nul termination there. I checked the > top ~5 hits, and didn't find much. > > I also checked https://www.haskell.org/hoogle/?hoogle=Lines > > The goal is to be able to operate on filenames that contain newlines, but > it's not that end of the world if that isn't very practical. > > Thanks! > > -- > Dan Stromberg > > > To give you an idea of how this might be done, I put together an example using the conduit-combinators library: https://gist.github.com/snoyberg/2a5ca79d97f483bdcfe9 This can be done in a more low-level manner by using the bytestring library directly, which will require learning less new concepts. However, streaming libraries like conduit and pipes are specifically designed for handling these kinds of problems. There's a tutorial on conduit available at: https://github.com/snoyberg/conduit#readme Michael -------------- next part -------------- An HTML attachment was scrubbed... URL: From allbery.b at gmail.com Sun Oct 11 14:57:27 2015 From: allbery.b at gmail.com (Brandon Allbery) Date: Sun, 11 Oct 2015 10:57:27 -0400 Subject: [Haskell-beginners] Reading a list of null-terminated filenames from stdin? In-Reply-To: <561A2A5A.5030303@math.ntnu.no> References: <66E1CC00-1FF9-452D-A947-CABCA8A07D4A@gmail.com> <44472AE7-3054-4D23-9864-7B51EAFC5123@gmail.com> <561A2A5A.5030303@math.ntnu.no> Message-ID: On Sun, Oct 11, 2015 at 5:22 AM, Harald Hanche-Olsen wrote: > Andrew Bernard wrote: > >> It may be valid, but it is just asking for trouble with many tools and >> utilities and scripts. Funny, I had to check re UNIX. I have been >> programming UNIX systems for over thirty years and never even imagined a >> newline in a filename! >> >> Would the OP say why he needs to use newlines in filenames? Something >> best avoided. I suppose this is not a Haskell matter, but one does have to >> ask. >> > > The OP must speak for himself, but as far as I am concerned, no reasonable > person uses newlines in filenames, ever. > > However, the possibility is there, and it may happen that someone > unreasonable has created a filename with a newline in it. This may become a > security issue if, for example, someone creates a file named > This is indeed the problem. I'm a sysadmin; if I need a tool like this, I don't usually have any say in what is in the filenames --- and, sadly, people *do* use all manner of odd characters, including newlines, non-UTF8, etc. It's my place to deal with what is, not what would be in an ideal world. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From daniel_hegyi at hotmail.com Mon Oct 12 05:32:05 2015 From: daniel_hegyi at hotmail.com (Daniel Hegyi) Date: Mon, 12 Oct 2015 05:32:05 +0000 Subject: [Haskell-beginners] Can't install Haskell platform on Mac OS X El Capitan Message-ID: Hi, I?m trying to install Haskell on Mac I have OSX El Capitan so I downloaded from https://www.haskell.org/platform/ the Download (64 bit) (10.11). The installer runs, however, when I type into terminal ghci I get ghci -bash: ghci: command not found ?which ghci? it just doesn?t return anything. Thanks, Daniel From raguay at customct.com Mon Oct 12 05:56:53 2015 From: raguay at customct.com (Richard Guay) Date: Mon, 12 Oct 2015 12:56:53 +0700 Subject: [Haskell-beginners] Can't install Haskell platform on Mac OS X El Capitan In-Reply-To: References: Message-ID: The installer can't create the links to your /usr/local/bin folder anymore under El Capitan. I just added this to my .bashrc and .zshrc files: export PATH="/Library/Frameworks/GHC.framework/Versions/Current/usr/bin/:/Library/Haskell/bin:$HOME/Library/Haskell/bin:$PATH"; That should fix your problem. At least, it did for me. Richard On Mon, Oct 12, 2015 at 12:32 PM, Daniel Hegyi wrote: > Hi, > > I?m trying to install Haskell on Mac > > I have OSX El Capitan so I downloaded from https://www.haskell.org/platform/ the Download (64 bit) (10.11). > > The installer runs, however, when I type into terminal ghci I get > > ghci > -bash: ghci: command not found > > ?which ghci? it just doesn?t return anything. > > Thanks, > Daniel > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From daniel_hegyi at hotmail.com Mon Oct 12 06:05:31 2015 From: daniel_hegyi at hotmail.com (Daniel Hegyi) Date: Mon, 12 Oct 2015 06:05:31 +0000 Subject: [Haskell-beginners] Can't install Haskell platform on Mac OS X El Capitan In-Reply-To: References: Message-ID: How can I add this to these files? I can?t find them. Also, I will want to compile from Emacs. Will I need to add this PATH somehow there as well? > On 12 Oct 2015, at 13:56, Richard Guay wrote: > > The installer can't create the links to your /usr/local/bin folder > anymore under El Capitan. I just added this to my .bashrc and .zshrc > files: > > export PATH="/Library/Frameworks/GHC.framework/Versions/Current/usr/bin/:/Library/Haskell/bin:$HOME/Library/Haskell/bin:$PATH"; > > That should fix your problem. At least, it did for me. > > Richard > > On Mon, Oct 12, 2015 at 12:32 PM, Daniel Hegyi wrote: >> Hi, >> >> I?m trying to install Haskell on Mac >> >> I have OSX El Capitan so I downloaded from https://www.haskell.org/platform/ the Download (64 bit) (10.11). >> >> The installer runs, however, when I type into terminal ghci I get >> >> ghci >> -bash: ghci: command not found >> >> ?which ghci? it just doesn?t return anything. >> >> Thanks, >> Daniel >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From raguay at customct.com Mon Oct 12 06:12:12 2015 From: raguay at customct.com (Richard Guay) Date: Mon, 12 Oct 2015 13:12:12 +0700 Subject: [Haskell-beginners] Can't install Haskell platform on Mac OS X El Capitan In-Reply-To: References: Message-ID: Depending on the shell you are using, you will have to put it in your .bashrc file for the bash shell or you .zshrc for zsh. Assuming you are using the default setup, you are then using bash and will need to add it to your .bashrc. In a unix type filesystem (which OS X is), all files starting with a "." are invisible. In a terminal in your home directory, type "emacs .bashrc" and add the line to the file. You can see the file in the terminal by using "ls -a" to list everything - even hidden files. Once you update your .bashrc file, reload your shell. Emacs will see it as well since it should use the PATH environment variable to find it. On Mon, Oct 12, 2015 at 1:05 PM, Daniel Hegyi wrote: > How can I add this to these files? I can?t find them. > > Also, I will want to compile from Emacs. Will I need to add this PATH somehow there as well? > > >> On 12 Oct 2015, at 13:56, Richard Guay wrote: >> >> The installer can't create the links to your /usr/local/bin folder >> anymore under El Capitan. I just added this to my .bashrc and .zshrc >> files: >> >> export PATH="/Library/Frameworks/GHC.framework/Versions/Current/usr/bin/:/Library/Haskell/bin:$HOME/Library/Haskell/bin:$PATH"; >> >> That should fix your problem. At least, it did for me. >> >> Richard >> >> On Mon, Oct 12, 2015 at 12:32 PM, Daniel Hegyi wrote: >>> Hi, >>> >>> I?m trying to install Haskell on Mac >>> >>> I have OSX El Capitan so I downloaded from https://www.haskell.org/platform/ the Download (64 bit) (10.11). >>> >>> The installer runs, however, when I type into terminal ghci I get >>> >>> ghci >>> -bash: ghci: command not found >>> >>> ?which ghci? it just doesn?t return anything. >>> >>> Thanks, >>> Daniel >>> _______________________________________________ >>> Beginners mailing list >>> Beginners at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From hanche at math.ntnu.no Mon Oct 12 07:21:09 2015 From: hanche at math.ntnu.no (Harald Hanche-Olsen) Date: Mon, 12 Oct 2015 09:21:09 +0200 Subject: [Haskell-beginners] Can't install Haskell platform on Mac OS X El Capitan In-Reply-To: References: Message-ID: <561B5F65.6030707@math.ntnu.no> Richard Guay wrote: > The installer can't create the links to your /usr/local/bin folder > anymore under El Capitan. How come? The /usr/local hierarchy is expressly excempt from the restrictions that apply to the rest of the /usr hierarchy. I have all kinds of stuff in /usr/local myself, no trouble at all. But Haskell platform used to install binaries in /usr/bin, which is definitely a no-no on El Capitan. I think a workaround was posted to this mailing list, or was it on cafe? Personally, I have abandoned Haskell platform in favour of the installation instructions here: https://github.com/bitemyapp/learnhaskell/blob/master/install.md So I couldn't comment on the viability of the workaround that I saw. ? Harald PS. I don't know what happens if /usr/local did not exist when you installed El Capitan. Is it then necessary to turn off SIP in order to create this directory, due to the restrictions on /usr? From raguay at customct.com Mon Oct 12 07:51:55 2015 From: raguay at customct.com (Richard Guay) Date: Mon, 12 Oct 2015 14:51:55 +0700 Subject: [Haskell-beginners] Can't install Haskell platform on Mac OS X El Capitan In-Reply-To: <561B5F65.6030707@math.ntnu.no> References: <561B5F65.6030707@math.ntnu.no> Message-ID: Not sure why, but some programs can not create links or files in /usr/local. I have ran into this with Hammerspoon and the Haskell installer. I agree the Haskell for Mac OS X is a better way to run, but I keep having cabal conflicts with other libraries. I was answering for the specific problem, not an alternate solution. On Mon, Oct 12, 2015 at 2:21 PM, Harald Hanche-Olsen wrote: > Richard Guay wrote: >> >> The installer can't create the links to your /usr/local/bin folder >> anymore under El Capitan. > > > How come? The /usr/local hierarchy is expressly excempt from the > restrictions that apply to the rest of the /usr hierarchy. > > I have all kinds of stuff in /usr/local myself, no trouble at all. > > But Haskell platform used to install binaries in /usr/bin, which is > definitely a no-no on El Capitan. I think a workaround was posted to this > mailing list, or was it on cafe? > > Personally, I have abandoned Haskell platform in favour of the installation > instructions here: > > https://github.com/bitemyapp/learnhaskell/blob/master/install.md > > So I couldn't comment on the viability of the workaround that I saw. > > ? Harald > > PS. I don't know what happens if /usr/local did not exist when you installed > El Capitan. Is it then necessary to turn off SIP in order to create this > directory, due to the restrictions on /usr? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From yuriy.pachin at gmail.com Mon Oct 12 10:08:30 2015 From: yuriy.pachin at gmail.com (Yury Pachin) Date: Mon, 12 Oct 2015 13:08:30 +0300 Subject: [Haskell-beginners] Can't install Haskell platform on Mac OS X El Capitan In-Reply-To: References: <561B5F65.6030707@math.ntnu.no> Message-ID: Haskell platform - bad idea. Use brew or stack https://www.fpcomplete.com/blog/2015/08/new-in-depth-guide-stack. On 12 October 2015 at 10:51, Richard Guay wrote: > Not sure why, but some programs can not create links or files in > /usr/local. I have ran into this with Hammerspoon and the Haskell > installer. I agree the Haskell for Mac OS X is a better way to run, > but I keep having cabal conflicts with other libraries. I was > answering for the specific problem, not an alternate solution. > > On Mon, Oct 12, 2015 at 2:21 PM, Harald Hanche-Olsen > wrote: > > Richard Guay wrote: > >> > >> The installer can't create the links to your /usr/local/bin folder > >> anymore under El Capitan. > > > > > > How come? The /usr/local hierarchy is expressly excempt from the > > restrictions that apply to the rest of the /usr hierarchy. > > > > I have all kinds of stuff in /usr/local myself, no trouble at all. > > > > But Haskell platform used to install binaries in /usr/bin, which is > > definitely a no-no on El Capitan. I think a workaround was posted to this > > mailing list, or was it on cafe? > > > > Personally, I have abandoned Haskell platform in favour of the > installation > > instructions here: > > > > https://github.com/bitemyapp/learnhaskell/blob/master/install.md > > > > So I couldn't comment on the viability of the workaround that I saw. > > > > ? Harald > > > > PS. I don't know what happens if /usr/local did not exist when you > installed > > El Capitan. Is it then necessary to turn off SIP in order to create this > > directory, due to the restrictions on /usr? > > _______________________________________________ > > Beginners mailing list > > Beginners at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- ? ?????????, ????? ????. -------------- next part -------------- An HTML attachment was scrubbed... URL: From allbery.b at gmail.com Mon Oct 12 10:57:08 2015 From: allbery.b at gmail.com (Brandon Allbery) Date: Mon, 12 Oct 2015 06:57:08 -0400 Subject: [Haskell-beginners] Can't install Haskell platform on Mac OS X El Capitan In-Reply-To: References: <561B5F65.6030707@math.ntnu.no> Message-ID: On Mon, Oct 12, 2015 at 6:08 AM, Yury Pachin wrote: > Haskell platform - bad idea. Someone will have to explain to me why when the whole Haskell community considers cabal-install and the Platform --- supposedly *from* the community --- to be the works of the devil, you all haven't set out to rid the world of the evil incarnate that created them. We will as always ignore or explain away little inconveniences, in favor of our preferred utter hatred. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at snoyman.com Mon Oct 12 11:01:40 2015 From: michael at snoyman.com (Michael Snoyman) Date: Mon, 12 Oct 2015 14:01:40 +0300 Subject: [Haskell-beginners] Can't install Haskell platform on Mac OS X El Capitan In-Reply-To: References: <561B5F65.6030707@math.ntnu.no> Message-ID: On Mon, Oct 12, 2015 at 1:57 PM, Brandon Allbery wrote: > > On Mon, Oct 12, 2015 at 6:08 AM, Yury Pachin > wrote: > >> Haskell platform - bad idea. > > > Someone will have to explain to me why when the whole Haskell community > considers cabal-install and the Platform --- supposedly *from* the > community --- to be the works of the devil, you all haven't set out to rid > the world of the evil incarnate that created them. > > We will as always ignore or explain away little inconveniences, in favor > of our preferred utter hatred. > > > Actually, there _has_ been a lot of effort to both fix the Haskell Platform and - in the interim - get it off of the main download page. For example: https://mail.haskell.org/pipermail/haskell-community/2015-September/000014.html There was also a poll taken in response to a related thread on the community list: https://docs.google.com/forms/d/1w2wKSxn5YN4LtSXYHvFT2IFw_BDaT_2cjUkP9pDeqLQ/viewanalytics As you can see, the vast majority of the poll respondents wanted the HP to be the least recommended option on the page, and a number of comments said it should be done away with entirely. Michael -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Mon Oct 12 11:10:24 2015 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 12 Oct 2015 13:10:24 +0200 Subject: [Haskell-beginners] Can't install Haskell platform on Mac OS X El Capitan In-Reply-To: References: <561B5F65.6030707@math.ntnu.no> Message-ID: > the whole Haskell community considers cabal-install and the Platform ... is this a fact? the whole community? such a bad reputation? platform did not work for me but maybe it was because I tried it at quite an early stage and made a few mistakes. Now I build ghc from source so do not really need the platform. The only thing in the installation process which I find cumbersome is the chicken and egg situation: you need ghc to build ghc. If it were possible to build bootstrap ghc entirely from source with minimum deps, this would be good. I used cabal & cabal-install without problems so far. From hanche at math.ntnu.no Mon Oct 12 11:21:00 2015 From: hanche at math.ntnu.no (Harald Hanche-Olsen) Date: Mon, 12 Oct 2015 13:21:00 +0200 Subject: [Haskell-beginners] Can't install Haskell platform on Mac OS X El Capitan In-Reply-To: References: <561B5F65.6030707@math.ntnu.no> Message-ID: <561B979C.1020302@math.ntnu.no> Brandon Allbery wrote: > > On Mon, Oct 12, 2015 at 6:08 AM, Yury Pachin > wrote: > > Haskell platform - bad idea. > > > Someone will have to explain to me why when the whole Haskell community > considers cabal-install and the Platform --- supposedly *from* the > community --- to be the works of the devil, you all haven't set out to > rid the world of the evil incarnate that created them. Since it was my message that started that discussion on this thread, let me hasten to assure you that I don't hate the Platform. I still think it is good for users to know it's not the only game in town, however. Yes, I have had some difficulties with it, and it got a bit worse with El Capitan, but I really don't know to what extent that is just the usual beginner's trouble. After I switched to Haskell for Mac [sic] OS X, I have not had any trouble (*). But then I haven't used it as much as I used the Platform before, so I really cannot say which, if any of them, is superior. (*) Well, almost none: cabal-install failed on hledger because it wants pretty-show, and pretty-show wants happy, and somehow happy did not get built. Just running cabal-install happy fixed the problem. I'd report this as a bug if I knew where to report it. But I expect this sort of problem is unrelated to the Platform versus alternatives debate. ? Harald From johnw at newartisans.com Mon Oct 12 16:59:30 2015 From: johnw at newartisans.com (John Wiegley) Date: Mon, 12 Oct 2015 09:59:30 -0700 Subject: [Haskell-beginners] Can't install Haskell platform on Mac OS X El Capitan In-Reply-To: (Michael Snoyman's message of "Mon, 12 Oct 2015 14:01:40 +0300") References: <561B5F65.6030707@math.ntnu.no> Message-ID: >>>>> Michael Snoyman writes: > As you can see, the vast majority of the poll respondents wanted the HP to > be the least recommended option on the page, and a number of comments said > it should be done away with entirely. Just a note for others who might not have noticed: The HP is now last on the downloads list, as desired by many. One thing I'd like to distinguish is between the "HP today" that we deliver via that page, and the "HP as a product" -- that is, a single downloadable artifact that serves as the best way to get newcomers started with Haskell. We don't yet have the HP we want, although we're actively working toward it. What I hope is that any discussion of the Platform will take this difference into account. I sympathize with current frustration about the HP, yet the *role* the HP is supposed to fill is still valid. Maybe this means the HP becomes a pretty wrapper around cabal or stack, with a pre-seeded local repository so the user already has a copy of GHC after downloading it... I don't know. But we do want a "single point of entry" for downloaders, that satisfies the needs of both active Haskell developers who need to deliver their code to clients, and brand new users who know nothing about package management, and who just want a REPL to follow along with their professor. So let the technical arguments fly about current approaches, but I hope we can all rally a similar idea of what we want in the end: An easy start to Haskell, and an easy ongoing experience. John From gbalcerek72 at gmail.com Thu Oct 15 21:37:14 2015 From: gbalcerek72 at gmail.com (Grzegorz Balcerek) Date: Thu, 15 Oct 2015 23:37:14 +0200 Subject: [Haskell-beginners] Reader and ReaderT Message-ID: <56201C8A.9010704@gmail.com> Hi, I have the following program: import Control.Monad.Reader first :: Reader [String] String first = do strings <- ask return $ if (null strings) then "empty" else head strings printFirst :: ReaderT [String] IO () printFirst = do strings <- ask let theFirstString = runReader first strings liftIO $ putStrLn theFirstString main = runReaderT printFirst ["first","second"] It compiles and works. However, in the printFirst function I am explicitly using ask and I am calling runReader. Can I somehow avoid doing that? The following version of the printFirst function does not compile. printFirst :: ReaderT [String] IO () printFirst = do theFirstString <- first liftIO $ putStrLn theFirstString Program2.hs:11:21: Couldn't match type `Data.Functor.Identity.Identity' with `IO' Expected type: ReaderT [String] IO String Actual type: Reader [String] String In a stmt of a 'do' block: theFirstString <- first In the expression: do { theFirstString <- first; liftIO $ putStrLn theFirstString } Can I somehow call first without using ask and runReader ? Regards Grzegorz Balcerek From rasen.dubi at gmail.com Thu Oct 15 21:55:01 2015 From: rasen.dubi at gmail.com (Alexey Shmalko) Date: Fri, 16 Oct 2015 00:55:01 +0300 Subject: [Haskell-beginners] Reader and ReaderT In-Reply-To: <56201C8A.9010704@gmail.com> References: <56201C8A.9010704@gmail.com> Message-ID: Hi, You could generalize first to ReaderT [String] a String, so that you could use it as ReaderT [String] IO String. You don't need to change the implementation - just change the type. Hope this helps, Alexey On Fri, Oct 16, 2015 at 12:37 AM, Grzegorz Balcerek wrote: > Hi, > > I have the following program: > > import Control.Monad.Reader > > first :: Reader [String] String > first = do > strings <- ask > return $ if (null strings) then "empty" else head strings > > printFirst :: ReaderT [String] IO () > printFirst = do > strings <- ask > let theFirstString = runReader first strings > liftIO $ putStrLn theFirstString > > main = runReaderT printFirst ["first","second"] > > It compiles and works. However, in the printFirst function I am explicitly > using ask and I am calling runReader. > Can I somehow avoid doing that? > The following version of the printFirst function does not compile. > > printFirst :: ReaderT [String] IO () > printFirst = do > theFirstString <- first > liftIO $ putStrLn theFirstString > > > Program2.hs:11:21: > Couldn't match type `Data.Functor.Identity.Identity' with `IO' > Expected type: ReaderT [String] IO String > Actual type: Reader [String] String > In a stmt of a 'do' block: theFirstString <- first > In the expression: > do { theFirstString <- first; > liftIO $ putStrLn theFirstString } > > Can I somehow call first without using ask and runReader ? > > Regards > Grzegorz Balcerek > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From gbalcerek72 at gmail.com Fri Oct 16 10:46:27 2015 From: gbalcerek72 at gmail.com (Grzegorz Balcerek) Date: Fri, 16 Oct 2015 12:46:27 +0200 Subject: [Haskell-beginners] Reader and ReaderT In-Reply-To: References: <56201C8A.9010704@gmail.com> Message-ID: <5620D583.3050900@gmail.com> Thank you! This works: first :: (Monad a) => ReaderT [String] a String Grzegorz W dniu 2015-10-15 o 23:55, Alexey Shmalko pisze: > Hi, > > You could generalize first to ReaderT [String] a String, so that you > could use it as ReaderT [String] IO String. You don't need to change > the implementation - just change the type. > > Hope this helps, > Alexey > > On Fri, Oct 16, 2015 at 12:37 AM, Grzegorz Balcerek > wrote: >> Hi, >> >> I have the following program: >> >> import Control.Monad.Reader >> >> first :: Reader [String] String >> first = do >> strings <- ask >> return $ if (null strings) then "empty" else head strings >> >> printFirst :: ReaderT [String] IO () >> printFirst = do >> strings <- ask >> let theFirstString = runReader first strings >> liftIO $ putStrLn theFirstString >> >> main = runReaderT printFirst ["first","second"] >> >> It compiles and works. However, in the printFirst function I am explicitly >> using ask and I am calling runReader. >> Can I somehow avoid doing that? >> The following version of the printFirst function does not compile. >> >> printFirst :: ReaderT [String] IO () >> printFirst = do >> theFirstString <- first >> liftIO $ putStrLn theFirstString >> >> >> Program2.hs:11:21: >> Couldn't match type `Data.Functor.Identity.Identity' with `IO' >> Expected type: ReaderT [String] IO String >> Actual type: Reader [String] String >> In a stmt of a 'do' block: theFirstString <- first >> In the expression: >> do { theFirstString <- first; >> liftIO $ putStrLn theFirstString } >> >> Can I somehow call first without using ask and runReader ? >> >> Regards >> Grzegorz Balcerek >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From martin.drautzburg at web.de Fri Oct 16 20:28:47 2015 From: martin.drautzburg at web.de (martin) Date: Fri, 16 Oct 2015 22:28:47 +0200 Subject: [Haskell-beginners] State Monad: how to use other Stateful computation on sub-state inside Message-ID: <56215DFF.1080505@web.de> Hello all, I found myself writing this piece of code: -- | Create and add a new 'Item' to the system sysAddItem :: ItmLabel -> ItmVolume -> ItmCapacity -> Position -> Instant -> State System ItmId sysAddItem lbl vol cap pos t = do sys <- get id <- sysNextId :: State System Id itms' <- return $ execState (itmAdd' (Itm id lbl vol cap pos t)) (sysItems sys) --** modify (\sys -> sys{sysItems=itms'}) return id In the lonely line ** in the middle I use itmAdd' :: Item -> State ItemDb (), where the ItemDb is part of the 'System' and can be extracted via sysItems. I believe this code is correct, but I don't like it. The expression to the right of <- must have the type State System ItemDb But ItemAdd' has the type Item -> State ItemDb () So I need to transform (Item -> State ItemDb ()) to (State System ItemDb). There is no question that I have to pass the Item, but the transformation of the States is quite noisy. Is there a better way to make this transformation, given a function System->ItemDb (i.e. sysItems)? From grzegorzmilka at gmail.com Sat Oct 17 06:09:24 2015 From: grzegorzmilka at gmail.com (Grzegorz Milka) Date: Sat, 17 Oct 2015 08:09:24 +0200 Subject: [Haskell-beginners] State Monad: how to use other Stateful computation on sub-state inside In-Reply-To: <56215DFF.1080505@web.de> References: <56215DFF.1080505@web.de> Message-ID: <5621E614.5030306@gmail.com> Hi Martin, I will present a few possibilities so that you can choose one that's available to you. Let's first think about what the code is doing. It is adding an item to the ItemDB. However you are operating on the granulity of a System so you want a function of type:itmAdd :: Item -> System -> System. If we had it then we could write: sysAddItem lbl vol cap pos t = do sys <- get id <- sysNextId :: State SystemId modify $ itmAdd (Itm id lbl vol cap pos t) return id That looks nicer. I'm guessing you don't have itmAdd at hand. One way would be to write it ourselves using itmAdd': itmAdd :: Item -> System -> System itmAdd item s = s{sysItems=execState (itmAdd' item) (sysItems s)} So this solution only hides the ugliness. The reason why it appears is because itmAdd' has a too specific type - an unnecessary State. What it essentially does is it adds an Item to ItemDB, so: itmAdd'' :: Item -> ItemDB -> ItemDB, then the function would look better. I myself would first write itmAdd'' (instead of itmAdd') and then if I really needed itmAdd' in multiple places I would write itmAdd item s = s{sysItems=itmAdd'' item $ sysItems s} itmAdd' item = modify $ itmAdd'' item The code here still may look nicer, but only slightly. My message here is that it is beneficial to think first about what are the most general types that you need and then perhaps splitting them into a combination of other general types. Here the root cause of the ugliness is that you too an unnecessarily specific type of itemAdd'. Best regards, Grzegorz On 16.10.2015 22:28, martin wrote: > Hello all, > > I found myself writing this piece of code: > > -- | Create and add a new 'Item' to the system > sysAddItem :: ItmLabel -> ItmVolume -> ItmCapacity -> Position -> Instant > -> State System ItmId > > sysAddItem lbl vol cap pos t = do > sys <- get > id <- sysNextId :: State System Id > > itms' <- return $ execState (itmAdd' (Itm id lbl vol cap pos t)) (sysItems sys) --** > > modify (\sys -> sys{sysItems=itms'}) > return id > > > In the lonely line ** in the middle I use > > itmAdd' :: Item -> State ItemDb (), > > where the ItemDb is part of the 'System' and can be extracted via sysItems. I believe this code is correct, but I don't > like it. > > The expression to the right of <- must have the type > > State System ItemDb > > But ItemAdd' has the type > > Item -> State ItemDb () > > So I need to transform > > (Item -> State ItemDb ()) to (State System ItemDb). > > There is no question that I have to pass the Item, but the transformation of the States is quite noisy. Is there a > better way to make this transformation, given a function System->ItemDb (i.e. sysItems)? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From karl at karlv.net Sat Oct 17 07:40:13 2015 From: karl at karlv.net (Karl Voelker) Date: Sat, 17 Oct 2015 00:40:13 -0700 Subject: [Haskell-beginners] State Monad: how to use other Stateful computation on sub-state inside In-Reply-To: <56215DFF.1080505@web.de> References: <56215DFF.1080505@web.de> Message-ID: > On Oct 16, 2015, at 1:28 PM, martin wrote: > > The expression to the right of <- must have the type > > State System ItemDb > > But ItemAdd' has the type > > Item -> State ItemDb () You have an insight here which is quite general. If you have a monad State s, where s has a subcomponent of type t, you should be able to transform any action State t a into an ?equivalent? action State s a, where instead of acting on the whole state, you act on the subcomponent. What would we need in order to do that transformation in a general way? A function to get the subcomponent out of the whole, and a function to put the new value of the subcomponent back into the whole. In other words, we?d need functions of types s -> t and t -> s -> s. Putting all of that together, we can imagine a transformation like this: f :: (s -> t) -> (t -> s -> s) -> State t a -> State s a I know of some libraries which provide a function with roughly that same type. The difference is that the first two parameters, the ?getter? and ?setter?, are combined into one parameter, and this combined thing is called a ?lens?. Lenses are useful in all kinds of situations, and this just happens to be one of them. Of course, if you don?t already have a lens, any lens library will give you a way to build one out of the getter and setter functions. Anyway, the two library functions which provide this transformation are called focus (in the data-lens-fd package, which is used with the lens type defined in the data-lens package) [1] and zoom (in the lens package) [2]. The lens package is more powerful, but also a good deal more confusing, so I would start with data-lens and data-lens-fd if you want a gentle introduction to lenses. -Karl 1: http://hackage.haskell.org/package/data-lens-fd-2.0.5/docs/Data-Lens.html#v:focus 2: http://hackage.haskell.org/package/lens-4.13/docs/Control-Lens-Zoom.html#v:zoom From martin.drautzburg at web.de Sat Oct 17 08:01:00 2015 From: martin.drautzburg at web.de (martin) Date: Sat, 17 Oct 2015 10:01:00 +0200 Subject: [Haskell-beginners] State Monad: how to use other Stateful computation on sub-state inside In-Reply-To: <5621E614.5030306@gmail.com> References: <56215DFF.1080505@web.de> <5621E614.5030306@gmail.com> Message-ID: <5622003C.60603@web.de> This is quite insightful. Now the problem presents itself as follows: In fact I orginally started with plain itmAdd (the one you called itmAdd'') which has no business with State or System. It is just Item->ItemDb -> ItemDb. However, I wanted to use do-notation and made it monadic leading to item' :: Item->State ItemDb () But then it becomes difficult to use it inside State System. Currently I am using subState :: (s1 -> s2) -> State s2 a -> State s1 s2 subState accessor f = do s <- get return $ execState f $ accessor s to make the necessary transformation. I have the feeling that this way of stacking things is a bit inside-out. And as you say, it only hides the ugliness. I will try to stack things bottom up. Am 10/17/2015 um 08:09 AM schrieb Grzegorz Milka: > Hi Martin, > > I will present a few possibilities so that you can choose one that's > available to you. > > Let's first think about what the code is doing. It is adding an item to > the ItemDB. However you are operating on the granulity of a System so > you want a function of type:itmAdd :: Item -> System -> System. If we > had it then we could write: > > sysAddItem lbl vol cap pos t = do > sys <- get > id <- sysNextId :: State SystemId > modify $ itmAdd (Itm id lbl vol cap pos t) > return id > > That looks nicer. I'm guessing you don't have itmAdd at hand. One way > would be to write it ourselves using itmAdd': > > itmAdd :: Item -> System -> System > itmAdd item s = s{sysItems=execState (itmAdd' item) (sysItems s)} > > So this solution only hides the ugliness. The reason why it appears is > because itmAdd' has a too specific type - an unnecessary State. What it > essentially does is it adds an Item to ItemDB, so: itmAdd'' :: Item -> > ItemDB -> ItemDB, then the function would look better. I myself would > first write itmAdd'' (instead of itmAdd') and then if I really needed > itmAdd' in multiple places I would write > > itmAdd item s = s{sysItems=itmAdd'' item $ sysItems s} > itmAdd' item = modify $ itmAdd'' item > > The code here still may look nicer, but only slightly. My message here > is that it is beneficial to think first about what are the most general > types that you need and then perhaps splitting them into a combination > of other general types. Here the root cause of the ugliness is that you > too an unnecessarily specific type of itemAdd'. > > Best regards, > Grzegorz > > On 16.10.2015 22:28, martin wrote: >> Hello all, >> >> I found myself writing this piece of code: >> >> -- | Create and add a new 'Item' to the system >> sysAddItem :: ItmLabel -> ItmVolume -> ItmCapacity -> Position -> Instant >> -> State System ItmId >> >> sysAddItem lbl vol cap pos t = do >> sys <- get >> id <- sysNextId :: State System Id >> >> itms' <- return $ execState (itmAdd' (Itm id lbl vol cap pos t)) (sysItems sys) --** >> >> modify (\sys -> sys{sysItems=itms'}) >> return id >> >> >> In the lonely line ** in the middle I use >> >> itmAdd' :: Item -> State ItemDb (), >> >> where the ItemDb is part of the 'System' and can be extracted via sysItems. I believe this code is correct, but I don't >> like it. >> >> The expression to the right of <- must have the type >> >> State System ItemDb >> >> But ItemAdd' has the type >> >> Item -> State ItemDb () >> >> So I need to transform >> >> (Item -> State ItemDb ()) to (State System ItemDb). >> >> There is no question that I have to pass the Item, but the transformation of the States is quite noisy. Is there a >> better way to make this transformation, given a function System->ItemDb (i.e. sysItems)? >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From martin.drautzburg at web.de Sat Oct 17 13:58:53 2015 From: martin.drautzburg at web.de (martin) Date: Sat, 17 Oct 2015 15:58:53 +0200 Subject: [Haskell-beginners] State Monad: how to use other Stateful computation on sub-state inside In-Reply-To: <5622003C.60603@web.de> References: <56215DFF.1080505@web.de> <5621E614.5030306@gmail.com> <5622003C.60603@web.de> Message-ID: <5622541D.3000606@web.de> Am 10/17/2015 um 10:01 AM schrieb martin: > This is quite insightful. Now the problem presents itself as follows: > > In fact I orginally started with plain itmAdd (the one you called itmAdd'') which has no business with State or System. > It is just Item->ItemDb -> ItemDb. > > However, I wanted to use do-notation and made it monadic leading to item' :: Item->State ItemDb () > > But then it becomes difficult to use it inside State System. Currently I am using > > subState :: (s1 -> s2) -> State s2 a -> State s1 s2 > subState accessor f = do > s <- get > return $ execState f $ accessor s > > to make the necessary transformation. I have the feeling that this way of stacking things is a bit inside-out. And as > you say, it only hides the ugliness. I will try to stack things bottom up. This turned out okay. Thank you very much and many thanks to Karl Voelker too, though I am still shying away from lenses. From neuralpancake at gmail.com Sun Oct 18 02:17:04 2015 From: neuralpancake at gmail.com (Frothy Bits) Date: Sat, 17 Oct 2015 19:17:04 -0700 Subject: [Haskell-beginners] ghci: inconsistent return values for succ Message-ID: Greetings, Absolutely brand new to Haskell. Taking ghci v7.10.2 out for a spin, and I find I get inconsistent return values for succ n: ghci> succ 3.14 4.1400000000000001 for example instead of the expected 4.14 succ 2.14 and 4.14 give the expected results. but succ 2.14 returns 2.1399999999999997. This anomalous behavior runs through the range of n.nn; in the n.01 range, for example, 16.01 and 63.01 return wonky results per above. I tested this on Windows and Linux (various flavors) and I get the same results there and in the interactive test code space on haskell.org. I'm not familiar enough with the language, yet, to go debugging this on my own, but it would seem to be at least a problem with how succ is implemented, if not how values are handled in general.....which could potentially be bad if you were trying to do anything requiring precise calculations.... -------------- next part -------------- An HTML attachment was scrubbed... URL: From strombrg at gmail.com Sun Oct 18 02:21:47 2015 From: strombrg at gmail.com (Dan Stromberg) Date: Sat, 17 Oct 2015 19:21:47 -0700 Subject: [Haskell-beginners] ghci: inconsistent return values for succ In-Reply-To: References: Message-ID: On Sat, Oct 17, 2015 at 7:17 PM, Frothy Bits wrote: > Greetings, > > Absolutely brand new to Haskell. Taking ghci v7.10.2 out for a spin, and > I find I get inconsistent return values for succ n: > > ghci> succ 3.14 > 4.1400000000000001 > > for example instead of the expected 4.14 > This is pretty standard for today's floating point hardware in CPU's. It's not a Haskell thing. It comes up in C and Python too - that is, in pretty much anything that uses hardware floating point. If you need precision, try an integral type or a rational. -- Dan Stromberg -------------- next part -------------- An HTML attachment was scrubbed... URL: From neuralpancake at gmail.com Sun Oct 18 02:48:38 2015 From: neuralpancake at gmail.com (Frothy Bits) Date: Sat, 17 Oct 2015 19:48:38 -0700 Subject: [Haskell-beginners] ghci: inconsistent return values for succ In-Reply-To: References: Message-ID: @ Dan Stromberg: Thanks, understood. On Sat, Oct 17, 2015 at 7:17 PM, Frothy Bits wrote: > Greetings, > > Absolutely brand new to Haskell. Taking ghci v7.10.2 out for a spin, and > I find I get inconsistent return values for succ n: > > ghci> succ 3.14 > 4.1400000000000001 > > for example instead of the expected 4.14 > > succ 2.14 and 4.14 give the expected results. but succ 2.14 returns > 2.1399999999999997. This anomalous behavior runs through the range of > n.nn; in the n.01 range, for example, 16.01 and 63.01 return wonky results > per above. > > I tested this on Windows and Linux (various flavors) and I get the same > results there and in the interactive test code space on haskell.org. > > I'm not familiar enough with the language, yet, to go debugging this on my > own, but it would seem to be at least a problem with how succ is > implemented, if not how values are handled in general.....which could > potentially be bad if you were trying to do anything requiring precise > calculations.... > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From k-bx at k-bx.com Sun Oct 18 09:15:38 2015 From: k-bx at k-bx.com (Kostiantyn Rybnikov) Date: Sun, 18 Oct 2015 12:15:38 +0300 Subject: [Haskell-beginners] ghci: inconsistent return values for succ In-Reply-To: References: Message-ID: If you use Decimal package [0], you can have what you want: ? succ (3.14 :: Decimal) 4.14 [0]: https://hackage.haskell.org/package/Decimal On Sun, Oct 18, 2015 at 5:17 AM, Frothy Bits wrote: > Greetings, > > Absolutely brand new to Haskell. Taking ghci v7.10.2 out for a spin, and > I find I get inconsistent return values for succ n: > > ghci> succ 3.14 > 4.1400000000000001 > > for example instead of the expected 4.14 > > succ 2.14 and 4.14 give the expected results. but succ 2.14 returns > 2.1399999999999997. This anomalous behavior runs through the range of > n.nn; in the n.01 range, for example, 16.01 and 63.01 return wonky results > per above. > > I tested this on Windows and Linux (various flavors) and I get the same > results there and in the interactive test code space on haskell.org. > > I'm not familiar enough with the language, yet, to go debugging this on my > own, but it would seem to be at least a problem with how succ is > implemented, if not how values are handled in general.....which could > potentially be bad if you were trying to do anything requiring precise > calculations.... > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From neuralpancake at gmail.com Sun Oct 18 15:57:38 2015 From: neuralpancake at gmail.com (Frothy Bits) Date: Sun, 18 Oct 2015 08:57:38 -0700 Subject: [Haskell-beginners] ghci: inconsistent return values for succ In-Reply-To: References: Message-ID: @ Kostiantyn: Thank you. Is the behavior I'm seeing actually related to a bug in parsec? http://stackoverflow.com/questions/29820870/floating-point-numbers-precision-and-parsec Yes or no, why wouldn't it be the default behavior of ghc to load the Decimal package? OTOH, the current default floating point behavior certainly got me thinking and digging: http://docs.oracle.com/cd/E19957-01/806-3568/ncg_goldberg.html On Sat, Oct 17, 2015 at 7:48 PM, Frothy Bits wrote: > @ Dan Stromberg: Thanks, understood. > > On Sat, Oct 17, 2015 at 7:17 PM, Frothy Bits > wrote: > >> Greetings, >> >> Absolutely brand new to Haskell. Taking ghci v7.10.2 out for a spin, and >> I find I get inconsistent return values for succ n: >> >> ghci> succ 3.14 >> 4.1400000000000001 >> >> for example instead of the expected 4.14 >> >> succ 2.14 and 4.14 give the expected results. but succ 2.14 returns >> 2.1399999999999997. This anomalous behavior runs through the range of >> n.nn; in the n.01 range, for example, 16.01 and 63.01 return wonky results >> per above. >> >> I tested this on Windows and Linux (various flavors) and I get the same >> results there and in the interactive test code space on haskell.org. >> >> I'm not familiar enough with the language, yet, to go debugging this on >> my own, but it would seem to be at least a problem with how succ is >> implemented, if not how values are handled in general.....which could >> potentially be bad if you were trying to do anything requiring precise >> calculations.... >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From k-bx at k-bx.com Sun Oct 18 16:56:51 2015 From: k-bx at k-bx.com (Kostiantyn Rybnikov) Date: Sun, 18 Oct 2015 19:56:51 +0300 Subject: [Haskell-beginners] ghci: inconsistent return values for succ In-Reply-To: References: Message-ID: > Is the behavior I'm seeing actually related to a bug in parsec? No, I don't think GHC relies on parsec at all. > Yes or no, why wouldn't it be the default behavior of ghc to load the Decimal package? Decimal is very inefficient, because it's implemented as a pair of numbers: Word8 to describe a position of a dot, and Integer to describe number itself. E.g., (3.14 :: Decimal) is the same as directly writing (Decimal 2 314). Integer, unlike Int and Double, is very inefficient for computation-heavy code. Interesting find! Ghc (its base library) provides Data.Fixed [0] module with similar purposes to Decimal. Initially I couldn't recommend it, since I thought it has the same Double-related behavior, but when I digged into it now, I found out that it's probably a bug (or a "feature") in "succ" implementation: ? succ (3.14 :: Fixed E12) 3.140000000001 ? (3.14 :: Fixed E12) + 1 4.140000000000 So, if you don't want to use Decimal, you can just use Data.Fixed (I find Decimal a bit more elegant though). [0]: https://hackage.haskell.org/package/base-4.8.1.0/docs/Data-Fixed.html On Sun, Oct 18, 2015 at 6:57 PM, Frothy Bits wrote: > @ Kostiantyn: Thank you. > > Is the behavior I'm seeing actually related to a bug in parsec? > > > http://stackoverflow.com/questions/29820870/floating-point-numbers-precision-and-parsec > > Yes or no, why wouldn't it be the default behavior of ghc to load the > Decimal package? > > OTOH, the current default floating point behavior certainly got me > thinking and digging: > > http://docs.oracle.com/cd/E19957-01/806-3568/ncg_goldberg.html > > > > > > On Sat, Oct 17, 2015 at 7:48 PM, Frothy Bits > wrote: > >> @ Dan Stromberg: Thanks, understood. >> >> On Sat, Oct 17, 2015 at 7:17 PM, Frothy Bits >> wrote: >> >>> Greetings, >>> >>> Absolutely brand new to Haskell. Taking ghci v7.10.2 out for a spin, >>> and I find I get inconsistent return values for succ n: >>> >>> ghci> succ 3.14 >>> 4.1400000000000001 >>> >>> for example instead of the expected 4.14 >>> >>> succ 2.14 and 4.14 give the expected results. but succ 2.14 returns >>> 2.1399999999999997. This anomalous behavior runs through the range of >>> n.nn; in the n.01 range, for example, 16.01 and 63.01 return wonky results >>> per above. >>> >>> I tested this on Windows and Linux (various flavors) and I get the same >>> results there and in the interactive test code space on haskell.org. >>> >>> I'm not familiar enough with the language, yet, to go debugging this on >>> my own, but it would seem to be at least a problem with how succ is >>> implemented, if not how values are handled in general.....which could >>> potentially be bad if you were trying to do anything requiring precise >>> calculations.... >>> >>> >> > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From iustin at k1024.org Sun Oct 18 17:47:21 2015 From: iustin at k1024.org (Iustin Pop) Date: Sun, 18 Oct 2015 19:47:21 +0200 Subject: [Haskell-beginners] ghci: inconsistent return values for succ In-Reply-To: References: Message-ID: <20151018174721.GC24159@teal.hq.k1024.org> On 2015-10-17 19:17:04, Frothy Bits wrote: > Greetings, > > Absolutely brand new to Haskell. Taking ghci v7.10.2 out for a spin, and I > find I get inconsistent return values for succ n: > > ghci> succ 3.14 > 4.1400000000000001 > > for example instead of the expected 4.14 Separately from the technical implementation of succ for floating point numbers, does it actually make sense to ask for the successor of a non-integral value? There must be some reason why Float and Double implement the Enum class, but I can't understand in what sense (mathematically) are real numbers enumerable. confused, iustin From rein.henrichs at gmail.com Sun Oct 18 18:11:10 2015 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Sun, 18 Oct 2015 18:11:10 +0000 Subject: [Haskell-beginners] ghci: inconsistent return values for succ In-Reply-To: <20151018174721.GC24159@teal.hq.k1024.org> References: <20151018174721.GC24159@teal.hq.k1024.org> Message-ID: This has nothing to do with Parsec or Decimal. Two things are happening: First, the type of the literal 3.14 is Fractional a => a. GHCi's extended default rules [1] pick Double as the default for Fractional. (This is a good choice.) Second, the closest number to 4.14 that is reresentable as a Double is 4.1400000000000001. This is an inherent limitation of the representation used. This effects every use of floating point numbers in every programming language, and every programmer should understand this. See [2] for more information. For an exact result, you can provide a different type for your Fractional literal that is capable of representing the result exactly: > succ 3.14 :: Rational 207 % 50 > There must be some reason why Float and Double implement the Enum class, > but I can't understand in what sense (mathematically) are real numbers enumerable You're absolutely right. It is, at best, a kludge and has no mathematical justification. [1] https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/interactive-evaluation.html#extended-default-rules [2] https://docs.oracle.com/cd/E19957-01/806-3568/ncg_goldberg.html > -------------- next part -------------- An HTML attachment was scrubbed... URL: From neuralpancake at gmail.com Mon Oct 19 04:14:57 2015 From: neuralpancake at gmail.com (Frothy Bits) Date: Sun, 18 Oct 2015 21:14:57 -0700 Subject: [Haskell-beginners] ghci: inconsistent return values for succ In-Reply-To: References: Message-ID: @ Kostiantyn: Thank you again for the links to Decimal and Data.Fixed @ Iustin: You're absolutely correct, I was abusing succ. I blame myself. @ Rein: Thank you, I'd previously shared the goldberg paper; it's illuminating. Fwiw, prior to adventures with succ, I'd noticed that simple operations on certain simple real numbers would give "exciting" results. (Undoubtedly, I should have just gone with that instead of posting about succ; apologies again for confusing Iustin.) ghci> map (+ 0.01)[0.01,0.02 .. 1.00] for example, gave me a nice list of visually stimulating values for the reasons Rein and Kostiantyn pointed out. With succ, I wondered what I would see if I did something "wrong." My assumption was that it would flail and give me an error message, something along the lines of "Fool, that is not the proper way to succ. Go play with natural numbers." That I'd get occasionally expected values with either the above or succ was.....peculiar, until reading Kostiantyn's replies and finding and reading the Goldberg paper, not to mention having a "Forth moment" and remembering scaled integer...... I (foolishly or not) made the assumption that Haskell would do something different with floats "out of the box." I do realize the same issues are inherent in other languages, but I wondered if it might be "smart," recognize I was calculating with real numbers and automagically either load what I needed or point me in that direction. That said, I really appreciate Rein's reply and recognize that picking Double for the extended default rules is "a good choice." Anyway, after loading Data.Fixed, this produces reasonable output: ghci> map (+ (0.01 :: Fixed E2)) [0.01,0.02 .. 1.01] Back to reading and learning by cutting myself. Thanks again all. On Sun, Oct 18, 2015 at 8:57 AM, Frothy Bits wrote: > @ Kostiantyn: Thank you. > > Is the behavior I'm seeing actually related to a bug in parsec? > > > http://stackoverflow.com/questions/29820870/floating-point-numbers-precision-and-parsec > > Yes or no, why wouldn't it be the default behavior of ghc to load the > Decimal package? > > OTOH, the current default floating point behavior certainly got me > thinking and digging: > > http://docs.oracle.com/cd/E19957-01/806-3568/ncg_goldberg.html > > > > > > On Sat, Oct 17, 2015 at 7:48 PM, Frothy Bits > wrote: > >> @ Dan Stromberg: Thanks, understood. >> >> On Sat, Oct 17, 2015 at 7:17 PM, Frothy Bits >> wrote: >> >>> Greetings, >>> >>> Absolutely brand new to Haskell. Taking ghci v7.10.2 out for a spin, >>> and I find I get inconsistent return values for succ n: >>> >>> ghci> succ 3.14 >>> 4.1400000000000001 >>> >>> for example instead of the expected 4.14 >>> >>> succ 2.14 and 4.14 give the expected results. but succ 2.14 returns >>> 2.1399999999999997. This anomalous behavior runs through the range of >>> n.nn; in the n.01 range, for example, 16.01 and 63.01 return wonky results >>> per above. >>> >>> I tested this on Windows and Linux (various flavors) and I get the same >>> results there and in the interactive test code space on haskell.org. >>> >>> I'm not familiar enough with the language, yet, to go debugging this on >>> my own, but it would seem to be at least a problem with how succ is >>> implemented, if not how values are handled in general.....which could >>> potentially be bad if you were trying to do anything requiring precise >>> calculations.... >>> >>> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ky3 at atamo.com Mon Oct 19 05:05:12 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Mon, 19 Oct 2015 12:05:12 +0700 Subject: [Haskell-beginners] ghci: inconsistent return values for succ In-Reply-To: References: Message-ID: On Sun, Oct 18, 2015 at 10:57 PM, Frothy Bits wrote: > Is the behavior I'm seeing actually related to a bug in parsec? If you're interested in digging deeper, I'd say look at the output, not the input end. Almost certainly the machine floating-point double for 3.14 and (3.14+1.0) are identical across ghc, C, and python. What's not identical is how different languages choose to display 4.14. C and python do some display rounding so you don't see the issue. The display algorithm in Haskell probably goes for the simple, naive approach. -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From rein.henrichs at gmail.com Mon Oct 19 10:13:50 2015 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Mon, 19 Oct 2015 10:13:50 +0000 Subject: [Haskell-beginners] ghci: inconsistent return values for succ In-Reply-To: References: Message-ID: > That said, I really appreciate Rein's reply and recognize that picking Double for the extended default rules is "a good choice." To follow up a bit, the reason that it's a good choice is pragmatic: we usually prefer to work with such numbers using native floating point math for speed rather than using rational or computable real or other representations which are more accurate but many orders of magnitude slower. If I said 3.5 + 1 in any general purpose language, I would be surprised if it did anything other than an immediate floating point calculation, and so it is (by default) in Haskell. If we want another representation then we must reach for it, but we don't need to reach very far. On Sun, Oct 18, 2015 at 10:05 PM Kim-Ee Yeoh wrote: > > On Sun, Oct 18, 2015 at 10:57 PM, Frothy Bits > wrote: > >> Is the behavior I'm seeing actually related to a bug in parsec? > > > If you're interested in digging deeper, I'd say look at the output, not > the input end. Almost certainly the machine floating-point double for 3.14 > and (3.14+1.0) are identical across ghc, C, and python. > > What's not identical is how different languages choose to display 4.14. > > C and python do some display rounding so you don't see the issue. The > display algorithm in Haskell probably goes for the simple, naive approach. > > -- Kim-Ee > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From strombrg at gmail.com Tue Oct 20 15:58:46 2015 From: strombrg at gmail.com (Dan Stromberg) Date: Tue, 20 Oct 2015 08:58:46 -0700 Subject: [Haskell-beginners] Why can't I print an IO Integer? Message-ID: Here's a small program that replicates the compilation issue I'm seeing: import qualified System.Posix.Files get_size :: String -> IO Integer get_size filename = do file_status <- System.Posix.Files.getFileStatus filename let file_size = System.Posix.Files.fileSize file_status let integer_file_size = fromIntegral file_size return integer_file_size main :: IO () main = do let filenames = ["/etc/services"] let sizes = map get_size filenames mapM_ print sizes The compilation error I get is: ghc -Wall --make -o stat2 stat2.hs [1 of 1] Compiling Main ( stat2.hs, stat2.o ) stat2.hs:15:11: No instance for (Show (IO Integer)) arising from a use of `print' Possible fix: add an instance declaration for (Show (IO Integer)) In the first argument of `mapM_', namely `print' In a stmt of a 'do' block: mapM_ print sizes In the expression: do { let filenames = ...; let sizes = map get_size filenames; mapM_ print sizes } make: *** [stat2] Error 1 I've googled quite a bit, and guessed quite a bit, and added type declarations some, but I'm still not converging on a solution. Why can't I print an IO Integer? Thanks! -- Dan Stromberg -------------- next part -------------- An HTML attachment was scrubbed... URL: From petr.vapenka at gmail.com Tue Oct 20 16:15:00 2015 From: petr.vapenka at gmail.com (=?UTF-8?Q?Petr_V=C3=A1penka?=) Date: Tue, 20 Oct 2015 18:15:00 +0200 Subject: [Haskell-beginners] Why can't I print an IO Integer? In-Reply-To: References: Message-ID: Hello Dan, `IO Integer` is something that, when executed, returns and `Integer` and there is no instance of `Show` for `IO Integer` as the compiler says. You have to run the computations that will return the numbers and then print them, like so: main :: IO () main = do let filenames = ["/etc/services"] let ioSizes = map get_size filenames :: [IO Integer] sizes <- sequence ioSizes mapM_ print sizes -- sequence :: Monad m => [m a] -> m [a] One important part is the use of sequence which transforms (ioSizes :: [IO Integer]) to `IO [Integer]` that is run and the result bound to (sizes : [Integer]). Hope that's clear enough to get the point :) Petr On Tue, Oct 20, 2015 at 5:58 PM, Dan Stromberg wrote: > > Here's a small program that replicates the compilation issue I'm seeing: > > import qualified System.Posix.Files > > get_size :: String -> IO Integer > get_size filename = do > file_status <- System.Posix.Files.getFileStatus filename > let file_size = System.Posix.Files.fileSize file_status > let integer_file_size = fromIntegral file_size > return integer_file_size > > main :: IO () > main = do > let filenames = ["/etc/services"] > let sizes = map get_size filenames > mapM_ print sizes > > The compilation error I get is: > > ghc -Wall --make -o stat2 stat2.hs > [1 of 1] Compiling Main ( stat2.hs, stat2.o ) > > stat2.hs:15:11: > No instance for (Show (IO Integer)) arising from a use of `print' > Possible fix: add an instance declaration for (Show (IO Integer)) > In the first argument of `mapM_', namely `print' > In a stmt of a 'do' block: mapM_ print sizes > In the expression: > do { let filenames = ...; > let sizes = map get_size filenames; > mapM_ print sizes } > make: *** [stat2] Error 1 > > I've googled quite a bit, and guessed quite a bit, and added type > declarations some, but I'm still not converging on a solution. > > Why can't I print an IO Integer? > > Thanks! > > -- > Dan Stromberg > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcin.jan.mrotek at gmail.com Tue Oct 20 16:17:14 2015 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Tue, 20 Oct 2015 18:17:14 +0200 Subject: [Haskell-beginners] Why can't I print an IO Integer? In-Reply-To: References: Message-ID: Hello, Function "print" has type "Show a => a -> IO ()". To use it with a value of type "IO Int", you need to use (>>=), which, specialized to IO, has type "IO a -> (a -> IO b) -> IO b". "print =<< foo", if foo :: IO Int, will have type IO () and is going to print the integer from foo. In your code, though, you can use mapM instead of map: sizes <- mapM get_size filenames mapM_ print sizes Best regards, Marcin Mrotek -------------- next part -------------- An HTML attachment was scrubbed... URL: From strombrg at gmail.com Tue Oct 20 19:28:30 2015 From: strombrg at gmail.com (Dan Stromberg) Date: Tue, 20 Oct 2015 12:28:30 -0700 Subject: [Haskell-beginners] Why can't I print an IO Integer? In-Reply-To: References: Message-ID: Please correct my inference if I'm wrong: An IO Integer is not an integer, it's a promise to read an Integer later. The "sequence" function tells the runtime it's time to make good on that promise. Sound about right? Thanks! On Tue, Oct 20, 2015 at 9:15 AM, Petr V?penka wrote: > Hello Dan, > > `IO Integer` is something that, when executed, returns and `Integer` and > there is no instance of `Show` for `IO Integer` as the compiler says. > > You have to run the computations that will return the numbers and then > print them, like so: > > main :: IO () > main = do > let filenames = ["/etc/services"] > let ioSizes = map get_size filenames :: [IO Integer] > sizes <- sequence ioSizes > mapM_ print sizes > > -- sequence :: Monad m => [m a] -> m [a] > > One important part is the use of sequence which transforms (ioSizes :: [IO > Integer]) to `IO [Integer]` that is run and the result bound to (sizes : > [Integer]). > > Hope that's clear enough to get the point :) > > Petr > > On Tue, Oct 20, 2015 at 5:58 PM, Dan Stromberg wrote: > >> >> Here's a small program that replicates the compilation issue I'm seeing: >> >> import qualified System.Posix.Files >> >> get_size :: String -> IO Integer >> get_size filename = do >> file_status <- System.Posix.Files.getFileStatus filename >> let file_size = System.Posix.Files.fileSize file_status >> let integer_file_size = fromIntegral file_size >> return integer_file_size >> >> main :: IO () >> main = do >> let filenames = ["/etc/services"] >> let sizes = map get_size filenames >> mapM_ print sizes >> >> The compilation error I get is: >> >> ghc -Wall --make -o stat2 stat2.hs >> [1 of 1] Compiling Main ( stat2.hs, stat2.o ) >> >> stat2.hs:15:11: >> No instance for (Show (IO Integer)) arising from a use of `print' >> Possible fix: add an instance declaration for (Show (IO Integer)) >> In the first argument of `mapM_', namely `print' >> In a stmt of a 'do' block: mapM_ print sizes >> In the expression: >> do { let filenames = ...; >> let sizes = map get_size filenames; >> mapM_ print sizes } >> make: *** [stat2] Error 1 >> >> I've googled quite a bit, and guessed quite a bit, and added type >> declarations some, but I'm still not converging on a solution. >> >> Why can't I print an IO Integer? >> >> Thanks! >> >> -- >> Dan Stromberg >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> >> > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -- Dan Stromberg -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcin.jan.mrotek at gmail.com Tue Oct 20 19:36:30 2015 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Tue, 20 Oct 2015 21:36:30 +0200 Subject: [Haskell-beginners] Why can't I print an IO Integer? In-Reply-To: References: Message-ID: > An IO Integer is not an integer, it's a promise to read an Integer later. The "sequence" function tells the runtime it's time to make good on that promise. Not exactly. You don't need "sequence" for a plain (IO Int), only for a list of IO actions. "sequence" just changes a "list of promises" into a "promise of a list": sequence :: (Traversable t, Monad m) => t (m a) -> m (t a) When specialized to IO and a list, the function becomes: sequence :: [IO a] -> IO [a] Also, for any f: sequence . map f === mapM f It is when you bind its result to your "main" (with "do" notation or (>>) and (>>=) operators) when it can interact with the rest of your program. You can bind it more than once, and it will be executed more than one time, like any other "IO something". Best regards, Marcin Mrotek From petr.vapenka at gmail.com Tue Oct 20 19:37:38 2015 From: petr.vapenka at gmail.com (=?UTF-8?Q?Petr_V=C3=A1penka?=) Date: Tue, 20 Oct 2015 21:37:38 +0200 Subject: [Haskell-beginners] Why can't I print an IO Integer? In-Reply-To: References: Message-ID: Using your wording, sequence makes from a `list of promises of integer` a `promise of list of integers`. You can get the value out of a promise using bind, ie using `<-` in do notation as written below. ioA :: IO Int ioA = return 1 main :: IO () main = do a <- ioA print a This may help: http://learnyouahaskell.com/input-and-output On Tue, Oct 20, 2015 at 9:28 PM, Dan Stromberg wrote: > > Please correct my inference if I'm wrong: > > An IO Integer is not an integer, it's a promise to read an Integer later. > The "sequence" function tells the runtime it's time to make good on that > promise. > > Sound about right? > > Thanks! > > On Tue, Oct 20, 2015 at 9:15 AM, Petr V?penka > wrote: > >> Hello Dan, >> >> `IO Integer` is something that, when executed, returns and `Integer` and >> there is no instance of `Show` for `IO Integer` as the compiler says. >> >> You have to run the computations that will return the numbers and then >> print them, like so: >> >> main :: IO () >> main = do >> let filenames = ["/etc/services"] >> let ioSizes = map get_size filenames :: [IO Integer] >> sizes <- sequence ioSizes >> mapM_ print sizes >> >> -- sequence :: Monad m => [m a] -> m [a] >> >> One important part is the use of sequence which transforms (ioSizes :: >> [IO Integer]) to `IO [Integer]` that is run and the result bound to (sizes >> : [Integer]). >> >> Hope that's clear enough to get the point :) >> >> Petr >> >> On Tue, Oct 20, 2015 at 5:58 PM, Dan Stromberg >> wrote: >> >>> >>> Here's a small program that replicates the compilation issue I'm seeing: >>> >>> import qualified System.Posix.Files >>> >>> get_size :: String -> IO Integer >>> get_size filename = do >>> file_status <- System.Posix.Files.getFileStatus filename >>> let file_size = System.Posix.Files.fileSize file_status >>> let integer_file_size = fromIntegral file_size >>> return integer_file_size >>> >>> main :: IO () >>> main = do >>> let filenames = ["/etc/services"] >>> let sizes = map get_size filenames >>> mapM_ print sizes >>> >>> The compilation error I get is: >>> >>> ghc -Wall --make -o stat2 stat2.hs >>> [1 of 1] Compiling Main ( stat2.hs, stat2.o ) >>> >>> stat2.hs:15:11: >>> No instance for (Show (IO Integer)) arising from a use of `print' >>> Possible fix: add an instance declaration for (Show (IO Integer)) >>> In the first argument of `mapM_', namely `print' >>> In a stmt of a 'do' block: mapM_ print sizes >>> In the expression: >>> do { let filenames = ...; >>> let sizes = map get_size filenames; >>> mapM_ print sizes } >>> make: *** [stat2] Error 1 >>> >>> I've googled quite a bit, and guessed quite a bit, and added type >>> declarations some, but I'm still not converging on a solution. >>> >>> Why can't I print an IO Integer? >>> >>> Thanks! >>> >>> -- >>> Dan Stromberg >>> >>> _______________________________________________ >>> Beginners mailing list >>> Beginners at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >>> >>> >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> >> > > > -- > Dan Stromberg > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mike_k_houghton at yahoo.co.uk Tue Oct 20 21:24:10 2015 From: mike_k_houghton at yahoo.co.uk (Mike Houghton) Date: Tue, 20 Oct 2015 22:24:10 +0100 Subject: [Haskell-beginners] duplicate monoids... Message-ID: Hi, I?m looking at a blog post on Monoids and finger trees at http://apfelmus.nfshost.com/articles/monoid-fingertree.html and would appreciate a bit of advice I have type Size = Int type Priority = Int instance Monoid Size where mempty = 0 mappend = (+) instance Monoid Priority where mempty = maxBound mappend = min and I get compiler error Duplicate instance declarations: instance Monoid Size -- Defined at /Users/mike/haskell/FingerTrees/Ftree.hs:60:10 instance Monoid Priority -- Defined at /Users/mike/haskell/FingerTrees/Ftree.hs:64:10 Which I can sort of understand as Size and Priority are both Int but on the other hand, internally, the monoids are different. Is this genuinely incorrect code or is there a language extension to get around this? Thanks Mike -------------- next part -------------- An HTML attachment was scrubbed... URL: From joel.s.williamson at gmail.com Tue Oct 20 21:40:21 2015 From: joel.s.williamson at gmail.com (Joel Williamson) Date: Tue, 20 Oct 2015 21:40:21 +0000 Subject: [Haskell-beginners] duplicate monoids... In-Reply-To: References: Message-ID: A type can only have a single instance of a given class. Imagine if this weren't true. The compiler would have to guess which of the instances you meant to use. The solution is to use newtype. That will introduce a different type, allowing separate instances, but is optimised out so it carries no runtime cost. On Tue, 20 Oct 2015, 17:24 Mike Houghton wrote: > Hi, > > I?m looking at a blog post on Monoids and finger trees at > http://apfelmus.nfshost.com/articles/monoid-fingertree.html > and would appreciate a bit of advice > > I have > > type Size = Int > type Priority = Int > > instance Monoid Size where > mempty = 0 > mappend = (+) > > instance Monoid Priority where > mempty = maxBound > mappend = min > > > and I get compiler error > > Duplicate instance declarations: > instance Monoid Size > -- Defined at /Users/mike/haskell/FingerTrees/Ftree.hs:60:10 > instance Monoid Priority > -- Defined at /Users/mike/haskell/FingerTrees/Ftree.hs:64:10 > > Which I can sort of understand as Size and Priority are both Int but on > the other hand, internally, the monoids are different. > > Is this genuinely incorrect code or is there a language extension to get > around this? > > Thanks > > Mike > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mike_k_houghton at yahoo.co.uk Tue Oct 20 21:55:41 2015 From: mike_k_houghton at yahoo.co.uk (Mike Houghton) Date: Tue, 20 Oct 2015 22:55:41 +0100 Subject: [Haskell-beginners] duplicate monoids... In-Reply-To: References: Message-ID: <3990AE1A-0C02-41FC-B750-BF17D90CD60F@yahoo.co.uk> Ahh! Nice. Thanks > On 20 Oct 2015, at 22:40, Joel Williamson wrote: > > A type can only have a single instance of a given class. Imagine if this weren't true. The compiler would have to guess which of the instances you meant to use. The solution is to use newtype. That will introduce a different type, allowing separate instances, but is optimised out so it carries no runtime cost. > > > On Tue, 20 Oct 2015, 17:24 Mike Houghton > wrote: > Hi, > > I?m looking at a blog post on Monoids and finger trees at http://apfelmus.nfshost.com/articles/monoid-fingertree.html > and would appreciate a bit of advice > > I have > > type Size = Int > type Priority = Int > > instance Monoid Size where > mempty = 0 > mappend = (+) > > instance Monoid Priority where > mempty = maxBound > mappend = min > > > and I get compiler error > > Duplicate instance declarations: > instance Monoid Size > -- Defined at /Users/mike/haskell/FingerTrees/Ftree.hs:60:10 > instance Monoid Priority > -- Defined at /Users/mike/haskell/FingerTrees/Ftree.hs:64:10 > > Which I can sort of understand as Size and Priority are both Int but on the other hand, internally, the monoids are different. > > Is this genuinely incorrect code or is there a language extension to get around this? > > Thanks > > Mike > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners -------------- next part -------------- An HTML attachment was scrubbed... URL: From javier.devega.ruiz at gmail.com Thu Oct 22 16:00:11 2015 From: javier.devega.ruiz at gmail.com (Javier de Vega Ruiz) Date: Thu, 22 Oct 2015 17:00:11 +0100 Subject: [Haskell-beginners] Difference of time execution times when measuring with time and profiling Message-ID: HI all, I am messing around with bang patterns and noticed some huge differences between the total time as reported by the time tool and the .prof file. Below is the code used. Without bang patterns: module Main where import Data.List fastFibs = unfoldr nextFib (1, 1) where nextFib (x, y) = Just $ (x, (y, (x + y))) main = putStrLn $ (show n) ++ "th fib is: " ++ (show $ fastFibs !! (n - 1)) where n = 1000000 With bang patterns: {-# LANGUAGE BangPatterns #-} module Main where import Data.List fastFibs = unfoldr nextFib (1, 1) where nextFib (!x, !y) = Just $ (x, (y, (x + y))) main = putStrLn $ (show n) ++ "th fib is: " ++ (show $ fastFibs !! (n - 1)) where n = 1000000 when looking at the first through time and prof I get the following. Without: real 0m53.501s user 0m0.015s sys 0m0.328s Thu Oct 22 16:46 2015 Time and Allocation Profiling Report (Final) fast-fib.exe +RTS -p -RTS total time = 9.52 secs (9520 ticks @ 1000 us, 1 processor) total alloc = 43,500,223,152 bytes (excludes profiling overheads) Please note the huge difference 53 vs 9 seconds. With: real 0m10.095s user 0m0.031s sys 0m0.344s Thu Oct 22 16:50 2015 Time and Allocation Profiling Report (Final) fast-fib.exe +RTS -p -RTS total time = 8.97 secs (8971 ticks @ 1000 us, 1 processor) total alloc = 43,500,309,960 bytes (excludes profiling overheads) Here differences seem to be much smaller. I am using Windows 8.1 64 bit, GHC 7.8.3 and measuring with the following line: ghc Main.hs -o fast-fib.exe -O2 -prof && time ./fast-fib.exe +RTS -p && cat fast-fib.prof Could someone please explain where the big difference is coming from and how to change the measuring approach to get more consistent results? Best regards, Javier de Vega Ruiz. -------------- next part -------------- An HTML attachment was scrubbed... URL: From tkoster at gmail.com Fri Oct 23 00:27:47 2015 From: tkoster at gmail.com (Thomas Koster) Date: Fri, 23 Oct 2015 11:27:47 +1100 Subject: [Haskell-beginners] Difference of time execution times when measuring with time and profiling In-Reply-To: References: Message-ID: Javier, On 23 October 2015 at 03:00, Javier de Vega Ruiz wrote: > I am messing around with bang patterns and noticed some huge differences > between the total time as reported by the time tool and the .prof file. > Below is the code used. > Without bang patterns: > module Main where > > import Data.List > > fastFibs = > unfoldr nextFib (1, 1) > where nextFib (x, y) = Just $ (x, (y, (x + y))) > > main = > putStrLn $ (show n) ++ "th fib is: " ++ (show $ fastFibs !! (n - 1)) > where n = 1000000 > > With bang patterns: > {-# LANGUAGE BangPatterns #-} > > module Main where > > import Data.List > > fastFibs = > unfoldr nextFib (1, 1) > where nextFib (!x, !y) = Just $ (x, (y, (x + y))) > > main = > putStrLn $ (show n) ++ "th fib is: " ++ (show $ fastFibs !! (n - 1)) > where n = 1000000 > > when looking at the first through time and prof I get the following. > Without: > real 0m53.501s > user 0m0.015s > sys 0m0.328s > Thu Oct 22 16:46 2015 Time and Allocation Profiling Report (Final) > > fast-fib.exe +RTS -p -RTS > > total time = 9.52 secs (9520 ticks @ 1000 us, 1 processor) > total alloc = 43,500,223,152 bytes (excludes profiling overheads) > > Please note the huge difference 53 vs 9 seconds. > > With: > real 0m10.095s > user 0m0.031s > sys 0m0.344s > Thu Oct 22 16:50 2015 Time and Allocation Profiling Report (Final) > > fast-fib.exe +RTS -p -RTS > > total time = 8.97 secs (8971 ticks @ 1000 us, 1 processor) > total alloc = 43,500,309,960 bytes (excludes profiling overheads) > > Here differences seem to be much smaller. > > I am using Windows 8.1 64 bit, GHC 7.8.3 and measuring with the following > line: > ghc Main.hs -o fast-fib.exe -O2 -prof && time ./fast-fib.exe +RTS -p && cat > fast-fib.prof > > Could someone please explain where the big difference is coming from and how > to change the measuring approach to get more consistent results? Before going into why the numbers are what they are, I think there is something wrong with your time tool on Windows. Your "user" time is suspiciously low in both measurements. When I ran your program on Linux, the report from the -s RTS option and the "real" and "user" numbers from the time tool were within milliseconds of each other (qualification: I used GHC 7.10.2). Apart from that, I am pretty sure the -p RTS option and the time tool are not measuring the same thing. I think the profiler samples "ticks" in the runtime, whereas the time tool and the -s option probably use CPU performance counters. Somebody more familiar with the GHC runtime should be able to give you more detail. -- Thomas Koster From martin at vlkk.cz Fri Oct 23 10:01:23 2015 From: martin at vlkk.cz (Martin Vlk) Date: Fri, 23 Oct 2015 10:01:23 +0000 Subject: [Haskell-beginners] Processing data from microphone interactively Message-ID: <562A0573.8080007@vlkk.cz> Hi, I am looking at reading sound from a microphone and controlling some other activity based on the sound data as they come. The motivation for this is writing some interactive animated graphics controlled by properties of the sound from mic. I am using the pulseaudio-simple library to read sound from the computer mic and that works fine. However the library function basically returns sound samples as a list of predefined length and this is not well suited for the kind of real-time processing I need. I am looking for advice on what would be a good idiomatic way to design such a program in Haskell. >From some research I am imagining I need something like the conduit library to connect the sound data to other parts of my program, but I am not sure how that would work or if it is a good idea in the first place. Or should I use some of the FRP libraries for this purpose? Or some other approach? I'd appreciate some advice on the direction to take. Many Thanks Martin From umairsd at gmail.com Fri Oct 23 12:42:35 2015 From: umairsd at gmail.com (Umair Saeed) Date: Fri, 23 Oct 2015 05:42:35 -0700 Subject: [Haskell-beginners] Why can't I return a partially applied function in my example? Message-ID: Hello all, I'm learning Haskell, and started to go through a set of intermediate exercises ( https://www.fpcomplete.com/user/DanBurton/20-intermediate-exercises). I am a bit puzzled about one of the exercises, and hope someone can help me understand why one of my solutions doesn't work. We have a typeclass, Misty (only the relevant banana function shown) as: class Misty m where banana :: (a -> m b) -> m a -> m b The exercise asks to implement this typeclass for the type ?((->) t)?. I started off by filling in the relevant types, and I get: banana :: (a -> ((->) t b) ) -> ((->) t a) -> ((->) t b) banana :: (a -> (t -> b)) -> (t -> a) -> (t -> b) Based on this, I decided to implement banana as: banana f g = (\x -> f (g x)) Here is my thought process: - The type of f is ?(a -> t -> b)?, and the type of g is ?(t -> a)? - g converts an argument of type ?t? into a result of type ?a?. - I then pass the result of ?(g x)? (which is of type ?a?) as an argument to ?f?. - At this point, ?f? would be partially applied, and I *expect* to get a result of type ?(t -> b)? However, when I try to build my solution, I get the following error (code is in a file called intermediate-help.hs): [1 of 1] Compiling Main ( intermediate-help.hs, interpreted ) intermediate-help.hs:7:25: Couldn't match expected type ?b? with actual type ?t -> b? ?b? is a rigid type variable bound by the type signature for banana :: (a -> t -> b) -> (t -> a) -> t -> b at intermediate-help.hs:7:5 Relevant bindings include x :: t (bound at intermediate-help.hs:7:20) g :: t -> a (bound at intermediate-help.hs:7:14) f :: a -> t -> b (bound at intermediate-help.hs:7:12) banana :: (a -> t -> b) -> (t -> a) -> t -> b (bound at intermediate-help.hs:7:5) In the expression: f (g x) In the expression: (\ x -> f (g x)) Failed, modules loaded: none. So here's my confusion: The compiler is complaining that it cannot match expected type ?b? with actual type ?t -> b?. However, as I reasoned above, when I wrote this code, I expected to get type ?t -> b?. Clearly, my thought process has a hole, and I need help/advice from more experienced Haskellers to identify what I am missing. Thank you for any help, ~Umair -------------- next part -------------- An HTML attachment was scrubbed... URL: From mail at andres-loeh.de Fri Oct 23 12:49:10 2015 From: mail at andres-loeh.de (Andres Loeh) Date: Fri, 23 Oct 2015 14:49:10 +0200 Subject: [Haskell-beginners] Why can't I return a partially applied function in my example? In-Reply-To: References: Message-ID: Hi. You are right, that 'f (g x)' has type '(t -> b)'. However, you're not returning 'f (g x)'. You're returning '\x -> f (g x)', and that has type 't -> (t -> b)', because 'x' is of type 't'. So you're returning a 't -> (t -> b)' where a 't -> b' is expected. Since the 't -> ...' of both types matches, GHC complains only about the mismatch of the result types. Cheers, Andres On Fri, Oct 23, 2015 at 2:42 PM, Umair Saeed wrote: > Hello all, > I'm learning Haskell, and started to go through a set of intermediate > exercises > (https://www.fpcomplete.com/user/DanBurton/20-intermediate-exercises). I am > a bit puzzled about one of the exercises, and hope someone can help me > understand why one of my solutions doesn't work. > > We have a typeclass, Misty (only the relevant banana function shown) as: > > > class Misty m where > banana :: (a -> m b) -> m a -> m b > > > The exercise asks to implement this typeclass for the type ?((->) t)?. I > started off by filling in the relevant types, and I get: > > banana :: (a -> ((->) t b) ) -> ((->) t a) -> ((->) t b) > banana :: (a -> (t -> b)) -> (t -> a) -> (t -> b) > > Based on this, I decided to implement banana as: > > banana f g = (\x -> f (g x)) > > Here is my thought process: > - The type of f is ?(a -> t -> b)?, and the type of g is ?(t -> a)? > - g converts an argument of type ?t? into a result of type ?a?. > - I then pass the result of ?(g x)? (which is of type ?a?) as an argument to > ?f?. > - At this point, ?f? would be partially applied, and I *expect* to get a > result of type ?(t -> b)? > > > However, when I try to build my solution, I get the following error (code is > in a file called intermediate-help.hs): > > [1 of 1] Compiling Main ( intermediate-help.hs, interpreted ) > > intermediate-help.hs:7:25: > Couldn't match expected type ?b? with actual type ?t -> b? > ?b? is a rigid type variable bound by > the type signature for > banana :: (a -> t -> b) -> (t -> a) -> t -> b > at intermediate-help.hs:7:5 > Relevant bindings include > x :: t (bound at intermediate-help.hs:7:20) > g :: t -> a (bound at intermediate-help.hs:7:14) > f :: a -> t -> b (bound at intermediate-help.hs:7:12) > banana :: (a -> t -> b) -> (t -> a) -> t -> b > (bound at intermediate-help.hs:7:5) > In the expression: f (g x) > In the expression: (\ x -> f (g x)) > Failed, modules loaded: none. > > > > So here's my confusion: The compiler is complaining that it cannot match > expected type ?b? with actual type ?t -> b?. However, as I reasoned above, > when I wrote this code, I expected to get type ?t -> b?. Clearly, my thought > process has a hole, and I need help/advice from more experienced Haskellers > to identify what I am missing. > > Thank you for any help, > ~Umair > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From tonymorris at gmail.com Fri Oct 23 13:02:50 2015 From: tonymorris at gmail.com (Tony Morris) Date: Fri, 23 Oct 2015 23:02:50 +1000 Subject: [Haskell-beginners] Why can't I return a partially applied function in my example? In-Reply-To: References: Message-ID: <562A2FFA.4070402@gmail.com> FYI, the material you are using was stolen. Here is the original. http://blog.tmorris.net/posts/20-intermediate-haskell-exercises/ On 23/10/15 22:42, Umair Saeed wrote: > Hello all, > I'm learning Haskell, and started to go through a set of intermediate > exercises > (https://www.fpcomplete.com/user/DanBurton/20-intermediate-exercises). I > am a bit puzzled about one of the exercises, and hope someone can help > me understand why one of my solutions doesn't work. > > We have a typeclass, Misty (only the relevant banana function shown) as: > > > class Misty m where > banana :: (a -> m b) -> m a -> m b > > > The exercise asks to implement this typeclass for the type ?((->) t)?. I > started off by filling in the relevant types, and I get: > > banana :: (a -> ((->) t b) ) -> ((->) t a) -> ((->) t b) > banana :: (a -> (t -> b)) -> (t -> a) -> (t -> b) > > Based on this, I decided to implement banana as: > > banana f g = (\x -> f (g x)) > > Here is my thought process: > - The type of f is ?(a -> t -> b)?, and the type of g is ?(t -> a)? > - g converts an argument of type ?t? into a result of type ?a?. > - I then pass the result of ?(g x)? (which is of type ?a?) as an > argument to ?f?. > - At this point, ?f? would be partially applied, and I *expect* to get a > result of type ?(t -> b)? > > > However, when I try to build my solution, I get the following error > (code is in a file called intermediate-help.hs): > > [1 of 1] Compiling Main ( intermediate-help.hs, interpreted ) > > intermediate-help.hs:7:25: > Couldn't match expected type ?b? with actual type ?t -> b? > ?b? is a rigid type variable bound by > the type signature for > banana :: (a -> t -> b) -> (t -> a) -> t -> b > at intermediate-help.hs:7:5 > Relevant bindings include > x :: t (bound at intermediate-help.hs:7:20) > g :: t -> a (bound at intermediate-help.hs:7:14) > f :: a -> t -> b (bound at intermediate-help.hs:7:12) > banana :: (a -> t -> b) -> (t -> a) -> t -> b > (bound at intermediate-help.hs:7:5) > In the expression: f (g x) > In the expression: (\ x -> f (g x)) > Failed, modules loaded: none. > > > > So here's my confusion: The compiler is complaining that it cannot match > expected type ?b? with actual type ?t -> b?. However, as I reasoned > above, when I wrote this code, I expected to get type ?t -> b?. Clearly, > my thought process has a hole, and I need help/advice from more > experienced Haskellers to identify what I am missing. > > Thank you for any help, > ~Umair > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From fa-ml at ariis.it Fri Oct 23 13:32:09 2015 From: fa-ml at ariis.it (Francesco Ariis) Date: Fri, 23 Oct 2015 15:32:09 +0200 Subject: [Haskell-beginners] Why can't I return a partially applied function in my example? In-Reply-To: <562A2FFA.4070402@gmail.com> References: <562A2FFA.4070402@gmail.com> Message-ID: <20151023133209.GA23945@casa.casa> On Fri, Oct 23, 2015 at 11:02:50PM +1000, Tony Morris wrote: > FYI, the material you are using was stolen. Here is the original. > > http://blog.tmorris.net/posts/20-intermediate-haskell-exercises/ :| No attribution/link whatsoever on the article page, (on the author's page [1] you can read "Shamelessly stolen from "). Can you confirm noone asked you permission to Ctrl-c/v your post? I am pretty sure FP Complete is several notches better than BuzzFeed and would act upon it. [1] https://www.fpcomplete.com/user/DanBurton From houdachanti at yahoo.fr Fri Oct 23 15:32:50 2015 From: houdachanti at yahoo.fr (chanti houda) Date: Fri, 23 Oct 2015 15:32:50 +0000 (UTC) Subject: [Haskell-beginners] Can't cast an IO String to s Astring References: <1238287669.3155358.1445614370217.JavaMail.yahoo@mail.yahoo.com> Message-ID: <1238287669.3155358.1445614370217.JavaMail.yahoo@mail.yahoo.com> Hello, I'm writing a Haskell code which consists to read a text file, parse it and thansform the parsing result on a specific language.I have a function affiche which takes a data type Ctrl and returns a String. This is the transformation funtion.I have also anothe function parsctrl, which parse the contents of a text file ("ctrl.txt") and after looks for a specific value ("A01") in the parse result (function cherchectrl). I need to use the result of the parsectrl function in another function fc.? The code is composed of three functions parsectrl = do ?f <- readFile "ctrl.txt" ?let Right r = parse? parseCtrl? " " f?let rez =cherchectrl ( r) "A01" ?return (rez) fc[]? =[] fc((door,[(all,v1),(alt,v2),(lint,v3),(w,v4),(r,v5),(loc,v6),( etat,v7),(ruin,v8)]):ls ) = ("&OUV ID='"++door ++"', ALLEGE="++show((moi v1)/1000)++", LINTEAU="++show((moi v3)/1000)++", LARGEUR="++show((moi v4)/1000)++", COEF=0.7, ALT="++show((moi v2)/1000)++", LOCIDS='"++v6++"', CTRLID='"++ v7++"', CTRLID_RUIN='"++ v8++" /" ++"\n" ++"&CTRL ID='"++v7++"', " ++ "ON_INI=.FALSE., DURATION=0 / \n"++"&CTRL ID='"++v8++"', LOCID='"++? ((parses("'"++v6++"'"))!!0) ++affiche(parsectrl)++ " / \n\n"? )++fc(ls) The parsectrl returns an IO String, but the function affiche needs a String as input and even when I tried to adapt the affiche function to take an? IO String -> String I can't.the result of fc must be a String too. The IO String comes from the parsectrl function. Can you help me to solve this problem: how can I transform an IO String to a String. Thank you by advance. -------------- next part -------------- An HTML attachment was scrubbed... URL: From rein.henrichs at gmail.com Fri Oct 23 17:16:09 2015 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Fri, 23 Oct 2015 17:16:09 +0000 Subject: [Haskell-beginners] Can't cast an IO String to s Astring In-Reply-To: <1238287669.3155358.1445614370217.JavaMail.yahoo@mail.yahoo.com> References: <1238287669.3155358.1445614370217.JavaMail.yahoo@mail.yahoo.com> <1238287669.3155358.1445614370217.JavaMail.yahoo@mail.yahoo.com> Message-ID: You can't transform an IO String into a String. This is one of the purposes of monads: to make it possible to work with things like IO, where it is impossible to turn an IO a into an a. The result of performing an IO action can be *bound* using (>>=) or <- in do notation so that the String is available for the rest of the computation: do f <- readFile "ctrl.txt" Right r <- parseCtrl f cherchectrl r "A01" Note that there's no need to wrap identifiers in (): (r) is the same as r, (rez) is the same as rez. And there's no need to say do { let r = something; return r }. You can just say do { something }. On Fri, Oct 23, 2015 at 8:32 AM chanti houda wrote: > Hello, I'm writing a Haskell code which consists to read a text file, > parse it and thansform the parsing result on a specific language. > I have a function *affiche *which takes a data type Ctrl and returns a > String. This is the transformation funtion. > I have also anothe function parsctrl, which parse the contents of a text > file ("ctrl.txt") and after looks for a specific value ("A01") in the parse > result (function *c**herchectrl*). > I need to use the result of the *parsectrl *function in another function > *fc*. > The code is composed of three functions > > > > parsectrl = do > f <- readFile "ctrl.txt" > let Right r = parse parseCtrl " " f > let rez =cherchectrl ( r) "A01" > return (rez) > > fc[] =[] > fc((door,[(all,v1),(alt,v2),(lint,v3),(w,v4),(r,v5),(loc,v6),( > etat,v7),(ruin,v8)]):ls ) = ("&OUV ID='"++door ++"', ALLEGE="++show((moi > v1)/1000)++", LINTEAU="++show((moi v3)/1000)++", LARGEUR="++show((moi > v4)/1000)++", COEF=0.7, ALT="++show((moi v2)/1000)++", LOCIDS='"++v6++"', > CTRLID='"++ v7++"', CTRLID_RUIN='"++ v8++" /" ++"\n" ++"&CTRL > ID='"++v7++"', " ++ "ON_INI=.FALSE., DURATION=0 / \n"++"&CTRL > ID='"++v8++"', LOCID='"++ ((parses("'"++v6++"'"))!!0) ++ > *affiche(parsectrl)*++ " / \n\n" )++fc(ls) > > The parsectrl returns an IO String, but the function affiche needs a > String as input and even when I tried to adapt the affiche function to take > an IO String -> String I can't. > the result of fc must be a String too. > > The IO String comes from the parsectrl function. > Can you help me to solve this problem: how can I transform an IO String to > a String. > > Thank you by advance. > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From rein.henrichs at gmail.com Fri Oct 23 17:17:23 2015 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Fri, 23 Oct 2015 17:17:23 +0000 Subject: [Haskell-beginners] Can't cast an IO String to s Astring In-Reply-To: References: <1238287669.3155358.1445614370217.JavaMail.yahoo@mail.yahoo.com> Message-ID: Or rather, you can just say do { return something } or do { return $ something } of "something" is a more complicated expression. On Fri, Oct 23, 2015 at 10:16 AM Rein Henrichs wrote: > You can't transform an IO String into a String. This is one of the > purposes of monads: to make it possible to work with things like IO, where > it is impossible to turn an IO a into an a. The result of performing an IO > action can be *bound* using (>>=) or <- in do notation so that the String > is available for the rest of the computation: > > do > f <- readFile "ctrl.txt" > Right r <- parseCtrl f > cherchectrl r "A01" > > Note that there's no need to wrap identifiers in (): (r) is the same as r, > (rez) is the same as rez. And there's no need to say do { let r = > something; return r }. You can just say do { something }. > > On Fri, Oct 23, 2015 at 8:32 AM chanti houda wrote: > >> Hello, I'm writing a Haskell code which consists to read a text file, >> parse it and thansform the parsing result on a specific language. >> I have a function *affiche *which takes a data type Ctrl and returns a >> String. This is the transformation funtion. >> I have also anothe function parsctrl, which parse the contents of a text >> file ("ctrl.txt") and after looks for a specific value ("A01") in the parse >> result (function *c**herchectrl*). >> I need to use the result of the *parsectrl *function in another function >> *fc*. >> The code is composed of three functions >> >> >> >> parsectrl = do >> f <- readFile "ctrl.txt" >> let Right r = parse parseCtrl " " f >> let rez =cherchectrl ( r) "A01" >> return (rez) >> >> fc[] =[] >> fc((door,[(all,v1),(alt,v2),(lint,v3),(w,v4),(r,v5),(loc,v6),( >> etat,v7),(ruin,v8)]):ls ) = ("&OUV ID='"++door ++"', ALLEGE="++show((moi >> v1)/1000)++", LINTEAU="++show((moi v3)/1000)++", LARGEUR="++show((moi >> v4)/1000)++", COEF=0.7, ALT="++show((moi v2)/1000)++", LOCIDS='"++v6++"', >> CTRLID='"++ v7++"', CTRLID_RUIN='"++ v8++" /" ++"\n" ++"&CTRL >> ID='"++v7++"', " ++ "ON_INI=.FALSE., DURATION=0 / \n"++"&CTRL >> ID='"++v8++"', LOCID='"++ ((parses("'"++v6++"'"))!!0) ++ >> *affiche(parsectrl)*++ " / \n\n" )++fc(ls) >> >> The parsectrl returns an IO String, but the function affiche needs a >> String as input and even when I tried to adapt the affiche function to take >> an IO String -> String I can't. >> the result of fc must be a String too. >> >> The IO String comes from the parsectrl function. >> Can you help me to solve this problem: how can I transform an IO String >> to a String. >> >> Thank you by advance. >> >> >> >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From apfelmus at quantentunnel.de Sat Oct 24 09:40:28 2015 From: apfelmus at quantentunnel.de (Heinrich Apfelmus) Date: Sat, 24 Oct 2015 11:40:28 +0200 Subject: [Haskell-beginners] Processing data from microphone interactively In-Reply-To: <562A0573.8080007@vlkk.cz> References: <562A0573.8080007@vlkk.cz> Message-ID: Hello Martin, in digital signal processing (DSP), audio samples are traditionally processed in *blocks*. Typical blocks sizes for real-time processing are 64, 128 or 256 bytes. The reason for this is that audio processing is a performance-sensitive task. If your code is too slow, then it cannot process all audio in time and there will be jitter. Typically, the operations that are applied to a single block are fairly limited (mixing, convolution, ...) and can be optimized into a tight loop, which you can then reuse as a "black box". In contrast, operations that act on blocks (envelopes, ...) are more open-ended and you would have to pay attention to optimizing them each and every time you write a program. This is related to the concepts of "audio rate" and "control rate". The former is the frequency at which audio is sampled, i.e. the frequency "within" a block, while the latter corresponds to more coarse-grained operations, that are approximately the same on every block. For you, this means that you probably want to call the `simpleRead` function with a block size of 128 and process each block individually before requesting the next. If individual processing proves too slow, you will have to use data structures that are closer to the machine, and call the `simpleReadRaw` function instead. Best regards, Heinrich Apfelmus -- http://apfelmus.nfshost.com Martin Vlk wrote: > Hi, > I am looking at reading sound from a microphone and controlling some > other activity based on the sound data as they come. The motivation for > this is writing some interactive animated graphics controlled by > properties of the sound from mic. > > I am using the pulseaudio-simple library to read sound from the computer > mic and that works fine. However the library function basically returns > sound samples as a list of predefined length and this is not well suited > for the kind of real-time processing I need. > > I am looking for advice on what would be a good idiomatic way to design > such a program in Haskell. > > From some research I am imagining I need something like the conduit > library to connect the sound data to other parts of my program, but I am > not sure how that would work or if it is a good idea in the first place. > > Or should I use some of the FRP libraries for this purpose? > Or some other approach? > > I'd appreciate some advice on the direction to take. > > Many Thanks > Martin From mike_k_houghton at yahoo.co.uk Sat Oct 24 11:55:59 2015 From: mike_k_houghton at yahoo.co.uk (Mike Houghton) Date: Sat, 24 Oct 2015 12:55:59 +0100 Subject: [Haskell-beginners] Ignore in import Message-ID: Hi, I?m reading Typeclassopdedia and an exercise is "A good exercise is to implement Functor instances for Either e, ((,) e), and ((->) e).? so I have instance Functor ((,) a) where fmap = undefined which gives compiler error Duplicate instance declarations: instance Functor ((,) a) -- Defined at /Users/mike/haskell/FingerTrees/M.hs:65:10 instance Functor ((,) a) -- Defined in ?GHC.Base? so I added import GHC.Base hiding ((,)) but I still get the error. Where am I going wrong? Many thanks Mike From imantc at gmail.com Sat Oct 24 13:13:32 2015 From: imantc at gmail.com (Imants Cekusins) Date: Sat, 24 Oct 2015 15:13:32 +0200 Subject: [Haskell-beginners] Ignore in import In-Reply-To: References: Message-ID: > Duplicate instance declarations: it appears that there is (or was?) no way to hide instance definitions: https://mail.haskell.org/pipermail/haskell-cafe/2009-July/063842.html however looking at the exercise: "... implement Functor instances for Either e, ((,) e), and ((->) e).? does this not suggest 1) instance Functor Either e, ((,) e) and 2) instance Functor Either e, ((->) e) ? From imantc at gmail.com Sat Oct 24 13:16:56 2015 From: imantc at gmail.com (Imants Cekusins) Date: Sat, 24 Oct 2015 15:16:56 +0200 Subject: [Haskell-beginners] Ignore in import In-Reply-To: References: Message-ID: ... or: 1) instance Functor Either e ((,) e) 2) instance Functor Either e ((->) e) ? From mike_k_houghton at yahoo.co.uk Sat Oct 24 13:35:19 2015 From: mike_k_houghton at yahoo.co.uk (Mike Houghton) Date: Sat, 24 Oct 2015 14:35:19 +0100 Subject: [Haskell-beginners] Ignore in import In-Reply-To: References: Message-ID: <3419F599-916D-4247-94E5-69160D4CC698@yahoo.co.uk> Mmmm I think its functor for each of Either e ((,) e) and ((->) e) ? > On 24 Oct 2015, at 14:16, Imants Cekusins wrote: > > ... or: > > 1) instance Functor Either e ((,) e) > 2) instance Functor Either e ((->) e) > > ? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From imantc at gmail.com Sat Oct 24 14:05:16 2015 From: imantc at gmail.com (Imants Cekusins) Date: Sat, 24 Oct 2015 16:05:16 +0200 Subject: [Haskell-beginners] Ignore in import In-Reply-To: <3419F599-916D-4247-94E5-69160D4CC698@yahoo.co.uk> References: <3419F599-916D-4247-94E5-69160D4CC698@yahoo.co.uk> Message-ID: > I think its functor for each of ... sorry, you are right. well maybe it is possible with a non-ghc compiler? From petr.vapenka at gmail.com Sat Oct 24 14:16:54 2015 From: petr.vapenka at gmail.com (=?UTF-8?Q?Petr_V=C3=A1penka?=) Date: Sat, 24 Oct 2015 16:16:54 +0200 Subject: [Haskell-beginners] Ignore in import In-Reply-To: References: <3419F599-916D-4247-94E5-69160D4CC698@yahoo.co.uk> Message-ID: You can try NoImplicitPrelude language extension (this may not work, too) or use newtype wrappers or normal data types with the same shape. Dne 24.10.2015 16:05 napsal u?ivatel "Imants Cekusins" : > > I think its functor for each of ... > > sorry, you are right. > > well maybe it is possible with a non-ghc compiler? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ryan.trinkle at gmail.com Sat Oct 24 15:25:16 2015 From: ryan.trinkle at gmail.com (Ryan Trinkle) Date: Sat, 24 Oct 2015 11:25:16 -0400 Subject: [Haskell-beginners] Ignore in import In-Reply-To: References: <3419F599-916D-4247-94E5-69160D4CC698@yahoo.co.uk> Message-ID: For the purpose of learning the material, it might be easiest to just write: class MyFunctor f where myFmap :: (a -> b) -> f a -> f b and then create instances of that, instead. This way, you won't have any conflicts with existing instances. On Sat, Oct 24, 2015 at 10:16 AM, Petr V?penka wrote: > You can try NoImplicitPrelude language extension (this may not work, too) > or use newtype wrappers or normal data types with the same shape. > Dne 24.10.2015 16:05 napsal u?ivatel "Imants Cekusins" : > > > I think its functor for each of ... >> >> sorry, you are right. >> >> well maybe it is possible with a non-ghc compiler? >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mike_k_houghton at yahoo.co.uk Sat Oct 24 16:13:59 2015 From: mike_k_houghton at yahoo.co.uk (Mike Houghton) Date: Sat, 24 Oct 2015 17:13:59 +0100 Subject: [Haskell-beginners] Ignore in import In-Reply-To: References: <3419F599-916D-4247-94E5-69160D4CC698@yahoo.co.uk> Message-ID: <043C231E-F9D9-44CA-BA04-E64AA04E92C9@yahoo.co.uk> Yes! It?s obvious once its pointed out. Thanks > On 24 Oct 2015, at 16:25, Ryan Trinkle wrote: > > For the purpose of learning the material, it might be easiest to just write: > > class MyFunctor f where > myFmap :: (a -> b) -> f a -> f b > > and then create instances of that, instead. > > This way, you won't have any conflicts with existing instances. > > On Sat, Oct 24, 2015 at 10:16 AM, Petr V?penka > wrote: > You can try NoImplicitPrelude language extension (this may not work, too) or use newtype wrappers or normal data types with the same shape. > > Dne 24.10.2015 16:05 napsal u?ivatel "Imants Cekusins" >: > > > I think its functor for each of ... > > sorry, you are right. > > well maybe it is possible with a non-ghc compiler? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners -------------- next part -------------- An HTML attachment was scrubbed... URL: From john-haskell at how-hard-can-it-be.com Sat Oct 24 19:36:48 2015 From: john-haskell at how-hard-can-it-be.com (John Lusk) Date: Sat, 24 Oct 2015 15:36:48 -0400 Subject: [Haskell-beginners] Fwd: Space consumption and strictness in strict map In-Reply-To: References: Message-ID: ---------- Forwarded message ---------- From: John Lusk Date: Sat, Oct 24, 2015 at 3:25 PM Subject: Space consumption and strictness in strict map To: beginners at haskell.org Hey, I have a problem I "solved" by sprinkling !s around like pixie dust, but I'd like to know what's going on. I'll attach my program, in all its messy glory, but the whole ball of wax is at https://github.com/JohnL4/PassphraseGenerator. It takes as input one of the 2012 Google ngram (specifically, 1-gram) raw data files. The expected input format is documented in several places. (For testing, I took the first million lines.) The bang that worked is on the 3rd argument of 'wordCount', the map. I tried commenting out the "(Map.insertWith (+) ngram matchCount aMap)" part (and just returning the input map). When I did that, boy was space consumption small, so that line is part of the problem. So, what's going on without the bang? I guess I'm just building up a bunch of thunks w/that Map.insertWith call, but what kind of thunks? Unevaluated calls to splitOn and (!!) and read and (+) and lines? I thought a strict Map would avoid that. I guess WHNF isn't enough? Looking at https://wiki.haskell.org/Weak_head_normal_form, I don't *think* I have any constructors in there, but profiling with -hd shows me that (:) is the most frequently occurring closure. Where is *that* coming from? Is the occurrence of (:) so high because it's either a built-in function applied to too few arguments or a lambda abstraction? Which one? (Also, is "lambda abstraction" the same as "lambda expresson"?) And then... what does that bang on the map argument do? Does it force evaluation of the passed argument all the way down to primitives, so that we truly get a data structure containing only strings and ints (and no thunks)? What does that do to time complexity? Does it have to traverse the entire map looking for thunks, even though I only added one at some random location in the map? Is there a better way? I guess I need to force strictness somewhere else, but I'm not sure how. I tried using seq (a little half-heartedly), and ($!), but I guess I did it wrong and only wound up with more thunks to seq and id ($!), right? So, I wound up with lazy strictness? Thanks for any help. John. -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: mostFrequent.hs Type: application/octet-stream Size: 2725 bytes Desc: not available URL: From martin at vlkk.cz Sun Oct 25 19:52:28 2015 From: martin at vlkk.cz (Martin Vlk) Date: Sun, 25 Oct 2015 19:52:28 +0000 Subject: [Haskell-beginners] Processing data from microphone interactively In-Reply-To: References: <562A0573.8080007@vlkk.cz> Message-ID: <562D32FC.7080504@vlkk.cz> Hi Heinrich, this is a great and very useful response, thanks! I am working through my implementation details and I'll post the result when I have it. Martin Heinrich Apfelmus: > Hello Martin, > > in digital signal processing (DSP), audio samples are traditionally > processed in *blocks*. Typical blocks sizes for real-time processing are > 64, 128 or 256 bytes. > > The reason for this is that audio processing is a performance-sensitive > task. If your code is too slow, then it cannot process all audio in time > and there will be jitter. Typically, the operations that are applied to > a single block are fairly limited (mixing, convolution, ...) and can be > optimized into a tight loop, which you can then reuse as a "black box". > In contrast, operations that act on blocks (envelopes, ...) are more > open-ended and you would have to pay attention to optimizing them each > and every time you write a program. > > This is related to the concepts of "audio rate" and "control rate". The > former is the frequency at which audio is sampled, i.e. the frequency > "within" a block, while the latter corresponds to more coarse-grained > operations, that are approximately the same on every block. > > > For you, this means that you probably want to call the `simpleRead` > function with a block size of 128 and process each block individually > before requesting the next. If individual processing proves too slow, > you will have to use data structures that are closer to the machine, and > call the `simpleReadRaw` function instead. > > > Best regards, > Heinrich Apfelmus > > -- > http://apfelmus.nfshost.com > > > Martin Vlk wrote: >> Hi, >> I am looking at reading sound from a microphone and controlling some >> other activity based on the sound data as they come. The motivation for >> this is writing some interactive animated graphics controlled by >> properties of the sound from mic. >> >> I am using the pulseaudio-simple library to read sound from the computer >> mic and that works fine. However the library function basically returns >> sound samples as a list of predefined length and this is not well suited >> for the kind of real-time processing I need. >> >> I am looking for advice on what would be a good idiomatic way to design >> such a program in Haskell. >> >> From some research I am imagining I need something like the conduit >> library to connect the sound data to other parts of my program, but I am >> not sure how that would work or if it is a good idea in the first place. >> >> Or should I use some of the FRP libraries for this purpose? >> Or some other approach? >> >> I'd appreciate some advice on the direction to take. >> >> Many Thanks >> Martin > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > From martin.drautzburg at web.de Sun Oct 25 20:00:14 2015 From: martin.drautzburg at web.de (martin) Date: Sun, 25 Oct 2015 21:00:14 +0100 Subject: [Haskell-beginners] Controlling the ordering in the TOC of haddock html Message-ID: <562D34CE.6040902@web.de> Hello all, I just started using haddock and on the "Contents" page it list all my modules and directories strictly in alphabetic order. I get something like this Modules Domain Domain.Item is about Items and their Positions Domain.Location Domain.Port Domain.Process implements a general Process entity Domain.System captures the state of the world Event implements the possible Events Misc Misc.Lens provides poor-man's Lens support Misc.Time implements Instant and Interval Simulation is the main simulation engine I'd rather see Modules Simulation is the main simulation engine Event implements the possible Events Domain Domain.Item is about Items and their Positions Domain.Location Domain.Port Domain.Process implements a general Process entity Domain.System captures the state of the world Misc Misc.Lens provides poor-man's Lens support Misc.Time implements Instant and Interval Is there a way I can control the order in the TOC page? From javier.devega.ruiz at gmail.com Mon Oct 26 12:02:40 2015 From: javier.devega.ruiz at gmail.com (Javier de Vega Ruiz) Date: Mon, 26 Oct 2015 12:02:40 +0000 Subject: [Haskell-beginners] Difference of time execution times when measuring with time and profiling In-Reply-To: References: Message-ID: Thanks Thomas, I tried in Linux and the behavior of the time tool seems more reasonable now: real 0m46.743s user 0m45.888s sys 0m0.160s After checking some of the RTS documentation, it turns out the GC's cost centre is not included by default, in order to include I had to change the -p to -pa which results in: fast-fib +RTS -pa -RTS total time = 47.43 secs (47433 ticks @ 1000 us, 1 processor) total alloc = 44,128,957,088 bytes (excludes profiling overheads) COST CENTRE MODULE %time %alloc ticks bytes GC GC 86.0 0.0 40778 0 fastFibs.nextFib Main 13.1 99.6 6228 43952857104 This clearly states where that 86% difference was coming from, the GC, which means the world makes sense again :) Does someone know how to add the cost centre for GC without having to use -pa? Best regards, Javier de Vega Ruiz. On Fri, Oct 23, 2015 at 1:27 AM, Thomas Koster wrote: > Javier, > > On 23 October 2015 at 03:00, Javier de Vega Ruiz > wrote: > > I am messing around with bang patterns and noticed some huge differences > > between the total time as reported by the time tool and the .prof file. > > Below is the code used. > > Without bang patterns: > > module Main where > > > > import Data.List > > > > fastFibs = > > unfoldr nextFib (1, 1) > > where nextFib (x, y) = Just $ (x, (y, (x + y))) > > > > main = > > putStrLn $ (show n) ++ "th fib is: " ++ (show $ fastFibs !! (n - 1)) > > where n = 1000000 > > > > With bang patterns: > > {-# LANGUAGE BangPatterns #-} > > > > module Main where > > > > import Data.List > > > > fastFibs = > > unfoldr nextFib (1, 1) > > where nextFib (!x, !y) = Just $ (x, (y, (x + y))) > > > > main = > > putStrLn $ (show n) ++ "th fib is: " ++ (show $ fastFibs !! (n - 1)) > > where n = 1000000 > > > > when looking at the first through time and prof I get the following. > > Without: > > real 0m53.501s > > user 0m0.015s > > sys 0m0.328s > > Thu Oct 22 16:46 2015 Time and Allocation Profiling Report > (Final) > > > > fast-fib.exe +RTS -p -RTS > > > > total time = 9.52 secs (9520 ticks @ 1000 us, 1 > processor) > > total alloc = 43,500,223,152 bytes (excludes profiling > overheads) > > > > Please note the huge difference 53 vs 9 seconds. > > > > With: > > real 0m10.095s > > user 0m0.031s > > sys 0m0.344s > > Thu Oct 22 16:50 2015 Time and Allocation Profiling Report > (Final) > > > > fast-fib.exe +RTS -p -RTS > > > > total time = 8.97 secs (8971 ticks @ 1000 us, 1 > processor) > > total alloc = 43,500,309,960 bytes (excludes profiling > overheads) > > > > Here differences seem to be much smaller. > > > > I am using Windows 8.1 64 bit, GHC 7.8.3 and measuring with the following > > line: > > ghc Main.hs -o fast-fib.exe -O2 -prof && time ./fast-fib.exe +RTS -p && > cat > > fast-fib.prof > > > > Could someone please explain where the big difference is coming from and > how > > to change the measuring approach to get more consistent results? > > Before going into why the numbers are what they are, I think there is > something wrong with your time tool on Windows. Your "user" time is > suspiciously low in both measurements. When I ran your program on > Linux, the report from the -s RTS option and the "real" and "user" > numbers from the time tool were within milliseconds of each other > (qualification: I used GHC 7.10.2). > > Apart from that, I am pretty sure the -p RTS option and the time tool > are not measuring the same thing. I think the profiler samples "ticks" > in the runtime, whereas the time tool and the -s option probably use > CPU performance counters. Somebody more familiar with the GHC runtime > should be able to give you more detail. > > -- > Thomas Koster > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From johnlusk4 at gmail.com Tue Oct 27 13:38:40 2015 From: johnlusk4 at gmail.com (John Lusk) Date: Tue, 27 Oct 2015 09:38:40 -0400 Subject: [Haskell-beginners] Space consumption and strictness in strict map Message-ID: Hello, beginners at haskell.org. I posted this a few days ago, but it looks like attachments get pulled out by Mailman, whether or not they are small text files ( :>( ), so I'm trying again, sans attachment. _________________________________________ Hey, I have a problem I "solved" by sprinkling !s around like pixie dust, but I'd like to know what's going on. My program is below, in all its messy glory, but the whole ball of wax is at https://github.com/JohnL4/PassphraseGenerator (mostFrequent.hs). It takes as input one of the 2012 Google ngram (specifically, 1-gram) raw data files. The expected input format is documented in several places. (For testing, I took the first million lines.) The bang that worked is on the 3rd argument of 'wordCount', the map. I tried commenting out the "(Map.insertWith (+) ngram matchCount aMap)" part (and just returning the input map). When I did that, boy was space consumption small, so that line is part of the problem. So, what's going on without the bang? I guess I'm just building up a bunch of thunks w/that Map.insertWith call, but what kind of thunks? Unevaluated calls to splitOn and (!!) and read and (+) and lines? I thought a strict Map would avoid that. I guess WHNF isn't enough? Looking at https://wiki.haskell.org/Weak_head_normal_form, I don't *think* I have any constructors in there, but profiling with -hd shows me that (:) is the most frequently occurring closure. Where is *that* coming from? Is the occurrence of (:) so high because it's either a built-in function applied to too few arguments or a lambda abstraction? Which one? (Also, is "lambda abstraction" the same as "lambda expresson"?) And then... what does that bang on the map argument do? Does it force evaluation of the passed argument all the way down to primitives, so that we truly get a data structure containing only strings and ints (and no thunks)? What does that do to time complexity? Does it have to traverse the entire map looking for thunks, even though I only added one at some random location in the map? Is there a better way? I guess I need to force strictness somewhere else, but I'm not sure how. I tried using seq (a little half-heartedly), and ($!), but I guess I did it wrong and only wound up with more thunks to seq and id ($!), right? So, I wound up with lazy strictness? Thanks for any help. John. My code: -- | Reads stdin and prints the n most-frequent words occurring after year y to stdout, along with -- | their counts. {-# LANGUAGE BangPatterns #-} import GHC.IO.Handle (hPutStr) import GHC.IO.Handle.FD (stderr) import Data.Char (toLower) import Data.List (intersperse, sortBy) import qualified Data.Map.Strict as Map import Data.List.Split (splitOn) {- Test data: let filetext = "aaa\t1900\t2\naaa\t1950\t3\nbbb\t1950\t5\nbbb_VERB\t1980\t9" -} -- | Number of most-frequent words we want. n :: Int n = 15000 -- | Earliest year we want to count while building frequency table y :: Int y = 1950 main :: IO() main = do {- Read line, split on tabs, take first three fields, which are: 1-gram (word), year, match-count. If year >= y: Trim parts of speech (POS) from 1-gram (leading, trailing known fragments delimited by "_") Known fragments: NOUN, VERB, ADJ, ADV, PRON (pronouns), DET (determiners and articles), ADP (prepositions, postpositions), NUM, CONJ, PRT (particles), X (miscellaneous) Split on "_", discard expected known fragments, complain if there are more than one fragments left. (Note that I have verified that each ngram has 0 or 1 trailing attributes, so the check for an unexpected number of parts is unnecessary.) Find word in dictionary and add match-count to that entry. At end of input, sort dictionary entries by match-counts (descending) and take first n entries for output. -} allInput <- getContents putStrLn (concat (intersperse "\n" (map fst (take n (sortBy countDescending (Map.toList (wordCounts y (lines allInput) Map.empty))))))) hPutStr stderr "Done.\n" -- | Orders inputs by 2nd element (count), descending countDescending :: (String,Int) -> (String,Int) -> Ordering countDescending (_, countA) (_, countB) | countA < countB = GT | countA == countB = EQ | otherwise = LT -- | Returns map of all counts (summed) for words occurring on or after given year. wordCounts :: Int -- ^ Year -> [String] -- ^ Lines in form "word\tyear\tcount\totherStuffWeDontCareAbout" -> Map.Map String Int -- ^ Input map -> Map.Map String Int -- ^ Output map wordCounts _ [] aMap = aMap wordCounts aYear (aLine:restLines) !aMap = let fields = splitOn "\t" aLine ngramParts = splitOn "_" (fields!!0) ngram = map toLower (ngramParts!!0) -- "ngram" is the same as "word", in this case. year = read (fields!!1) :: Int matchCount = read (fields!!2) :: Int in if (year < aYear) then (wordCounts aYear restLines aMap) else (wordCounts aYear restLines (Map.insertWith (+) ngram matchCount aMap) -- aMap ) -------------- next part -------------- An HTML attachment was scrubbed... URL: From toad3k at gmail.com Tue Oct 27 13:57:40 2015 From: toad3k at gmail.com (David McBride) Date: Tue, 27 Oct 2015 09:57:40 -0400 Subject: [Haskell-beginners] Space consumption and strictness in strict map In-Reply-To: References: Message-ID: Not 100% on this, but I would say the map is strict in keys and values as it says in the haddocks, but it is still an immutable structure. If you don't force the map while you are building it, you end up with unevaluated thunks, just like you would with +. insertWith + x y (insertWith + x y (insertWith + x y ...))) On the bright side because it is strict, the addition you are doing on the values of this map are being evaluated, so the + you are using is not also leaving behind thunks like value + value + value. I'd say the reason (:) is so common is because the arguments to insertWith both come from a list that is not being cleaned up until you force the map. On Tue, Oct 27, 2015 at 9:38 AM, John Lusk wrote: > Hello, beginners at haskell.org. I posted this a few days ago, but it looks > like attachments get pulled out by Mailman, whether or not they are small > text files ( :>( ), so I'm trying again, sans attachment. > _________________________________________ > > Hey, I have a problem I "solved" by sprinkling !s around like pixie dust, > but I'd like to know what's going on. My program is below, in all its > messy glory, but the whole ball of wax is at > https://github.com/JohnL4/PassphraseGenerator (mostFrequent.hs). It > takes as input one of the 2012 Google ngram (specifically, 1-gram) raw data > files. The expected input format is documented in several places. (For > testing, I took the first million lines.) > > The bang that worked is on the 3rd argument of 'wordCount', the map. I > tried commenting out the "(Map.insertWith (+) ngram matchCount aMap)" > part (and just returning the input map). When I did that, boy was space > consumption small, so that line is part of the problem. > > So, what's going on without the bang? > > I guess I'm just building up a bunch of thunks w/that Map.insertWith > call, but what kind of thunks? Unevaluated calls to splitOn and (!!) and > read and (+) and lines? > > I thought a strict Map would avoid that. I guess WHNF isn't enough? > Looking at https://wiki.haskell.org/Weak_head_normal_form, I don't *think* I > have any constructors in there, but profiling with -hd shows me that (:) is > the most frequently occurring closure. Where is *that* coming from? Is > the occurrence of (:) so high because it's either a built-in function > applied to too few arguments or a lambda abstraction? Which one? (Also, is > "lambda abstraction" the same as "lambda expresson"?) > > And then... what does that bang on the map argument do? Does it force > evaluation of the passed argument all the way down to primitives, so that > we truly get a data structure containing only strings and ints (and no > thunks)? What does that do to time complexity? Does it have to traverse > the entire map looking for thunks, even though I only added one at some > random location in the map? > > Is there a better way? > > I guess I need to force strictness somewhere else, but I'm not sure how. > I tried using seq (a little half-heartedly), and ($!), but I guess I did > it wrong and only wound up with more thunks to seq and id ($!), right? > So, I wound up with lazy strictness? > > Thanks for any help. > > John. > > My code: > > -- | Reads stdin and prints the n most-frequent words occurring after year > y to stdout, along with > -- | their counts. > > {-# LANGUAGE BangPatterns #-} > > import GHC.IO.Handle (hPutStr) > import GHC.IO.Handle.FD (stderr) > import Data.Char (toLower) > import Data.List (intersperse, sortBy) > import qualified Data.Map.Strict as Map > import Data.List.Split (splitOn) > > {- > Test data: > let filetext = > "aaa\t1900\t2\naaa\t1950\t3\nbbb\t1950\t5\nbbb_VERB\t1980\t9" > -} > > -- | Number of most-frequent words we want. > n :: Int > n = 15000 > > -- | Earliest year we want to count while building frequency table > y :: Int > y = 1950 > > main :: IO() > main = do > {- > Read line, split on tabs, take first three fields, which are: 1-gram > (word), year, match-count. > If year >= y: > Trim parts of speech (POS) from 1-gram (leading, trailing known > fragments delimited by "_") > Known fragments: NOUN, VERB, ADJ, ADV, PRON (pronouns), DET > (determiners and articles), ADP > (prepositions, postpositions), NUM, CONJ, PRT (particles), X > (miscellaneous) > > Split on "_", discard expected known fragments, complain if there are > more than one fragments left. (Note that I > have verified that each ngram has 0 or 1 trailing attributes, so the > check for an unexpected number of parts > is unnecessary.) > > Find word in dictionary and add match-count to that entry. > At end of input, sort dictionary entries by match-counts (descending) and > take first n entries for output. > -} > allInput <- getContents > putStrLn (concat (intersperse "\n" (map fst (take n (sortBy > countDescending > (Map.toList > (wordCounts y (lines allInput) Map.empty))))))) > hPutStr stderr "Done.\n" > > -- | Orders inputs by 2nd element (count), descending > countDescending :: (String,Int) -> (String,Int) -> Ordering > countDescending (_, countA) (_, countB) > | countA < countB = GT > | countA == countB = EQ > | otherwise = LT > > -- | Returns map of all counts (summed) for words occurring on or after > given year. > wordCounts :: Int -- ^ Year > -> [String] -- ^ Lines in form > "word\tyear\tcount\totherStuffWeDontCareAbout" > -> Map.Map String Int -- ^ Input map > -> Map.Map String Int -- ^ Output map > wordCounts _ [] aMap = aMap > wordCounts aYear (aLine:restLines) !aMap = > let fields = splitOn "\t" aLine > ngramParts = splitOn "_" (fields!!0) > ngram = map toLower (ngramParts!!0) -- "ngram" is the same as > "word", in this case. > year = read (fields!!1) :: Int > matchCount = read (fields!!2) :: Int > in if (year < aYear) > then (wordCounts aYear restLines aMap) > else (wordCounts aYear restLines > (Map.insertWith (+) ngram matchCount aMap) > -- aMap > ) > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From martin.drautzburg at web.de Tue Oct 27 17:53:59 2015 From: martin.drautzburg at web.de (martin) Date: Tue, 27 Oct 2015 18:53:59 +0100 Subject: [Haskell-beginners] How would you implement Instant and Interval Message-ID: <562FBA37.20806@web.de> Hello all If I define an Instant as a point in Time and an Interval as the difference between two Instants, and I also want to use (+) and (-), how can I do this. My initial thought making them instances of the Num class, but that does not work. (-) is okay on Intervals, but on Instant it returns a different type (Interval). Is it possible at all to define a typeclass with (-) :: Instant -> Instant -> Interval without using language extensions? From imantc at gmail.com Tue Oct 27 19:21:57 2015 From: imantc at gmail.com (Imants Cekusins) Date: Tue, 27 Oct 2015 20:21:57 +0100 Subject: [Haskell-beginners] How would you implement Instant and Interval In-Reply-To: <562FBA37.20806@web.de> References: <562FBA37.20806@web.de> Message-ID: Would this package help: http://hackage.haskell.org/package/time-interval ? -------------- next part -------------- An HTML attachment was scrubbed... URL: From bergey at alum.mit.edu Tue Oct 27 20:40:29 2015 From: bergey at alum.mit.edu (Daniel Bergey) Date: Tue, 27 Oct 2015 16:40:29 -0400 Subject: [Haskell-beginners] How would you implement Instant and Interval In-Reply-To: <562FBA37.20806@web.de> References: <562FBA37.20806@web.de> Message-ID: <87y4eoniyq.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> On 2015-10-27 at 13:53, martin wrote: > Hello all > > If I define an Instant as a point in Time and an Interval as the difference between two Instants, and I also want to use > (+) and (-), how can I do this. > > My initial thought making them instances of the Num class, but that does not work. (-) is okay on Intervals, but on > Instant it returns a different type (Interval). > > Is it possible at all to define a typeclass with (-) :: Instant -> Instant -> Interval without using language extensions? I think you are asking for the same type class function to have the types `Instant -> Instant -> Interval` and `Interval -> Interval -> Interval` for two different instances. I don't believe this is possible without language extensions. Below is an example of doing it with TypeFamilies. If I actually wanted this, I'd probably use the Affine class from linear[1] or vector-space[2] instead of the Sub class I define here. At any event, I don't think I'd want to give up on using - in it's normal meaning of Num, in order to use it for Time and Interval. newtype Time = Time Double deriving Show newtype Interval = Interval Double deriving Show class Sub a where type Diff a (.-.) :: a -> a -> Diff a instance Sub Time where type Diff Time = Interval (Time a) .-. (Time b) = Interval (a - b) instance Sub Interval where type Diff Interval = Interval (Interval a) .-. (Interval b) = Interval (a - b) Footnotes: [1] http://hackage.haskell.org/package/linear-1.20.2/docs/Linear-Affine.html [2] http://hackage.haskell.org/package/vector-space-0.10.2/docs/Data-AffineSpace.html From chak at justtesting.org Wed Oct 28 01:54:17 2015 From: chak at justtesting.org (Manuel M T Chakravarty) Date: Wed, 28 Oct 2015 12:54:17 +1100 Subject: [Haskell-beginners] New chapter in Learning Haskell: fractal structures Message-ID: <20A2666E-5194-456E-962E-3629F3BAB32A@justtesting.org> Our tutorial ?Learning Haskell? just gained a new fun chapter on visualising recursion with fractal structures: http://blog.haskellformac.com/blog/fractals-recursion-in-pictures Happy Coding! Manuel PS: This is going to be a good one for anybody who wants to get their kids interested in programming, too. From galeonet at tiscali.it Wed Oct 28 10:52:53 2015 From: galeonet at tiscali.it (galeonet at tiscali.it) Date: Wed, 28 Oct 2015 11:52:53 +0100 Subject: [Haskell-beginners] lists strange behaviour Message-ID: <46e77e6767444119625810ea038f1c81@tiscali.it> Hello, if I write down: [(x,y)|x<-[1..5],y<-[1..5]] I obtain as expected: [(1,1),(1,2),(1,3),(1,4),(1,5),(2,1),(2,2),(2,3),(2,4),(2,5),(3,1),(3,2),(3,3),(3,4),(3,5),(4,1),(4,2),(4,3),(4,4),(4,5),(5,1),(5,2),(5,3),(5,4),(5,5)] If I write down: [(x,y)|x<-[1..5],y<-[1..5],x==5] I obtain as expected: [(1,1),(1,2),(1,3),(1,4),(1,5)] but if I write: [(x,y)|x<-[1..5],y<-[1..5],x<-[1]] I obtain: [(1,1),(1,2),(1,3),(1,4),(1,5),(1,1),(1,2),(1,3),(1,4),(1,5),(1,1),(1,2),(1,3),(1,4),(1,5),(1,1),(1,2),(1,3),(1,4),(1,5),(1,1),(1,2),(1,3),(1,4),(1,5)] Why????? Thank you in advance. Regards, Maurizio Connetti gratis il mondo con la nuova indoona: hai la chat, le chiamate, le video chiamate e persino le chiamate di gruppo. E chiami gratis anche i numeri fissi e mobili nel mondo! Scarica subito l?app Vai su https://www.indoona.com/ From ky3 at atamo.com Wed Oct 28 11:01:18 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Wed, 28 Oct 2015 18:01:18 +0700 Subject: [Haskell-beginners] lists strange behaviour In-Reply-To: <46e77e6767444119625810ea038f1c81@tiscali.it> References: <46e77e6767444119625810ea038f1c81@tiscali.it> Message-ID: On Wed, Oct 28, 2015 at 5:52 PM, wrote: > but if I write: [(x,y)|x<-[1..5],y<-[1..5],x<-[1]] > I obtain: > > [(1,1),(1,2),(1,3),(1,4),(1,5),(1,1),(1,2),(1,3),(1,4),(1,5),(1,1),(1,2),(1,3),(1,4),(1,5),(1,1),(1,2),(1,3),(1,4),(1,5),(1,1),(1,2),(1,3),(1,4),(1,5)] > Others will chime in with a full answer soon. Meanwhile, consider that [(x,y)|x<-[1..5],y<-[1..5],x<-[1]] (which is quite weird as a set-theoretic expression) is Haskell-equivalent to [(x,y)|_<-[1..5],y<-[1..5],x<-[1]] Now consider [(x,y)|y<-[1..5],x<-[1]] which is [(1,1),(1,2),(1,3),(1,4),(1,5)] as you expect. Separately, consider [ a | _ <- [1..5], f a ] where you can experiment with different values of f and a. Putting together the pieces will give you an answer to your query. -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From patrick.browne at dit.ie Wed Oct 28 14:59:09 2015 From: patrick.browne at dit.ie (PATRICK BROWNE) Date: Wed, 28 Oct 2015 14:59:09 +0000 Subject: [Haskell-beginners] let , equations, and monads Message-ID: {- From Learn Haskell Fast and Hard : 4.3.1. Maybe is a monad http://yannesposito.com/Scratch/en/blog/Haskell-the-Hard-Way/#maybe-monad Concerning the code below I have the following questions: 1) Are eligibleLet and eligibleEquational operationally equivalent (i.e. perform the same operations) and/or semantically equivalent(i.e. Church-Rosser)? 2) Apart from the return type of Maybe instead of Bool how does eligibleMonad differ from eligibleLet? Regards, Pat -} deposit value account = account + value withdraw value account = account - value -- You are eligible for a bonus only if your sequence of transactions stays out of the red. eligibleLet :: (Num a,Ord a) => a -> Bool eligibleLet account = let account1 = deposit 100 account in if (account1 < 0) then False else let account2 = withdraw 200 account1 in if (account2 < 0) then False else let account3 = deposit 100 account2 in if (account3 < 0) then False else let account4 = withdraw 300 account3 in if (account4 < 0) then False else let account5 = deposit 1000 account4 in if (account5 < 0) then False else True -- No let expressions, hence intermediate calculations are performed multiple times. -- Should terminates on first point of failure eligibleEquational :: (Num a,Ord a) => a -> Bool eligibleEquational account = if (deposit 100 account) < 0 then False else if (withdraw 200 (deposit 100 account)) < 0 then False else if (deposit 100 (withdraw 200 (deposit 100 account))) < 0 then False else if (withdraw 300 (deposit 100 (withdraw 200 (deposit 100 account)))) < 0 then False else if (deposit 1000 (withdraw 300 (deposit 100 (withdraw 200 (deposit 100 account))))) < 0 then False else True -- Monadic version depositM :: (Num a) => a -> a -> Maybe a depositM value account = Just (account + value) withdrawM :: (Num a,Ord a) => a -> a -> Maybe a withdrawM value account = if (account < value) then Nothing else Just (account - value) eligibleMonad :: (Num a, Ord a) => a -> Maybe Bool eligibleMonad account = do account1 <- depositM 100 account account2 <- withdrawM 200 account1 account3 <- depositM 100 account2 account4 <- withdrawM 300 account3 account5 <- depositM 1000 account4 Just True main = do print $ eligibleLet 300 -- True print $ eligibleLet 299 -- Falsen print $ eligibleEquational 300 -- True print $ eligibleEquational 299 -- False print $ eligibleMonad 300 -- Just True print $ eligibleMonad 299 -- Nothing -- This email originated from DIT. If you received this email in error, please delete it from your system. Please note that if you are not the named addressee, disclosing, copying, distributing or taking any action based on the contents of this email or attachments is prohibited. www.dit.ie Is ? ITB?C a th?inig an r?omhphost seo. M? fuair t? an r?omhphost seo tr? earr?id, scrios de do ch?ras ? le do thoil. Tabhair ar aird, mura t? an seola? ainmnithe, go bhfuil dianchosc ar aon nochtadh, aon ch?ipe?il, aon d?ileadh n? ar aon ghn?omh a dh?anfar bunaithe ar an ?bhar at? sa r?omhphost n? sna hiat?in seo. www.dit.ie T? ITB?C ag aistri? go Gr?inseach Ghorm?in ? DIT is on the move to Grangegorman -------------- next part -------------- An HTML attachment was scrubbed... URL: From martin.drautzburg at web.de Fri Oct 30 18:43:23 2015 From: martin.drautzburg at web.de (martin) Date: Fri, 30 Oct 2015 19:43:23 +0100 Subject: [Haskell-beginners] randmomR produces only even values Message-ID: <5633BA4B.7030101@web.de> Hello all When I read: mkStdGen :: Int -> StdGen The function mkStdGen provides an alternative way of producing an initial generator, by mapping an Int into a generator. Again, distinct arguments should be likely to produce distinct generators. I thought, that > fst $ R.randomR (1,10) (R.mkStdGen s) should get me a random value between 1 and 10 and that I get different values depending on the seed s. But this > length $ filter even $ map (\s -> fst $ randomR (1::Int,10) (mkStdGen s))[1..1000] gives my 1000, i.e. all random numbers are even numbers. However, when I use random instead of randomR > length $ filter even $ map (\s -> fst $ random (mkStdGen s) ::Int)[1..1000] I get 499 (okay) Why is that so? From maydwell at gmail.com Fri Oct 30 22:40:24 2015 From: maydwell at gmail.com (Lyndon Maydwell) Date: Sat, 31 Oct 2015 09:40:24 +1100 Subject: [Haskell-beginners] randmomR produces only even values In-Reply-To: <5633BA4B.7030101@web.de> References: <5633BA4B.7030101@web.de> Message-ID: I've replicated this and it does seem very strange, and possibly even a bug. I would guess that most people don't encounter this issue as a generator is usually only seeded once, then threaded throughout generation. Not seeded for once for every random output. The other common practice is that generators are usually seeded on far more random input values than a list of ascending ints. Seed behaviour: main = mapM_ print (map p l) p x = length $ filter even $ map (\s -> fst $ randomR (1::Int,10) (mkStdGen s)) x l = map ls [1..10] ls x = map (\y -> x * y * 10) [1..1000] 1000 1000 1000 1000 1000 894 766 670 596 536 Still, I am very surprised by this behaviour. I couldn't find any reference to this behaviour in[1], which is supposedly what the System.Random implementation is based on. Does anyone else have an explanation? - Lyndon [1] - https://en.wikipedia.org/wiki/Linear_congruential_generator On Sat, Oct 31, 2015 at 5:43 AM, martin wrote: > Hello all > > > When I read: > > mkStdGen :: Int -> StdGen > > The function mkStdGen provides an alternative way of producing an initial > generator, by mapping an Int into a generator. > Again, distinct arguments should be likely to produce distinct generators. > > I thought, that > > > fst $ R.randomR (1,10) (R.mkStdGen s) > > should get me a random value between 1 and 10 and that I get different > values depending on the seed s. But this > > > length $ filter even $ map (\s -> fst $ randomR (1::Int,10) (mkStdGen > s))[1..1000] > > gives my 1000, i.e. all random numbers are even numbers. > > However, when I use random instead of randomR > > > length $ filter even $ map (\s -> fst $ random (mkStdGen s) > ::Int)[1..1000] > > I get 499 (okay) > > Why is that so? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From martin.drautzburg at web.de Sat Oct 31 08:32:58 2015 From: martin.drautzburg at web.de (martin) Date: Sat, 31 Oct 2015 09:32:58 +0100 Subject: [Haskell-beginners] randmomR produces only even values In-Reply-To: References: <5633BA4B.7030101@web.de> Message-ID: <56347CBA.8030201@web.de> I filed an issue on github (https://github.com/haskell/random/issues). Maybe the authors can shed some light on this. Am 10/30/2015 um 11:40 PM schrieb Lyndon Maydwell: > I've replicated this and it does seem very strange, and possibly even a bug. > > I would guess that most people don't encounter this issue as a generator is usually only seeded once, then threaded > throughout generation. Not seeded for once for every random output. The other common practice is that generators are > usually seeded on far more random input values than a list of ascending ints. > > Seed behaviour: > > main = mapM_ print (map p l) > p x = length $ filter even $ map (\s -> fst $ randomR (1::Int,10) (mkStdGen s)) x > l = map ls [1..10] > ls x = map (\y -> x * y * 10) [1..1000] > > 1000 > 1000 > 1000 > 1000 > 1000 > 894 > 766 > 670 > 596 > 536 > > > Still, I am very surprised by this behaviour. I couldn't find any reference to this behaviour in[1], which is supposedly > what the System.Random implementation is based on. > > Does anyone else have an explanation? > > > - Lyndon > > > [1] - https://en.wikipedia.org/wiki/Linear_congruential_generator > > On Sat, Oct 31, 2015 at 5:43 AM, martin > wrote: > > Hello all > > > When I read: > > mkStdGen :: Int -> StdGen > > The function mkStdGen provides an alternative way of producing an initial generator, by mapping an Int into a generator. > Again, distinct arguments should be likely to produce distinct generators. > > I thought, that > > > fst $ R.randomR (1,10) (R.mkStdGen s) > > should get me a random value between 1 and 10 and that I get different values depending on the seed s. But this > > > length $ filter even $ map (\s -> fst $ randomR (1::Int,10) (mkStdGen s))[1..1000] > > gives my 1000, i.e. all random numbers are even numbers. > > However, when I use random instead of randomR > > > length $ filter even $ map (\s -> fst $ random (mkStdGen s) ::Int)[1..1000] > > I get 499 (okay) > > Why is that so? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >