From gmalecha at gmail.com Sun Jun 1 21:55:21 2014 From: gmalecha at gmail.com (Gregory Malecha) Date: Sun, 1 Jun 2014 17:55:21 -0400 Subject: [Haskell-beginners] Is there a name for the following? Message-ID: Hello -- I'm wondering if there is any "name" for a functor "F" that has a function with the following type: (a -> F b) -> F (a -> b) or (F a -> F b) -> F (a -> b) If there is, I would imagine it being related to Applicative in some way, though clearly there are many Applicatives that do not have an implementation of this. Thanks. -- gregory malecha -------------- next part -------------- An HTML attachment was scrubbed... URL: From tonymorris at gmail.com Mon Jun 2 00:09:47 2014 From: tonymorris at gmail.com (Tony Morris) Date: Mon, 02 Jun 2014 10:09:47 +1000 Subject: [Haskell-beginners] Is there a name for the following? In-Reply-To: References: Message-ID: <538BC0CB.3080008@gmail.com> Doubt it. What would be the instances? What resulted in this requirement? Data.Distributive might help. Just guessing. On 02/06/14 07:55, Gregory Malecha wrote: > Hello -- > > I'm wondering if there is any "name" for a functor "F" that has a > function with the following type: > > (a -> F b) -> F (a -> b) > > or > > (F a -> F b) -> F (a -> b) > > If there is, I would imagine it being related to Applicative in some > way, though clearly there are many Applicatives that do not have an > implementation of this. > > Thanks. > > -- > gregory malecha > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners -- Tony Morris http://tmorris.net/ -------------- next part -------------- An HTML attachment was scrubbed... URL: From byorgey at seas.upenn.edu Mon Jun 2 01:58:20 2014 From: byorgey at seas.upenn.edu (Brent Yorgey) Date: Sun, 1 Jun 2014 21:58:20 -0400 Subject: [Haskell-beginners] Is there a name for the following? In-Reply-To: References: Message-ID: <20140602015819.GA25615@seas.upenn.edu> Hi Gregory, On Sun, Jun 01, 2014 at 05:55:21PM -0400, Gregory Malecha wrote: > Hello -- > > I'm wondering if there is any "name" for a functor "F" that has a function > with the following type: > > (a -> F b) -> F (a -> b) > > or > > (F a -> F b) -> F (a -> b) > > If there is, I would imagine it being related to Applicative in some way, > though clearly there are many Applicatives that do not have an > implementation of this. As for the first type, any distributive/representable functor (http://hackage.haskell.org/package/distributive-0.4/docs/Data-Distributive.html#t:Distributive, http://hackage.haskell.org/package/adjunctions-4.0.3/docs/Data-Functor-Rep.html) will have such a function---that is, when F a is isomorphic to (r -> a) for some type r. Then it is just (a -> r -> b) -> (r -> a -> b) I rather suspect that these are the *only* functors that will work, but I'm not sure how to prove it off the top of my head. Intuitively, if F does not have some fixed structure, i.e. it is isomorphic to a sum type, then (given that 'a' can be infinite) there is no way to combine the infinitely many F structures resulting from the (a -> F b) function into a single F structure on the right. Relatedly, you may be interested in http://winterkoninkje.dreamwidth.org/81209.html http://hackage.haskell.org/package/countable-0.1/docs/Data-Searchable.html#t:Finite which are very similar, although they quantify over 'a' rather than 'F'. I do not have any good intuition about the second type. -Brent From mark.m.fredrickson at gmail.com Mon Jun 2 16:28:43 2014 From: mark.m.fredrickson at gmail.com (Mark Fredrickson) Date: Mon, 2 Jun 2014 11:28:43 -0500 Subject: [Haskell-beginners] Static records (CSV tables as modules) In-Reply-To: <87bnueded6.fsf@gmail.com> References: <87bnueded6.fsf@gmail.com> Message-ID: Thanks for this solution. I think I could pair this with a data type generated at runtime to index the vector and I'd be in great shape. Related question: Does anyone know example code that creates data types at runtime via TH? -M On Fri, May 30, 2014 at 6:40 PM, Ben Gamari wrote: > Mark Fredrickson writes: > > > Hello, > > > > I writing a program that operates on some static data, currently saved in > > CSV files. Right now I parse the files at run time and then generate > > hashmap tables to connect the different data. > > > > Since I'm only ever operating on static data, I'm wondering if I can > > generate module files that capture the records as a sum type. To access > the > > fields of the records, I could then imagine functions that exhaustively > map > > the constructors to the data. > > > > Do any tools to generate .hs files from CSV or other formats exist? > Insofar > > as this question has been asked before, the recommendation is "use > Template > > Haskell", which makes sense, but is a less complete solution than I'm > > hoping for. > > > How does the TH hack below look? > > See this Gist for this code and a test-case. Unfortunately there are a > few gotchas here, > > 1. The record type needs a `Lift` instance[2]. There are a pain to > write but can be derived[3] > 2. The type of your data can't be defined in the same module as the TH > splice due to GHC's stage restriction > > Cheers, > > - Ben > > > [1] https://gist.github.com/bgamari/efad8560ab7dd38e9407 > [2] > http://hackage.haskell.org/package/template-haskell-2.9.0.0/docs/Language-Haskell-TH-Syntax.html#t:Lift > [3] http://hackage.haskell.org/package/th-lift > > > {-# LANGUAGE TemplateHaskell, FlexibleContexts #-} > > module StaticCSV (staticCSV) where > > import Control.Applicative > import Data.Csv as Csv hiding (Name) > import Data.Proxy > import Data.Data > import Language.Haskell.TH > import Language.Haskell.TH.Syntax (Lift, lift) > import qualified Data.ByteString.Lazy as BSL > import qualified Data.Vector as V > > staticCSV :: (FromRecord a, Lift (V.Vector a)) => FilePath -> Proxy a -> > ExpQ > staticCSV fileName ty = do > contents <- runIO $ BSL.readFile fileName > csv <- case decode NoHeader contents of > Right a -> return $ fmap (flip asProxyTypeOf ty) a > Left err -> fail err > [| csv |] > > instance Lift a => Lift (V.Vector a) where > lift v = do > list <- ListE <$> mapM lift (V.toList v) > return $ AppE (VarE 'V.fromList) list > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From jzdudek at gmail.com Mon Jun 2 21:14:25 2014 From: jzdudek at gmail.com (Jacek Dudek) Date: Mon, 2 Jun 2014 17:14:25 -0400 Subject: [Haskell-beginners] Project euler question In-Reply-To: <537D9D70.4060209@web.de> References: <537D07F4.3000606@web.de> <537D9D70.4060209@web.de> Message-ID: {- Hi Martin, I must say, I don't follow your solution. Are you generating all the permutations according to lexicographic order and then choosing the one millionth one? Is there any particular reason why you're using a monad? For what it's worth here's how I solved the problem. -} nthPerm :: Ord a => Int -> [a] -> Maybe [a] -- This wrapper function just tests for cases -- where the arguments don't make sense. nthPerm m cs | m < 1 || null cs || product [1 .. length cs] < m || nub cs /= cs = Nothing | otherwise = Just (nthPerm' (m - 1) (sort cs)) nthPerm' :: Ord a => Int -> [a] -> [a] -- This function calculates the solution for arguments that make sense. -- Interpret the first argument as: the number of permutations, in -- lexicographic order, that come BEFORE the one you want. So if you -- wanted the 10-th permutation, the argument would be 9. -- The second argument is the list of elements. It's assumed to be non -- empty, contain no duplicates, and be sorted. nthPerm' 0 cs = cs nthPerm' m cs = let -- Number of elements that are permuted: n = length cs -- Number of permutations for lists with one element less than n: d = product [1 .. n - 1] -- Express m, the number of permutations before the one we want -- in this form: m = b * d + r, where 0 < r < d. This will tell -- us which "branch" our permutation is in. See "diagram" below. b = div m d r = rem m d -- Take out the element in the list that corresponds to the -- correct "branch". c = cs !! b in -- The correct permutation = c : the correct sub-permutation -- of the original list with element c removed. c : nthPerm' r (delete c cs) -- Diagram: The permutations of [0 .. 9] can be expressed as: -- -- P [0 .. 9] = map (0 :) $ P (delete 0 [0 .. 9]) -- branch 0 -- ++ map (1 :) $ P (delete 1 [0 .. 9]) -- branch 1 -- ++ map (2 :) $ P (delete 2 [0 .. 9]) -- branch 2 -- . -- . -- . -- ++ map (9 :) $ P (delete 9 [0 .. 9]) -- branch 9 On 5/22/14, martin wrote: > Am 05/21/2014 11:14 PM, schrieb David McBride: >> Err actually I guess I got the euler answer, I guess I don't understand >> your solution without the "minus" function >> definition. > > "minus" is from Data.List.Ordered. It it like the standard set operation > "minus" when both lists are ordered. > >> >> >> On Wed, May 21, 2014 at 5:10 PM, David McBride > > wrote: >> >> For what it is worth, I'm getting the same answer as you are. >> >> > head $ drop (1000000-1) $ sort $ Data.List.permutations [0..9] >> [2,7,8,3,9,1,5,4,6,0] >> >> >(sort $ Data.List.permutations [0..9]) !! (1000000-1) >> [2,7,8,3,9,1,5,4,6,0] >> >> I guess either euler is wrong or we are both crazy. >> >> >> On Wed, May 21, 2014 at 4:09 PM, martin > > wrote: >> >> Hello all, >> >> I tried to solve Problem 24 (https://projecteuler.net/problem=24) >> and came up with the following solution: >> >> import Data.List.Ordered >> import Data.Char >> >> elems = [0,1,2,3,4,5,6,7,8,9] :: [Int] >> >> x = do >> a <- elems >> b <- elems `without` [a] >> c <- elems `without` [a,b] >> d <- elems `without` [a,b,c] >> e <- elems `without` [a,b,c,d] >> f <- elems `without` [a,b,c,d,e] >> g <- elems `without` [a,b,c,d,e,f] >> h <- elems `without` [a,b,c,d,e,f,g] >> i <- elems `without` [a,b,c,d,e,f,g,h] >> j <- elems `without` [a,b,c,d,e,f,g,h,i] >> return [a,b,c,d,e,f,g,h,i,j] >> >> without a b = minus a ( sort b) >> >> solution = filter isDigit $ show $ (x !! 1000001) >> -- "2783915640" >> >> PE tells me that this is wrong, and I peeked the correct answer, >> which is 2783915460 (the 4 and 6 are swapped). So I >> tried to find out where the correct answer is in my list x and >> added >> >> y = filter (\(x,y) -> x == "2783915460") $ zip (map (filter >> isDigit . show) x) [1..] >> -- [("2783915460",1000000)] >> >> How can that be? "solution" tells me that the millionth element is >> "2783915640" but "y" tells me that >> "2783915460" is at >> the millionth position? I just cannot see it. >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://www.haskell.org/mailman/listinfo/beginners >> >> >> >> >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://www.haskell.org/mailman/listinfo/beginners >> > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners > From defigueiredo at ucdavis.edu Wed Jun 4 22:58:27 2014 From: defigueiredo at ucdavis.edu (Dimitri DeFigueiredo) Date: Wed, 04 Jun 2014 16:58:27 -0600 Subject: [Haskell-beginners] Literate Haskell in Markdown but not Bird style In-Reply-To: References: <537D07F4.3000606@web.de> <537D9D70.4060209@web.de> Message-ID: <538FA493.5050608@ucdavis.edu> Hi All, Is there a way to use literate haskell with GHC using Markdown but *not* using the Bird style for the code? It seems either one uses Bird style or has to put latex style \begin{code} markup (which markdown doesn't hide) In other words, is there a way to mark up the code in Markdown in a way that GHC understands without having to preprocess the file? I just wanted to write a .lhs file in markdown like I write a .hs file today. Thanks, Dimitri From timmelzer at gmail.com Wed Jun 4 23:55:21 2014 From: timmelzer at gmail.com (Norbert Melzer) Date: Thu, 5 Jun 2014 01:55:21 +0200 Subject: [Haskell-beginners] Literate Haskell in Markdown but not Bird style In-Reply-To: <538FA493.5050608@ucdavis.edu> References: <537D07F4.3000606@web.de> <537D9D70.4060209@web.de> <538FA493.5050608@ucdavis.edu> Message-ID: Because markdown knows about code in two ways, which differs by implementation, I have to ask which you want to use. Do you want to mark code by indenting it or by fencing it? As far as I remember the documentation, fenced code blocks should be possible where indented are not. But how exactly I had to search again. Am 05.06.2014 00:58 schrieb "Dimitri DeFigueiredo" : > Hi All, > > Is there a way to use literate haskell with GHC using Markdown but *not* > using the Bird style for the code? > It seems either one uses Bird style or has to put latex style \begin{code} > markup (which markdown doesn't hide) > > In other words, is there a way to mark up the code in Markdown in a way > that GHC understands without having to preprocess the file? I just wanted > to write a .lhs file in markdown like I write a .hs file today. > > Thanks, > > Dimitri > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From byorgey at seas.upenn.edu Thu Jun 5 01:45:53 2014 From: byorgey at seas.upenn.edu (Brent Yorgey) Date: Wed, 4 Jun 2014 21:45:53 -0400 Subject: [Haskell-beginners] Literate Haskell in Markdown but not Bird style In-Reply-To: <538FA493.5050608@ucdavis.edu> References: <537D07F4.3000606@web.de> <537D9D70.4060209@web.de> <538FA493.5050608@ucdavis.edu> Message-ID: <20140605014553.GA380@seas.upenn.edu> On Wed, Jun 04, 2014 at 04:58:27PM -0600, Dimitri DeFigueiredo wrote: > Hi All, > > Is there a way to use literate haskell with GHC using Markdown but > *not* using the Bird style for the code? > It seems either one uses Bird style or has to put latex style > \begin{code} markup (which markdown doesn't hide) Those are the only two styles which GHC accepts. > In other words, is there a way to mark up the code in Markdown in a > way that GHC understands without having to preprocess the file? I > just wanted to write a .lhs file in markdown like I write a .hs file > today. If you are willing/able to use pandoc, it implements a special version of Markdown for .lhs files which understands Bird tracks. See http://johnmacfarlane.net/pandoc/README.html#pandocs-markdown -Brent From defigueiredo at ucdavis.edu Thu Jun 5 06:53:05 2014 From: defigueiredo at ucdavis.edu (Dimitri DeFigueiredo) Date: Thu, 05 Jun 2014 00:53:05 -0600 Subject: [Haskell-beginners] Literate Haskell in Markdown but not Bird style In-Reply-To: <20140605014553.GA380@seas.upenn.edu> References: <537D07F4.3000606@web.de> <537D9D70.4060209@web.de> <538FA493.5050608@ucdavis.edu> <20140605014553.GA380@seas.upenn.edu> Message-ID: <539013D1.2000806@ucdavis.edu> Thanks. I wanted to use the fenced version like so. ```haskell myFunction :: Int -> String -- some code goes here ``` I find that typing with the Bird style, I get lots of '>' left behind at the end of lines causing syntax problems before I compile. It also makes it harder for me to reformat the code. For example, 'unindent block' no longer works on my editor. Cheers, Dimitri Em 04/06/14 19:45, Brent Yorgey escreveu: > On Wed, Jun 04, 2014 at 04:58:27PM -0600, Dimitri DeFigueiredo wrote: >> Hi All, >> >> Is there a way to use literate haskell with GHC using Markdown but >> *not* using the Bird style for the code? >> It seems either one uses Bird style or has to put latex style >> \begin{code} markup (which markdown doesn't hide) > Those are the only two styles which GHC accepts. > >> In other words, is there a way to mark up the code in Markdown in a >> way that GHC understands without having to preprocess the file? I >> just wanted to write a .lhs file in markdown like I write a .hs file >> today. > If you are willing/able to use pandoc, it implements a special version > of Markdown for .lhs files which understands Bird tracks. See > > http://johnmacfarlane.net/pandoc/README.html#pandocs-markdown > > -Brent > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners From gale at sefer.org Thu Jun 5 09:01:41 2014 From: gale at sefer.org (Yitzchak Gale) Date: Thu, 5 Jun 2014 12:01:41 +0300 Subject: [Haskell-beginners] Literate Haskell in Markdown but not Bird style In-Reply-To: <539013D1.2000806@ucdavis.edu> References: <537D07F4.3000606@web.de> <537D9D70.4060209@web.de> <538FA493.5050608@ucdavis.edu> <20140605014553.GA380@seas.upenn.edu> <539013D1.2000806@ucdavis.edu> Message-ID: That makes sense. Perhaps you should use latex style, then use a quick script to change the begin and end lines to markdown fences. It would be a one-liner in bash, or a very simple Haskell program, for example. -Yitz On Thu, Jun 5, 2014 at 9:53 AM, Dimitri DeFigueiredo wrote: > Thanks. I wanted to use the fenced version like so. > > ```haskell > myFunction :: Int -> String > -- some code goes here > ``` > > I find that typing with the Bird style, I get lots of '>' left behind at the > end of lines causing syntax problems before I compile. It also makes it > harder for me to reformat the code. For example, 'unindent block' no longer > works on my editor. > > > Cheers, > > Dimitri > > > Em 04/06/14 19:45, Brent Yorgey escreveu: > >> On Wed, Jun 04, 2014 at 04:58:27PM -0600, Dimitri DeFigueiredo wrote: >>> >>> Hi All, >>> >>> Is there a way to use literate haskell with GHC using Markdown but >>> *not* using the Bird style for the code? >>> It seems either one uses Bird style or has to put latex style >>> \begin{code} markup (which markdown doesn't hide) >> >> Those are the only two styles which GHC accepts. >> >>> In other words, is there a way to mark up the code in Markdown in a >>> way that GHC understands without having to preprocess the file? I >>> just wanted to write a .lhs file in markdown like I write a .hs file >>> today. >> >> If you are willing/able to use pandoc, it implements a special version >> of Markdown for .lhs files which understands Bird tracks. See >> >> http://johnmacfarlane.net/pandoc/README.html#pandocs-markdown >> >> -Brent >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://www.haskell.org/mailman/listinfo/beginners > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners From byorgey at seas.upenn.edu Thu Jun 5 16:30:14 2014 From: byorgey at seas.upenn.edu (Brent Yorgey) Date: Thu, 5 Jun 2014 12:30:14 -0400 Subject: [Haskell-beginners] Literate Haskell in Markdown but not Bird style In-Reply-To: <539013D1.2000806@ucdavis.edu> References: <537D07F4.3000606@web.de> <537D9D70.4060209@web.de> <538FA493.5050608@ucdavis.edu> <20140605014553.GA380@seas.upenn.edu> <539013D1.2000806@ucdavis.edu> Message-ID: <20140605163014.GA4393@seas.upenn.edu> On Thu, Jun 05, 2014 at 12:53:05AM -0600, Dimitri DeFigueiredo wrote: > Thanks. I wanted to use the fenced version like so. > > ```haskell > myFunction :: Int -> String > -- some code goes here > ``` OK. Unfortunately it is not possible to get GHC to recognize code in that format without some preprocessing. > I find that typing with the Bird style, I get lots of '>' left behind > at the end of lines causing syntax problems before I compile. It also > makes it harder for me to reformat the code. For example, 'unindent > block' no longer works on my editor. Sounds like the real issue is that you need better editor support. What editor are you using? I am just curious, I am not going to suggest that you change editors. =) -Brent > Em 04/06/14 19:45, Brent Yorgey escreveu: > >On Wed, Jun 04, 2014 at 04:58:27PM -0600, Dimitri DeFigueiredo wrote: > >>Hi All, > >> > >>Is there a way to use literate haskell with GHC using Markdown but > >>*not* using the Bird style for the code? > >>It seems either one uses Bird style or has to put latex style > >>\begin{code} markup (which markdown doesn't hide) > >Those are the only two styles which GHC accepts. > > > >>In other words, is there a way to mark up the code in Markdown in a > >>way that GHC understands without having to preprocess the file? I > >>just wanted to write a .lhs file in markdown like I write a .hs file > >>today. > >If you are willing/able to use pandoc, it implements a special version > >of Markdown for .lhs files which understands Bird tracks. See > > > > http://johnmacfarlane.net/pandoc/README.html#pandocs-markdown > > > >-Brent > >_______________________________________________ > >Beginners mailing list > >Beginners at haskell.org > >http://www.haskell.org/mailman/listinfo/beginners > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners From defigueiredo at ucdavis.edu Thu Jun 5 16:44:05 2014 From: defigueiredo at ucdavis.edu (Dimitri DeFigueiredo) Date: Thu, 05 Jun 2014 10:44:05 -0600 Subject: [Haskell-beginners] Literate Haskell in Markdown but not Bird style In-Reply-To: <20140605163014.GA4393@seas.upenn.edu> References: <537D07F4.3000606@web.de> <537D9D70.4060209@web.de> <538FA493.5050608@ucdavis.edu> <20140605014553.GA380@seas.upenn.edu> <539013D1.2000806@ucdavis.edu> <20140605163014.GA4393@seas.upenn.edu> Message-ID: <53909E55.3050601@ucdavis.edu> I'm using Sublime Text. I do like it a lot! I disagree that what I need is a better editor. What is the more popular to annotate code today: Github Markdown or Latex? The source file of a latex document is not amenable to be read as you are coding, but Markdown is. So, it helps make the code cleaner. ;-) Dimitri Em 05/06/14 10:30, Brent Yorgey escreveu: > On Thu, Jun 05, 2014 at 12:53:05AM -0600, Dimitri DeFigueiredo wrote: >> Thanks. I wanted to use the fenced version like so. >> >> ```haskell >> myFunction :: Int -> String >> -- some code goes here >> ``` > OK. Unfortunately it is not possible to get GHC to recognize code in > that format without some preprocessing. > >> I find that typing with the Bird style, I get lots of '>' left behind >> at the end of lines causing syntax problems before I compile. It also >> makes it harder for me to reformat the code. For example, 'unindent >> block' no longer works on my editor. > Sounds like the real issue is that you need better editor support. > What editor are you using? I am just curious, I am not going to > suggest that you change editors. =) > > -Brent > >> Em 04/06/14 19:45, Brent Yorgey escreveu: >>> On Wed, Jun 04, 2014 at 04:58:27PM -0600, Dimitri DeFigueiredo wrote: >>>> Hi All, >>>> >>>> Is there a way to use literate haskell with GHC using Markdown but >>>> *not* using the Bird style for the code? >>>> It seems either one uses Bird style or has to put latex style >>>> \begin{code} markup (which markdown doesn't hide) >>> Those are the only two styles which GHC accepts. >>> >>>> In other words, is there a way to mark up the code in Markdown in a >>>> way that GHC understands without having to preprocess the file? I >>>> just wanted to write a .lhs file in markdown like I write a .hs file >>>> today. >>> If you are willing/able to use pandoc, it implements a special version >>> of Markdown for .lhs files which understands Bird tracks. See >>> >>> http://johnmacfarlane.net/pandoc/README.html#pandocs-markdown >>> >>> -Brent >>> _______________________________________________ >>> Beginners mailing list >>> Beginners at haskell.org >>> http://www.haskell.org/mailman/listinfo/beginners >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://www.haskell.org/mailman/listinfo/beginners > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners From byorgey at seas.upenn.edu Thu Jun 5 17:15:36 2014 From: byorgey at seas.upenn.edu (Brent Yorgey) Date: Thu, 5 Jun 2014 13:15:36 -0400 Subject: [Haskell-beginners] Literate Haskell in Markdown but not Bird style In-Reply-To: <53909E55.3050601@ucdavis.edu> References: <537D07F4.3000606@web.de> <537D9D70.4060209@web.de> <538FA493.5050608@ucdavis.edu> <20140605014553.GA380@seas.upenn.edu> <539013D1.2000806@ucdavis.edu> <20140605163014.GA4393@seas.upenn.edu> <53909E55.3050601@ucdavis.edu> Message-ID: <20140605171536.GA1792@seas.upenn.edu> I didn't say you need a better editor! I said you need better *support* from your editor for writing literate Haskell code. I don't know much about Sublime Text but you might find this useful: https://bitbucket.org/wrossmck/literate-haskell-bird-style Anyway, I agree Markdown is better for annotating your code, unless you are writing a paper about it. -Brent On Thu, Jun 05, 2014 at 10:44:05AM -0600, Dimitri DeFigueiredo wrote: > I'm using Sublime Text. I do like it a lot! I disagree that what I > need is a better editor. What is the more popular to annotate code > today: Github Markdown or Latex? The source file of a latex document > is not amenable to be read as you are coding, but Markdown is. So, it > helps make the code cleaner. ;-) > > Dimitri > > Em 05/06/14 10:30, Brent Yorgey escreveu: > >On Thu, Jun 05, 2014 at 12:53:05AM -0600, Dimitri DeFigueiredo wrote: > >>Thanks. I wanted to use the fenced version like so. > >> > >>```haskell > >>myFunction :: Int -> String > >>-- some code goes here > >>``` > >OK. Unfortunately it is not possible to get GHC to recognize code in > >that format without some preprocessing. > > > >>I find that typing with the Bird style, I get lots of '>' left behind > >>at the end of lines causing syntax problems before I compile. It also > >>makes it harder for me to reformat the code. For example, 'unindent > >>block' no longer works on my editor. > >Sounds like the real issue is that you need better editor support. > >What editor are you using? I am just curious, I am not going to > >suggest that you change editors. =) > > > >-Brent > > > >>Em 04/06/14 19:45, Brent Yorgey escreveu: > >>>On Wed, Jun 04, 2014 at 04:58:27PM -0600, Dimitri DeFigueiredo wrote: > >>>>Hi All, > >>>> > >>>>Is there a way to use literate haskell with GHC using Markdown but > >>>>*not* using the Bird style for the code? > >>>>It seems either one uses Bird style or has to put latex style > >>>>\begin{code} markup (which markdown doesn't hide) > >>>Those are the only two styles which GHC accepts. > >>> > >>>>In other words, is there a way to mark up the code in Markdown in a > >>>>way that GHC understands without having to preprocess the file? I > >>>>just wanted to write a .lhs file in markdown like I write a .hs file > >>>>today. > >>>If you are willing/able to use pandoc, it implements a special version > >>>of Markdown for .lhs files which understands Bird tracks. See > >>> > >>> http://johnmacfarlane.net/pandoc/README.html#pandocs-markdown > >>> > >>>-Brent > >>>_______________________________________________ > >>>Beginners mailing list > >>>Beginners at haskell.org > >>>http://www.haskell.org/mailman/listinfo/beginners > >>_______________________________________________ > >>Beginners mailing list > >>Beginners at haskell.org > >>http://www.haskell.org/mailman/listinfo/beginners > >_______________________________________________ > >Beginners mailing list > >Beginners at haskell.org > >http://www.haskell.org/mailman/listinfo/beginners > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners From defigueiredo at ucdavis.edu Fri Jun 6 04:00:32 2014 From: defigueiredo at ucdavis.edu (Dimitri DeFigueiredo) Date: Thu, 05 Jun 2014 22:00:32 -0600 Subject: [Haskell-beginners] Literate Haskell in Markdown but not Bird style In-Reply-To: <20140605171536.GA1792@seas.upenn.edu> References: <537D07F4.3000606@web.de> <537D9D70.4060209@web.de> <538FA493.5050608@ucdavis.edu> <20140605014553.GA380@seas.upenn.edu> <539013D1.2000806@ucdavis.edu> <20140605163014.GA4393@seas.upenn.edu> <53909E55.3050601@ucdavis.edu> <20140605171536.GA1792@seas.upenn.edu> Message-ID: <53913CE0.7010706@ucdavis.edu> Thanks for the link. :-) Dimitri Em 05/06/14 11:15, Brent Yorgey escreveu: > I didn't say you need a better editor! I said you need better > *support* from your editor for writing literate Haskell code. I don't > know much about Sublime Text but you might find this useful: > > https://bitbucket.org/wrossmck/literate-haskell-bird-style > > Anyway, I agree Markdown is better for annotating your code, unless > you are writing a paper about it. > > -Brent > > On Thu, Jun 05, 2014 at 10:44:05AM -0600, Dimitri DeFigueiredo wrote: >> I'm using Sublime Text. I do like it a lot! I disagree that what I >> need is a better editor. What is the more popular to annotate code >> today: Github Markdown or Latex? The source file of a latex document >> is not amenable to be read as you are coding, but Markdown is. So, it >> helps make the code cleaner. ;-) >> >> Dimitri >> >> Em 05/06/14 10:30, Brent Yorgey escreveu: >>> On Thu, Jun 05, 2014 at 12:53:05AM -0600, Dimitri DeFigueiredo wrote: >>>> Thanks. I wanted to use the fenced version like so. >>>> >>>> ```haskell >>>> myFunction :: Int -> String >>>> -- some code goes here >>>> ``` >>> OK. Unfortunately it is not possible to get GHC to recognize code in >>> that format without some preprocessing. >>> >>>> I find that typing with the Bird style, I get lots of '>' left behind >>>> at the end of lines causing syntax problems before I compile. It also >>>> makes it harder for me to reformat the code. For example, 'unindent >>>> block' no longer works on my editor. >>> Sounds like the real issue is that you need better editor support. >>> What editor are you using? I am just curious, I am not going to >>> suggest that you change editors. =) >>> >>> -Brent >>> >>>> Em 04/06/14 19:45, Brent Yorgey escreveu: >>>>> On Wed, Jun 04, 2014 at 04:58:27PM -0600, Dimitri DeFigueiredo wrote: >>>>>> Hi All, >>>>>> >>>>>> Is there a way to use literate haskell with GHC using Markdown but >>>>>> *not* using the Bird style for the code? >>>>>> It seems either one uses Bird style or has to put latex style >>>>>> \begin{code} markup (which markdown doesn't hide) >>>>> Those are the only two styles which GHC accepts. >>>>> >>>>>> In other words, is there a way to mark up the code in Markdown in a >>>>>> way that GHC understands without having to preprocess the file? I >>>>>> just wanted to write a .lhs file in markdown like I write a .hs file >>>>>> today. >>>>> If you are willing/able to use pandoc, it implements a special version >>>>> of Markdown for .lhs files which understands Bird tracks. See >>>>> >>>>> http://johnmacfarlane.net/pandoc/README.html#pandocs-markdown >>>>> >>>>> -Brent >>>>> _______________________________________________ >>>>> Beginners mailing list >>>>> Beginners at haskell.org >>>>> http://www.haskell.org/mailman/listinfo/beginners >>>> _______________________________________________ >>>> Beginners mailing list >>>> Beginners at haskell.org >>>> http://www.haskell.org/mailman/listinfo/beginners >>> _______________________________________________ >>> Beginners mailing list >>> Beginners at haskell.org >>> http://www.haskell.org/mailman/listinfo/beginners >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://www.haskell.org/mailman/listinfo/beginners > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners From vxanica at gmail.com Fri Jun 6 11:23:06 2014 From: vxanica at gmail.com (Song Zhang) Date: Fri, 6 Jun 2014 19:23:06 +0800 Subject: [Haskell-beginners] About ! before a type signature Message-ID: This is about syntax of Haskell. I am reading the source code of Yampa. I find that a definition like the following data SF' a b where SFArr :: !(DTime -> a -> Transition a b) -> !(FunDesc a b) -> SF' a b in Yampa.hs. -------------- next part -------------- An HTML attachment was scrubbed... URL: From bob at redivi.com Fri Jun 6 13:05:42 2014 From: bob at redivi.com (Bob Ippolito) Date: Fri, 6 Jun 2014 06:05:42 -0700 Subject: [Haskell-beginners] About ! before a type signature In-Reply-To: References: Message-ID: That declares those fields to be strict. See also http://www.haskell.org/haskellwiki/Performance/Data_types On Friday, June 6, 2014, Song Zhang wrote: > This is about syntax of Haskell. > I am reading the source code of Yampa. I find that a definition like the > following > > data SF' a b where > SFArr :: !(DTime -> a -> Transition a b) -> !(FunDesc a b) -> SF' a b > > > in Yampa.hs. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From phil at cnphil.com Sat Jun 7 04:14:40 2014 From: phil at cnphil.com (=?utf-8?Q?Xiaojun_=22Phil=22_Hu?=) Date: Sat, 7 Jun 2014 12:14:40 +0800 Subject: [Haskell-beginners] About ! before a type signature In-Reply-To: References: Message-ID: <5FB30F9763F2407E882A8A8256CF9F6C@cnphil.com> I?m just curious, but is there any practical guide or tutorial on this topic? I found it relatively hard to reason about the time complexity of Haskell programs. ? Xiaojun "Phil (http://cnphil.com/)" Hu On Friday, 6 June, 2014 at 21:05, Bob Ippolito wrote: > That declares those fields to be strict. See also http://www.haskell.org/haskellwiki/Performance/Data_types > > On Friday, June 6, 2014, Song Zhang wrote: > > This is about syntax of Haskell. > > I am reading the source code of Yampa. I find that a definition like the following > > > > data SF' a b where > > SFArr :: !(DTime -> a -> Transition a b) -> !(FunDesc a b) -> SF' a b > > > > > > > > in Yampa.hs. > _______________________________________________ > Beginners mailing list > Beginners at haskell.org (mailto:Beginners at haskell.org) > http://www.haskell.org/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ky3 at atamo.com Sat Jun 7 05:15:07 2014 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Sat, 7 Jun 2014 12:15:07 +0700 Subject: [Haskell-beginners] About ! before a type signature In-Reply-To: <5FB30F9763F2407E882A8A8256CF9F6C@cnphil.com> References: <5FB30F9763F2407E882A8A8256CF9F6C@cnphil.com> Message-ID: On Sat, Jun 7, 2014 at 11:14 AM, Xiaojun "Phil" Hu wrote: > I found it relatively hard to reason about the time complexity of Haskell > programs. Is that the question you really want to ask? If it is, the answer is trivial: if it's O(f(n)) time in other languages, it's also O(f(n)) time in Haskell. (Note: space is a different story.) But what typically people want to know is: why is my program so slow? You wonder about the constants covered up by Big-Oh. And so you're going to have to get acquainted with 0) lambda calculus 1) graph reduction, 2) the G-machine, and 3) the spineless-tagless variant thereof. You're also going to have to learn to read Core and understand some of the higher order core-to-core optimizations that GHC performs. -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From arcseldon at gmail.com Sat Jun 7 05:21:25 2014 From: arcseldon at gmail.com (Richard Seldon) Date: Sat, 7 Jun 2014 14:21:25 +0900 Subject: [Haskell-beginners] Most important Functional Methods Message-ID: <98E0B114-8F0E-4330-AC0F-1A505D195954@gmail.com> Hello, I have a general question, not specific to Haskell although I am learning Haskell as I ask this question.. Please can someone provide consensus on the most important functional methods in their view. I read somewhere that having map, reduce, filter, mergeAll, and zip pretty much means everything else can be derived. Further, what I specifically want to know is whether flatMap should be included as an implementation in a functional library, or whether it should be excluded because it is derivable using ?building block? functions. Hope this makes sense. In languages like JS, there is a lot of resistance to include flatMap in prominent libraries such as underscore and lodash. Am curious to know what the Haskell community view is here, or whether in this community too opinions are widely divided. Alternatives I have seen are: 1). Chaining functions together chain(map(), map() 2). Using reduce() - which seems so versatile like a for loop for anything if really want 3). Using flatten(), or chaining pluck and flatten 4). Using map flatten compact - this gets rid of null, undefined etc in a language like JS too Recently, Reactive extensions have got really popular and it seems increasingly that flatMap is ideal for these situations. Would welcome some general advice and thoughts. If this is off-topic of course, then sorry to have caused any inconvenience. My thoughts are that the Haskell community have the necessary experience regarding functional programming in general to offer opinion. Best regards, From bob at redivi.com Sat Jun 7 06:52:25 2014 From: bob at redivi.com (Bob Ippolito) Date: Fri, 6 Jun 2014 23:52:25 -0700 Subject: [Haskell-beginners] About ! before a type signature In-Reply-To: References: <5FB30F9763F2407E882A8A8256CF9F6C@cnphil.com> Message-ID: I really like the explanation of Haskell's non-strict evaluation from Parallel and Concurrent Programming in Haskell, reading this chapter will probably be sufficient and much easier than studying all of GHC's implementation details: http://chimera.labs.oreilly.com/books/1230000000929/ch02.html#sec_par-eval-whnf On Fri, Jun 6, 2014 at 10:15 PM, Kim-Ee Yeoh wrote: > > On Sat, Jun 7, 2014 at 11:14 AM, Xiaojun "Phil" Hu > wrote: > >> I found it relatively hard to reason about the time complexity of Haskell >> programs. > > > Is that the question you really want to ask? > > If it is, the answer is trivial: if it's O(f(n)) time in other languages, > it's also O(f(n)) time in Haskell. (Note: space is a different story.) > > But what typically people want to know is: why is my program so slow? > > You wonder about the constants covered up by Big-Oh. > > And so you're going to have to get acquainted with > > 0) lambda calculus > 1) graph reduction, > 2) the G-machine, and > 3) the spineless-tagless variant thereof. > > You're also going to have to learn to read Core and understand some of the > higher order core-to-core optimizations that GHC performs. > > > -- Kim-Ee > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From erikprice at gmail.com Sat Jun 7 12:40:09 2014 From: erikprice at gmail.com (Erik Price) Date: Sat, 7 Jun 2014 05:40:09 -0700 Subject: [Haskell-beginners] Most important Functional Methods In-Reply-To: <98E0B114-8F0E-4330-AC0F-1A505D195954@gmail.com> References: <98E0B114-8F0E-4330-AC0F-1A505D195954@gmail.com> Message-ID: On Saturday, June 7, 2014, Richard Seldon wrote: > Hello, > > I have a general question, not specific to Haskell although I am learning > Haskell as I ask this question.. > > Please can someone provide consensus on the most important functional > methods in their view. > > I read somewhere that having map, reduce, filter, mergeAll, and zip pretty > much means everything else can be derived. You might be interested in reading this excellent introductory article on folds, which are Haskell's equivalent to what some languages call reduce: http://www.cs.nott.ac.uk/~gmh/fold.pdf It shows how many of the basic higher-order functions (such as map, filter, etc) can be derived from a fold. e -------------- next part -------------- An HTML attachment was scrubbed... URL: From haskell at patrickmylund.com Sat Jun 7 12:51:00 2014 From: haskell at patrickmylund.com (Patrick Mylund Nielsen) Date: Sat, 7 Jun 2014 08:51:00 -0400 Subject: [Haskell-beginners] Most important Functional Methods In-Reply-To: References: <98E0B114-8F0E-4330-AC0F-1A505D195954@gmail.com> Message-ID: On Sat, Jun 7, 2014 at 8:40 AM, Erik Price wrote: > > > On Saturday, June 7, 2014, Richard Seldon wrote: > >> Hello, >> >> I have a general question, not specific to Haskell although I am learning >> Haskell as I ask this question.. >> >> Please can someone provide consensus on the most important functional >> methods in their view. >> >> I read somewhere that having map, reduce, filter, mergeAll, and zip >> pretty much means everything else can be derived. > > > You might be interested in reading this excellent introductory article on > folds, which are Haskell's equivalent to what some languages call reduce: > > http://www.cs.nott.ac.uk/~gmh/fold.pdf > > It shows how many of the basic higher-order functions (such as map, > filter, etc) can be derived from a fold. > > e > In fact, concatMap (flatMap) is defined like so: -- | Map a function over a list and concatenate the results.concatMap :: (a -> [b]) -> [a] -> [b]concatMap f = foldr ((++) . f) [] -------------- next part -------------- An HTML attachment was scrubbed... URL: From elric at kiosa.org Sun Jun 8 00:04:09 2014 From: elric at kiosa.org (Elric) Date: Sat, 07 Jun 2014 20:04:09 -0400 Subject: [Haskell-beginners] Lions, Wolves and Goats Message-ID: <5393A879.6030401@kiosa.org> Hi, / Disclaimer: I have been learning Haskell for a month and there are still several things about this wonderful language I know nothing of, so please bear with me. Also, I apologize for this (somewhat) long mail./ I came across this article: http://unriskinsight.blogspot.co.at/2014/06/fast-functional-goats-lions-and-wolves.html a couple of days ago. This compares performance of solving a problem (which I will get to) using the functional constructs alone in languages like C++11 and Java 8. Since, Haskell is my first foray into FP, I thought I should try solving this in Haskell. So the problem at hand is this: There is a magical forest which has only Lions, Wolves and Goats. Lions are stronger than Wolves which are in turn stronger than Goats. Each strong animal is capable of eating a weaker animal, which also in turn transforms the '/eater/' into an animal which was not involved. /i.e./ If a Lion eats a Wolf it gets transformed into a Goat. If a Wolf eats a Sheep it gets transformed into a Lion. Below are the two versions of the code I came up with to solve this. Neither of them converge to the 'endStates' even after about 15 minutes. So there is definitely something wrong with what I have done. But after banging my head on the keyboard for more then a day with this, I would appreciate some pointers or help. -- version 1 import Data.List data Animal = Lion Int | Wolf Int | Goat Int deriving (Show, Eq) type Forest = [Animal] -- lions f = count 0 f -- where -- count acc [] = acc -- count acc ((Lion a):as) = acc + a + (count acc as) -- count acc (_:as) = acc + (count acc as) -- wolfs f = count 0 f -- where -- count acc [] = acc -- count acc ((Wolf a):as) = acc + a + (count acc as) -- count acc (_:as) = acc + (count acc as) -- goats f = count 0 f -- where -- count acc [] = acc -- count acc ((Goat a):as) = acc + a + (count acc as) -- count acc (_:as) = acc + (count acc as) lions [Lion l, Wolf w, Goat g] = l wolfs [Lion l, Wolf w, Goat g] = w goats [Lion l, Wolf w, Goat g] = g --Invalid eat calls are returned with [], to denote termination eat :: Forest -> Animal -> Animal -> Forest eat f (Lion _) (Goat le) = if (l >= le && g >= le) then [Lion (l-le), Wolf (w+le), Goat (g-le)] else [] where l = lions f w = wolfs f g = goats f eat f (Lion _) (Wolf le) = if (l >= le && w >= le) then [Lion (l-le), Wolf (w-le), Goat (g+le)] else [] where l = lions f w = wolfs f g = goats f eat f (Wolf _) (Goat we) = if (w >= we && g >= we) then [Lion (l+we), Wolf (w-we), Goat (g-we)] else [] where l = lions f w = wolfs f g = goats f eat _ _ _ = [] lionEatGoat :: Forest -> Forest lionEatGoat f = eat f (Lion 0) (Goat 1) lionEatWolf :: Forest -> Forest lionEatWolf f = eat f (Lion 0) (Wolf 1) wolfEatGoat :: Forest -> Forest wolfEatGoat f = eat f (Wolf 0) (Goat 1) meal :: Forest -> [Forest] meal [] = [] meal f@[Lion l, Wolf w, Goat g] | endState f = [] | l == 0 = [f] ++ weg | w == 0 = [f] ++ leg | g == 0 = [f] ++ lew | (l /= 0) && (w /= 0) && (g /= 0) = [f] ++ leg ++ lew ++ weg | otherwise = [] where leg = meal $ lionEatGoat f lew = meal $ lionEatWolf f weg = meal $ wolfEatGoat f endState :: Forest -> Bool endState f = if ((l == 0 && g == 0) || (l == 0 && w == 0) || (w == 0 && g == 0)) then True else False where l = lions f w = wolfs f g = goats f endStates = filter endState main = do putStrLn $ show $ endStates $ meal [Lion 6, Wolf 55, Goat 17] I thought using the ADT was causing the performance issue and reverted to using a plain 3-termed list which holds [Lion count, Wolf Count, Sheep Count] :: [Int] -- version 2 import Data.List lionEatGoat :: [Int] -> [Int] lionEatGoat [l,w,g] = [l-1,w+1,g-1] lionEatWolf :: [Int] -> [Int] lionEatWolf [l,w,g] = [l-1,w-1,g+1] wolfEatGoat :: [Int] -> [Int] wolfEatGoat [l,w,g] = [l+1,w-1,g-1] meal :: [Int] -> [[Int]] meal [] = [] meal f@[l, w, g] | endState f = [] | l == 0 = (f:weg:(meal weg)) | w == 0 = (f:leg:(meal leg)) | g == 0 = (f:lew:(meal lew)) | (l /= 0) && (w /= 0) && (g /= 0) = (f:leg:lew:weg:(meal leg ++ meal lew ++ meal weg)) | otherwise = [] where leg = lionEatGoat f lew = lionEatWolf f weg = wolfEatGoat f endState :: [Int] -> Bool endState [l,w,g] = if ((l == 0 && g == 0) || (l == 0 && w == 0) || (w == 0 && g == 0)) then True else False endStates = filter endState main = do putStrLn $ show $ endStates $ meal [Lion 6, Wolf 55, Goat 17] This is still extremely slow, without the program ever terminating. Can someone please tell me what I am doing wrong. -Elric -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Sun Jun 8 06:33:56 2014 From: fa-ml at ariis.it (Francesco Ariis) Date: Sun, 8 Jun 2014 08:33:56 +0200 Subject: [Haskell-beginners] Lions, Wolves and Goats In-Reply-To: <5393A879.6030401@kiosa.org> References: <5393A879.6030401@kiosa.org> Message-ID: <20140608063356.GA14455@x60s.casa> On Sat, Jun 07, 2014 at 08:04:09PM -0400, Elric wrote: > Hi, > > I came across this article: http://unriskinsight.blogspot.co.at/2014/06/fast-functional-goats-lions-and-wolves.html > a couple of days ago. This compares performance of solving a problem > (which I will get to) using the functional constructs alone in > languages like C++11 and Java 8. > Since, Haskell is my first foray into FP, I thought I should try > solving this in Haskell. > Hello Elric, I gave a go at the problem, managed to get a result (23). I attach the .hs file (not my best Haskell, but hopefully clear enough). The crucial point in my solution lies in this lines: carnage :: [Forest] -> [Forest] let wodup = nub aa in -- etc. etc. Which means after every iteration I call |nub| on my list of possible states; nub is a function from |Data.List| and removes duplicate elements from a list. If I omit that nub call, the program doesn't reach a solution (as it is computationally quite inefficient). I think that's the problem with your versions. Let me know if this helps -------------- next part -------------- A non-text attachment was scrubbed... Name: carnage.hs Type: text/x-haskell Size: 1226 bytes Desc: not available URL: From cma at bitemyapp.com Sun Jun 8 07:30:12 2014 From: cma at bitemyapp.com (Christopher Allen) Date: Sun, 8 Jun 2014 02:30:12 -0500 Subject: [Haskell-beginners] Made a video sharing my Haskell workflow and thought process while hacking on a library I wrote Message-ID: Not a straw-project, real thing I've been working on. Have gotten good feedback so far and was told I should post it here. More feedback, improvement suggestions desired. This is my first video. Made it because I thought there's a bit of a gap between the beginner and Kmett-grade expert material. This might help explain some Aeson usage patterns as well. https://www.youtube.com/watch?v=Li6oaO8x2VY I'll make more videos covering a broader range of topics if people seem interested. Thanks for your time everybody. --- Chris -------------- next part -------------- An HTML attachment was scrubbed... URL: From nadirsampaoli at gmail.com Sun Jun 8 12:42:40 2014 From: nadirsampaoli at gmail.com (Nadir Sampaoli) Date: Sun, 8 Jun 2014 14:42:40 +0200 Subject: [Haskell-beginners] Made a video sharing my Haskell workflow and thought process while hacking on a library I wrote In-Reply-To: References: Message-ID: Hello, 2014-06-08 9:30 GMT+02:00 Christopher Allen : > > https://www.youtube.com/watch?v=Li6oaO8x2VY > > --- Chris I am just a Haskell beginner/hobbyist; so it comes as a positive surprise that my workflow isn't much different from what I've seen in the video. What I'm not sure of is if the case in study is representative of what most of Haskell development consist of or if it's just one aspect: I refer to the fact that the video mostly consisted of writing a binding to a particular JSON object structure. I was expecting to see a large use of things like Monad Reader and State and Transformers and Lenses and stuff I don't understand: did you try to keep them away from this recording on purpose or they don't actually come up in real work as often as they seem to do to "an outside observer" like me? It was certainly interesting to see how to add type safety for something which is as far from type safety as you can go (I'm clearly referring to JS objects :P). This seems an important aspect in Haskell development: getting into type-safety as soon as possible in these kinds of translations. The most important thing about this kind of video, as far as I'm concerned, is seeing how someone else (and, most importantly, someone experienced) works. As I said, I'm a hobbyist, so when I play with Haskell I'm alone 100% of the time and have a hard time seeing where I could do better and what parts should I focus more. It must to be said that IRC and blogs are undoubtedly a big help, but what I, as a beginner, am mostly looking for, is a visual witness of actual, hands-on workflow process and especially the reasoning that backs up the act of writing code (and not some made-up examples like list manipulations et similia). So, yes, this video was certainly instructive and I'd like to see more! Thank you, Nadir From fa-ml at ariis.it Sun Jun 8 13:19:56 2014 From: fa-ml at ariis.it (Francesco Ariis) Date: Sun, 8 Jun 2014 15:19:56 +0200 Subject: [Haskell-beginners] Made a video sharing my Haskell workflow and thought process while hacking on a library I wrote In-Reply-To: References: Message-ID: <20140608131956.GA13820@x60s.casa> On Sun, Jun 08, 2014 at 02:30:12AM -0500, Christopher Allen wrote: > Not a straw-project, real thing I've been working on. Have gotten good > feedback so far and was told I should post it here. > Thanks for sharing, I picked up some useful tips from your video (e.g.: having |-Wall| always on), and apart from that it is always interesting to see someone writing programs "in the wild". The quality of the audio bothered me a bit (I can hear white noise in the background and that muddles your voice). Hope to see more of these videos! From bob at redivi.com Sun Jun 8 19:41:52 2014 From: bob at redivi.com (Bob Ippolito) Date: Sun, 8 Jun 2014 12:41:52 -0700 Subject: [Haskell-beginners] Lions, Wolves and Goats In-Reply-To: <20140608063356.GA14455@x60s.casa> References: <5393A879.6030401@kiosa.org> <20140608063356.GA14455@x60s.casa> Message-ID: Here's another approach that more closely models what's going on in the C++ version. I defined an ordNub rather than using nub as nub is O(n^2) as it only requires Eq. https://gist.github.com/etrepum/5bfedc8bbe576f89fe09 import qualified Data.Set as S import Data.List (partition) import System.Environment (getArgs) data LWG = LWG { _lion, _wolf, _goat :: {-# UNPACK #-} !Int } deriving (Show, Ord, Eq) lionEatGoat, lionEatWolf, wolfEatGoat :: LWG -> LWG lionEatGoat (LWG l w g) = LWG (l - 1) (w + 1) (g - 1) lionEatWolf (LWG l w g) = LWG (l - 1) (w - 1) (g + 1) wolfEatGoat (LWG l w g) = LWG (l + 1) (w - 1) (g - 1) stableState :: LWG -> Bool stableState (LWG l w g) = length (filter (==0) [l, w, g]) >= 2 validState :: LWG -> Bool validState (LWG l w g) = all (>=0) [l, w, g] possibleMeals :: LWG -> [LWG] possibleMeals state = filter validState . map ($ state) $ [lionEatGoat, lionEatWolf, wolfEatGoat] ordNub :: Ord a => [a] -> [a] ordNub = S.toList . S.fromList endStates :: [LWG] -> [LWG] endStates states | not (null stable) = stable | not (null unstable) = endStates (concatMap possibleMeals unstable) | otherwise = [] where (stable, unstable) = partition stableState (ordNub states) main :: IO () main = do [l, w, g] <- map read `fmap` getArgs mapM_ print . endStates $ [LWG l w g] On Sat, Jun 7, 2014 at 11:33 PM, Francesco Ariis wrote: > On Sat, Jun 07, 2014 at 08:04:09PM -0400, Elric wrote: > > Hi, > > > > I came across this article: > http://unriskinsight.blogspot.co.at/2014/06/fast-functional-goats-lions-and-wolves.html > > a couple of days ago. This compares performance of solving a problem > > (which I will get to) using the functional constructs alone in > > languages like C++11 and Java 8. > > Since, Haskell is my first foray into FP, I thought I should try > > solving this in Haskell. > > > > Hello Elric, > I gave a go at the problem, managed to get a result (23). > I attach the .hs file (not my best Haskell, but hopefully clear enough). > > The crucial point in my solution lies in this lines: > > carnage :: [Forest] -> [Forest] > let wodup = nub aa in > -- etc. etc. > > Which means after every iteration I call |nub| on my list of possible > states; nub is a function from |Data.List| and removes duplicate > elements from a list. > > If I omit that nub call, the program doesn't reach a solution (as it > is computationally quite inefficient). I think that's the problem > with your versions. > > Let me know if this helps > > > > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ben at smart-cactus.org Sun Jun 8 20:52:27 2014 From: ben at smart-cactus.org (Ben Gamari) Date: Sun, 08 Jun 2014 16:52:27 -0400 Subject: [Haskell-beginners] Lions, Wolves and Goats In-Reply-To: <5393A879.6030401@kiosa.org> References: <5393A879.6030401@kiosa.org> Message-ID: <87bnu3gm44.fsf@gmail.com> Elric writes: > Hi, > > Disclaimer: I have been learning Haskell for a month and there are still > several things about this wonderful language I know nothing of, so > please bear with me. Also, I apologize for this (somewhat) long mail./ > ... > > Below are the two versions of the code I came up with to solve this. > Neither of them converge to the 'endStates' even after about 15 minutes. > So there is definitely something wrong with what I have done. But after > banging my head on the keyboard for more then a day with this, I would > appreciate some pointers or help. > For one, you don't appear to be removing duplicates from the search set resulting in a blow-up in your search space. > > I thought using the ADT was causing the performance issue and reverted > to using a plain 3-termed list which holds [Lion count, Wolf Count, > Sheep Count] :: [Int] > Your problem here isn't the use of ADTs, it's the use of lists. Why not instead define a forest as follows? data Forest = Forest { wolfs, lions, goats :: !Int } Note how I used a strictness annotation !Int here to ensure that the compiler unboxes these members (at least with GHC >= 7.8), which is almost certainly what you want in this case. Anyways, I took a quick stab at the problem myself. My approach can be found here[1]. Performance isn't great (a bit better than Javascript) but then again the code is pretty much as naive as one could get. I'm sure things could be improved. Cheers, - Ben [1] https://gist.github.com/anonymous/e4a2ccd8df05255d5ed5 -------------- next part -------------- A non-text attachment was scrubbed... Name: not available Type: application/pgp-signature Size: 472 bytes Desc: not available URL: From defigueiredo at ucdavis.edu Tue Jun 10 05:01:38 2014 From: defigueiredo at ucdavis.edu (Dimitri DeFigueiredo) Date: Mon, 09 Jun 2014 23:01:38 -0600 Subject: [Haskell-beginners] tutorials on space complexity? In-Reply-To: <87bnu3gm44.fsf@gmail.com> References: <5393A879.6030401@kiosa.org> <87bnu3gm44.fsf@gmail.com> Message-ID: <53969132.7060401@ucdavis.edu> Are there any good tutorials on understanding space complexity for haskell programs? My current approach of "waiting for it to crash" by being out of memory, doesn't really seem like good engineering practice. However, I have not found a source that gives me any proactive insight into what should be avoided. Most of what I have read only helps to solve the problem "after the fact". How do we design programs that avoid those problems from the beginning? Any pointers? Thanks, Dimitri From bob at redivi.com Tue Jun 10 05:21:58 2014 From: bob at redivi.com (Bob Ippolito) Date: Mon, 9 Jun 2014 22:21:58 -0700 Subject: [Haskell-beginners] tutorials on space complexity? In-Reply-To: <53969132.7060401@ucdavis.edu> References: <5393A879.6030401@kiosa.org> <87bnu3gm44.fsf@gmail.com> <53969132.7060401@ucdavis.edu> Message-ID: I found the beginning of Parallel and Concurrent Programming in Haskell particularly enlightening: http://chimera.labs.oreilly.com/books/1230000000929/ch02.html#sec_par-eval-whnf After reading that, Haskell's evaluation strategy finally clicked for me. Now I can much more easily spot and fix these sorts of errors before even running them for the most part. On Mon, Jun 9, 2014 at 10:01 PM, Dimitri DeFigueiredo < defigueiredo at ucdavis.edu> wrote: > Are there any good tutorials on understanding space complexity for haskell > programs? > > My current approach of "waiting for it to crash" by being out of memory, > doesn't really seem like good engineering practice. However, I have not > found a source that gives me any proactive insight into what should be > avoided. Most of what I have read only helps to solve the problem "after > the fact". How do we design programs that avoid those problems from the > beginning? Any pointers? > > Thanks, > > Dimitri > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From defigueiredo at ucdavis.edu Tue Jun 10 05:32:15 2014 From: defigueiredo at ucdavis.edu (Dimitri DeFigueiredo) Date: Mon, 09 Jun 2014 23:32:15 -0600 Subject: [Haskell-beginners] tutorials on space complexity? In-Reply-To: References: <5393A879.6030401@kiosa.org> <87bnu3gm44.fsf@gmail.com> <53969132.7060401@ucdavis.edu> Message-ID: <5396985F.2010001@ucdavis.edu> Thanks Bob. Following your previous comment on this list, I read chapter 2 and really liked it, but I feel it was only scratching the surface. The example bug of implementing 'sum' using 'foldl' was insightful, but I'm sure 'foldl (+)' is not the only circumstance where laziness builds up large data structures unnecessarily and I'm afraid of recursion now. Are there more insights peppered throughout the book? Or other good pointers you know? Thanks again! Dimitri Em 09/06/14 23:21, Bob Ippolito escreveu: > I found the beginning of Parallel and Concurrent Programming in > Haskell particularly enlightening: > http://chimera.labs.oreilly.com/books/1230000000929/ch02.html#sec_par-eval-whnf > > After reading that, Haskell's evaluation strategy finally clicked for > me. Now I can much more easily spot and fix these sorts of errors > before even running them for the most part. > > > On Mon, Jun 9, 2014 at 10:01 PM, Dimitri DeFigueiredo > > wrote: > > Are there any good tutorials on understanding space complexity for > haskell programs? > > My current approach of "waiting for it to crash" by being out of > memory, doesn't really seem like good engineering practice. > However, I have not found a source that gives me any proactive > insight into what should be avoided. Most of what I have read only > helps to solve the problem "after the fact". How do we design > programs that avoid those problems from the beginning? Any pointers? > > Thanks, > > Dimitri > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners -------------- next part -------------- An HTML attachment was scrubbed... URL: From bob at redivi.com Tue Jun 10 05:53:23 2014 From: bob at redivi.com (Bob Ippolito) Date: Mon, 9 Jun 2014 22:53:23 -0700 Subject: [Haskell-beginners] tutorials on space complexity? In-Reply-To: <5396985F.2010001@ucdavis.edu> References: <5393A879.6030401@kiosa.org> <87bnu3gm44.fsf@gmail.com> <53969132.7060401@ucdavis.edu> <5396985F.2010001@ucdavis.edu> Message-ID: I don't recall too much more in the book about strictness, but it's a great read nonetheless. The one thing it could do a better job of covering is how types defined with data and newtype differ, and how to use strict fields in data types. It does give an explanation of how to implement NFData in terms of seq, but you can often get away with simply defining strict data types. Some of that is in here, but there isn't a lot of explanation: http://www.haskell.org/haskellwiki/Performance/Data_types I honestly don't recall where I picked up all that, it might've just been from reading parts of the Haskell Report or RWH. https://www.haskell.org/onlinereport/haskell2010/haskellch4.html#x10-680004.2 http://book.realworldhaskell.org/read/profiling-and-optimization.html I would recommend trying to understand the general case, not to look for specific examples of what not to do because you'll never find them all :) Ultimately it all boils down to following the pattern matching of constructors (since that's what forces evaluation to happen) and you should assume that Haskell is going to be as lazy as it possibly can (ignore what the optimizer *might* do). The special cases are seq, newtype, and strict fields. On Mon, Jun 9, 2014 at 10:32 PM, Dimitri DeFigueiredo < defigueiredo at ucdavis.edu> wrote: > Thanks Bob. > > Following your previous comment on this list, I read chapter 2 and really > liked it, but I feel it was only scratching the surface. The example bug of > implementing 'sum' using 'foldl' was insightful, but I'm sure 'foldl (+)' > is not the only circumstance where laziness builds up large data structures > unnecessarily and I'm afraid of recursion now. > Are there more insights peppered throughout the book? Or other good > pointers you know? > > Thanks again! > > Dimitri > > > Em 09/06/14 23:21, Bob Ippolito escreveu: > > I found the beginning of Parallel and Concurrent Programming in Haskell > particularly enlightening: > > http://chimera.labs.oreilly.com/books/1230000000929/ch02.html#sec_par-eval-whnf > > After reading that, Haskell's evaluation strategy finally clicked for > me. Now I can much more easily spot and fix these sorts of errors before > even running them for the most part. > > > On Mon, Jun 9, 2014 at 10:01 PM, Dimitri DeFigueiredo < > defigueiredo at ucdavis.edu> wrote: > >> Are there any good tutorials on understanding space complexity for >> haskell programs? >> >> My current approach of "waiting for it to crash" by being out of memory, >> doesn't really seem like good engineering practice. However, I have not >> found a source that gives me any proactive insight into what should be >> avoided. Most of what I have read only helps to solve the problem "after >> the fact". How do we design programs that avoid those problems from the >> beginning? Any pointers? >> >> Thanks, >> >> Dimitri >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://www.haskell.org/mailman/listinfo/beginners >> > > > > _______________________________________________ > Beginners mailing listBeginners at haskell.orghttp://www.haskell.org/mailman/listinfo/beginners > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ky3 at atamo.com Tue Jun 10 09:01:59 2014 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Tue, 10 Jun 2014 16:01:59 +0700 Subject: [Haskell-beginners] tutorials on space complexity? In-Reply-To: <53969132.7060401@ucdavis.edu> References: <5393A879.6030401@kiosa.org> <87bnu3gm44.fsf@gmail.com> <53969132.7060401@ucdavis.edu> Message-ID: On Tue, Jun 10, 2014 at 12:01 PM, Dimitri DeFigueiredo < defigueiredo at ucdavis.edu> wrote: > My current approach of "waiting for it to crash" by being out of memory, > doesn't really seem like good engineering practice Have you tried the graphical profiling tools? And looked up RWH's chapter on profiling and optimization? Don's answer here is a widely cited resource: http://stackoverflow.com/questions/3276240/tools-for-analyzing-performance-of-a-haskell-program -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From apfelmus at quantentunnel.de Tue Jun 10 09:20:48 2014 From: apfelmus at quantentunnel.de (Heinrich Apfelmus) Date: Tue, 10 Jun 2014 11:20:48 +0200 Subject: [Haskell-beginners] tutorials on space complexity? In-Reply-To: <53969132.7060401@ucdavis.edu> References: <5393A879.6030401@kiosa.org> <87bnu3gm44.fsf@gmail.com> <53969132.7060401@ucdavis.edu> Message-ID: Dimitri DeFigueiredo wrote: > Are there any good tutorials on understanding space complexity for > haskell programs? > > My current approach of "waiting for it to crash" by being out of memory, > doesn't really seem like good engineering practice. However, I have not > found a source that gives me any proactive insight into what should be > avoided. Most of what I have read only helps to solve the problem "after > the fact". How do we design programs that avoid those problems from the > beginning? Any pointers? Lazy evaluation makes it difficult to reason about space usage -- it's not compositional anymore. However, I have found the following technique, dubbed "space invariants", to be very helpful: http://apfelmus.nfshost.com/blog/2013/08/21-space-invariants.html The main idea is that because it is impossible to trace lazy evaluation in detail, we have to use invariants. In particular, we can attach bounds on space usage to semantic meaning. Example: "If this container with 5 elements is in WHNF, then it will use only as much space as the 5 elements." (This invariant seems banal, but the point is that lazy evaluation does not preserve it.) (WHNF means "weak head normal form", i.e. the expression has been evaluated to the outermost constructor.) Best regards, Heinrich Apfelmus -- http://apfelmus.nfshost.com From christian.sperandio at gmail.com Tue Jun 10 20:26:02 2014 From: christian.sperandio at gmail.com (Christian Sperandio) Date: Tue, 10 Jun 2014 22:26:02 +0200 Subject: [Haskell-beginners] Cabal and proxy on Windows 8 Message-ID: <2EE30320-31E9-47FF-83BB-D02C0D494CE4@gmail.com> Hi, I?d like to try Haskell at my work and if the result is good I want to push this language in the company. But I?ve got an issue because of our proxy configuration. The developers work on Windows 8 and our proxy is configured with a PAC file. The issue is we can?t use cabal to fetch package. When we run the cabal update command, nothing happen. We understand the problem comes from the proxy is not used inside a command prompt. I tried to use the Eclipse plugin but unfortunately, it uses the cabal command too. Somebody knows how we can have a well configured cabal ? Thanks. Chris Ps1. I try the netssh winhttp command. But I don?t succeed to define the PAC file. It seems, we can only define a proxy address. But it?s not enough. Ps2. The internet settings on Windows is like that: http://proxyserve:3810/fpac_file From edwards.benj at gmail.com Tue Jun 10 23:42:44 2014 From: edwards.benj at gmail.com (Benjamin Edwards) Date: Tue, 10 Jun 2014 16:42:44 -0700 (PDT) Subject: [Haskell-beginners] Cabal and proxy on Windows 8 In-Reply-To: <2EE30320-31E9-47FF-83BB-D02C0D494CE4@gmail.com> References: <2EE30320-31E9-47FF-83BB-D02C0D494CE4@gmail.com> Message-ID: <1402443764201.c6025505@Nodemailer> I used cntlm to great effect with cabal. Figure out the proxy address from the PAC file then use cntlm to proxy using your windows credentials. On Tue, Jun 10, 2014 at 9:26 PM, Christian Sperandio wrote: > Hi, > I?d like to try Haskell at my work and if the result is good I want to push this language in the company. > But I?ve got an issue because of our proxy configuration. The developers work on Windows 8 and our proxy is configured with a PAC file. > The issue is we can?t use cabal to fetch package. When we run the cabal update command, nothing happen. We understand the problem comes > from the proxy is not used inside a command prompt. > I tried to use the Eclipse plugin but unfortunately, it uses the cabal command too. > Somebody knows how we can have a well configured cabal ? > Thanks. > Chris > Ps1. I try the netssh winhttp command. But I don?t succeed to define the PAC file. It seems, we can only define a proxy address. But it?s not enough. > Ps2. The internet settings on Windows is like that: http://proxyserve:3810/fpac_file > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners -------------- next part -------------- An HTML attachment was scrubbed... URL: From c.venu at aol.com Thu Jun 12 01:54:42 2014 From: c.venu at aol.com (Venu Chakravorty) Date: Wed, 11 Jun 2014 21:54:42 -0400 (EDT) Subject: [Haskell-beginners] Functions in "where" block. Message-ID: <8D153F86943B671-2F34-1B4DC@webmail-d263.sysops.aol.com> Hello everyone, I can't figure out why the following function does not work: myFun :: Integer -> Integer myFun x = op x + ep x where op x = 99 ep x = 1 -- squawks here Yeah it's a stupid function, but I was just trying to declare two functions in the "where" block. I expected this to work and always return 100. This is the error I get while compiling: ================== Prelude> :l fun.hs [1 of 1] Compiling Main ( fun.hs, interpreted ) fun.hs:4:15: parse error on input `=' Failed, modules loaded: none. ================== Could someone please tell me where I am going wrong? Thanks in advance. Regards, Venu Chakravorty. -------------- next part -------------- An HTML attachment was scrubbed... URL: From ky3 at atamo.com Thu Jun 12 02:21:56 2014 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Thu, 12 Jun 2014 09:21:56 +0700 Subject: [Haskell-beginners] Functions in "where" block. In-Reply-To: <8D153F86943B671-2F34-1B4DC@webmail-d263.sysops.aol.com> References: <8D153F86943B671-2F34-1B4DC@webmail-d263.sysops.aol.com> Message-ID: On Thu, Jun 12, 2014 at 8:54 AM, Venu Chakravorty wrote: > fun.hs:4:15: parse error on input `=' > The problem wasn't obvious until I copy-pasted it into an editor: You have tabs instead of spaces for the line defining ep. The rule of thumb is that your editor must expand all tabs into matching spaces for whitespace-sensitive languages like haskell. Or else you'll waste time with this kind of parsing errors. -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From defigueiredo at ucdavis.edu Thu Jun 12 04:32:39 2014 From: defigueiredo at ucdavis.edu (Dimitri DeFigueiredo) Date: Thu, 12 Jun 2014 01:32:39 -0300 Subject: [Haskell-beginners] tutorials on space complexity? In-Reply-To: References: <5393A879.6030401@kiosa.org> <87bnu3gm44.fsf@gmail.com> <53969132.7060401@ucdavis.edu> Message-ID: <53992D67.4070405@ucdavis.edu> Thanks for the links. The guidance on your blog post is exactly the kind of analysis I was looking for. Dimitri Em 10/06/14 06:20, Heinrich Apfelmus escreveu: > Dimitri DeFigueiredo wrote: >> Are there any good tutorials on understanding space complexity for >> haskell programs? >> >> My current approach of "waiting for it to crash" by being out of >> memory, doesn't really seem like good engineering practice. However, >> I have not found a source that gives me any proactive insight into >> what should be avoided. Most of what I have read only helps to solve >> the problem "after the fact". How do we design programs that avoid >> those problems from the beginning? Any pointers? > > Lazy evaluation makes it difficult to reason about space usage -- it's > not compositional anymore. However, I have found the following > technique, dubbed "space invariants", to be very helpful: > > http://apfelmus.nfshost.com/blog/2013/08/21-space-invariants.html > > The main idea is that because it is impossible to trace lazy > evaluation in detail, we have to use invariants. In particular, we can > attach bounds on space usage to semantic meaning. Example: > > "If this container with 5 elements is in WHNF, then it will use only > as much space as the 5 elements." > > (This invariant seems banal, but the point is that lazy evaluation > does not preserve it.) > > (WHNF means "weak head normal form", i.e. the expression has been > evaluated to the outermost constructor.) > > > Best regards, > Heinrich Apfelmus > > -- > http://apfelmus.nfshost.com > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners From elric at kiosa.org Fri Jun 13 15:37:11 2014 From: elric at kiosa.org (Elric) Date: Fri, 13 Jun 2014 11:37:11 -0400 Subject: [Haskell-beginners] Lions, Wolves and Goats In-Reply-To: <20140608063356.GA14455@x60s.casa> References: <5393A879.6030401@kiosa.org> <20140608063356.GA14455@x60s.casa> Message-ID: <539B1AA7.7050703@kiosa.org> Thank You Ariis, I was using nub in a wrong way, like so: meal :: Forest -> [Forest] meal [] = [] meal f@[Lion l, Wolf w, Goat g] | endState f = [] | l == 0 = [f] ++ weg | w == 0 = [f] ++ leg | g == 0 = [f] ++ lew | (l /= 0) && (w /= 0) && (g /= 0) = [f] ++ leg ++ lew ++ weg | otherwise = [] where leg = nub $ meal $ ionEatGoat f lew = nub $ meal $ lionEatWolf f weg = nub $ meal $ wolfEatGoat f After looking at your solution, I realized I was essentially generating every possible state, and THEN trying to remove the duplicates, whereas in your solution at each step you remove possible duplicates states of the forest and propagate to the next step only from there. Thank You, Praveen On 06/08/2014 02:33 AM, Francesco Ariis wrote: > On Sat, Jun 07, 2014 at 08:04:09PM -0400, Elric wrote: >> Hi, >> >> I came across this article: http://unriskinsight.blogspot.co.at/2014/06/fast-functional-goats-lions-and-wolves.html >> a couple of days ago. This compares performance of solving a problem >> (which I will get to) using the functional constructs alone in >> languages like C++11 and Java 8. >> Since, Haskell is my first foray into FP, I thought I should try >> solving this in Haskell. >> > Hello Elric, > I gave a go at the problem, managed to get a result (23). > I attach the .hs file (not my best Haskell, but hopefully clear enough). > > The crucial point in my solution lies in this lines: > > carnage :: [Forest] -> [Forest] > let wodup = nub aa in > -- etc. etc. > > Which means after every iteration I call |nub| on my list of possible > states; nub is a function from |Data.List| and removes duplicate > elements from a list. > > If I omit that nub call, the program doesn't reach a solution (as it > is computationally quite inefficient). I think that's the problem > with your versions. > > Let me know if this helps > > > > > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners -------------- next part -------------- An HTML attachment was scrubbed... URL: From elric at kiosa.org Fri Jun 13 15:51:23 2014 From: elric at kiosa.org (Elric) Date: Fri, 13 Jun 2014 11:51:23 -0400 Subject: [Haskell-beginners] Lions, Wolves and Goats In-Reply-To: <87bnu3gm44.fsf@gmail.com> References: <5393A879.6030401@kiosa.org> <87bnu3gm44.fsf@gmail.com> Message-ID: <539B1DFB.5050603@kiosa.org> Thank You Ben, Your solution is really neat. I was trying to create the infix 'eat' function when I was thinking of implementing this in Haskell. But I completely forgot about being able to use the Record syntax to do this. I am not sure about the purpose of !Int, but that is something for me to read more and learn :) Thank You, Elric On 06/08/2014 04:52 PM, Ben Gamari wrote: > Elric writes: > >> Hi, >> >> Disclaimer: I have been learning Haskell for a month and there are still >> several things about this wonderful language I know nothing of, so >> please bear with me. Also, I apologize for this (somewhat) long mail./ >> > ... >> Below are the two versions of the code I came up with to solve this. >> Neither of them converge to the 'endStates' even after about 15 minutes. >> So there is definitely something wrong with what I have done. But after >> banging my head on the keyboard for more then a day with this, I would >> appreciate some pointers or help. >> > For one, you don't appear to be removing duplicates from the search set > resulting in a blow-up in your search space. > >> I thought using the ADT was causing the performance issue and reverted >> to using a plain 3-termed list which holds [Lion count, Wolf Count, >> Sheep Count] :: [Int] >> > Your problem here isn't the use of ADTs, it's the use of lists. Why not > instead define a forest as follows? > > data Forest = Forest { wolfs, lions, goats :: !Int } > > Note how I used a strictness annotation !Int here to ensure that the > compiler unboxes these members (at least with GHC >= 7.8), which is > almost certainly what you want in this case. > > Anyways, I took a quick stab at the problem myself. My approach can be > found here[1]. Performance isn't great (a bit better than Javascript) > but then again the code is pretty much as naive as one could get. I'm > sure things could be improved. > > Cheers, > > - Ben > > > [1] https://gist.github.com/anonymous/e4a2ccd8df05255d5ed5 -------------- next part -------------- An HTML attachment was scrubbed... URL: From elric at kiosa.org Fri Jun 13 15:54:29 2014 From: elric at kiosa.org (Elric) Date: Fri, 13 Jun 2014 11:54:29 -0400 Subject: [Haskell-beginners] Lions, Wolves and Goats In-Reply-To: References: <5393A879.6030401@kiosa.org> <20140608063356.GA14455@x60s.casa> Message-ID: <539B1EB5.2030207@kiosa.org> Thank You Bob, I learnt quite a bit from your solution. I have been restricting myself to Lists so far. I think I will have to start exploring other data structures like Sets in Haskell as well. :) Thank You, Elric On 06/08/2014 03:41 PM, Bob Ippolito wrote: > Here's another approach that more closely models what's going on in > the C++ version. I defined an ordNub rather than using nub as nub is > O(n^2) as it only requires Eq. > > https://gist.github.com/etrepum/5bfedc8bbe576f89fe09 > > import qualified Data.Set as S > import Data.List (partition) > import System.Environment (getArgs) > > data LWG = LWG { _lion, _wolf, _goat :: {-# UNPACK #-} !Int } > deriving (Show, Ord, Eq) > > lionEatGoat, lionEatWolf, wolfEatGoat :: LWG -> LWG > lionEatGoat (LWG l w g) = LWG (l - 1) (w + 1) (g - 1) > lionEatWolf (LWG l w g) = LWG (l - 1) (w - 1) (g + 1) > wolfEatGoat (LWG l w g) = LWG (l + 1) (w - 1) (g - 1) > > stableState :: LWG -> Bool > stableState (LWG l w g) = length (filter (==0) [l, w, g]) >= 2 > > validState :: LWG -> Bool > validState (LWG l w g) = all (>=0) [l, w, g] > > possibleMeals :: LWG -> [LWG] > possibleMeals state = > filter validState . > map ($ state) $ [lionEatGoat, lionEatWolf, wolfEatGoat] > > ordNub :: Ord a => [a] -> [a] > ordNub = S.toList . S.fromList > > endStates :: [LWG] -> [LWG] > endStates states > | not (null stable) = stable > | not (null unstable) = endStates (concatMap possibleMeals unstable) > | otherwise = [] > where (stable, unstable) = partition stableState (ordNub states) > main :: IO () > main = do > [l, w, g] <- map read `fmap` getArgs > mapM_ print . endStates $ [LWG l w g] > > > > On Sat, Jun 7, 2014 at 11:33 PM, Francesco Ariis > wrote: > > On Sat, Jun 07, 2014 at 08:04:09PM -0400, Elric wrote: > > Hi, > > > > I came across this article: > http://unriskinsight.blogspot.co.at/2014/06/fast-functional-goats-lions-and-wolves.html > > a couple of days ago. This compares performance of solving a problem > > (which I will get to) using the functional constructs alone in > > languages like C++11 and Java 8. > > Since, Haskell is my first foray into FP, I thought I should try > > solving this in Haskell. > > > > Hello Elric, > I gave a go at the problem, managed to get a result (23). > I attach the .hs file (not my best Haskell, but hopefully clear > enough). > > The crucial point in my solution lies in this lines: > > carnage :: [Forest] -> [Forest] > let wodup = nub aa in > -- etc. etc. > > Which means after every iteration I call |nub| on my list of possible > states; nub is a function from |Data.List| and removes duplicate > elements from a list. > > If I omit that nub call, the program doesn't reach a solution (as it > is computationally quite inefficient). I think that's the problem > with your versions. > > Let me know if this helps > > > > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners -------------- next part -------------- An HTML attachment was scrubbed... URL: From fuuzetsu at fuuzetsu.co.uk Sun Jun 15 23:39:33 2014 From: fuuzetsu at fuuzetsu.co.uk (Mateusz Kowalczyk) Date: Mon, 16 Jun 2014 01:39:33 +0200 Subject: [Haskell-beginners] Functions in "where" block. In-Reply-To: References: <8D153F86943B671-2F34-1B4DC@webmail-d263.sysops.aol.com> Message-ID: <539E2EB5.5080600@fuuzetsu.co.uk> On 06/12/2014 04:21 AM, Kim-Ee Yeoh wrote: > On Thu, Jun 12, 2014 at 8:54 AM, Venu Chakravorty wrote: > >> fun.hs:4:15: parse error on input `=' >> > > The problem wasn't obvious until I copy-pasted it into an editor: > > You have tabs instead of spaces for the line defining ep. > > The rule of thumb is that your editor must expand all tabs into matching > spaces for whitespace-sensitive languages like haskell. Or else you'll > waste time with this kind of parsing errors. > > -- Kim-Ee > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners > For reference, GHC treats hard tabs as 8 spaces. Even in my mail client the problem is quite apparent[1]. Set your editor to use spaces only. I think [2] is the standard reference for whitespace style. [1]: http://fuuzetsu.co.uk/images/1402875503.png [2]: http://urchin.earth.li/~ian/style/haskell.html -- Mateusz K. From tim.v2.0 at gmail.com Mon Jun 16 23:15:19 2014 From: tim.v2.0 at gmail.com (Tim Perry) Date: Mon, 16 Jun 2014 16:15:19 -0700 Subject: [Haskell-beginners] Lions, Wolves and Goats In-Reply-To: <539B1EB5.2030207@kiosa.org> References: <5393A879.6030401@kiosa.org> <20140608063356.GA14455@x60s.casa> <539B1EB5.2030207@kiosa.org> Message-ID: I tried a set-based solution and it can process ~1600 items in 25 seconds on this i7. Seems really slow compared to the times posted here: http://unriskinsight.blogspot.co.at/2014/06/fast-functional-goats-lions-and-wolves.html I'm curious if anyone spots any major flaw. If not, I'll profile it tonight -- I can't afford to spend more time on this at work Tim On Fri, Jun 13, 2014 at 8:54 AM, Elric wrote: > Thank You Bob, > > I learnt quite a bit from your solution. I have been restricting myself to > Lists so far. I think I will have to start exploring other data structures > like Sets in Haskell as well. :) > > Thank You, > Elric > > > On 06/08/2014 03:41 PM, Bob Ippolito wrote: > > Here's another approach that more closely models what's going on in the > C++ version. I defined an ordNub rather than using nub as nub is O(n^2) as > it only requires Eq. > > https://gist.github.com/etrepum/5bfedc8bbe576f89fe09 > > import qualified Data.Set as S > import Data.List (partition) > import System.Environment (getArgs) > > data LWG = LWG { _lion, _wolf, _goat :: {-# UNPACK #-} !Int } > deriving (Show, Ord, Eq) > > lionEatGoat, lionEatWolf, wolfEatGoat :: LWG -> LWG > lionEatGoat (LWG l w g) = LWG (l - 1) (w + 1) (g - 1) > lionEatWolf (LWG l w g) = LWG (l - 1) (w - 1) (g + 1) > wolfEatGoat (LWG l w g) = LWG (l + 1) (w - 1) (g - 1) > > stableState :: LWG -> Bool > stableState (LWG l w g) = length (filter (==0) [l, w, g]) >= 2 > > validState :: LWG -> Bool > validState (LWG l w g) = all (>=0) [l, w, g] > > possibleMeals :: LWG -> [LWG] > possibleMeals state = > filter validState . > map ($ state) $ [lionEatGoat, lionEatWolf, wolfEatGoat] > > ordNub :: Ord a => [a] -> [a] > ordNub = S.toList . S.fromList > > endStates :: [LWG] -> [LWG] > endStates states > | not (null stable) = stable > | not (null unstable) = endStates (concatMap possibleMeals unstable) > | otherwise = [] > where (stable, unstable) = partition stableState (ordNub states) > > main :: IO () > main = do > [l, w, g] <- map read `fmap` getArgs > mapM_ print . endStates $ [LWG l w g] > > > > On Sat, Jun 7, 2014 at 11:33 PM, Francesco Ariis wrote: > >> On Sat, Jun 07, 2014 at 08:04:09PM -0400, Elric wrote: >> > Hi, >> > >> > I came across this article: >> http://unriskinsight.blogspot.co.at/2014/06/fast-functional-goats-lions-and-wolves.html >> > a couple of days ago. This compares performance of solving a problem >> > (which I will get to) using the functional constructs alone in >> > languages like C++11 and Java 8. >> > Since, Haskell is my first foray into FP, I thought I should try >> > solving this in Haskell. >> > >> >> Hello Elric, >> I gave a go at the problem, managed to get a result (23). >> I attach the .hs file (not my best Haskell, but hopefully clear enough). >> >> The crucial point in my solution lies in this lines: >> >> carnage :: [Forest] -> [Forest] >> let wodup = nub aa in >> -- etc. etc. >> >> Which means after every iteration I call |nub| on my list of possible >> states; nub is a function from |Data.List| and removes duplicate >> elements from a list. >> >> If I omit that nub call, the program doesn't reach a solution (as it >> is computationally quite inefficient). I think that's the problem >> with your versions. >> >> Let me know if this helps >> >> >> >> >> >> >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://www.haskell.org/mailman/listinfo/beginners >> >> > > > _______________________________________________ > Beginners mailing listBeginners at haskell.orghttp://www.haskell.org/mailman/listinfo/beginners > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From tim.v2.0 at gmail.com Mon Jun 16 23:16:30 2014 From: tim.v2.0 at gmail.com (Tim Perry) Date: Mon, 16 Jun 2014 16:16:30 -0700 Subject: [Haskell-beginners] Lions, Wolves and Goats In-Reply-To: References: <5393A879.6030401@kiosa.org> <20140608063356.GA14455@x60s.casa> <539B1EB5.2030207@kiosa.org> Message-ID: Oops, I forgot the gist location. https://gist.github.com/anonymous/99bc650c41e07364764c I tried a set-based solution and it can process ~1600 items in 25 seconds on this i7. Seems really slow compared to the times posted here: http://unriskinsight.blogspot.co.at/2014/06/fast-functional-goats-lions-and-wolves.html I'm curious if anyone spots any major flaw. If not, I'll profile it tonight -- I can't afford to spend more time on this at work On Mon, Jun 16, 2014 at 4:15 PM, Tim Perry wrote: > I tried a set-based solution and it can process ~1600 items in 25 seconds > on this i7. Seems really slow compared to the times posted here: > > http://unriskinsight.blogspot.co.at/2014/06/fast-functional-goats-lions-and-wolves.html > > I'm curious if anyone spots any major flaw. If not, I'll profile it > tonight -- I can't afford to spend more time on this at work > > Tim > > > > On Fri, Jun 13, 2014 at 8:54 AM, Elric wrote: > >> Thank You Bob, >> >> I learnt quite a bit from your solution. I have been restricting myself >> to Lists so far. I think I will have to start exploring other data >> structures like Sets in Haskell as well. :) >> >> Thank You, >> Elric >> >> >> On 06/08/2014 03:41 PM, Bob Ippolito wrote: >> >> Here's another approach that more closely models what's going on in the >> C++ version. I defined an ordNub rather than using nub as nub is O(n^2) as >> it only requires Eq. >> >> https://gist.github.com/etrepum/5bfedc8bbe576f89fe09 >> >> import qualified Data.Set as S >> import Data.List (partition) >> import System.Environment (getArgs) >> >> data LWG = LWG { _lion, _wolf, _goat :: {-# UNPACK #-} !Int } >> deriving (Show, Ord, Eq) >> >> lionEatGoat, lionEatWolf, wolfEatGoat :: LWG -> LWG >> lionEatGoat (LWG l w g) = LWG (l - 1) (w + 1) (g - 1) >> lionEatWolf (LWG l w g) = LWG (l - 1) (w - 1) (g + 1) >> wolfEatGoat (LWG l w g) = LWG (l + 1) (w - 1) (g - 1) >> >> stableState :: LWG -> Bool >> stableState (LWG l w g) = length (filter (==0) [l, w, g]) >= 2 >> >> validState :: LWG -> Bool >> validState (LWG l w g) = all (>=0) [l, w, g] >> >> possibleMeals :: LWG -> [LWG] >> possibleMeals state = >> filter validState . >> map ($ state) $ [lionEatGoat, lionEatWolf, wolfEatGoat] >> >> ordNub :: Ord a => [a] -> [a] >> ordNub = S.toList . S.fromList >> >> endStates :: [LWG] -> [LWG] >> endStates states >> | not (null stable) = stable >> | not (null unstable) = endStates (concatMap possibleMeals unstable) >> | otherwise = [] >> where (stable, unstable) = partition stableState (ordNub states) >> >> main :: IO () >> main = do >> [l, w, g] <- map read `fmap` getArgs >> mapM_ print . endStates $ [LWG l w g] >> >> >> >> On Sat, Jun 7, 2014 at 11:33 PM, Francesco Ariis wrote: >> >>> On Sat, Jun 07, 2014 at 08:04:09PM -0400, Elric wrote: >>> > Hi, >>> > >>> > I came across this article: >>> http://unriskinsight.blogspot.co.at/2014/06/fast-functional-goats-lions-and-wolves.html >>> > a couple of days ago. This compares performance of solving a problem >>> > (which I will get to) using the functional constructs alone in >>> > languages like C++11 and Java 8. >>> > Since, Haskell is my first foray into FP, I thought I should try >>> > solving this in Haskell. >>> > >>> >>> Hello Elric, >>> I gave a go at the problem, managed to get a result (23). >>> I attach the .hs file (not my best Haskell, but hopefully clear enough). >>> >>> The crucial point in my solution lies in this lines: >>> >>> carnage :: [Forest] -> [Forest] >>> let wodup = nub aa in >>> -- etc. etc. >>> >>> Which means after every iteration I call |nub| on my list of possible >>> states; nub is a function from |Data.List| and removes duplicate >>> elements from a list. >>> >>> If I omit that nub call, the program doesn't reach a solution (as it >>> is computationally quite inefficient). I think that's the problem >>> with your versions. >>> >>> Let me know if this helps >>> >>> >>> >>> >>> >>> >>> >>> _______________________________________________ >>> Beginners mailing list >>> Beginners at haskell.org >>> http://www.haskell.org/mailman/listinfo/beginners >>> >>> >> >> >> _______________________________________________ >> Beginners mailing listBeginners at haskell.orghttp://www.haskell.org/mailman/listinfo/beginners >> >> >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://www.haskell.org/mailman/listinfo/beginners >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From rsx at bluewin.ch Sat Jun 21 12:47:47 2014 From: rsx at bluewin.ch (Roland Senn) Date: Sat, 21 Jun 2014 14:47:47 +0200 Subject: [Haskell-beginners] attoparsec: How to use the many1 combinator Message-ID: <53A57EF3.6080808@bluewin.ch> I'm trying to do a first very simple example with attoparsec. The file "test.txt" contains the line: START 111 2222 333 END The following code works and gives the result: Done "\n" ["111","2222","333"] {-# LANGUAGE OverloadedStrings #-} import qualified Data.ByteString as BS import Control.Applicative import Data.Attoparsec.ByteString as P main :: IO() main = do bs <- BS.readFile "test.txt" parseTest pTest bs pTest :: Parser [BS.ByteString] pTest = do string "START" n1 <- pNumber n2 <- pNumber n3 <- pNumber string "END" return [n1, n2, n3] pNumber :: Parser BS.ByteString pNumber = do pSkipSpaces term <- P.takeWhile (\c -> c >= 0x31 && c <= 0x39) pSkipSpaces return term pSkipSpaces :: Parser () pSkipSpaces = do P.takeWhile (\c -> c == 0x20) return () Unfortunately I must have exactly three numbers between START and END. To make this more flexible, I changed pTest: pTest :: Parser [BS.ByteString] pTest = do string "START" ns <- P.many1 $ pNumber <* (string "END") return ns Now the program fails with: Fail "2222 333 END\n" [] "Failed reading: takeWith" Why ?? Many thanks for your help! -------------- next part -------------- A non-text attachment was scrubbed... Name: Test.hs Type: text/x-haskell Size: 589 bytes Desc: not available URL: -------------- next part -------------- START 111 2222 333 END From toad3k at gmail.com Sat Jun 21 13:33:54 2014 From: toad3k at gmail.com (David McBride) Date: Sat, 21 Jun 2014 09:33:54 -0400 Subject: [Haskell-beginners] attoparsec: How to use the many1 combinator In-Reply-To: <53A57EF3.6080808@bluewin.ch> References: <53A57EF3.6080808@bluewin.ch> Message-ID: You have a couple problems here. P.many1 $ pNumber <* (string "END") ... which is the same as ... P.many1 (pNumber <* string "END") In other words it matches 111 END 222 END 333 END. Try this: ns <- (P.many1 pNumber) <* string "END" This almost works, but when you actually run it you'll get an infinite loop. The reason is because pNumber if it doesn't find a match it will never actually fail, therefore many1 will continue using it forever attempting to find a match that will never occur. The reason why it never fails is that it is composed of combinators that never fail, pSkipSpaces and itself are both composed entirely of takeWhiles, which if they don't find a match they just continue on without doing anything. If you make a small change though: term <- P.takeWhile1 (\c -> c >= 0x31 && c <= 0x39) then it works fine. On Sat, Jun 21, 2014 at 8:47 AM, Roland Senn wrote: > I'm trying to do a first very simple example with attoparsec. > > The file "test.txt" contains the line: > > START 111 2222 333 END > > The following code works and gives the result: Done "\n" > ["111","2222","333"] > > {-# LANGUAGE OverloadedStrings #-} > import qualified Data.ByteString as BS > import Control.Applicative > import Data.Attoparsec.ByteString as P > main :: IO() > main = do > bs <- BS.readFile "test.txt" > parseTest pTest bs > pTest :: Parser [BS.ByteString] > pTest = do > string "START" > n1 <- pNumber > n2 <- pNumber > n3 <- pNumber > string "END" > return [n1, n2, n3] > pNumber :: Parser BS.ByteString > pNumber = do > pSkipSpaces > term <- P.takeWhile (\c -> c >= 0x31 && c <= 0x39) > pSkipSpaces > return term > pSkipSpaces :: Parser () > pSkipSpaces = do > P.takeWhile (\c -> c == 0x20) > return () > > Unfortunately I must have exactly three numbers between START and END. To > make this more flexible, I changed pTest: > > pTest :: Parser [BS.ByteString] > pTest = do > string "START" > ns <- P.many1 $ pNumber <* (string "END") > return ns > > Now the program fails with: Fail "2222 333 END\n" [] "Failed reading: > takeWith" > Why ?? > > Many thanks for your help! > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From rsx at bluewin.ch Sat Jun 21 13:51:20 2014 From: rsx at bluewin.ch (Roland Senn) Date: Sat, 21 Jun 2014 15:51:20 +0200 Subject: [Haskell-beginners] attoparsec: How to use the many1 combinator In-Reply-To: References: <53A57EF3.6080808@bluewin.ch> Message-ID: <53A58DD8.50200@bluewin.ch> David, Many thanks! Yes I had the infinite loop to0. Regards Roland Am 21.06.2014 15:33, schrieb David McBride: > You have a couple problems here. > > P.many1 $ pNumber <* (string "END") ... which is the same as ... > P.many1 (pNumber <* string "END") > > In other words it matches 111 END 222 END 333 END. Try this: > > ns <- (P.many1 pNumber) <* string "END" > > This almost works, but when you actually run it you'll get an infinite > loop. The reason is because pNumber if it doesn't find a match it > will never actually fail, therefore many1 will continue using it > forever attempting to find a match that will never occur. The reason > why it never fails is that it is composed of combinators that never > fail, pSkipSpaces and itself are both composed entirely of takeWhiles, > which if they don't find a match they just continue on without doing > anything. If you make a small change though: > > term <- P.takeWhile1 (\c -> c >= 0x31 && c <= 0x39) > > then it works fine. > > > > > On Sat, Jun 21, 2014 at 8:47 AM, Roland Senn > wrote: > > I'm trying to do a first very simple example with attoparsec. > > The file "test.txt" contains the line: > > START 111 2222 333 END > > The following code works and gives the result: Done "\n" > ["111","2222","333"] > > {-# LANGUAGE OverloadedStrings #-} > import qualified Data.ByteString as BS > import Control.Applicative > import Data.Attoparsec.ByteString as P > main :: IO() > main = do > bs <- BS.readFile "test.txt" > parseTest pTest bs > pTest :: Parser [BS.ByteString] > pTest = do > string "START" > n1 <- pNumber > n2 <- pNumber > n3 <- pNumber > string "END" > return [n1, n2, n3] > pNumber :: Parser BS.ByteString > pNumber = do > pSkipSpaces > term <- P.takeWhile (\c -> c >= 0x31 && c <= 0x39) > pSkipSpaces > return term > pSkipSpaces :: Parser () > pSkipSpaces = do > P.takeWhile (\c -> c == 0x20) > return () > > Unfortunately I must have exactly three numbers between START and > END. To make this more flexible, I changed pTest: > > pTest :: Parser [BS.ByteString] > pTest = do > string "START" > ns <- P.many1 $ pNumber <* (string "END") > return ns > > Now the program fails with: Fail "2222 333 END\n" [] "Failed > reading: takeWith" > Why ?? > > Many thanks for your help! > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners -------------- next part -------------- An HTML attachment was scrubbed... URL: From jzdudek at gmail.com Tue Jun 24 16:44:34 2014 From: jzdudek at gmail.com (Jacek Dudek) Date: Tue, 24 Jun 2014 12:44:34 -0400 Subject: [Haskell-beginners] Functions in "where" block. In-Reply-To: <8D153F86943B671-2F34-1B4DC@webmail-d263.sysops.aol.com> References: <8D153F86943B671-2F34-1B4DC@webmail-d263.sysops.aol.com> Message-ID: {- Hi Venu, the problem is incorrect indentation. The line that defines ep must have the same (or greater) indentation than the line that defines op. Also, it is recommended that you use strictly spaces for indentation. In some editors, for example Vim, you can set an option that automatically converts your tab keystrokes into spaces. Copy this email as is with the code below to see one possible convention for writing where clauses. To recreate the same error again, move the line that defines ep back one space. By the way, your email landed in my spam box for some reason, so you might not be getting any replies to subsequent emails. -} myFun :: Integer -> Integer myFun x = op x + ep x where op x = 99 ep x = 1 On 6/11/14, Venu Chakravorty wrote: > Hello everyone, > I can't figure out why the following function does not work: > > > > > myFun :: Integer -> Integer > myFun x = op x + ep x > where op x = 99 > ep x = 1 -- squawks here > > > > Yeah it's a stupid function, but I was just trying to declare two functions > in the "where" block. I expected > this to work and always return 100. > > > This is the error I get while compiling: > > ================== > Prelude> :l fun.hs > [1 of 1] Compiling Main ( fun.hs, interpreted ) > > > fun.hs:4:15: parse error on input `=' > Failed, modules loaded: none. > > ================== > > > Could someone please tell me where I am going wrong? > Thanks in advance. > > > > Regards, > Venu Chakravorty. > > > > >