From mike_k_houghton at yahoo.co.uk Mon Sep 7 19:59:18 2015 From: mike_k_houghton at yahoo.co.uk (Mike Houghton) Date: Mon, 7 Sep 2015 20:59:18 +0100 Subject: [Haskell-beginners] Applicative on Tree Message-ID: <1EA6639D-6967-4092-8690-1E9446BBEA4C@yahoo.co.uk> Hi, I?m looking at data Tree a = Node a [Tree a] deriving (Show) and trying to write the Applicative instance. I have I think a correct Functor : instance Functor (Tree) where fmap f (Node x tr) = Node (f x) ( fmap (fmap f) tr) but I?m well and truly stuck on Applicative :) I have instance Applicative (Tree) where pure x = Node x [] (Node f []) <*> tr = fmap f tr (Node f fs) <*> tr@(Node x xs) = ????? I cant get rid of the question marks! :) any pointers would be really appreciated! Thanks From imantc at gmail.com Mon Sep 7 23:39:04 2015 From: imantc at gmail.com (Imants Cekusins) Date: Tue, 8 Sep 2015 01:39:04 +0200 Subject: [Haskell-beginners] Applicative on Tree In-Reply-To: <1EA6639D-6967-4092-8690-1E9446BBEA4C@yahoo.co.uk> References: <1EA6639D-6967-4092-8690-1E9446BBEA4C@yahoo.co.uk> Message-ID: > data Tree a = Node a [Tree a] well here is something that builds and runs. Not sure if the monad laws apply. watch out for indents! {-# LANGUAGE InstanceSigs #-} module TreeApp where import Debug.Trace import Data.Char data Tree a = Node a [Tree a] deriving (Show) instance Functor Tree where fmap::(a -> b) -> Tree a -> Tree b fmap f (Node x l0) = Node (f x) (fmap f <$> l0) instance Applicative Tree where pure::a -> Tree a pure a = Node a [] (<*>)::Tree (a -> b) -> Tree a -> Tree b (<*>) (Node f _) tra = f <$> tra instance Monad Tree where return::a -> Tree a return a = pure a (>>=)::Tree a -> (a -> Tree b) -> Tree b (>>=) (Node x []) amb = amb x (>>=) (Node x l0) amb = Node b (m1 <$> l0) where (Node b _) = amb x m1 ta = ta >>= amb f::Char->Int f = digitToInt mb::Char->Tree Int mb c = f <$> (pure c) main::Char -> Char -> IO () main a b = print $ tc4 >>= mb {- do print ti2 print ta3 tm4 <- tc4 -} where tc1 = pure a ti2 = f <$> tc1 ta3 = (Node f []) <*> tc1 tc4 = Node b [tc1] From imantc at gmail.com Tue Sep 8 00:32:01 2015 From: imantc at gmail.com (Imants Cekusins) Date: Tue, 8 Sep 2015 02:32:01 +0200 Subject: [Haskell-beginners] Applicative on Tree In-Reply-To: References: <1EA6639D-6967-4092-8690-1E9446BBEA4C@yahoo.co.uk> Message-ID: #2 .. this is probably correct: {-# LANGUAGE InstanceSigs #-} module TreeApp where import Debug.Trace import Data.Char data Tree a = Node a [Tree a] deriving (Show) instance Functor Tree where fmap::(a -> b) -> Tree a -> Tree b fmap f (Node x l0) = Node (f x) (fmap f <$> l0) instance Applicative Tree where pure::a -> Tree a pure a = Node a [] (<*>)::Tree (a -> b) -> Tree a -> Tree b (<*>) (Node f []) tra = f <$> tra (<*>) tab@(Node f tf0) (Node x l0) = Node (f x) l1 where l1 = [fu <*> a | fu <- tf0 , a <- l0] instance Monad Tree where return::a -> Tree a return a = pure a (>>=)::Tree a -> (a -> Tree b) -> Tree b (>>=) (Node x []) amb = amb x (>>=) (Node x l0) amb = Node b (m1 <$> l0) where (Node b _) = amb x m1 ta = ta >>= amb f1::Char->Int f1 = digitToInt mb::Char->Tree Int mb c = f1 <$> (pure c) main::Char -> Char -> IO () main a b = print $ tc4 >>= mb where tc1 = Node a [Node b []] ti2 = f1 <$> tc1 ta3 = (Node f1 []) <*> tc1 tc4 = Node b [tc1] From mike_k_houghton at yahoo.co.uk Tue Sep 8 13:47:36 2015 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Tue, 8 Sep 2015 13:47:36 +0000 (UTC) Subject: [Haskell-beginners] Applicative on Tree In-Reply-To: References: <1EA6639D-6967-4092-8690-1E9446BBEA4C@yahoo.co.uk> Message-ID: <229551334.4666113.1441720056819.JavaMail.yahoo@mail.yahoo.com> Thanks I'll work through it. On Tuesday, 8 September 2015, 0:39, Imants Cekusins wrote: > data Tree a = Node a [Tree a] well here is something that builds and runs. Not sure if the monad laws apply. watch out for indents! {-# LANGUAGE InstanceSigs #-} module TreeApp where import Debug.Trace import Data.Char data Tree a = Node a [Tree a]? deriving (Show) instance Functor Tree where ? fmap::(a -> b) -> Tree a -> Tree b ? fmap f (Node x l0) = Node (f x) (fmap f <$> l0) instance Applicative Tree where ? pure::a -> Tree a ? pure a =? Node a [] ? (<*>)::Tree (a -> b) -> Tree a -> Tree b ? (<*>) (Node f _) tra = f <$> tra instance Monad Tree where ? return::a -> Tree a ? return a = pure a ? (>>=)::Tree a -> (a -> Tree b) -> Tree b ? (>>=) (Node x []) amb = amb x ? (>>=) (Node x l0) amb = Node b (m1 <$> l0) ? ? ? ? where (Node b _) = amb x ? ? ? ? ? ? ? m1 ta = ta >>= amb f::Char->Int f = digitToInt mb::Char->Tree Int mb c = f <$> (pure c) main::Char -> Char -> IO () main a b = print $ tc4 >>= mb {- ? do ? ? ? print ti2 ? ? ? print ta3 ? ? ? tm4 <- tc4 -} ? where tc1 = pure a ? ? ? ? ti2 = f <$> tc1 ? ? ? ? ta3 = (Node f []) <*> tc1 ? ? ? ? tc4 = Node b [tc1] _______________________________________________ Beginners mailing list Beginners at haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners -------------- next part -------------- An HTML attachment was scrubbed... URL: From r.wobben at home.nl Thu Sep 10 07:23:29 2015 From: r.wobben at home.nl (Roelof Wobben) Date: Thu, 10 Sep 2015 09:23:29 +0200 Subject: [Haskell-beginners] wierd quickcheck outcome Message-ID: <55F12FF1.9080002@home.nl> Hello, I have this function : fourDifferent:: Integer -> Integer -> Integer -> Integer -> Bool fourDifferent a b c d = ( a == b ) && ( a == c ) && (a == d) which I wants to test with this function : prop_fourDifferent :: Integer -> Integer -> Integer -> Integer -> Bool prop_fourDifferent a b c d = fourDifferent a b c d == ( a == b ) && ( a == c ) && (a == d) so I do quickCheck propFourDifferent and see this outcome : *Solution> quickCheck prop_fourDifferent *** Failed! Falsifiable (after 2 tests and 2 shrinks): 0 0 0 1 *Solution> fourDifferent 0 0 0 1 False *Solution> let a = 0 *Solution> let b = 0 *Solution> let c = 0 *Solution> let d = 1 *Solution> (a == b) && ( a == c) && ( a == d ) False *Solution> So why is it failing. both gives false , Roelof From raabe at froglogic.com Thu Sep 10 07:54:37 2015 From: raabe at froglogic.com (Frerich Raabe) Date: Thu, 10 Sep 2015 09:54:37 +0200 Subject: [Haskell-beginners] wierd quickcheck outcome In-Reply-To: <55F12FF1.9080002@home.nl> References: <55F12FF1.9080002@home.nl> Message-ID: On 2015-09-10 09:23, Roelof Wobben wrote: > which I wants to test with this function : > > prop_fourDifferent :: Integer -> Integer -> Integer -> Integer -> Bool > prop_fourDifferent a b c d = fourDifferent a b c d == ( a == b ) && ( a == c > ) && (a == d) The problem is that (==) has a higher precedence (4) than (&&) (which has precedence 3). So your definition is equivalent to prop_fourDifferent a b c d = (fourDifferent a b c d == ( a == b )) && ( a == c ) && (a == d) You need some extra parentheses there, try prop_fourDifferent a b c d = fourDifferent a b c d == (( a == b ) && ( a == c ) && (a == d)) -- Frerich Raabe - raabe at froglogic.com www.froglogic.com - Multi-Platform GUI Testing From ky3 at atamo.com Thu Sep 10 09:25:03 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Thu, 10 Sep 2015 16:25:03 +0700 Subject: [Haskell-beginners] wierd quickcheck outcome In-Reply-To: <55F12FF1.9080002@home.nl> References: <55F12FF1.9080002@home.nl> Message-ID: Hi Roelof, > False == True && False False > False == (True && False) True > :info (==) class Eq a where (==) :: a -> a -> Bool infix 4 == > :info (&&) (&&) :: Bool -> Bool -> Bool infixr 3 && So (==) at level 4 binds tighter than (&&) at level 3. See: https://www.haskell.org/onlinereport/decls.html#fixity -- Kim-Ee On Thu, Sep 10, 2015 at 2:23 PM, Roelof Wobben wrote: > Hello, > > I have this function : > > fourDifferent:: Integer -> Integer -> Integer -> Integer -> Bool > fourDifferent a b c d = ( a == b ) && ( a == c ) && (a == d) > > which I wants to test with this function : > > prop_fourDifferent :: Integer -> Integer -> Integer -> Integer -> Bool > prop_fourDifferent a b c d = fourDifferent a b c d == ( a == b ) && ( a == > c ) && (a == d) > > so I do quickCheck propFourDifferent and see this outcome : > > *Solution> quickCheck prop_fourDifferent > *** Failed! Falsifiable (after 2 tests and 2 shrinks): > 0 > 0 > 0 > 1 > > *Solution> fourDifferent 0 0 0 1 > False > *Solution> let a = 0 > *Solution> let b = 0 > *Solution> let c = 0 > *Solution> let d = 1 > *Solution> (a == b) && ( a == c) && ( a == d ) False > *Solution> > > > So why is it failing. both gives false , > > Roelof > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From r.wobben at home.nl Thu Sep 10 12:12:44 2015 From: r.wobben at home.nl (Roelof Wobben) Date: Thu, 10 Sep 2015 14:12:44 +0200 Subject: [Haskell-beginners] wierd quickcheck outcome In-Reply-To: References: <55F12FF1.9080002@home.nl> Message-ID: <55F173BC.7040701@home.nl> Op 10-9-2015 om 09:54 schreef Frerich Raabe: > On 2015-09-10 09:23, Roelof Wobben wrote: >> which I wants to test with this function : >> >> prop_fourDifferent :: Integer -> Integer -> Integer -> Integer -> Bool >> prop_fourDifferent a b c d = fourDifferent a b c d == ( a == b ) && ( >> a == c ) && (a == d) > > The problem is that (==) has a higher precedence (4) than (&&) (which > has precedence 3). So your definition is equivalent to > > prop_fourDifferent a b c d = (fourDifferent a b c d == ( a == b )) > && ( a == c ) && (a == d) > > You need some extra parentheses there, try > > prop_fourDifferent a b c d = fourDifferent a b c d == (( a == b ) && > ( a == c ) && (a == d)) > Thanks, Learned that in this sort of situations I have to check the precendence. Roelof From sevcsik at gmail.com Sun Sep 13 01:15:43 2015 From: sevcsik at gmail.com (=?UTF-8?Q?Sevcsik_Andr=C3=A1s?=) Date: Sun, 13 Sep 2015 01:15:43 +0000 Subject: [Haskell-beginners] How do ambigious types compile with Aeson Message-ID: Hi list, > ghci> decode $ fromStrict $ encodeUtf8 $ "{\"a\" : \"b\"}" > Nothing > ghci> decode $ fromStrict $ encodeUtf8 $ "{\"a\" : \"b\"}" :: Maybe Object > Just (fromList [("a",String "b")]) The question is: how can the first example compile? I would expect that since GHC cannot infer the type I want from Aeson to decode to, it would die with an error that "t0 type variable is ambigious". But instead, it compiles just fine, and fails runtime. How it's decided what type should Aeson try to decode to? What type is that gives me Nothing on whatever JSON input I give? Cheers, Andras Sevcsik -- Minden j?t, Sevcsik Andr?s -------------- next part -------------- An HTML attachment was scrubbed... URL: From allbery.b at gmail.com Sun Sep 13 01:19:52 2015 From: allbery.b at gmail.com (Brandon Allbery) Date: Sat, 12 Sep 2015 21:19:52 -0400 Subject: [Haskell-beginners] How do ambigious types compile with Aeson In-Reply-To: References: Message-ID: On Sat, Sep 12, 2015 at 9:15 PM, Sevcsik Andr?s wrote: > How it's decided what type should Aeson try to decode to? What type is > that gives me Nothing on whatever JSON input I give? ghci has ExtendedDefaultRules enabled, which means that many things will infer a type of () if one cannot otherwise be determined. This is not something Aeson has control over. Try ":seti -XNoExtendedDefaultRules" and ask ghci again; it should produce an ambiguous type error. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From sevcsik at gmail.com Sun Sep 13 01:59:05 2015 From: sevcsik at gmail.com (=?UTF-8?Q?Sevcsik_Andr=C3=A1s?=) Date: Sun, 13 Sep 2015 01:59:05 +0000 Subject: [Haskell-beginners] How do ambigious types compile with Aeson In-Reply-To: References: Message-ID: That explains it, thank you! On Sun, Sep 13, 2015, 03:20 Brandon Allbery wrote: > On Sat, Sep 12, 2015 at 9:15 PM, Sevcsik Andr?s wrote: > >> How it's decided what type should Aeson try to decode to? What type is >> that gives me Nothing on whatever JSON input I give? > > > ghci has ExtendedDefaultRules enabled, which means that many things will > infer a type of () if one cannot otherwise be determined. This is not > something Aeson has control over. > Try ":seti -XNoExtendedDefaultRules" and ask ghci again; it should produce > an ambiguous type error. > > -- > brandon s allbery kf8nh sine nomine > associates > allbery.b at gmail.com > ballbery at sinenomine.net > unix, openafs, kerberos, infrastructure, xmonad > http://sinenomine.net > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Minden j?t, Sevcsik Andr?s -------------- next part -------------- An HTML attachment was scrubbed... URL: From ryan.warner.mn+haskell at gmail.com Mon Sep 14 18:23:08 2015 From: ryan.warner.mn+haskell at gmail.com (Ryan Warner) Date: Mon, 14 Sep 2015 18:23:08 +0000 Subject: [Haskell-beginners] Converting a data type to an abstract data type Message-ID: I had defined a data type similar to the following: data Record = Record { name :: String, age :: Int } Later, I realized I needed it be an ADT defined like: data Record a = Record { name :: String, age :: Int, resource :: a } The change turned out to be fairly well contained and probably only took me a half hour to propagate up. However, I see the potential for this to be a bigger job. Are there any editors that automate that kind of refactoring? -Ryan -------------- next part -------------- An HTML attachment was scrubbed... URL: From cma at bitemyapp.com Mon Sep 14 18:24:43 2015 From: cma at bitemyapp.com (Christopher Allen) Date: Mon, 14 Sep 2015 13:24:43 -0500 Subject: [Haskell-beginners] Converting a data type to an abstract data type In-Reply-To: References: Message-ID: Maybe Alan Zimmerman's Haskell refactorer project is pertinent? I don't think they're anything ready-to-use though. On Mon, Sep 14, 2015 at 1:23 PM, Ryan Warner < ryan.warner.mn+haskell at gmail.com> wrote: > I had defined a data type similar to the following: > > data Record = Record { name :: String, age :: Int } > > Later, I realized I needed it be an ADT defined like: > data Record a = Record { name :: String, age :: Int, resource :: a } > > The change turned out to be fairly well contained and probably only took > me a half hour to propagate up. However, I see the potential for this to be > a bigger job. Are there any editors that automate that kind of refactoring? > > -Ryan > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -- Chris Allen Currently working on http://haskellbook.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Mon Sep 14 19:18:55 2015 From: fa-ml at ariis.it (Francesco Ariis) Date: Mon, 14 Sep 2015 21:18:55 +0200 Subject: [Haskell-beginners] [Haskell-cafe] Powerset of a set In-Reply-To: References: Message-ID: <20150914191855.GA8615@casa.casa> On Mon, Sep 14, 2015 at 01:57:10PM -0500, JORGE MALDONADO wrote: > The powerset of set s is a set containing all subsets of s. > I need a clue on how to write Haskell code to get the superset of a set > using direct recursion and list comprehension. > > Best regads. This is good for haskell-beginners rather than haskell cafe. Clue: - say you have a list `l` [a,b,c,d,e] - you have the powerset of list `m` [b,c,d,e] - how can you use the `powerset of m` to calculate the `powerset of l`? From amindfv at gmail.com Mon Sep 14 21:01:25 2015 From: amindfv at gmail.com (amindfv at gmail.com) Date: Mon, 14 Sep 2015 17:01:25 -0400 Subject: [Haskell-beginners] Converting a data type to an abstract data type In-Reply-To: References: Message-ID: <19823829-84BC-4EA9-B3FE-67D25A520025@gmail.com> The term you're looking for is "parameterized," not "abstract." An abstract data type is something else. Can't help with your original question though, sorry! tom El Sep 14, 2015, a las 14:23, Ryan Warner escribi?: > I had defined a data type similar to the following: > > data Record = Record { name :: String, age :: Int } > > Later, I realized I needed it be an ADT defined like: > data Record a = Record { name :: String, age :: Int, resource :: a } > > The change turned out to be fairly well contained and probably only took me a half hour to propagate up. However, I see the potential for this to be a bigger job. Are there any editors that automate that kind of refactoring? > > -Ryan > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From ky3 at atamo.com Tue Sep 15 03:16:29 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Tue, 15 Sep 2015 10:16:29 +0700 Subject: [Haskell-beginners] Converting a data type to an abstract data type In-Reply-To: References: Message-ID: On Tue, Sep 15, 2015 at 1:23 AM, Ryan Warner < ryan.warner.mn+haskell at gmail.com> wrote: > However, I see the potential for this to be a bigger job. Are there any > editors that automate that kind of refactoring? Let me ask: for this smaller scenario, what were the repetitive activities? Specifically, how would automation alleviate the labor? As for the potential for this to be a bigger job, aren't there ways of minimizing such blowup risks in the first place? What can be done to avoid incrementalizing on data design? -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From ryan.warner.mn+haskell at gmail.com Tue Sep 15 17:02:03 2015 From: ryan.warner.mn+haskell at gmail.com (Ryan Warner) Date: Tue, 15 Sep 2015 17:02:03 +0000 Subject: [Haskell-beginners] Converting a data type to an abstract data type In-Reply-To: References: Message-ID: On Mon, Sep 14, 2015 at 10:17 PM Kim-Ee Yeoh wrote: > > On Tue, Sep 15, 2015 at 1:23 AM, Ryan Warner < > ryan.warner.mn+haskell at gmail.com> wrote: > >> However, I see the potential for this to be a bigger job. Are there any >> editors that automate that kind of refactoring? > > > Let me ask: for this smaller scenario, what were the repetitive > activities? Specifically, how would automation alleviate the labor? > > I should've just posted a link. So, this is my toy project I'm using to learn haskell. I changed the definition of my Room datatype, and then that propagated though some other types and functions. In this case, I decided that including the room's textual description in the model itself felt like the model was being polluted with view information. So I converted the Room to a parameterized datatype to allow me to relocate the textual description. You can see that here: https://github.com/LoggerMN/hsAdventure/commit/b19514bd639e7e575151f659851d80ee4f832860#diff-10e71f04a6bef79f976e195d937f0bfbL21 As for the potential for this to be a bigger job, aren't there ways of > minimizing such blowup risks in the first place? What can be done to avoid > incrementalizing on data design? > > I see many ways to improve this code. And to be sure, next time I'll be closer to an ideal answer the first time out of the chute. So, practice and planning will minimize the risk. But that only get's you so far, and a requirement change might require you refactor your code anyway. As you say, it minimizes, does not eliminate the risk. Other language have powerful refactoring tools, so I was wondering if there were some for haskell as well. Maybe there is a different design pattern I should be using here that would've have avoided this problem. If so, I'd love to know! -Ryan > -- Kim-Ee > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ky3 at atamo.com Wed Sep 16 16:57:26 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Wed, 16 Sep 2015 23:57:26 +0700 Subject: [Haskell-beginners] Converting a data type to an abstract data type In-Reply-To: References: Message-ID: On Wed, Sep 16, 2015 at 12:02 AM, Ryan Warner < ryan.warner.mn+haskell at gmail.com> wrote: > So I converted the Room to a parameterized datatype to allow me to > relocate the textual description. When I look at the diff, I see numerous changes to explicit top-level signatures. If you're experimenting with data design at the keyboard, you could leave out signatures and let the compiler infer them for you. That way, there's so much you no longer need to refactor. So, practice and planning will minimize the risk. But that only get's you > so far, and a requirement change might require you refactor your code > anyway. As you say, it minimizes, does not eliminate the risk. > Some requirement changes are just costly. In my neck of the woods, a house that's 50% complete -- but where the owner then demands that it be two-storey high and not just one -- will need to be torn down, have the foundation buttressed to support the additional weight, and restarted from scratch. Getting the foundational data structures right is a bit like that. (But you might chime in that, isn't this just like modifying SQL schemas, and what about the whole NoSQL movement that started as a consequence? No comment there.) Other language have powerful refactoring tools, so I was wondering if there > were some for haskell as well. Maybe there is a different design pattern I > should be using here that would've have avoided this problem. If so, I'd > love to know! I mentioned about leaving out type signatures at the exploratory stage, but even with your code, much of the repetitive work comes down to a global search-and-replace for, e.g. "State ->" to "State r ->" There's ghc-mod which isn't a refactoring tool but a library you could use to write that tool with. Some of the refactoring really can't be automated away. Suppose you add another tag to a sumtype T. To remain well-defined, functions that have T on the left of an arrow must now case on the new tag. The ghc option -W, which invokes -fwarn-incomplete-patterns, will help you locate all such functions. But with a DRY codebase, the functions have duplication squeezed out of them so extending them need to be done case-by-case. Beyond an editor that jumps from line ref to line ref, what kind of automation do you envision here? Lastly, I'm not sure there really is a "different design pattern" that would've help you dodge this. I'm old skool Dijkstra in that way. I noodle about with pen and paper on the datatypes and the function signatures on them. Once everything clicks and nothing seems left out, I'm ready to hit the keyboard. -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From ryan.warner.mn+haskell at gmail.com Thu Sep 17 01:42:56 2015 From: ryan.warner.mn+haskell at gmail.com (Ryan Warner) Date: Thu, 17 Sep 2015 01:42:56 +0000 Subject: [Haskell-beginners] Converting a data type to an abstract data type In-Reply-To: References: Message-ID: On Wed, Sep 16, 2015 at 11:58 AM Kim-Ee Yeoh wrote: > > you could leave out signatures and let the compiler infer them for you. > That way, there's so much you no longer need to refactor. > > Thanks for pointing that out. I hadn't recognized that yet. Are type signatures used sparingly in most Haskell code? Or as you say, is it coming to formalize the signatures once the exploration is complete? -Ryan -------------- next part -------------- An HTML attachment was scrubbed... URL: From rein.henrichs at gmail.com Thu Sep 17 06:49:01 2015 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Thu, 17 Sep 2015 06:49:01 +0000 Subject: [Haskell-beginners] Converting a data type to an abstract data type In-Reply-To: References: Message-ID: > Are type signatures used sparingly in most Haskell code? No, generally most Haskell code uses explicit top-level type signatures everywhere. They provide useful guidance to the developer as much as (if not more so than) the compiler. If possible, you could use a type synonym for your type which keeps changing. That way there would be only one place to make the change. On Wed, Sep 16, 2015 at 6:43 PM Ryan Warner wrote: > On Wed, Sep 16, 2015 at 11:58 AM Kim-Ee Yeoh wrote: > >> >> you could leave out signatures and let the compiler infer them for you. >> That way, there's so much you no longer need to refactor. >> >> > Thanks for pointing that out. I hadn't recognized that yet. Are type > signatures used sparingly in most Haskell code? Or as you say, is it coming > to formalize the signatures once the exploration is complete? > > -Ryan > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ryan.warner.mn+haskell at gmail.com Thu Sep 17 12:54:14 2015 From: ryan.warner.mn+haskell at gmail.com (Ryan Warner) Date: Thu, 17 Sep 2015 12:54:14 +0000 Subject: [Haskell-beginners] Converting a data type to an abstract data type In-Reply-To: References: Message-ID: > If possible, you could use a type synonym for your type which keeps > changing. That way there would be only one place to make the change. > > I like the sound of this idea. I'll give it a try. -------------- next part -------------- An HTML attachment was scrubbed... URL: From andrew.bernard at gmail.com Sat Sep 19 01:00:25 2015 From: andrew.bernard at gmail.com (Andrew Bernard) Date: Sat, 19 Sep 2015 11:00:25 +1000 Subject: [Haskell-beginners] Monad transformers Message-ID: <5B5D8A39-1DEE-4D01-AFE9-B67E3A3DFF3B@gmail.com> Greetings All, While I admire Haskell enormously, as a an intermediate beginner I find it difficult to know what is normal Haskell style for real world programming. On the subject of monad transformers, the paper by Martin Grab?mller titled 'Monad Transformers Step by Step' gives an example of an evaluator using monad transformers with the following type: type Eval6 ? = ReaderT Env (ErrorT String (WriterT [String] (StateT Integer IO))) ? Is this how normal Haskell is developed and written in practice? I find the type and the function impenetrably dense and difficult to understand. Should I be aspiring to have my functions look and work like this? Of course it depends on what you want to do, but the essence of the question is, does Haskell ultimately end up looking like this for any real programming, beyond textbook list manipulation functions? Andrew -------------- next part -------------- An HTML attachment was scrubbed... URL: From allbery.b at gmail.com Sat Sep 19 01:30:38 2015 From: allbery.b at gmail.com (Brandon Allbery) Date: Fri, 18 Sep 2015 21:30:38 -0400 Subject: [Haskell-beginners] Monad transformers In-Reply-To: <5B5D8A39-1DEE-4D01-AFE9-B67E3A3DFF3B@gmail.com> References: <5B5D8A39-1DEE-4D01-AFE9-B67E3A3DFF3B@gmail.com> Message-ID: On Fri, Sep 18, 2015 at 9:00 PM, Andrew Bernard wrote: > Is this how normal Haskell is developed and written in practice? I find > the type and the function impenetrably dense and difficult to understand. > Should I be aspiring to have my functions look and work like this? Of > course it depends on what you want to do, but the essence of the question > is, does Haskell ultimately end up looking like this for any real > programming, beyond textbook list manipulation functions? If you need that, then yes. If not, then no. Usually that kind of thing is packaged up in higher level libraries; the type Eval6 would be exposed, the underlying stuff is used internally and you would not normally need to know or care about it unless you were specifically working on the internals of that library. Most applications you would write, you only care about Eval6 and any functions exported along with it. That said, I think in most cases you would use a newtype and derive through MonadReader, MonadError, MonadState, and MonadIO so you can ignore precisely how the type was built and just use it. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From andrew.bernard at gmail.com Sat Sep 19 01:32:02 2015 From: andrew.bernard at gmail.com (Andrew Bernard) Date: Sat, 19 Sep 2015 11:32:02 +1000 Subject: [Haskell-beginners] Config data In-Reply-To: <1460553189.8392786.1433617637485.JavaMail.yahoo@mail.yahoo.com> References: <9CF9E935-C382-4692-91E4-91BDDB8DDB03@yahoo.co.uk> <1460553189.8392786.1433617637485.JavaMail.yahoo@mail.yahoo.com> Message-ID: Greetings, Better style in functional programming is to be as stateless as possible. Reverting to using global state, your life would be easier coding in Python. Isn?t this a classic use for a Reader monad, which is for the purpose of passing an environment around without having to do so explicitly? Andrew On 7/06/2015, 05:07, "Beginners on behalf of mike h" wrote: Global state is an option - thanks. Didn't think Haskell allowed this. -------------- next part -------------- An HTML attachment was scrubbed... URL: From martin at vlkk.cz Sat Sep 19 06:30:18 2015 From: martin at vlkk.cz (Martin Vlk) Date: Sat, 19 Sep 2015 06:30:18 +0000 Subject: [Haskell-beginners] Monad transformers In-Reply-To: <5B5D8A39-1DEE-4D01-AFE9-B67E3A3DFF3B@gmail.com> References: <5B5D8A39-1DEE-4D01-AFE9-B67E3A3DFF3B@gmail.com> Message-ID: <55FD00FA.30801@vlkk.cz> Hi, I am also something of a beginner in Haskell and have to say I am slowly getting to see that many things that once looked impenetrable are starting to clear up for me. I am basically developing the intuitions that work in the Haskell world - different intuitions from those I acquired when I worked using imperative languages. So possibly even advanced Haskell code is not impenetrable by nature - it's just different - and once you get over the initial difficulty it'll then look clear and not that dense at all? Martin Andrew Bernard: > Greetings All, > > While I admire Haskell enormously, as a an intermediate beginner I find it difficult to know what is normal Haskell style for real world programming. On the subject of monad transformers, the paper by Martin Grab?mller titled 'Monad Transformers Step by Step' gives an example of an evaluator using monad transformers with the following type: > > type Eval6 ? = ReaderT Env (ErrorT String (WriterT [String] (StateT Integer IO))) ? > > Is this how normal Haskell is developed and written in practice? I find the type and the function impenetrably dense and difficult to understand. Should I be aspiring to have my functions look and work like this? Of course it depends on what you want to do, but the essence of the question is, does Haskell ultimately end up looking like this for any real programming, beyond textbook list manipulation functions? > > Andrew > > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From ram at rkrishnan.org Sat Sep 19 07:00:22 2015 From: ram at rkrishnan.org (Ramakrishnan Muthukrishnan) Date: Sat, 19 Sep 2015 12:30:22 +0530 Subject: [Haskell-beginners] Monad transformers In-Reply-To: <5B5D8A39-1DEE-4D01-AFE9-B67E3A3DFF3B@gmail.com> References: <5B5D8A39-1DEE-4D01-AFE9-B67E3A3DFF3B@gmail.com> Message-ID: <1442646022.1439455.387904993.7BD3C932@webmail.messagingengine.com> On Sat, Sep 19, 2015, at 06:30 AM, Andrew Bernard wrote: > Greetings All, > > While I admire Haskell enormously, as a an intermediate beginner I > find it difficult to know what is normal Haskell style for real world > programming. On the subject of monad transformers, the paper by Martin > Grab?mller titled 'Monad Transformers Step by Step' gives an example > of an evaluator using monad transformers with the following type: > > type Eval6 ? = ReaderT Env (ErrorT String (WriterT [String] (StateT > Integer IO))) ? I felt the same too when I looked at that paper and read some other Haskell code. But in my own little practice, I haven't written such type signatures. One of the talks that can help you get rid of the fear is this one by Brian Hurt. It certainly helped me and I used a few Monad Transformers after that talk to make my code cleaner. Encourage you to have a look. Cheers and happy hacking! -- Ramakrishnan -------------- next part -------------- An HTML attachment was scrubbed... URL: From lethuillier at wmail.io Sat Sep 19 07:15:53 2015 From: lethuillier at wmail.io (lethuillier at wmail.io) Date: Sat, 19 Sep 2015 07:15:53 +0000 Subject: [Haskell-beginners] Monad transformers In-Reply-To: <55FD00FA.30801@vlkk.cz> References: <5B5D8A39-1DEE-4D01-AFE9-B67E3A3DFF3B@gmail.com> <55FD00FA.30801@vlkk.cz> Message-ID: <1442646954073-c4e024bb-ece6bcd0-e4fd8608@wmail.io> Hi. I am a beginner too. For the most part I agree with you, except that Haskell is, in my opinion, a dense language per se. Haskell is more poetry than prose; you do not read/write a poem like a novel. Whether you are new to this language or master it, it is dense. Guillaume Saturday, Sep 19, 2015 8:30 AM Martin Vlk wrote: > Hi, I am also something of a beginner in Haskell and have to say I am > slowly getting to see that many things that once looked impenetrable are > starting to clear up for me. > > I am basically developing the intuitions that work in the Haskell world > - different intuitions from those I acquired when I worked using > imperative languages. > > So possibly even advanced Haskell code is not impenetrable by nature - > it's just different - and once you get over the initial difficulty it'll > then look clear and not that dense at all? > > Martin > > Andrew Bernard: >> Greetings All, >> >> While I admire Haskell enormously, as a an intermediate beginner I find it difficult to know what is normal Haskell style for real world programming. On the subject of monad transformers, the paper by Martin Grab?mller titled 'Monad Transformers Step by Step' gives an example of an evaluator using monad transformers with the following type: >> >> type Eval6 ? = ReaderT Env (ErrorT String (WriterT [String] (StateT Integer IO))) ? >> >> Is this how normal Haskell is developed and written in practice? I find the type and the function impenetrably dense and difficult to understand. Should I be aspiring to have my functions look and work like this? Of course it depends on what you want to do, but the essence of the question is, does Haskell ultimately end up looking like this for any real programming, beyond textbook list manipulation functions? >> >> Andrew >> >> >> >> >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners -- Sent from Whiteout Mail - https://whiteout.io My PGP key: https://keys.whiteout.io/lethuillier at wmail.io -------------- next part -------------- A non-text attachment was scrubbed... Name: not available Type: application/pgp-signature Size: 528 bytes Desc: not available URL: From martin at vlkk.cz Sat Sep 19 07:37:13 2015 From: martin at vlkk.cz (Martin Vlk) Date: Sat, 19 Sep 2015 07:37:13 +0000 Subject: [Haskell-beginners] Monad transformers In-Reply-To: <1442646954073-c4e024bb-ece6bcd0-e4fd8608@wmail.io> References: <5B5D8A39-1DEE-4D01-AFE9-B67E3A3DFF3B@gmail.com> <55FD00FA.30801@vlkk.cz> <1442646954073-c4e024bb-ece6bcd0-e4fd8608@wmail.io> Message-ID: <55FD10A9.9050802@vlkk.cz> Also, looking at this topic in more detail - we could speak of different kinds of denseness. One is inherent because there is so much encoded in the types and abstractions used. However this is the kind of denseness that IMO fades away as you get the right intuitions. Then it's true that there is lots of space in Haskell for writing dense code - this is the "poetry" bit. But I can also write code that is more spacious, I write out more things explicitly, variables with longer names, etc. It'll be less of a poetry maybe, but easier to read. There can be different kinds of poetry... :-) M. lethuillier at wmail.io: > Hi. I am a beginner too. > > For the most part I agree with you, except that Haskell is, in my opinion, a dense language per se. > > Haskell is more poetry than prose; you do not read/write a poem like a novel. > > Whether you are new to this language or master it, it is dense. > > Guillaume > > > Saturday, Sep 19, 2015 8:30 AM Martin Vlk wrote: >> Hi, I am also something of a beginner in Haskell and have to say I am >> slowly getting to see that many things that once looked impenetrable are >> starting to clear up for me. >> >> I am basically developing the intuitions that work in the Haskell world >> - different intuitions from those I acquired when I worked using >> imperative languages. >> >> So possibly even advanced Haskell code is not impenetrable by nature - >> it's just different - and once you get over the initial difficulty it'll >> then look clear and not that dense at all? >> >> Martin >> >> Andrew Bernard: >>> Greetings All, >>> >>> While I admire Haskell enormously, as a an intermediate beginner I find it difficult to know what is normal Haskell style for real world programming. On the subject of monad transformers, the paper by Martin Grab?mller titled 'Monad Transformers Step by Step' gives an example of an evaluator using monad transformers with the following type: >>> >>> type Eval6 ? = ReaderT Env (ErrorT String (WriterT [String] (StateT Integer IO))) ? >>> >>> Is this how normal Haskell is developed and written in practice? I find the type and the function impenetrably dense and difficult to understand. Should I be aspiring to have my functions look and work like this? Of course it depends on what you want to do, but the essence of the question is, does Haskell ultimately end up looking like this for any real programming, beyond textbook list manipulation functions? >>> >>> Andrew >>> >>> >>> >>> >>> >>> _______________________________________________ >>> Beginners mailing list >>> Beginners at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >>> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > -- > Sent from Whiteout Mail - https://whiteout.io > > My PGP key: https://keys.whiteout.io/lethuillier at wmail.io > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From fa-ml at ariis.it Sat Sep 19 07:41:25 2015 From: fa-ml at ariis.it (Francesco Ariis) Date: Sat, 19 Sep 2015 09:41:25 +0200 Subject: [Haskell-beginners] Monad transformers In-Reply-To: <1442646954073-c4e024bb-ece6bcd0-e4fd8608@wmail.io> References: <5B5D8A39-1DEE-4D01-AFE9-B67E3A3DFF3B@gmail.com> <55FD00FA.30801@vlkk.cz> <1442646954073-c4e024bb-ece6bcd0-e4fd8608@wmail.io> Message-ID: <20150919074125.GA2532@casa.casa> On Sat, Sep 19, 2015 at 07:15:53AM +0000, lethuillier at wmail.io wrote: > Haskell is more poetry than prose; you do not read/write a poem like a novel. Pandoc, xmonad, parsec: as prosaic you can get! ?Viva la prosificaci?n! :? From teztingit at gmail.com Mon Sep 21 18:23:33 2015 From: teztingit at gmail.com (goforgit .) Date: Mon, 21 Sep 2015 20:23:33 +0200 Subject: [Haskell-beginners] Numeric Integer vs Integer Message-ID: Hello! Could someone explain to me the difference between the following? data Atype = Numeric Integer | A | B C and data Atype = Integer | A | B C Thanks in advance! -------------- next part -------------- An HTML attachment was scrubbed... URL: From allbery.b at gmail.com Mon Sep 21 18:39:51 2015 From: allbery.b at gmail.com (Brandon Allbery) Date: Mon, 21 Sep 2015 14:39:51 -0400 Subject: [Haskell-beginners] Numeric Integer vs Integer In-Reply-To: References: Message-ID: On Mon, Sep 21, 2015 at 2:23 PM, goforgit . wrote: > Could someone explain to me the difference between the following? > > data Atype = Numeric Integer | A | B C > > and > > data Atype = Integer | A | B C > The second one is an enumeration with three values: "Integer" (which is *not* an integer, nor does it contain one), "A", and "B" which as written there takes a value of some unspecified type C as a parameter. The first one is a enumeration with three values: "Numeric" which takes an Integer as a parameter, "A", and "B" which takes a value of some unspecified type C as a parameter. Note that the "Integer" in the second one has *nothing whatsoever* to do with the *type* Integer. Remember that you must always provide a data constructor with "data"; you cannot simply say "data MyInt = Integer" to "wrap" an Integer, because you have not said what to wrap it *in*. (You may have intended to create a type alias, though; that would be "type", not "data".) A "data" always requires a data constructor name, so the compiler can tell when you are talking about a value of that type by looking for the constructor. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From teztingit at gmail.com Tue Sep 22 14:54:00 2015 From: teztingit at gmail.com (goforgit .) Date: Tue, 22 Sep 2015 16:54:00 +0200 Subject: [Haskell-beginners] Numeric Integer vs Integer In-Reply-To: References: Message-ID: Thanks Brandon, that cleared things up! On Mon, Sep 21, 2015 at 8:39 PM, Brandon Allbery wrote: > > On Mon, Sep 21, 2015 at 2:23 PM, goforgit . wrote: > >> Could someone explain to me the difference between the following? >> >> data Atype = Numeric Integer | A | B C >> >> and >> >> data Atype = Integer | A | B C >> > > The second one is an enumeration with three values: "Integer" (which is > *not* an integer, nor does it contain one), "A", and "B" which as written > there takes a value of some unspecified type C as a parameter. > The first one is a enumeration with three values: "Numeric" which takes an > Integer as a parameter, "A", and "B" which takes a value of some > unspecified type C as a parameter. > > Note that the "Integer" in the second one has *nothing whatsoever* to do > with the *type* Integer. > > Remember that you must always provide a data constructor with "data"; you > cannot simply say "data MyInt = Integer" to "wrap" an Integer, because you > have not said what to wrap it *in*. (You may have intended to create a type > alias, though; that would be "type", not "data".) A "data" always requires > a data constructor name, so the compiler can tell when you are talking > about a value of that type by looking for the constructor. > > -- > brandon s allbery kf8nh sine nomine > associates > allbery.b at gmail.com > ballbery at sinenomine.net > unix, openafs, kerberos, infrastructure, xmonad > http://sinenomine.net > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From teztingit at gmail.com Wed Sep 23 07:51:24 2015 From: teztingit at gmail.com (goforgit .) Date: Wed, 23 Sep 2015 09:51:24 +0200 Subject: [Haskell-beginners] Numeric Integer vs Integer In-Reply-To: References: Message-ID: I have a follow up question, I hope it's alright. What about the following? data List a = Empty | Add a (List a) What does the a mean and why is it possible to put it there? On Tue, Sep 22, 2015 at 4:54 PM, goforgit . wrote: > Thanks Brandon, that cleared things up! > > On Mon, Sep 21, 2015 at 8:39 PM, Brandon Allbery > wrote: > >> >> On Mon, Sep 21, 2015 at 2:23 PM, goforgit . wrote: >> >>> Could someone explain to me the difference between the following? >>> >>> data Atype = Numeric Integer | A | B C >>> >>> and >>> >>> data Atype = Integer | A | B C >>> >> >> The second one is an enumeration with three values: "Integer" (which is >> *not* an integer, nor does it contain one), "A", and "B" which as written >> there takes a value of some unspecified type C as a parameter. >> The first one is a enumeration with three values: "Numeric" which takes >> an Integer as a parameter, "A", and "B" which takes a value of some >> unspecified type C as a parameter. >> >> Note that the "Integer" in the second one has *nothing whatsoever* to do >> with the *type* Integer. >> >> Remember that you must always provide a data constructor with "data"; you >> cannot simply say "data MyInt = Integer" to "wrap" an Integer, because you >> have not said what to wrap it *in*. (You may have intended to create a type >> alias, though; that would be "type", not "data".) A "data" always requires >> a data constructor name, so the compiler can tell when you are talking >> about a value of that type by looking for the constructor. >> >> -- >> brandon s allbery kf8nh sine nomine >> associates >> allbery.b at gmail.com >> ballbery at sinenomine.net >> unix, openafs, kerberos, infrastructure, xmonad >> http://sinenomine.net >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcin.jan.mrotek at gmail.com Wed Sep 23 08:11:31 2015 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Wed, 23 Sep 2015 10:11:31 +0200 Subject: [Haskell-beginners] Numeric Integer vs Integer In-Reply-To: References: Message-ID: Hello, This means that the List type is parametrized by another type. Think of it as a sort of a function between types. Best regards, Marcin Mrotek -------------- next part -------------- An HTML attachment was scrubbed... URL: From sumit.sahrawat.apm13 at iitbhu.ac.in Wed Sep 23 08:12:08 2015 From: sumit.sahrawat.apm13 at iitbhu.ac.in (Sumit Sahrawat, Maths & Computing, IIT (BHU)) Date: Wed, 23 Sep 2015 13:42:08 +0530 Subject: [Haskell-beginners] Numeric Integer vs Integer In-Reply-To: References: Message-ID: What you wrote is equivalent to the following pseudo-haskell. *List* takes a type and returns a new type, which represents a list of elements of that type in this case. Thus *List* is a *type-constructor*. It has two data-constructors, i.e. there are two ways to create elements of the type *List a*, for any type a. -- 'Empty' is a value of type 'List a', for all types 'a'. This is one possible way to construct elements of type 'List a'. Empty :: List a -- 'Add' is a function that takes an element of type 'a', and a 'List a', and constructs a 'List a' out of them. Add :: a -> List a -> List a Using the GHC extension, *GADTs*, it is possible to write code that directly reflects this structure. Although that is considered an advanced feature of the language. {-# LANGUAGE GADTs #-} data List a where Empty :: List a Add :: a -> List a -> List a On 23 September 2015 at 13:21, goforgit . wrote: > I have a follow up question, I hope it's alright. > > What about the following? > > data List a = Empty | Add a (List a) > > What does the a mean and why is it possible to put it there? > > > On Tue, Sep 22, 2015 at 4:54 PM, goforgit . wrote: > >> Thanks Brandon, that cleared things up! >> >> On Mon, Sep 21, 2015 at 8:39 PM, Brandon Allbery >> wrote: >> >>> >>> On Mon, Sep 21, 2015 at 2:23 PM, goforgit . wrote: >>> >>>> Could someone explain to me the difference between the following? >>>> >>>> data Atype = Numeric Integer | A | B C >>>> >>>> and >>>> >>>> data Atype = Integer | A | B C >>>> >>> >>> The second one is an enumeration with three values: "Integer" (which is >>> *not* an integer, nor does it contain one), "A", and "B" which as written >>> there takes a value of some unspecified type C as a parameter. >>> The first one is a enumeration with three values: "Numeric" which takes >>> an Integer as a parameter, "A", and "B" which takes a value of some >>> unspecified type C as a parameter. >>> >>> Note that the "Integer" in the second one has *nothing whatsoever* to do >>> with the *type* Integer. >>> >>> Remember that you must always provide a data constructor with "data"; >>> you cannot simply say "data MyInt = Integer" to "wrap" an Integer, because >>> you have not said what to wrap it *in*. (You may have intended to create a >>> type alias, though; that would be "type", not "data".) A "data" always >>> requires a data constructor name, so the compiler can tell when you are >>> talking about a value of that type by looking for the constructor. >>> >>> -- >>> brandon s allbery kf8nh sine nomine >>> associates >>> allbery.b at gmail.com >>> ballbery at sinenomine.net >>> unix, openafs, kerberos, infrastructure, xmonad >>> http://sinenomine.net >>> >>> _______________________________________________ >>> Beginners mailing list >>> Beginners at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >>> >>> >> > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -- Regards Sumit Sahrawat -------------- next part -------------- An HTML attachment was scrubbed... URL: From ky3 at atamo.com Wed Sep 23 08:48:13 2015 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Wed, 23 Sep 2015 15:48:13 +0700 Subject: [Haskell-beginners] Numeric Integer vs Integer In-Reply-To: References: Message-ID: On Wed, Sep 23, 2015 at 2:51 PM, goforgit . wrote: > What about the following? > > data List a = Empty | Add a (List a) > > What does the a mean and why is it possible to put it there? In addition to the good answers already given, it helps to think of it this way: Here's a list of Bools: data ListBool = EmptyListBool | AddListBool Bool ListBool Here's a list of Chars: data ListChar = EmptyListChar | AddListChar Char ListChar Here's a list of Ints: data ListInt = EmptyListInt | AddListInt Int ListInt Well just look at all that repetition! Surely there must be a way to keep DRY and abstract over all that? Let's see: what's common to all of the above? What stays the same? What changes? Here's something that tries to express and separate out what's "fixed" and what's "insert type here": data ListX = Empty | Add X ListX We're close. That almost but doesn't quite work, because Haskell treats capital X as a concrete type, like Bool and Char and Int. What we want is a type _variable_. And Haskell gives us that, if we use lower-case letters: data List x = Empty | Add x (List x) The parens is needed to distinguish against data List x = Empty | Add x List x which doesn't work for reasons you can probably guess. Finally, it's convention to use type variables a b c and not x y z. -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From teztingit at gmail.com Wed Sep 23 10:39:37 2015 From: teztingit at gmail.com (goforgit .) Date: Wed, 23 Sep 2015 12:39:37 +0200 Subject: [Haskell-beginners] Numeric Integer vs Integer In-Reply-To: References: Message-ID: Thank you guys, very good descriptions given on my question. Together with your answers and the analogy of it being somewhat similar to something in C++ made me understand how it works. Again many thanks! On Wed, Sep 23, 2015 at 10:48 AM, Kim-Ee Yeoh wrote: > > On Wed, Sep 23, 2015 at 2:51 PM, goforgit . wrote: > >> What about the following? >> >> data List a = Empty | Add a (List a) >> >> What does the a mean and why is it possible to put it there? > > > In addition to the good answers already given, it helps to think of it > this way: > > Here's a list of Bools: > > data ListBool = EmptyListBool | AddListBool Bool ListBool > > Here's a list of Chars: > > data ListChar = EmptyListChar | AddListChar Char ListChar > > Here's a list of Ints: > > data ListInt = EmptyListInt | AddListInt Int ListInt > > Well just look at all that repetition! > > Surely there must be a way to keep DRY and abstract over all that? > > Let's see: what's common to all of the above? What stays the same? What > changes? > > Here's something that tries to express and separate out what's "fixed" and > what's "insert type here": > > data ListX = Empty | Add X ListX > > We're close. > > That almost but doesn't quite work, because Haskell treats capital X as a > concrete type, like Bool and Char and Int. > > What we want is a type _variable_. And Haskell gives us that, if we use > lower-case letters: > > data List x = Empty | Add x (List x) > > The parens is needed to distinguish against > > data List x = Empty | Add x List x > > which doesn't work for reasons you can probably guess. > > Finally, it's convention to use type variables a b c and not x y z. > > -- Kim-Ee > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mlang at delysid.org Thu Sep 24 14:11:29 2015 From: mlang at delysid.org (Mario Lang) Date: Thu, 24 Sep 2015 16:11:29 +0200 Subject: [Haskell-beginners] Optimising a combinatorial algorithm? Message-ID: <87oagrq54e.fsf@fx.delysid.org> Hi! TL;DR: My implementation looks elegant (to me), but is rather slow compared to a well optimized C++ impl. of the same algorithm. Runtime differences are currently huge. Looking for input on what I could change to match C++ performance, without loosing too much expressiveness of the code. I am writing software to deal with Braille music code. As an exercise for me, and as an attempt to boil the algorithm down to a more readable form, I am in the process of translating my C++ program[1] to Haskell. So far, so good. Given that I only came back to Haskell (after 10 years of a break) roughly 2 weeks ago, I think I have made quite nice progress. However, now that I reached a stage where I can actually do a performance comparison, the dreaded thing has happened: The performance of my Haskell implementation is rather horrible to what my C++ implementation can deliver. While the code size has gone down roughly by a factor of 10, runtime has gone up roughly by the same factor... For the impatient, here is the code I am talking about: https://github.com/mlang/hbmc/blob/master/Data/Braille/Music.hs The first half of the code is concerend with parsing braille. Performance is not critical here, so I opted to use Parsec, mostly because I am interested in good quality error messages. The fun starts with the definition of 'pvs'. The problem: Braille music values are inherently ambiguous. The sign for a whole note can also mean a 16th note, a sign for a half note can also mean a 32th note, the sign for a quarter note can also mean a 64th, and a 8th note could also mean a 128th note. This is histoical, and there is no way around this. The time signature (meter) is used to actually tell which note is which. This is relatively easy to do for an experienced human, but quite complicated for a computer. A measure (bar) of braille music can contain parallel *and* sequential parts. The data structure is basically: data Sign = ... type PartialVoice = [Sign] type PartialMeasure = [PartialVoice] type Voice = [PartialMeasure] type Measure = [Voice] As a constraint, all PartialVoices in a PartialMeasure need to have the exact same duration. Similarily, all Voices inside a Measure also need to have the exact same duration. So 'pvs', 'pms', 'vs' and 'ms' in my Data.Braille.Music module are concerned with calculating all possible interpretations of the input. All in all, the current Haskell implementation is doing what it should. However, profiling tells me I am allocating roughly 2GB of memory to disambiguate a single measure of music in 3/2 time. This takes roughly 1.2s on my rather fast CPU. The amount of allocation and the runtime are unacceptable. If I leave it at that, I might as well ditch the code and terminate the experiment. As a comparison, my C++ impl. takes roughly 1s to disambiguate 32 measures of the same piece, while Haskell already takes 1.2s to disambiguate just one of these measures. Profiling tells me I am spending 90% of all the time in 'dur', which is my small helper method to calculate the duration of a PartialVoice, PartialMeasure or Voice. The project is setup to support profiling: git clone https://github.com/mlang/hbmc cd hbmc cabal run profiling Do you see a way to significantly speed this algorithm up, without loosing a lot of expressiveness/elegancy? Since I am back to Haskell since only 2 weeks, I am basically happy abut every sort of hint/tip you can give me. Stylistic, as well as performance-related. For now, this is really just a toy project. However, if I can manage to improve the performance significantly without destroying the readability of the code too much, I might be interested to finish translating my current C++ work into a more-or-less complete Haskell library. After all, BMC is more or less a compiler. And Haskell is supposed to be very good at this stuff :-) Here is a link to the original C++ project: [1] https://github.com/malng/bmc -- CYa, ????? From daniel.trstenjak at gmail.com Thu Sep 24 14:41:52 2015 From: daniel.trstenjak at gmail.com (Daniel Trstenjak) Date: Thu, 24 Sep 2015 16:41:52 +0200 Subject: [Haskell-beginners] Optimising a combinatorial algorithm? In-Reply-To: <87oagrq54e.fsf@fx.delysid.org> References: <87oagrq54e.fsf@fx.delysid.org> Message-ID: <20150924144152.GA9234@machine> Hi Mario, I just took a quick look on the implementation of 'dur' and as a first thing I would replace foldl with the strict version foldl'. This already might explain the memory usage. Greetings, Daniel From kaddkaka at gmail.com Thu Sep 24 14:51:11 2015 From: kaddkaka at gmail.com (David Moberg) Date: Thu, 24 Sep 2015 16:51:11 +0200 Subject: [Haskell-beginners] applicative style In-Reply-To: References: Message-ID: This mail got stuck in my spam filter because of auth reason. Bumping in case someone else who missed it wants to answer. 2015-08-28 19:12 GMT+02:00 Williams, Wes(AWF) : > Hi haskellers, > > I am trying to understand why I get the following error in learning > applicative style. > > Prelude> let estimates = [5,5,8,8,2,1,5,2] > > Prelude> (/) <$> Just $ foldl (+) 0 estimates <*> Just . fromIntegral $ > length estimates > > > :54:1: > > Non type-variable argument in the constraint: Fractional (Maybe r) > > (Use FlexibleContexts to permit this) > > When checking that ?it? has the inferred type > > it :: forall a r. > > (Fractional (Maybe r), Num a, Num (Int -> Maybe a -> r)) => > > Maybe r -> Maybe r > > All the parts work individually. If use let and assign the parts to x and > y it also works. > > E.g. This works > let x = Just $ foldl (+) estimates > Let y = Just . fromIntegral $ length estimates > (/) <$> x <*> y > > I clearly do not understand exactly how these work. :-) > > Thanks for any help, > -wes > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mlang at delysid.org Thu Sep 24 15:41:05 2015 From: mlang at delysid.org (Mario Lang) Date: Thu, 24 Sep 2015 17:41:05 +0200 Subject: [Haskell-beginners] applicative style In-Reply-To: (David Moberg's message of "Thu, 24 Sep 2015 16:51:11 +0200") References: Message-ID: <87lhbvg6zy.fsf@fx.delysid.org> David Moberg writes: > This mail got stuck in my spam filter because of auth reason. > Bumping in case someone else who missed it wants to answer. > > 2015-08-28 19:12 GMT+02:00 Williams, Wes(AWF) : > >> Hi haskellers, >> >> I am trying to understand why I get the following error in learning >> applicative style. >> >> Prelude> let estimates = [5,5,8,8,2,1,5,2] >> >> Prelude> (/) <$> Just $ foldl (+) 0 estimates <*> Just . fromIntegral $ length estimates I think $ is the culprit. You can not combine $ and <*> and get what you expect, because $ works on *the whole* expression: Prelude> (/) <$> Just (foldl (+) 0 estimates) <*> Just (fromIntegral (length estimates)) Just 4.5 Another problem was (.), you actually don't need any function composition here. -- CYa, ????? From teztingit at gmail.com Thu Sep 24 16:04:18 2015 From: teztingit at gmail.com (goforgit .) Date: Thu, 24 Sep 2015 18:04:18 +0200 Subject: [Haskell-beginners] foldl on Bool:s Message-ID: Reading http://learnyouahaskell.com/higher-order-functions I understand that with the function sum' :: (Num a) => [a] -> a sum' = foldl (+) 0 the call ghci>>> sum' [1,2,3] will be evaluated as 0 + 1 + 2 + 3 = 6 But what about the function elem' :: (Eq a) => a -> [a] -> Bool elem' y ys = foldl (\acc x -> if x == y then True else acc) False ys and calling it with ghci>>> elem' 3 [1,2,3] How is that evaluated to True by foldl in elem'? Thanks in advance for any explanation to this! -------------- next part -------------- An HTML attachment was scrubbed... URL: From mlang at delysid.org Thu Sep 24 16:42:32 2015 From: mlang at delysid.org (Mario Lang) Date: Thu, 24 Sep 2015 18:42:32 +0200 Subject: [Haskell-beginners] Optimising a combinatorial algorithm? In-Reply-To: <20150924144152.GA9234@machine> (Daniel Trstenjak's message of "Thu, 24 Sep 2015 16:41:52 +0200") References: <87oagrq54e.fsf@fx.delysid.org> <20150924144152.GA9234@machine> Message-ID: <871tdn22h3.fsf@fx.delysid.org> Daniel Trstenjak writes: > Hi Mario, > > I just took a quick look on the implementation of 'dur' > and as a first thing I would replace foldl with > the strict version foldl'. > > This already might explain the memory usage. foldl' helps a bit, but is not the main contributor to the overhead. Before: 1,954,532,728 bytes allocated in the heap After: 1,741,200,280 bytes allocated in the heap And runtime is more or less unaffected. -- CYa, ????? From chas at chas.io Thu Sep 24 16:42:45 2015 From: chas at chas.io (Chas Leichner) Date: Thu, 24 Sep 2015 09:42:45 -0700 Subject: [Haskell-beginners] Optimising a combinatorial algorithm? In-Reply-To: <20150924144152.GA9234@machine> References: <87oagrq54e.fsf@fx.delysid.org> <20150924144152.GA9234@machine> Message-ID: I haven't had a chance to test anything, but list operations are frequently problematic because they make it easy to accidentally write O(n^2) algorithms. Have you tried using Sequences or Vectors? I would expect one of them to give you better performance for your access patterns. On Thursday, September 24, 2015, Daniel Trstenjak < daniel.trstenjak at gmail.com> wrote: > > Hi Mario, > > I just took a quick look on the implementation of 'dur' > and as a first thing I would replace foldl with > the strict version foldl'. > > This already might explain the memory usage. > > Greetings, > Daniel > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From toad3k at gmail.com Thu Sep 24 18:07:15 2015 From: toad3k at gmail.com (David McBride) Date: Thu, 24 Sep 2015 14:07:15 -0400 Subject: [Haskell-beginners] Optimising a combinatorial algorithm? In-Reply-To: <87oagrq54e.fsf@fx.delysid.org> References: <87oagrq54e.fsf@fx.delysid.org> Message-ID: I tried memoizing dur in some places, but it gets called with too many different arguments to make it worthwhile. I tried change StateT to Strict.StateT. Last ditch effort, I tried making your data types strict, but that didn't help. The dur in your PartialVoice Duration instance gets called 3.5 million times. I don't know if you are going to find a magic bullet that makes this faster without tweaking your algorithm. I feel like their is a way to speed it up, maybe even exploit laziness to eliminate things early, but I'm just not familiar with this domain. Sorry On Thu, Sep 24, 2015 at 10:11 AM, Mario Lang wrote: > Hi! > > TL;DR: My implementation looks elegant (to me), but is rather slow > compared to a well optimized C++ impl. of the same algorithm. Runtime > differences are currently huge. Looking for input on what I could > change to match C++ performance, without loosing too much expressiveness > of the code. > > I am writing software to deal with Braille music code. > As an exercise for me, and as an attempt to boil the algorithm down > to a more readable form, I am in the process of translating my C++ > program[1] to Haskell. So far, so good. Given that I only came back to > Haskell (after 10 years of a break) roughly 2 weeks ago, I think I > have made quite nice progress. However, now that I reached a stage > where I can actually do a performance comparison, the dreaded thing has > happened: The performance of my Haskell implementation is rather > horrible to what my C++ implementation can deliver. While the code size > has gone down roughly by a factor of 10, runtime has gone up roughly by > the same factor... > > For the impatient, here is the code I am talking about: > https://github.com/mlang/hbmc/blob/master/Data/Braille/Music.hs > > The first half of the code is concerend with parsing braille. > Performance is not critical here, so I opted to use Parsec, mostly > because I am interested in good quality error messages. > > The fun starts with the definition of 'pvs'. > > The problem: > Braille music values are inherently ambiguous. The sign for a whole > note can also mean a 16th note, a sign for a half note can also > mean a 32th note, the sign for a quarter note can also mean a 64th, and > a 8th note could also mean a 128th note. This is histoical, and there > is no way around this. The time signature (meter) is used to actually > tell which note is which. This is relatively easy to do for an > experienced human, but quite complicated for a computer. > A measure (bar) of braille music can contain parallel *and* sequential > parts. The data structure is basically: > > data Sign = ... > type PartialVoice = [Sign] > type PartialMeasure = [PartialVoice] > type Voice = [PartialMeasure] > type Measure = [Voice] > > As a constraint, all PartialVoices in a PartialMeasure need to have the > exact same duration. Similarily, all Voices inside a Measure also need to > have the exact same duration. > > So 'pvs', 'pms', 'vs' and 'ms' in my Data.Braille.Music module are > concerned > with calculating all possible interpretations of the input. > > All in all, the current Haskell implementation is doing what it should. > However, profiling tells me I am allocating roughly 2GB of memory > to disambiguate a single measure of music in 3/2 time. > This takes roughly 1.2s on my rather fast CPU. > > The amount of allocation and the runtime are unacceptable. > If I leave it at that, I might as well ditch the code and terminate the > experiment. > As a comparison, my C++ impl. takes roughly 1s to disambiguate 32 measures > of > the same piece, while Haskell already takes 1.2s to disambiguate just > one of these measures. > > Profiling tells me I am spending 90% of all the time in 'dur', which is my > small helper method to calculate the duration of a PartialVoice, > PartialMeasure or Voice. > > The project is setup to support profiling: > > git clone https://github.com/mlang/hbmc > cd hbmc > cabal run profiling > > Do you see a way to significantly speed this algorithm up, without > loosing a lot of expressiveness/elegancy? > > Since I am back to Haskell since only 2 weeks, I am basically happy abut > every sort of hint/tip you can give me. Stylistic, as well as > performance-related. > > For now, this is really just a toy project. However, if I can manage to > improve the performance significantly without destroying the readability > of the code too much, I might be interested to finish translating my > current C++ work into a more-or-less complete Haskell library. > After all, BMC is more or less a compiler. > And Haskell is supposed to be very good at this stuff :-) > > Here is a link to the original C++ project: > [1] https://github.com/malng/bmc > > -- > CYa, > ????? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From k-bx at k-bx.com Thu Sep 24 19:45:21 2015 From: k-bx at k-bx.com (Kostiantyn Rybnikov) Date: Thu, 24 Sep 2015 22:45:21 +0300 Subject: [Haskell-beginners] foldl on Bool:s In-Reply-To: References: Message-ID: Hi. Your function gets passed numbers one by one in the place of x, and its previous result in the place of acc, and it returns a Bool. Initial value in place of acc parameter ("previous result") is put as False (since you begin with answer "no" to question "is it elem?"). Hope this helps. 24 ???. 2015 19:04 "goforgit ." ????: > Reading http://learnyouahaskell.com/higher-order-functions > > I understand that with the function > > sum' :: (Num a) => [a] -> a > sum' = foldl (+) 0 > > the call > > ghci>>> sum' [1,2,3] > > will be evaluated as > > 0 + 1 + 2 + 3 = 6 > > But what about the function > > elem' :: (Eq a) => a -> [a] -> Bool > elem' y ys = foldl (\acc x -> if x == y then True else acc) False ys > > and calling it with > > ghci>>> elem' 3 [1,2,3] > > How is that evaluated to True by foldl in elem'? > > Thanks in advance for any explanation to this! > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ozgurakgun at gmail.com Thu Sep 24 20:11:05 2015 From: ozgurakgun at gmail.com (Ozgur Akgun) Date: Thu, 24 Sep 2015 21:11:05 +0100 Subject: [Haskell-beginners] Optimising a combinatorial algorithm? In-Reply-To: <87oagrq54e.fsf@fx.delysid.org> References: <87oagrq54e.fsf@fx.delysid.org> Message-ID: On 24 September 2015 at 15:11, Mario Lang wrote: > Profiling tells me I am spending 90% of all the time in 'dur', which is my > small helper method to calculate the duration of a PartialVoice, > PartialMeasure or Voice. > As a start, and to aid profiling, I suggest getting rid of the Duration type class and giving explicit names to different dur functions. Which one of the dur's is getting called most? How do they interact? My hunch is that after you do this (something like) memoization to avoid calculating the durations repeatedly will be needed. Hope this helps, Ozgur PS: Cool problem! Do you have some input/output pairs available? If you can share some, others can validate their attempts without too much domain knowledge. -------------- next part -------------- An HTML attachment was scrubbed... URL: From mlang at delysid.org Thu Sep 24 21:18:25 2015 From: mlang at delysid.org (Mario Lang) Date: Thu, 24 Sep 2015 23:18:25 +0200 Subject: [Haskell-beginners] Optimising a combinatorial algorithm? In-Reply-To: (David McBride's message of "Thu, 24 Sep 2015 14:07:15 -0400") References: <87oagrq54e.fsf@fx.delysid.org> Message-ID: <87d1x7v7mm.fsf@fx.delysid.org> David McBride writes: > I tried memoizing dur in some places, but it gets called with too many > different arguments to make it worthwhile. Likely with all possible combinations from the input :-) > I tried change StateT to Strict.StateT. > Last ditch effort, I tried making your data types strict, but that didn't > help. > > The dur in your PartialVoice Duration instance gets called 3.5 million > times. I don't know if you are going to find a magic bullet that makes > this faster without tweaking your algorithm. I feel like their is a way to > speed it up, maybe even exploit laziness to eliminate things early, but I'm > just not familiar with this domain. Sorry lazyness is a good topic. I am not sure how it actually affects this algorithm. I wonder if my use of 'filter' is the actual culprit, and if I instead should try to rewrite the uses of 'traverse' to actually try and not generate invalid possibilities in the first place. Right now, I am sort of hoping lazyness would work together with filter being applied after all possibilities have been generated. Thanks for your time and insights. > On Thu, Sep 24, 2015 at 10:11 AM, Mario Lang wrote: > >> Hi! >> >> TL;DR: My implementation looks elegant (to me), but is rather slow >> compared to a well optimized C++ impl. of the same algorithm. Runtime >> differences are currently huge. Looking for input on what I could >> change to match C++ performance, without loosing too much expressiveness >> of the code. >> >> I am writing software to deal with Braille music code. >> As an exercise for me, and as an attempt to boil the algorithm down >> to a more readable form, I am in the process of translating my C++ >> program[1] to Haskell. So far, so good. Given that I only came back to >> Haskell (after 10 years of a break) roughly 2 weeks ago, I think I >> have made quite nice progress. However, now that I reached a stage >> where I can actually do a performance comparison, the dreaded thing has >> happened: The performance of my Haskell implementation is rather >> horrible to what my C++ implementation can deliver. While the code size >> has gone down roughly by a factor of 10, runtime has gone up roughly by >> the same factor... >> >> For the impatient, here is the code I am talking about: >> https://github.com/mlang/hbmc/blob/master/Data/Braille/Music.hs >> >> The first half of the code is concerend with parsing braille. >> Performance is not critical here, so I opted to use Parsec, mostly >> because I am interested in good quality error messages. >> >> The fun starts with the definition of 'pvs'. >> >> The problem: >> Braille music values are inherently ambiguous. The sign for a whole >> note can also mean a 16th note, a sign for a half note can also >> mean a 32th note, the sign for a quarter note can also mean a 64th, and >> a 8th note could also mean a 128th note. This is histoical, and there >> is no way around this. The time signature (meter) is used to actually >> tell which note is which. This is relatively easy to do for an >> experienced human, but quite complicated for a computer. >> A measure (bar) of braille music can contain parallel *and* sequential >> parts. The data structure is basically: >> >> data Sign = ... >> type PartialVoice = [Sign] >> type PartialMeasure = [PartialVoice] >> type Voice = [PartialMeasure] >> type Measure = [Voice] >> >> As a constraint, all PartialVoices in a PartialMeasure need to have the >> exact same duration. Similarily, all Voices inside a Measure also need to >> have the exact same duration. >> >> So 'pvs', 'pms', 'vs' and 'ms' in my Data.Braille.Music module are >> concerned >> with calculating all possible interpretations of the input. >> >> All in all, the current Haskell implementation is doing what it should. >> However, profiling tells me I am allocating roughly 2GB of memory >> to disambiguate a single measure of music in 3/2 time. >> This takes roughly 1.2s on my rather fast CPU. >> >> The amount of allocation and the runtime are unacceptable. >> If I leave it at that, I might as well ditch the code and terminate the >> experiment. >> As a comparison, my C++ impl. takes roughly 1s to disambiguate 32 measures >> of >> the same piece, while Haskell already takes 1.2s to disambiguate just >> one of these measures. >> >> Profiling tells me I am spending 90% of all the time in 'dur', which is my >> small helper method to calculate the duration of a PartialVoice, >> PartialMeasure or Voice. >> >> The project is setup to support profiling: >> >> git clone https://github.com/mlang/hbmc >> cd hbmc >> cabal run profiling >> >> Do you see a way to significantly speed this algorithm up, without >> loosing a lot of expressiveness/elegancy? >> >> Since I am back to Haskell since only 2 weeks, I am basically happy abut >> every sort of hint/tip you can give me. Stylistic, as well as >> performance-related. >> >> For now, this is really just a toy project. However, if I can manage to >> improve the performance significantly without destroying the readability >> of the code too much, I might be interested to finish translating my >> current C++ work into a more-or-less complete Haskell library. >> After all, BMC is more or less a compiler. >> And Haskell is supposed to be very good at this stuff :-) >> >> Here is a link to the original C++ project: >> [1] https://github.com/malng/bmc >> >> -- >> CYa, >> ????? >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners -- CYa, ????? | Debian Developer .''`. | Get my public key via finger mlang/key at db.debian.org : :' : | 1024D/7FC1A0854909BCCDBE6C102DDFFC022A6B113E44 `. `' `- From teztingit at gmail.com Fri Sep 25 18:10:26 2015 From: teztingit at gmail.com (goforgit .) Date: Fri, 25 Sep 2015 20:10:26 +0200 Subject: [Haskell-beginners] Numeric Integer vs Integer In-Reply-To: References: Message-ID: Again, I have a follow up question related to that list. Is it possible to make the list an instance of something in order to use for example takeWhile on List? Thanks in advance! On Wed, Sep 23, 2015 at 9:51 AM, goforgit . wrote: > I have a follow up question, I hope it's alright. > > What about the following? > > data List a = Empty | Add a (List a) > > What does the a mean and why is it possible to put it there? > > > On Tue, Sep 22, 2015 at 4:54 PM, goforgit . wrote: > >> Thanks Brandon, that cleared things up! >> >> On Mon, Sep 21, 2015 at 8:39 PM, Brandon Allbery >> wrote: >> >>> >>> On Mon, Sep 21, 2015 at 2:23 PM, goforgit . wrote: >>> >>>> Could someone explain to me the difference between the following? >>>> >>>> data Atype = Numeric Integer | A | B C >>>> >>>> and >>>> >>>> data Atype = Integer | A | B C >>>> >>> >>> The second one is an enumeration with three values: "Integer" (which is >>> *not* an integer, nor does it contain one), "A", and "B" which as written >>> there takes a value of some unspecified type C as a parameter. >>> The first one is a enumeration with three values: "Numeric" which takes >>> an Integer as a parameter, "A", and "B" which takes a value of some >>> unspecified type C as a parameter. >>> >>> Note that the "Integer" in the second one has *nothing whatsoever* to do >>> with the *type* Integer. >>> >>> Remember that you must always provide a data constructor with "data"; >>> you cannot simply say "data MyInt = Integer" to "wrap" an Integer, because >>> you have not said what to wrap it *in*. (You may have intended to create a >>> type alias, though; that would be "type", not "data".) A "data" always >>> requires a data constructor name, so the compiler can tell when you are >>> talking about a value of that type by looking for the constructor. >>> >>> -- >>> brandon s allbery kf8nh sine nomine >>> associates >>> allbery.b at gmail.com >>> ballbery at sinenomine.net >>> unix, openafs, kerberos, infrastructure, xmonad >>> http://sinenomine.net >>> >>> _______________________________________________ >>> Beginners mailing list >>> Beginners at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >>> >>> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From teztingit at gmail.com Fri Sep 25 18:10:50 2015 From: teztingit at gmail.com (goforgit .) Date: Fri, 25 Sep 2015 20:10:50 +0200 Subject: [Haskell-beginners] foldl on Bool:s In-Reply-To: References: Message-ID: Thanks I got it now :) On Thu, Sep 24, 2015 at 9:45 PM, Kostiantyn Rybnikov wrote: > Hi. > > Your function gets passed numbers one by one in the place of x, and its > previous result in the place of acc, and it returns a Bool. Initial value > in place of acc parameter ("previous result") is put as False (since you > begin with answer "no" to question "is it elem?"). > > Hope this helps. > 24 ???. 2015 19:04 "goforgit ." ????: > >> Reading http://learnyouahaskell.com/higher-order-functions >> >> I understand that with the function >> >> sum' :: (Num a) => [a] -> a >> sum' = foldl (+) 0 >> >> the call >> >> ghci>>> sum' [1,2,3] >> >> will be evaluated as >> >> 0 + 1 + 2 + 3 = 6 >> >> But what about the function >> >> elem' :: (Eq a) => a -> [a] -> Bool >> elem' y ys = foldl (\acc x -> if x == y then True else acc) False ys >> >> and calling it with >> >> ghci>>> elem' 3 [1,2,3] >> >> How is that evaluated to True by foldl in elem'? >> >> Thanks in advance for any explanation to this! >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> >> > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From allbery.b at gmail.com Fri Sep 25 18:20:29 2015 From: allbery.b at gmail.com (Brandon Allbery) Date: Fri, 25 Sep 2015 14:20:29 -0400 Subject: [Haskell-beginners] Numeric Integer vs Integer In-Reply-To: References: Message-ID: On Fri, Sep 25, 2015 at 2:10 PM, goforgit . wrote: > Is it possible to make the list an instance of something in order to use > for example takeWhile on List? Not presently for takeWhile; it's specific to the built-in list type. Things are gradually being migrated to Foldable and Traversable, though. -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From teztingit at gmail.com Fri Sep 25 19:02:04 2015 From: teztingit at gmail.com (goforgit .) Date: Fri, 25 Sep 2015 21:02:04 +0200 Subject: [Haskell-beginners] Numeric Integer vs Integer In-Reply-To: References: Message-ID: Alrighty then, thanks brandon! On Fri, Sep 25, 2015 at 8:20 PM, Brandon Allbery wrote: > On Fri, Sep 25, 2015 at 2:10 PM, goforgit . wrote: > >> Is it possible to make the list an instance of something in order to use >> for example takeWhile on List? > > > Not presently for takeWhile; it's specific to the built-in list type. > Things are gradually being migrated to Foldable and Traversable, though. > > -- > brandon s allbery kf8nh sine nomine > associates > allbery.b at gmail.com > ballbery at sinenomine.net > unix, openafs, kerberos, infrastructure, xmonad > http://sinenomine.net > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From rein.henrichs at gmail.com Fri Sep 25 22:16:23 2015 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Fri, 25 Sep 2015 22:16:23 +0000 Subject: [Haskell-beginners] foldl on Bool:s In-Reply-To: References: Message-ID: Note that you would like the elem function to stop at the matching element and return True rather than checking the rest of the list needlessy, which can be done with foldr but not with foldl. The actual implementation of elem does this, so you can say: > elem 1 [1..] True which would fail to terminate with the foldl version. On Fri, Sep 25, 2015 at 11:10 AM goforgit . wrote: > Thanks I got it now :) > > On Thu, Sep 24, 2015 at 9:45 PM, Kostiantyn Rybnikov > wrote: > >> Hi. >> >> Your function gets passed numbers one by one in the place of x, and its >> previous result in the place of acc, and it returns a Bool. Initial value >> in place of acc parameter ("previous result") is put as False (since you >> begin with answer "no" to question "is it elem?"). >> >> Hope this helps. >> 24 ???. 2015 19:04 "goforgit ." ????: >> >>> Reading http://learnyouahaskell.com/higher-order-functions >>> >>> I understand that with the function >>> >>> sum' :: (Num a) => [a] -> a >>> sum' = foldl (+) 0 >>> >>> the call >>> >>> ghci>>> sum' [1,2,3] >>> >>> will be evaluated as >>> >>> 0 + 1 + 2 + 3 = 6 >>> >>> But what about the function >>> >>> elem' :: (Eq a) => a -> [a] -> Bool >>> elem' y ys = foldl (\acc x -> if x == y then True else acc) False ys >>> >>> and calling it with >>> >>> ghci>>> elem' 3 [1,2,3] >>> >>> How is that evaluated to True by foldl in elem'? >>> >>> Thanks in advance for any explanation to this! >>> >>> _______________________________________________ >>> Beginners mailing list >>> Beginners at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >>> >>> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> >> > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From jamb at hinojosa.com Fri Sep 25 23:18:08 2015 From: jamb at hinojosa.com (jamb at hinojosa.com) Date: Fri, 25 Sep 2015 18:18:08 -0500 Subject: [Haskell-beginners] Get max element of a list using foldl or foldr Message-ID: Hello, I am a complete Haskell beginner and I am doing some exercises of my book but I am stuck with the following: Define myMax :: Ord a => [a] -> a which returns the maximum element of a list. I must use foldl1 or foldr1 and I am given the hint to use max which gets the maximum of 2 elements. I will very much appreciate if you help me solve it. Thanks in advance, JAMB From fa-ml at ariis.it Fri Sep 25 23:57:32 2015 From: fa-ml at ariis.it (Francesco Ariis) Date: Sat, 26 Sep 2015 01:57:32 +0200 Subject: [Haskell-beginners] Get max element of a list using foldl or foldr In-Reply-To: References: Message-ID: <20150925235732.GA3813@casa.casa> On Fri, Sep 25, 2015 at 06:18:08PM -0500, jamb at hinojosa.com wrote: > Hello, > > I am a complete Haskell beginner and I am doing some exercises of my book > but I am stuck with the following: > > Define > myMax :: Ord a => [a] -> a > which returns the maximum element of a list. > > I must use foldl1 or foldr1 and I am given the hint to use max which gets > the maximum of 2 elements. > > I will very much appreciate if you help me solve it. Let's say you have foldl1 f [1,7,2,5] where f is a binary operator (a function that 'takes two parameters'). `foldl1` will apply 1 and 7 to f, obtaining X, so we have: X and [2,5] then it will apply X and 2 to f, obtaining Y, so we're left with Y and 5 and finally `f Y 5`, leading to your final result Z. Now, if `f a b = a + b`, we would have [1,7,2,5] -- 1+7 8 [2,5] -- 8+2 10 [5] -- 10+5 15 <-- final result But you aren't interested in the sum of the list, but its maximum. Which operation could you use instead of (+) to achieve your goal? From jamb at hinojosa.com Sat Sep 26 00:10:58 2015 From: jamb at hinojosa.com (jamb at hinojosa.com) Date: Fri, 25 Sep 2015 19:10:58 -0500 Subject: [Haskell-beginners] Get max element of a list using foldl or foldr In-Reply-To: <20150925235732.GA3813@casa.casa> References: <20150925235732.GA3813@casa.casa> Message-ID: <5f61f1c87cb2e17eedc28fb2f1ccf21e@hinojosa.com> El 2015-09-25 18:57, Francesco Ariis escribi?: > On Fri, Sep 25, 2015 at 06:18:08PM -0500, jamb at hinojosa.com wrote: >> Hello, >> >> I am a complete Haskell beginner and I am doing some exercises of my >> book >> but I am stuck with the following: >> >> Define >> myMax :: Ord a => [a] -> a >> which returns the maximum element of a list. >> >> I must use foldl1 or foldr1 and I am given the hint to use max which >> gets >> the maximum of 2 elements. >> >> I will very much appreciate if you help me solve it. > > Let's say you have > > foldl1 f [1,7,2,5] > > where f is a binary operator (a function that 'takes two parameters'). > `foldl1` will apply 1 and 7 to f, obtaining X, so we have: > > X and [2,5] > > then it will apply X and 2 to f, obtaining Y, so we're left with > > Y and 5 > > and finally `f Y 5`, leading to your final result Z. > > Now, if `f a b = a + b`, we would have > > [1,7,2,5] -- 1+7 > 8 [2,5] -- 8+2 > 10 [5] -- 10+5 > 15 <-- final result > > But you aren't interested in the sum of the list, but its maximum. > Which operation could you use instead of (+) to achieve your goal? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners I?ve got it! I tried the following successfully: myMax [] = error "List is empty." myMax xs = foldl1 (max) xs I see that my problem was in understanding the way max was applied to a list. Thanks for your kind support. From rein.henrichs at gmail.com Sat Sep 26 03:31:43 2015 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Sat, 26 Sep 2015 03:31:43 +0000 Subject: [Haskell-beginners] Get max element of a list using foldl or foldr In-Reply-To: <5f61f1c87cb2e17eedc28fb2f1ccf21e@hinojosa.com> References: <20150925235732.GA3813@casa.casa> <5f61f1c87cb2e17eedc28fb2f1ccf21e@hinojosa.com> Message-ID: The parens around max are unnecessary: myMax xs = foldl1 max xs On Fri, Sep 25, 2015 at 5:13 PM wrote: > El 2015-09-25 18:57, Francesco Ariis escribi?: > > On Fri, Sep 25, 2015 at 06:18:08PM -0500, jamb at hinojosa.com wrote: > >> Hello, > >> > >> I am a complete Haskell beginner and I am doing some exercises of my > >> book > >> but I am stuck with the following: > >> > >> Define > >> myMax :: Ord a => [a] -> a > >> which returns the maximum element of a list. > >> > >> I must use foldl1 or foldr1 and I am given the hint to use max which > >> gets > >> the maximum of 2 elements. > >> > >> I will very much appreciate if you help me solve it. > > > > Let's say you have > > > > foldl1 f [1,7,2,5] > > > > where f is a binary operator (a function that 'takes two parameters'). > > `foldl1` will apply 1 and 7 to f, obtaining X, so we have: > > > > X and [2,5] > > > > then it will apply X and 2 to f, obtaining Y, so we're left with > > > > Y and 5 > > > > and finally `f Y 5`, leading to your final result Z. > > > > Now, if `f a b = a + b`, we would have > > > > [1,7,2,5] -- 1+7 > > 8 [2,5] -- 8+2 > > 10 [5] -- 10+5 > > 15 <-- final result > > > > But you aren't interested in the sum of the list, but its maximum. > > Which operation could you use instead of (+) to achieve your goal? > > _______________________________________________ > > Beginners mailing list > > Beginners at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > > > > I?ve got it! > I tried the following successfully: > > myMax [] = error "List is empty." > myMax xs = foldl1 (max) xs > > I see that my problem was in understanding the way max was applied to a > list. > > > Thanks for your kind support. > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From andrew.bernard at gmail.com Fri Sep 25 23:59:13 2015 From: andrew.bernard at gmail.com (Andrew Bernard) Date: Sat, 26 Sep 2015 09:59:13 +1000 Subject: [Haskell-beginners] Get max element of a list using foldl or foldr In-Reply-To: References: Message-ID: <7F5C3FC3-F4A3-4C6C-9EB0-155C33B1605F@gmail.com> Hi JAMB, If I just show an answer if defeats the purpose of the exercise, but just use max in a lambda function for the fold. But, you need to consider what the maximum of an empty list is. Since it is hard to say what it may be, may I suggest you return a Maybe value for your function, and don?t forget to cover the case of the empty list []. Andrew From bh at intevation.de Sat Sep 26 14:55:05 2015 From: bh at intevation.de (Bernhard Herzog) Date: Sat, 26 Sep 2015 16:55:05 +0200 Subject: [Haskell-beginners] Optimising a combinatorial algorithm? In-Reply-To: <87oagrq54e.fsf@fx.delysid.org> References: <87oagrq54e.fsf@fx.delysid.org> Message-ID: <201509261655.05852.bh@intevation.de> On 24.09.2015, Mario Lang wrote: > TL;DR: My implementation looks elegant (to me), but is rather slow > compared to a well optimized C++ impl. of the same algorithm. Runtime > differences are currently huge. Looking for input on what I could > change to match C++ performance, without loosing too much expressiveness > of the code. [...] > Profiling tells me I am spending 90% of all the time in 'dur', which is my > small helper method to calculate the duration of a PartialVoice, > PartialMeasure or Voice. > > The project is setup to support profiling: > > git clone https://github.com/mlang/hbmc > cd hbmc > cabal run profiling Some performance tips: AFAICT, the main reason the dur methods are so slow is they traverses the lists much too often. An easy way to reduce that number is to cache the duration of lists of Sign values in PartialVoice by replacing the type alias with a new data type like this: data PartialVoice = PV (Maybe Rational) [Sign] To always initialize the duration when constructing a PartialVoice, a helper function is useful: mkPV signs = PV (sumDuration signs) signs Here sumDuration is defined in the same way as the current dur method for PartialVoice: sumDuration :: Duration a => [a] -> Maybe Rational sumDuration = foldl' (liftA2 (+)) (pure 0) . map dur The dur method for PartialVoice can then be implemented by simply accessing the cached value: instance Duration PartialVoice where dur (PV d _) = d Since that parameter of PV is lazy the actual sum is only computed when the value is needed and for any given PV value it is computed at most once. On my system, that change alone improved the running time by a factor of almost 10 according to the profiler output. The type Voice can obviously be treated in a similar way. Some other changes that can improve the speed: Use Integer instead of Rational. This should be possible since all duration values appear to be integer multiples of 1/128, so you can just represent them by that factor and use a newtype wrapper for increased type safety. Parameterize Sign with the type of the duration. AFAICT the only reason to wrap the duration in a Maybe is that you cannot assign a duration during parsing, so the parsers always assign Nothing as duration. The pvs function will always assign a Just-value to each Sign, however. So after parsing, the Measure has Nothing for the duration in every Sign, but the Measures returned by ms always have Just values. You you could express this in the types by parameterizing Sign and the other types with the type of a duration. The parser would then create e.g. Sign () values and pvs would turn those into e.g. Sign Rational values. This improves type safety, makes the meaning clearer and simplifies the code because you don't need to lift operations into the Maybe or do case analyses. Some stylistic things: instance Duration Measure where dur m = case m of [] -> Nothing; otherwise -> dur (head m) would better be written like this: instance Duration Measure where dur [] = Nothing dur (x:_) = dur x I.e. try not to use head. Use pattern matching instead. Particularly in cases like this, where you already pattern match on the list in question. This applies to some other functions as well, e.g. allEqDur. Also, if you want to ignore parts of a pattern match, use "_" as the pattern, not "otherwise". In the way you used it, it introduces a new binding in that branch of the case expression and shadows the definition from the Prelude. Idiomatic use of "otherwise" is as the condition on the catch-all case of a guard. If you compile your code with GHC's -Wall option it warns about this and other things. Bernhard From teztingit at gmail.com Sun Sep 27 08:28:50 2015 From: teztingit at gmail.com (goforgit .) Date: Sun, 27 Sep 2015 10:28:50 +0200 Subject: [Haskell-beginners] foldl on Bool:s In-Reply-To: References: Message-ID: Interesting, I did not know that, thank you! On Sat, Sep 26, 2015 at 12:16 AM, Rein Henrichs wrote: > Note that you would like the elem function to stop at the matching element > and return True rather than checking the rest of the list needlessy, which > can be done with foldr but not with foldl. The actual implementation of > elem does this, so you can say: > > > elem 1 [1..] > True > > which would fail to terminate with the foldl version. > > On Fri, Sep 25, 2015 at 11:10 AM goforgit . wrote: > >> Thanks I got it now :) >> >> On Thu, Sep 24, 2015 at 9:45 PM, Kostiantyn Rybnikov >> wrote: >> >>> Hi. >>> >>> Your function gets passed numbers one by one in the place of x, and its >>> previous result in the place of acc, and it returns a Bool. Initial value >>> in place of acc parameter ("previous result") is put as False (since you >>> begin with answer "no" to question "is it elem?"). >>> >>> Hope this helps. >>> 24 ???. 2015 19:04 "goforgit ." ????: >>> >>>> Reading http://learnyouahaskell.com/higher-order-functions >>>> >>>> I understand that with the function >>>> >>>> sum' :: (Num a) => [a] -> a >>>> sum' = foldl (+) 0 >>>> >>>> the call >>>> >>>> ghci>>> sum' [1,2,3] >>>> >>>> will be evaluated as >>>> >>>> 0 + 1 + 2 + 3 = 6 >>>> >>>> But what about the function >>>> >>>> elem' :: (Eq a) => a -> [a] -> Bool >>>> elem' y ys = foldl (\acc x -> if x == y then True else acc) False ys >>>> >>>> and calling it with >>>> >>>> ghci>>> elem' 3 [1,2,3] >>>> >>>> How is that evaluated to True by foldl in elem'? >>>> >>>> Thanks in advance for any explanation to this! >>>> >>>> _______________________________________________ >>>> Beginners mailing list >>>> Beginners at haskell.org >>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >>>> >>>> >>> _______________________________________________ >>> Beginners mailing list >>> Beginners at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >>> >>> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mlang at delysid.org Tue Sep 29 13:37:43 2015 From: mlang at delysid.org (Mario Lang) Date: Tue, 29 Sep 2015 15:37:43 +0200 Subject: [Haskell-beginners] Optimising a combinatorial algorithm? In-Reply-To: <201509261655.05852.bh@intevation.de> (Bernhard Herzog's message of "Sat, 26 Sep 2015 16:55:05 +0200") References: <87oagrq54e.fsf@fx.delysid.org> <201509261655.05852.bh@intevation.de> Message-ID: <87y4fptkgo.fsf@fx.delysid.org> Bernhard Herzog writes: > On 24.09.2015, Mario Lang wrote: >> TL;DR: My implementation looks elegant (to me), but is rather slow >> compared to a well optimized C++ impl. of the same algorithm. Runtime >> differences are currently huge. Looking for input on what I could >> change to match C++ performance, without loosing too much expressiveness >> of the code. > [...] >> Profiling tells me I am spending 90% of all the time in 'dur', which is my >> small helper method to calculate the duration of a PartialVoice, >> PartialMeasure or Voice. >> >> The project is setup to support profiling: >> >> git clone https://github.com/mlang/hbmc >> cd hbmc >> cabal run profiling > > Some performance tips: > > AFAICT, the main reason the dur methods are so slow is they traverses > the lists much too often. An easy way to reduce that number is to cache > the duration of lists of Sign values in PartialVoice by replacing the > type alias with a new data type like this: > > data PartialVoice = PV (Maybe Rational) [Sign] > > To always initialize the duration when constructing a PartialVoice, a > helper function is useful: > > mkPV signs = PV (sumDuration signs) signs > > Here sumDuration is defined in the same way as the current dur method > for PartialVoice: > > sumDuration :: Duration a => [a] -> Maybe Rational > sumDuration = foldl' (liftA2 (+)) (pure 0) . map dur > > The dur method for PartialVoice can then be implemented by simply > accessing the cached value: > > instance Duration PartialVoice where > > dur (PV d _) = d > > Since that parameter of PV is lazy the actual sum is only computed when > the value is needed and for any given PV value it is computed at most > once. > > On my system, that change alone improved the running time by a factor of > almost 10 according to the profiler output. Confirmed (committed). Thanks a lot! This indeed brought a factor of 10 speedup. I wonder why the attempts to memoize dur by other people did not help at all. After all, this is just another type of memoisation, isn't it? > Some other changes that can improve the speed: > > Use Integer instead of Rational. > > This should be possible since all duration values appear to be integer > multiples of 1/128, so you can just represent them by that factor and > use a newtype wrapper for increased type safety. I will eventually have to deal with musical tuplets, so it is not just 128th values. I see your point, but I am going to delay that optimisation until I know I really need it. > Parameterize Sign with the type of the duration. > > AFAICT the only reason to wrap the duration in a Maybe is that you > cannot assign a duration during parsing, so the parsers always assign > Nothing as duration. The pvs function will always assign a Just-value to > each Sign, however. So after parsing, the Measure has Nothing for the > duration in every Sign, but the Measures returned by ms always have Just > values. You you could express this in the types by parameterizing Sign > and the other types with the type of a duration. The parser would then > create e.g. Sign () values and pvs would turn those into e.g. Sign > Rational values. That is a good idea I was already thinking about. Actually, what I am trying to figure out is how to do closely related, but different, datatypes in Haskell. In C++, I am used to being able to inherit from an existing class, just adding the new fields I need. This works without name clashes obviously because two classes can have the same field names without clashing. However, I am missing something like this from Haskell. What I actually need in the long run, is a separate data type for every enhancement step in my post-processing. I current have AmbiguousSign and Sign. However, I will need more types like this, with every step, I'd like to add yet another field, which is going to be computed by that step. AFAIU the parametrisation trick you mention above works for a single field. How would I go about progressively adding more and more fields to a base data type? > This improves type safety, makes the meaning clearer and simplifies the > code because you don't need to lift operations into the Maybe or do case > analyses. I agree. Doing away with the Maybe was a good thing. > Also, if you want to ignore parts of a pattern match, use "_" as the > pattern, not "otherwise". In the way you used it, it introduces a new > binding in that branch of the case expression and shadows the definition > from the Prelude. Idiomatic use of "otherwise" is as the condition on > the catch-all case of a guard. Oh, thanks for pointing that out, I didn't realize at all that otherwise doesn't work like expected in "normal" case expressions. -- CYa, ????? From jamb at hinojosa.com Tue Sep 29 14:10:48 2015 From: jamb at hinojosa.com (jamb at hinojosa.com) Date: Tue, 29 Sep 2015 09:10:48 -0500 Subject: [Haskell-beginners] Help with a data type declaration Message-ID: How can I interpret the following data type declaration? The book where I am studying (and other sources I have read as well) only show more simple examples. This is what I can say about it: * "Tree" is the name of the new type. * "Branch" and "Leaf" are the type constructors. * What is "a" and "b"? * It seems to me that this type is kind of "recursively" defined but I do not know exactly. data Tree a b = Branch b (Tree a b) (Tree a b) | Leaf a I will very much appreciate your feedback. Regards, JAMB From objitsu at gmail.com Tue Sep 29 15:10:15 2015 From: objitsu at gmail.com (emacstheviking) Date: Tue, 29 Sep 2015 16:10:15 +0100 Subject: [Haskell-beginners] Help with a data type declaration In-Reply-To: References: Message-ID: a = left b = right That would at least make the sentiment clearer. On 29 September 2015 at 15:10, wrote: > How can I interpret the following data type declaration? The book where I > am studying (and other sources I have read as well) only show more simple > examples. This is what I can say about it: > > * "Tree" is the name of the new type. > * "Branch" and "Leaf" are the type constructors. > * What is "a" and "b"? > * It seems to me that this type is kind of "recursively" defined but I do > not know exactly. > > > data Tree a b = Branch b (Tree a b) (Tree a b) > | Leaf a > > I will very much appreciate your feedback. > > Regards, > JAMB > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From objitsu at gmail.com Tue Sep 29 15:10:56 2015 From: objitsu at gmail.com (emacstheviking) Date: Tue, 29 Sep 2015 16:10:56 +0100 Subject: [Haskell-beginners] Help with a data type declaration In-Reply-To: References: Message-ID: Is the definition of Branch correct though, shouldn't it be Branch (Tree a b) (Tree a b) ...? On 29 September 2015 at 16:10, emacstheviking wrote: > a = left b = right > > That would at least make the sentiment clearer. > > > > On 29 September 2015 at 15:10, wrote: > >> How can I interpret the following data type declaration? The book where I >> am studying (and other sources I have read as well) only show more simple >> examples. This is what I can say about it: >> >> * "Tree" is the name of the new type. >> * "Branch" and "Leaf" are the type constructors. >> * What is "a" and "b"? >> * It seems to me that this type is kind of "recursively" defined but I do >> not know exactly. >> >> >> data Tree a b = Branch b (Tree a b) (Tree a b) >> | Leaf a >> >> I will very much appreciate your feedback. >> >> Regards, >> JAMB >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From toad3k at gmail.com Tue Sep 29 15:22:37 2015 From: toad3k at gmail.com (David McBride) Date: Tue, 29 Sep 2015 11:22:37 -0400 Subject: [Haskell-beginners] Help with a data type declaration In-Reply-To: References: Message-ID: It just stores a 'b' on every branch and an 'a' on every leaf. I'm not sure what you'd use it for, but there's nothing wrong with it. On Tue, Sep 29, 2015 at 11:10 AM, emacstheviking wrote: > Is the definition of Branch correct though, shouldn't it be Branch (Tree a > b) (Tree a b) ...? > > > On 29 September 2015 at 16:10, emacstheviking wrote: > >> a = left b = right >> >> That would at least make the sentiment clearer. >> >> >> >> On 29 September 2015 at 15:10, wrote: >> >>> How can I interpret the following data type declaration? The book where >>> I am studying (and other sources I have read as well) only show more simple >>> examples. This is what I can say about it: >>> >>> * "Tree" is the name of the new type. >>> * "Branch" and "Leaf" are the type constructors. >>> * What is "a" and "b"? >>> * It seems to me that this type is kind of "recursively" defined but I >>> do not know exactly. >>> >>> >>> data Tree a b = Branch b (Tree a b) (Tree a b) >>> | Leaf a >>> >>> I will very much appreciate your feedback. >>> >>> Regards, >>> JAMB >>> _______________________________________________ >>> Beginners mailing list >>> Beginners at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >>> >> >> > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From karl at karlv.net Tue Sep 29 15:27:59 2015 From: karl at karlv.net (Karl Voelker) Date: Tue, 29 Sep 2015 08:27:59 -0700 Subject: [Haskell-beginners] Help with a data type declaration In-Reply-To: References: Message-ID: <1443540479.2900266.396621081.1261A474@webmail.messagingengine.com> On Tue, Sep 29, 2015, at 07:10 AM, jamb at hinojosa.com wrote: > * "Tree" is the name of the new type. > * "Branch" and "Leaf" are the type constructors. > * What is "a" and "b"? "Tree" is not quite the name of a type. It is the name of a type constructor - in other words, it is a "type-level function". This also explains "a" and "b" - they are the parameters to the type constructor (which means they are "type variables"). To get a type, you have to apply the type constructor. So, for example, "Tree Char Int" is a type. "Branch" and "Leaf" are not type constructors - they are *data* constructors. > * It seems to me that this type is kind of "recursively" defined but I > do not know exactly. Yes. It's recursive because a value of type "Tree a b" can be built up from other values of type "Tree a b" (if you use the "Branch" constructor). -Karl From sumit.sahrawat.apm13 at iitbhu.ac.in Tue Sep 29 15:35:47 2015 From: sumit.sahrawat.apm13 at iitbhu.ac.in (Sumit Sahrawat, Maths & Computing, IIT (BHU)) Date: Tue, 29 Sep 2015 21:05:47 +0530 Subject: [Haskell-beginners] Help with a data type declaration In-Reply-To: <1443540479.2900266.396621081.1261A474@webmail.messagingengine.com> References: <1443540479.2900266.396621081.1261A474@webmail.messagingengine.com> Message-ID: This Wikipedia article is a good read for getting the concepts right: https://en.wikipedia.org/wiki/Algebraic_data_type On 29 September 2015 at 20:57, Karl Voelker wrote: > On Tue, Sep 29, 2015, at 07:10 AM, jamb at hinojosa.com wrote: > > * "Tree" is the name of the new type. > > * "Branch" and "Leaf" are the type constructors. > > * What is "a" and "b"? > > "Tree" is not quite the name of a type. It is the name of a type > constructor - in other words, it is a "type-level function". This also > explains "a" and "b" - they are the parameters to the type constructor > (which means they are "type variables"). > > To get a type, you have to apply the type constructor. So, for example, > "Tree Char Int" is a type. > > "Branch" and "Leaf" are not type constructors - they are *data* > constructors. > > > * It seems to me that this type is kind of "recursively" defined but I > > do not know exactly. > > Yes. It's recursive because a value of type "Tree a b" can be built up > from other values of type "Tree a b" (if you use the "Branch" > constructor). > > -Karl > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Regards Sumit Sahrawat -------------- next part -------------- An HTML attachment was scrubbed... URL: From andrew.bernard at gmail.com Wed Sep 30 04:22:21 2015 From: andrew.bernard at gmail.com (Andrew Bernard) Date: Wed, 30 Sep 2015 14:22:21 +1000 Subject: [Haskell-beginners] State and Maybe and monad transformers Message-ID: <30BD7F82-598F-47D1-80B3-137101DA696F@gmail.com> Greetings All, I am writing code using a BankersDequeue from Data.Dequeue. I?d like to wrap the push and pop operations in a state monad for the standard reason, to avoid passing the dequeue around between function calls, and regard it as state instead, which it is. Wishing to avoid throwing a runtime error if the queue is empty (for the general case of queues) I have written a reduction of the concept using a crude stack to experiment, which uses State and Maybe. I notice that there are very few examples of using State and Maybe together. My questions are: Is this a faulty design pattern? Should this be done with monad transformers? Are there examples to be found of using State with Maybe as a monad transformer combination? Why is this pattern relatively rare, it seems? Is this program on the right track? Andrew ? snip module Main where import Control.Monad.State type Stack = [Int] popIt :: Stack -> (Maybe Int, Stack) popIt [] = (Nothing, []) popIt (x:xs) = (Just x, xs) pop :: State Stack (Maybe Int) pop = state popIt push :: Int -> State Stack (Maybe ()) push a = state $ \xs -> (Just (), a:xs) main = do let a = evalState (do push 3 push 2 push 1 pop pop a <- pop return a ) [] print a ? snip From andrew.bernard at gmail.com Mon Sep 28 15:15:04 2015 From: andrew.bernard at gmail.com (Andrew Bernard) Date: Tue, 29 Sep 2015 01:15:04 +1000 Subject: [Haskell-beginners] Haskell package maturity Message-ID: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> Since starting to look on Hackage for packages for such vital things as queues and algorithms, I am surprised to see very low numbers of downloads for packages that seem to me to be vitally important. For example, queuelike has only been downloaded 1617 times since being uploaded in 2009. Similar very low numbers seem to apply for many packages. Another example is cubicspline with only 485 downloads. My question is, are the numbers on Hackage correct, and if so, do they indicate hardly anybody uses them, or indeed Haskell? I am starting to wonder. I also notice version numbers are very low, often less than one and most often around 0.1 or so. This is either a display of extreme modesty on the part of Haskell library code developers (in fact, often found in open source communities), or an indication of lack of maturity of the code. Overall I am puzzled about this. I am trying to establish what packages to use in my coding and there seems to be little indication of what to choose, and how to assess code maturity. What am I missing? Andrew -------------- next part -------------- An HTML attachment was scrubbed... URL: From ben.kolera at gmail.com Wed Sep 30 05:44:05 2015 From: ben.kolera at gmail.com (Ben Kolera) Date: Wed, 30 Sep 2015 05:44:05 +0000 Subject: [Haskell-beginners] State and Maybe and monad transformers In-Reply-To: <30BD7F82-598F-47D1-80B3-137101DA696F@gmail.com> References: <30BD7F82-598F-47D1-80B3-137101DA696F@gmail.com> Message-ID: Andrew, It looks like you're quickly going to hit a point where MaybeT is helpful to you. https://hackage.haskell.org/package/transformers-0.4.3.0/docs/Control-Monad-Trans-Maybe.html This gives you a trick to ignore the fact that you're getting a maybe and make MaybeT terminate the computation early if there was nothing on the stack to make further computations with. It will involve making the leap from simple monads to transformers though, which can be tricky but is worthwhile in the long run. There is a fairly succinct explanation of all of this, here: https://wiki.haskell.org/Monad_Transformers_Tutorial It's just based on IO rather than State, but that makes little difference to the concept. Typing this out in a rush at work, so apologies in advance if this doesn't make any sense. ;) Cheers, Ben On Wed, 30 Sep 2015 at 14:22 Andrew Bernard wrote: > Greetings All, > > I am writing code using a BankersDequeue from Data.Dequeue. I?d like to > wrap the push and pop operations in a state monad for the standard reason, > to avoid passing the dequeue around between function calls, and regard it > as state instead, which it is. Wishing to avoid throwing a runtime error if > the queue is empty (for the general case of queues) I have written a > reduction of the concept using a crude stack to experiment, which uses > State and Maybe. I notice that there are very few examples of using State > and Maybe together. My questions are: Is this a faulty design pattern? > Should this be done with monad transformers? Are there examples to be found > of using State with Maybe as a monad transformer combination? Why is this > pattern relatively rare, it seems? Is this program on the right track? > > Andrew > > ? snip > > module Main where > > import Control.Monad.State > > type Stack = [Int] > > popIt :: Stack -> (Maybe Int, Stack) > popIt [] = (Nothing, []) > popIt (x:xs) = (Just x, xs) > > pop :: State Stack (Maybe Int) > pop = state popIt > > push :: Int -> State Stack (Maybe ()) > push a = state $ \xs -> (Just (), a:xs) > > main = do > let a = evalState (do > push 3 > push 2 > push 1 > pop > pop > a <- pop > return a > ) [] > print a > > ? snip > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From objitsu at gmail.com Wed Sep 30 10:22:18 2015 From: objitsu at gmail.com (emacstheviking) Date: Wed, 30 Sep 2015 11:22:18 +0100 Subject: [Haskell-beginners] Haskell package maturity In-Reply-To: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> References: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> Message-ID: Andrew, The sheer number of packages is overwhelming and you can spend a very long time indeed trying to find something "suitable"... which... eventually may lead one to the conclusion, "It'll be quicker to roll my own" and then "Hey, I will upload it to Hackage, someone else might like it"... and so the list grows and grows and what began as an altruistic thought serves only to make it harder for the next guy to "find a suitable package". Personally, I've walked away from Haskell purely because I got fed up being continually bitten by "cabal hell". It's a shame because apart from LISP no other language has had such an impact on my thinking. I did find that whatever package I used though, they tend to work, so maybe take the first one and get on with it, that's what I used to do. Hope that helped, it probably didn't. All the best, Sean Charles. On 28 September 2015 at 16:15, Andrew Bernard wrote: > Since starting to look on Hackage for packages for such vital things as > queues and algorithms, I am surprised to see very low numbers of downloads > for packages that seem to me to be vitally important. For example, > queuelike has only been downloaded 1617 times since being uploaded in 2009. > Similar very low numbers seem to apply for many packages. Another example > is cubicspline with only 485 downloads. > > My question is, are the numbers on Hackage correct, and if so, do they > indicate hardly anybody uses them, or indeed Haskell? I am starting to > wonder. > > I also notice version numbers are very low, often less than one and most > often around 0.1 or so. This is either a display of extreme modesty on the > part of Haskell library code developers (in fact, often found in open > source communities), or an indication of lack of maturity of the code. > Overall I am puzzled about this. I am trying to establish what packages to > use in my coding and there seems to be little indication of what to choose, > and how to assess code maturity. What am I missing? > > Andrew > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From toad3k at gmail.com Wed Sep 30 13:29:47 2015 From: toad3k at gmail.com (David McBride) Date: Wed, 30 Sep 2015 09:29:47 -0400 Subject: [Haskell-beginners] Haskell package maturity In-Reply-To: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> References: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> Message-ID: Ultimately when browsing hackage, there are a few things on a package that stop people from using them. Louis Wasserman, no idea who that is. Last updated in Aptirl 2009, boy that's a long time ago. No link to his repository, no link to documentation or a website. This could be a great library, a real diamond in the rough, but there is no shortage of alternative data structure libraries on hackage that have been tried and tested. On Mon, Sep 28, 2015 at 11:15 AM, Andrew Bernard wrote: > Since starting to look on Hackage for packages for such vital things as > queues and algorithms, I am surprised to see very low numbers of downloads > for packages that seem to me to be vitally important. For example, > queuelike has only been downloaded 1617 times since being uploaded in 2009. > Similar very low numbers seem to apply for many packages. Another example > is cubicspline with only 485 downloads. > > My question is, are the numbers on Hackage correct, and if so, do they > indicate hardly anybody uses them, or indeed Haskell? I am starting to > wonder. > > I also notice version numbers are very low, often less than one and most > often around 0.1 or so. This is either a display of extreme modesty on the > part of Haskell library code developers (in fact, often found in open > source communities), or an indication of lack of maturity of the code. > Overall I am puzzled about this. I am trying to establish what packages to > use in my coding and there seems to be little indication of what to choose, > and how to assess code maturity. What am I missing? > > Andrew > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From d12frosted at icloud.com Wed Sep 30 13:39:43 2015 From: d12frosted at icloud.com (Boris Buliga) Date: Wed, 30 Sep 2015 13:39:43 +0000 (GMT) Subject: [Haskell-beginners] Haskell package maturity In-Reply-To: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> References: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> Message-ID: Hey, AFAIK, the number of install Hackage shows is real. But it's hard to tell what those numbers mean without you telling their name. As for version numbers. You see, when you create new cabal project the default version number is `0.1.0.0`. And when people release their packages - first version usually remains at `0.1.0.0`. Both first and second numbers in version are major numbers. So usually you can safely treat `0.1.x.x` as `1.x.x` in other ecosystems.? ~ Boris Best regards, Boris Buliga On Wed, Sep 30, 2015 at 7:49 AM, Andrew Bernard wrote: > Since starting to look on Hackage for packages for such vital things as queues and algorithms, I am surprised to see very low numbers of downloads for packages that seem to me to be vitally important. For example, queuelike has only been downloaded 1617 times since being uploaded in 2009. Similar very low numbers seem to apply for many packages. Another example is cubicspline with only 485 downloads. > My question is, are the numbers on Hackage correct, and if so, do they indicate hardly anybody uses them, or indeed Haskell? I am starting to wonder. > I also notice version numbers are very low, often less than one and most often around 0.1 or so. This is either a display of extreme modesty on the part of Haskell library code developers (in fact, often found in open source communities), or an indication of lack of maturity of the code. Overall I am puzzled about this. I am trying to establish what packages to use in my coding and there seems to be little indication of what to choose, and how to assess code maturity. What am I missing? > Andrew -------------- next part -------------- An HTML attachment was scrubbed... URL: From ryan.trinkle at gmail.com Wed Sep 30 13:44:04 2015 From: ryan.trinkle at gmail.com (Ryan Trinkle) Date: Wed, 30 Sep 2015 09:44:04 -0400 Subject: [Haskell-beginners] Haskell package maturity In-Reply-To: References: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> Message-ID: Andrew, I understand why you're concerned, but I would encourage you to press onward. In my experience - building commercial web applications in Haskell for the last 4 years - Haskell's library ecosystem works very well in practice. In a recent project, I was able to run an interesting experiment: half my team (and half my code) was using JavaScript, and half was using Haskell. In both cases, we made an effort to avoid "not invented here" syndrome, and I think we largely succeeded in maintaining the right mentality about outside libraries. However, the *results* of that mentality were very different in these two cases. In the case of JavaScript, for any problem we had, there were many libraries that tried to solve it. That was awesome. However, before integrating a library, we had to spend a lot of time testing it, making sure it wouldn't interfere with our existing code, and integrating it. After 2 years, we had about 10 JS library dependencies, and we had gone through 10 or 20 more - integrated them, found they had serious issues, and then been forced to replace them. In Haskell, there were usually only one or two choices for a particular problem. However, with a cursory glance of the code, we were usually able to determine that the code didn't do anything nasty. With QuickCheck and ghci, we were able to test things out very rapidly, to make sure they basically worked. Although cabal hell did occasionally rear its head, we were very strict about dependency versioning (eventually adopting Nix, which has very good Haskell support, to lock everything down) which meant that only the person working on the library integration had to deal with any sort of hell, and the rest of the team could simply pull and build. By the end of the project, we were using over 80 libraries from Hackage (more than 200, if you count dependencies-of-dependencies), there was only one time we had to replace a library that had made it past our initial vetting process. I don't know much about how Hackage works or what the download counts represent, but I have found the download counts to be a useful, very rough approximation of relative popularity. If one library has wildly more downloads than another, I'll often look at it first - although, I'll usually look at the other ones as well, eventually. Although the version numbers can look strange, you should know that the Package Version Policy (PVP) counts both the first and second digit groups as "Major version" numbers, with the first group usually used incremented only when the project is seriously overhauled. So, many projects stay at 0.1 indefinitely. For example, the containers library is currently at version 0.5.6.3, despite being very mature, completely stable, and in use by thousands of projects. About 10% of the 200 transitive dependencies in my earlier project were version 0.1.something. So, to make a long story short, my experience with Hackage libraries has been overwhelmingly positive. The success rate with integrations has been over 98%, and the vetting and integration process has generally been quick and painless. Compared to the other ecosystems I've had experience with, I've been able to integrate - and *keep* integrated, for the long haul - far more code from Hackage than from anywhere else. I hope you'll give it a shot, and I think you'll be pleasantly surprised by how things turn out. Regards, Ryan On Wed, Sep 30, 2015 at 6:22 AM, emacstheviking wrote: > Andrew, > > The sheer number of packages is overwhelming and you can spend a very long > time indeed trying to find something "suitable"... which... eventually may > lead one to the conclusion, "It'll be quicker to roll my own" and then > "Hey, I will upload it to Hackage, someone else might like it"... and so > the list grows and grows and what began as an altruistic thought serves > only to make it harder for the next guy to "find a suitable package". > > Personally, I've walked away from Haskell purely because I got fed up > being continually bitten by "cabal hell". > It's a shame because apart from LISP no other language has had such an > impact on my thinking. > > I did find that whatever package I used though, they tend to work, so > maybe take the first one and get on with it, that's what I used to do. > > Hope that helped, it probably didn't. > All the best, > Sean Charles. > > > On 28 September 2015 at 16:15, Andrew Bernard > wrote: > >> Since starting to look on Hackage for packages for such vital things as >> queues and algorithms, I am surprised to see very low numbers of downloads >> for packages that seem to me to be vitally important. For example, >> queuelike has only been downloaded 1617 times since being uploaded in 2009. >> Similar very low numbers seem to apply for many packages. Another example >> is cubicspline with only 485 downloads. >> >> My question is, are the numbers on Hackage correct, and if so, do they >> indicate hardly anybody uses them, or indeed Haskell? I am starting to >> wonder. >> >> I also notice version numbers are very low, often less than one and most >> often around 0.1 or so. This is either a display of extreme modesty on the >> part of Haskell library code developers (in fact, often found in open >> source communities), or an indication of lack of maturity of the code. >> Overall I am puzzled about this. I am trying to establish what packages to >> use in my coding and there seems to be little indication of what to choose, >> and how to assess code maturity. What am I missing? >> >> Andrew >> >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> >> > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From allbery.b at gmail.com Wed Sep 30 14:08:01 2015 From: allbery.b at gmail.com (Brandon Allbery) Date: Wed, 30 Sep 2015 10:08:01 -0400 Subject: [Haskell-beginners] Haskell package maturity In-Reply-To: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> References: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> Message-ID: On Mon, Sep 28, 2015 at 11:15 AM, Andrew Bernard wrote: > Since starting to look on Hackage for packages for such vital things as > queues and algorithms, I am surprised to see very low numbers of downloads > for packages that seem to me to be vitally important. For example, > queuelike has only been downloaded 1617 times since being uploaded in 2009. > Similar very low numbers seem to apply for many packages. Another example > is cubicspline with only 485 downloads. Isn't that count fairly recent (like within the past year or so)? I recall it being one of the things that came in with "new Hackage". -- brandon s allbery kf8nh sine nomine associates allbery.b at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From stephen.tetley at gmail.com Wed Sep 30 14:11:49 2015 From: stephen.tetley at gmail.com (Stephen Tetley) Date: Wed, 30 Sep 2015 15:11:49 +0100 Subject: [Haskell-beginners] Haskell package maturity In-Reply-To: References: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> Message-ID: I remember Louis as being quite active on the Libraries mailing list as the queue package was developed and possibly was even keen to have a priority queue include in the Base library "Containers". So I expect the code is of pretty high quality and a quick scan indicates Louis went as far as adding SPECIALIZE and INLINE pragmas for performance. However, queues seem to be relatively unused but functional programmers (Chris Okasaki's famous Edison data structures have a similar "small" download count on Hackage). Maybe even the author didn't need them often after they were written. On 30 September 2015 at 14:29, David McBride wrote: > Ultimately when browsing hackage, there are a few things on a package that > stop people from using them. Louis Wasserman, no idea who that is. Last > updated in Aptirl 2009, boy that's a long time ago. No link to his > repository, no link to documentation or a website. > > This could be a great library, a real diamond in the rough, but there is no > shortage of alternative data structure libraries on hackage that have been > tried and tested. > From andrew.bernard at gmail.com Wed Sep 30 14:45:10 2015 From: andrew.bernard at gmail.com (Andrew Bernard) Date: Thu, 1 Oct 2015 00:45:10 +1000 Subject: [Haskell-beginners] Haskell package maturity In-Reply-To: References: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> Message-ID: <0876DAB6-2396-4A59-ACCF-EEE80E4DAFF2@gmail.com> I suspected as much - so I suppose it is the count since the new Hackage 2 implementation. That?s helpful to know. Andrew Bernard > On 1 Oct 2015, at 00:08, Brandon Allbery wrote: > > Isn't that count fairly recent (like within the past year or so)? I recall it being one of the things that came in with "new Hackage". -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcin.jan.mrotek at gmail.com Wed Sep 30 15:02:43 2015 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Wed, 30 Sep 2015 17:02:43 +0200 Subject: [Haskell-beginners] Haskell package maturity In-Reply-To: <0876DAB6-2396-4A59-ACCF-EEE80E4DAFF2@gmail.com> References: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> <0876DAB6-2396-4A59-ACCF-EEE80E4DAFF2@gmail.com> Message-ID: Hello, As for the queuelike package, I think its non-priority queue part loses users to container's Sequence, monadic queues seem to at least partially overlap in functionality with streaming libraries (pipes, conduit), and priority queues are also implemented by a couple of packages (priority-queue, pqueue). (also, I imagine not everyone likes the type class + implementations style of programming.) Unfortunately, Hackage is a bit of a mess. I've started programming in Haskell years after the last version of queuelike was uploaded, and today is the first time I've heard of it. The last time I needed a queue I've used Sequence, and when I was googling for priority queues I didn't see any mention of this package. I figure it being filed under "Algorithms" and not "Containers" also doesn't help things. As for the 0.* versions, as it was said, people in general seem not to pay attention to the numbers, and only bump the major version when they make some really significant change, or they run out of comfortable minor version numbers. Hackage's package versioning policy insists only on bumping the minor version number for breaking changes. Best regards, Marcin Mrotek -------------- next part -------------- An HTML attachment was scrubbed... URL: From mlang at delysid.org Wed Sep 30 16:11:06 2015 From: mlang at delysid.org (Mario Lang) Date: Wed, 30 Sep 2015 18:11:06 +0200 Subject: [Haskell-beginners] Haskell package maturity In-Reply-To: (Marcin Mrotek's message of "Wed, 30 Sep 2015 17:02:43 +0200") References: <2ECC5F98-5F8A-4548-91D9-99055B5AAF16@gmail.com> <0876DAB6-2396-4A59-ACCF-EEE80E4DAFF2@gmail.com> Message-ID: <87bncj99b9.fsf@fx.delysid.org> Marcin Mrotek writes: > I've started programming in Haskell years after the last version of > queuelike was uploaded, and today is the first time I've heard of > it. The last time I needed a queue I've used Sequence, and when I was > googling for priority queues I didn't see any mention of this > package. I figure it being filed under "Algorithms" and not > "Containers" also doesn't help things. FWIW, I recently looked at the "packages by category"[1] page on Hackage and found it more or less completely useless. There are far too many categories. Some categories do appear with their singular and plural forms, and many packages seem to be filed at least unexpectedly into a category. I gather this mess has developed because categories have been added over time. Does Hackage have an "override" file for package provided data? [1] http://hackage.haskell.org/packages/ -- CYa, ????? -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 635 bytes Desc: not available URL: