From 50295 at web.de Fri Jan 1 19:17:36 2016 From: 50295 at web.de (Olumide) Date: Fri, 1 Jan 2016 19:17:36 +0000 Subject: [Haskell-beginners] Parametrizing [] as an instance of the Functor type class In-Reply-To: <5685293A.7020104@plaimi.net> References: <5685284A.3010702@web.de> <5685293A.7020104@plaimi.net> Message-ID: <5686D0D0.4070004@web.de> Can you please give an example of [] used as a type constructor? I'm still learning Haskell and don't yet know what kind is. Is it related to type constructors? Regards, - Olumide On 31/12/15 13:10, Alexander Berntsen wrote: >... > On 31/12/15 14:06, Olumide wrote: >> Overall, I'm a bit confused about the relationship between the type >> constructor f and []. > f = []. In other words, [] *is* the type constructor. > > In Haskell, [] is both the type constructor for lists *and* the term > level value for an empty list. This is unfortunate. In ghci you can > see this. > > ? :t [] > [] :: [t] -- term level > ? :k [] > [] :: * -> * -- type level From alexander at plaimi.net Fri Jan 1 19:41:45 2016 From: alexander at plaimi.net (Alexander Berntsen) Date: Fri, 1 Jan 2016 20:41:45 +0100 Subject: [Haskell-beginners] Parametrizing [] as an instance of the Functor type class In-Reply-To: <5686D0D0.4070004@web.de> References: <5685284A.3010702@web.de> <5685293A.7020104@plaimi.net> <5686D0D0.4070004@web.de> Message-ID: <5686D679.1000909@plaimi.net> -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA512 On 01/01/16 20:17, Olumide wrote: > Can you please give an example of [] used as a type constructor? Whenever you write a list type, e.g. [Int], you are using [] as a type constructor. The fact that you can write [Int] instead of '[] Int' is simply syntax sugar. We can imagine the simple function that returns the first element of a list, if there is one. head :: [a] -> Maybe a head [] = Nothing head (x:xs) = Just x Here we use [] both on type and term level. On type level we use it to mean a list of 'a's, and on term level we use it to mean the empty list. If we desugar the type signature slightly, we can write 'head :: [] a - -> Maybe a', which should make the type level use of [] even more clear. Here [] would be the f in Functor f, just like Maybe would be the f in the Functor Maybe instance. > I'm still learning Haskell and don't yet know what kind is. Is it > related to type constructors? Kinds are to types what types are to terms. In other words, a term has a type, which has a kind. 3.0 can have the type Double, and Double has the kind *. You can read '*' as "the concrete type" -- i.e. a plain type such as Double, Int, or String. [] and Maybe on the other hand have kind * -> *. You can think about this in much the same way you'd think about functions. ? :t (+) -- A function (+) :: Num a => a -> a -> a ? :t 1 + 2 -- A value 1 + 2 :: Num a => a ? :k Maybe -- A Type constructor Maybe :: * -> * ? :k Maybe Int -- A concrete type Maybe Int :: * So similarly to how 1 + 2 is a plain value of a plain type, the kind of 'Maybe Int' is just the concrete *. But (+) by itself is a function, and Maybe by itself is a type constructor. I.e. they need arguments. We call types of kind * -> *, such as Maybe and [], type constructors, because they can't have terms on their own. There is no value for a type like Maybe; it's just not possible, since it isn't a concrete type. Hope that helps. - -- Alexander alexander at plaimi.net https://secure.plaimi.net/~alexander -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQIbBAEBCgAGBQJWhtZ5AAoJENQqWdRUGk8BfDwP+IU0aGnSqYer7kAOK+SRMA5J 60bYS9WNG7+vN4qr3gBoQXC6YFy3DfUqqPiuBpI7O7rb68KAlAmPj7q7ALG7U293 h7DJ9SYli6bmNsqVxE5a3zkMVKu5wdeH6nKBApKy6gMA4g0AOV8DJ5I+Z/0nqDGj owjCwn0WrL7Avum160aOIqYzraoI20YgVvOXWflj70ljtSjclYlSp3iiy2sVdrQz GXVSipGVRhrZ/8t55skB5gR3ASjr3X6+JRnuvO7qtywuWPF513jAiqNp0yfNQKkp 6yVtenWuuCsQh5eIjelD345vKdYCvnzA7v2iq4pnggj04DpKwyYbb5yZ0vUaYX44 9W5tYlyxL08jxuQHokwdDw0CWzk+3xIYNMXmj22OKpgW+QymDqTkB6UheaHHdCFN 1qvmvUKNjYF5y/h3Y+skR5fz6iHsemShuIIFTfgDVClpOaTn/bny18+PcoAzuNvH WQD1NYTviE3IYXvP6vWQtizYKwW4ljlk3ilDLeYvcWQhK5P+KAYFDamKJtWGhnFC L+vrXybqWn/IIAXjuV8DY+vhi1V5U6kr+ATA9IkDuXyv7cs0zu1lnrI9LC/YEDdJ sNnDrquhlwUU80mVvVmEGKyOHgEQtlEmipGoL0dCg43Erd6ra3Bu95o9nUy6KHbc bu+qp2ZxQA722UIwNUI= =WV5c -----END PGP SIGNATURE----- From martin.drautzburg at web.de Sat Jan 2 19:53:24 2016 From: martin.drautzburg at web.de (martin) Date: Sat, 2 Jan 2016 20:53:24 +0100 Subject: [Haskell-beginners] Tree-like Structure with unique elements on each level Message-ID: <56882AB4.2090109@web.de> Hello all, I recently modeled a tree like this: data Predicate a = Any | Pred (S.Set a) data Product a = Pany | Prod (S.Set(Predicate a, S.Set(Product a))) What I wanted to achieve was to have each element only once on each level. Hence the Sets. But this structure does not achieve this. I can easily duplicate elements on a level as long as their subordinates are different, so I might as well give up working with sets. Is there a way to construct a tree where each element can occur only once on each level? From imantc at gmail.com Sat Jan 2 21:12:57 2016 From: imantc at gmail.com (Imants Cekusins) Date: Sat, 2 Jan 2016 22:12:57 +0100 Subject: [Haskell-beginners] Tree-like Structure with unique elements on each level In-Reply-To: <56882AB4.2090109@web.de> References: <56882AB4.2090109@web.de> Message-ID: > data Predicate a = Any | Pred (S.Set a) data Product a = Pany | Prod (S.Set(Predicate a, S.Set(Product a))) Does this fit: data Predicate a = Any | Pred a data Product a = Pred' (Predicate a) | Prod (Product a) ? -------------- next part -------------- An HTML attachment was scrubbed... URL: From pmcilroy at gmail.com Sun Jan 3 06:55:41 2016 From: pmcilroy at gmail.com (pmcilroy at gmail.com) Date: Sat, 2 Jan 2016 22:55:41 -0800 Subject: [Haskell-beginners] Implementing instance of '^' operator Message-ID: <5688c5ec.e93e420a.22e11.5725@mx.google.com> As a ?hello world? example for type definitions, I like to define a numeric type that can handle the mod p multiplicative group, where p is prime. This requires: ? Implementing interface functions ? Defining non-trivial implementations, where constructor must be private, etc. ? Invoking an abstract superclass concrete instance method from within the subclass method definition The latter appears not to be possible in Haskell. Is this true? Here?s the basic code, but I punted on x^n. It looks like I?d have to paste in the entire original definition of ?^?. data Modp a = Modp a a deriving (Eq, Show) mkModp p n | isPrime p = Modp p (n `mod` p) | otherwise = error $ show p ++ " is not a prime" instance Integral a => Num (Modp a) where (Modp q n) + (Modp p m) | p==q = Modp p $ (n+m) `mod` p | otherwise = error $ "unequal moduli" (Modp p n) * (Modp q m) | p==q = Modp p $ (n*m) `mod` p | otherwise = error $ "unequal moduli" negate (Modp p n) = Modp p (p-n) -- can't reuse base because ^ is impl. directly in prelude {- (Modp p x) ^ n | n <= p = (Modp p x) `baseExp` n | n1 == 0 = (Modp p x) | n > p = x ^ n1 where baseExp = ^ in Num n1 = n `mod` p -} instance Integral a => Fractional (Modp a) where recip (Modp p n) = (Modp p n)^(p-2) isPrime p = True -- stub -------------- next part -------------- An HTML attachment was scrubbed... URL: From hanche at math.ntnu.no Sun Jan 3 13:06:55 2016 From: hanche at math.ntnu.no (Harald Hanche-Olsen) Date: Sun, 3 Jan 2016 13:06:55 +0000 Subject: [Haskell-beginners] Implementing instance of '^' operator In-Reply-To: <5688c5ec.e93e420a.22e11.5725@mx.google.com> References: <5688c5ec.e93e420a.22e11.5725@mx.google.com> Message-ID: -----Original Message----- From:?pmcilroy at gmail.com Date:?3 January 2016 at 07:55:53 > As a ?hello world? example for type definitions, I like to define a numeric type that can > handle the mod p multiplicative group, where p is prime. This requires: > ? Implementing interface functions [?] I can?t help with the question you?re asking, but I have a minor nitpick: You want to have negate (Modp p 0) = Modp p 0, and not Modp p p as in your current implementation. ? Harald From julian.rohrhuber at musikundmedien.net Sun Jan 3 13:31:13 2016 From: julian.rohrhuber at musikundmedien.net (Julian Rohrhuber) Date: Sun, 03 Jan 2016 14:31:13 +0100 Subject: [Haskell-beginners] infinite type Message-ID: <17B0B5CA-F769-463D-B16D-DF876F620BAB@musikundmedien.net> The function g, when called with a binary function returns a type error which I?d really like to understand: why is this type ?infinite" rather than just incomplete or something similar? I would have expected some kind of partial binding. Can someone help me with an explanation? Prelude> let f g = g . g Prelude> let sum x y = x + y Prelude> f sum :14:3: Occurs check: cannot construct the infinite type: a ~ a -> a Expected type: (a -> a) -> a -> a Actual type: a -> a -> a Relevant bindings include it :: (a -> a) -> a -> a (bound at :14:1) In the first argument of ?f?, namely ?sum? In the expression: f sum With a similar call using lambda expressions, the error is different: Prelude> (\x y -> x + y) . (\x y -> x + y) :32:1: Non type-variable argument in the constraint: Num (a -> a) (Use FlexibleContexts to permit this) When checking that ?it? has the inferred type it :: forall a. (Num a, Num (a -> a)) => a -> (a -> a) -> a -> a Prelude> From joel.neely at gmail.com Sun Jan 3 13:42:14 2016 From: joel.neely at gmail.com (Joel Neely) Date: Sun, 3 Jan 2016 07:42:14 -0600 Subject: [Haskell-beginners] infinite type In-Reply-To: <17B0B5CA-F769-463D-B16D-DF876F620BAB@musikundmedien.net> References: <17B0B5CA-F769-463D-B16D-DF876F620BAB@musikundmedien.net> Message-ID: I'm curious as to the intended meaning of let f g = g . g Without reading further down, I immediately thought: "composing g onto g must require that the argument and result types (domain and range) of g must be identical". Then, when I read f sum I don't know what that means, given that sum is [1] "a function of two arguments" yielding a single value (or, if I want to have my daily dose of curry, sum is [2] "a function of one argument yielding a (function of one argument yielding a single value)". With either reading, I don't know how to reconcile sum with the expectation on the argument to f. I think that's what the compiler is saying as well. Expected type: (a -> a) -> a -> a Actual type: a -> a -> a The "expected type" expression seems to match what I expected from the definition of f, and the "actual type" expression seems to match reading [2]. So I'm wondering how that aligns with what you intended to express. -jn- On Sun, Jan 3, 2016 at 7:31 AM, Julian Rohrhuber < julian.rohrhuber at musikundmedien.net> wrote: > The function g, when called with a binary function returns a type error > which I?d really like to understand: why is this type ?infinite" rather > than just incomplete or something similar? I would have expected some kind > of partial binding. Can someone help me with an explanation? > > Prelude> let f g = g . g > Prelude> let sum x y = x + y > Prelude> f sum > > :14:3: > Occurs check: cannot construct the infinite type: a ~ a -> a > Expected type: (a -> a) -> a -> a > Actual type: a -> a -> a > Relevant bindings include > it :: (a -> a) -> a -> a (bound at :14:1) > In the first argument of ?f?, namely ?sum? > In the expression: f sum > > > With a similar call using lambda expressions, the error is different: > > Prelude> (\x y -> x + y) . (\x y -> x + y) > > :32:1: > Non type-variable argument in the constraint: Num (a -> a) > (Use FlexibleContexts to permit this) > When checking that ?it? has the inferred type > it :: forall a. (Num a, Num (a -> a)) => a -> (a -> a) -> a -> a > Prelude> > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Beauty of style and harmony and grace and good rhythm depend on simplicity. - Plato -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Sun Jan 3 15:03:48 2016 From: imantc at gmail.com (Imants Cekusins) Date: Sun, 3 Jan 2016 16:03:48 +0100 Subject: [Haskell-beginners] infinite type In-Reply-To: References: <17B0B5CA-F769-463D-B16D-DF876F620BAB@musikundmedien.net> Message-ID: Hello Julian, Prelude> let f g = g . g Prelude> let sum x y = x + y Prelude> f sum If you are trying to call 'f' and see the result, args are missing. If you are trying to create new type, use 'let'. Prelude> (\x y -> x + y) . (\x y -> x + y) Similar story. Let or args ;) -------------- next part -------------- An HTML attachment was scrubbed... URL: From julian.rohrhuber at musikundmedien.net Sun Jan 3 19:46:19 2016 From: julian.rohrhuber at musikundmedien.net (Julian Rohrhuber) Date: Sun, 03 Jan 2016 20:46:19 +0100 Subject: [Haskell-beginners] infinite type In-Reply-To: References: <17B0B5CA-F769-463D-B16D-DF876F620BAB@musikundmedien.net> Message-ID: <8107590B-CA6B-4A9D-A845-9A97BADB8B6E@musikundmedien.net> Hi all, than you for your helpful replies. > > On 03.01.2016, at 16:03, Imants Cekusins wrote: > > Hello Julian, > > Prelude> let f g = g . g > Prelude> let sum x y = x + y > Prelude> f sum > > If you are trying to call 'f' and see the result, args are missing. > > If you are trying to create new type, use 'let'. > > Prelude> (\x y -> x + y) . (\x y -> x + y) > > Similar story. Let or args Hello Imants ? same with ?let? here: Prelude> let f g = g . g Prelude> let sum x y = x + y Prelude> let sum' = f sum :43:14: Occurs check: cannot construct the infinite type: a ~ a -> a > On 03.01.2016, at 14:42, Joel Neely wrote: > I'm curious as to the intended meaning of > > let f g = g . g > > Without reading further down, I immediately thought: "composing g onto g must require that the argument and result types (domain and range) of g must be identical?. yes, that domain and range are the same is implied when you rise a function "to a power? (which is what f does). I just assumed that arity and type are two different things in Haskell. > Then, when I read > > f sum > > I don't know what that means, given that sum is [1] "a function of two arguments" yielding a single value (or, if I want to have my daily dose of curry, sum is [2] "a function of one argument yielding a (function of one argument yielding a single value)". > > With either reading, I don't know how to reconcile sum with the expectation on the argument to f. As you wondered what I was trying to express, I was thinking along reading [2]. With: Prelude> let z = sum 2 Prelude> let z' = f z z' is a function with one argument, and yes, this works because z was one with a single argument. But assuming that function composition (.) is a function too, I was curious what would happen if I applied it partially. So an intermediate step would have been this: let k = (\x y -> x + y) . (\x -> x + 1) which is fine. It leaves a binary op function as I expected. By contrast, let k = (\x y -> x + y) . (\x y -> x + y) returns Non type-variable argument in the constraint: Num (a -> a) Instead of something like following which I had dared to expect: let k = (\z -> (\x y -> x + y + z)) What really made me wonder then was how come that f sum would return not a "Non type-variable argument?, but "cannot construct the infinite type: a ~ a -> a? Where does the infinity come from? From imantc at gmail.com Sun Jan 3 20:01:41 2016 From: imantc at gmail.com (Imants Cekusins) Date: Sun, 3 Jan 2016 21:01:41 +0100 Subject: [Haskell-beginners] infinite type In-Reply-To: <8107590B-CA6B-4A9D-A845-9A97BADB8B6E@musikundmedien.net> References: <17B0B5CA-F769-463D-B16D-DF876F620BAB@musikundmedien.net> <8107590B-CA6B-4A9D-A845-9A97BADB8B6E@musikundmedien.net> Message-ID: Prelude> let f g = g . g Prelude> let sum x y = x + y Prelude> let sum' = f sum Occurs check: cannot construct the infinite type: a ~ a -> a If f and sum were defined in a module, given a signature, I suppose this would compile. Similarly, sometimes valid functions defined within function body without signatures sometimes make compiler complain. Once such functions are moved to top (module) level and given a signature, compiler is happy. -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Sun Jan 3 21:05:04 2016 From: imantc at gmail.com (Imants Cekusins) Date: Sun, 3 Jan 2016 22:05:04 +0100 Subject: [Haskell-beginners] infinite type In-Reply-To: <8107590B-CA6B-4A9D-A845-9A97BADB8B6E@musikundmedien.net> References: <17B0B5CA-F769-463D-B16D-DF876F620BAB@musikundmedien.net> <8107590B-CA6B-4A9D-A845-9A97BADB8B6E@musikundmedien.net> Message-ID: >Where does the infinity come from? Here is composition signature: (.) :: (b -> c) -> (a -> b) -> a -> c It looks like it is applicable to functions with 1 arg. Sum expects 2 args. I guess this explains why sum can not be passed to f -------------- next part -------------- An HTML attachment was scrubbed... URL: From tanuki at gmail.com Sun Jan 3 21:30:38 2016 From: tanuki at gmail.com (Theodore Lief Gannon) Date: Sun, 3 Jan 2016 13:30:38 -0800 Subject: [Haskell-beginners] infinite type In-Reply-To: References: <17B0B5CA-F769-463D-B16D-DF876F620BAB@musikundmedien.net> <8107590B-CA6B-4A9D-A845-9A97BADB8B6E@musikundmedien.net> Message-ID: On Sun, Jan 3, 2016 at 1:05 PM, Imants Cekusins wrote: > Here is composition signature: > > (.) > :: > (b -> c) -> (a -> b) -> a -> c > > It looks like it is applicable to functions with 1 arg. Sum expects 2 > args. I guess this explains why sum can not be passed to f > This isn't accurate, and it's useful to understand why. Every function in Haskell has exactly one argument. Joel touched on this earlier. It's easier to see if you add the implied parentheses to the type signatures: sum :: Num a => a -> (a -> a) f :: (a -> a) -> (a -> a) To really drive it home, let's play with synonyms. type Endo' a = (a -> a) Endo already exists as a newtype in Data.Monoid, thus Endo' here. Now: sum :: Num a => a -> Endo' a f :: Endo' a -> Endo' a -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Sun Jan 3 21:50:27 2016 From: imantc at gmail.com (Imants Cekusins) Date: Sun, 3 Jan 2016 22:50:27 +0100 Subject: [Haskell-beginners] infinite type In-Reply-To: References: <17B0B5CA-F769-463D-B16D-DF876F620BAB@musikundmedien.net> <8107590B-CA6B-4A9D-A845-9A97BADB8B6E@musikundmedien.net> Message-ID: Well even if (.) can be used with functions returning functions (partially applied), calling g . g where g expects 2 args and returns 1 does not seem intuitive. Could you think of a useful practical example of (a->a->a) . (a->a->a) ? -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Sun Jan 3 22:43:31 2016 From: imantc at gmail.com (Imants Cekusins) Date: Sun, 3 Jan 2016 23:43:31 +0100 Subject: [Haskell-beginners] infinite type In-Reply-To: References: <17B0B5CA-F769-463D-B16D-DF876F620BAB@musikundmedien.net> <8107590B-CA6B-4A9D-A845-9A97BADB8B6E@musikundmedien.net> Message-ID: > Every function in Haskell has exactly one argument. well partially applied functions may be used in the intermediary stages of function processing however if programmer expects a function to return primitive value (as opposed to a function), that return value will only be available once that function is fully applied. In other words, for f:: (...) -> z where z is a primitive value (not a function), (...) can be as long as we like, if not full (...) are applied, we get f1::(...')->z To obtain z - the purpose f was written for - we need to pass full (...) although every function may be passed 1 (or even 0) args, n or (in)complete args has some meaning. -------------- next part -------------- An HTML attachment was scrubbed... URL: From martin.drautzburg at web.de Mon Jan 4 09:57:27 2016 From: martin.drautzburg at web.de (martin) Date: Mon, 4 Jan 2016 10:57:27 +0100 Subject: [Haskell-beginners] Functor instance for ordered lists Message-ID: <568A4207.9040809@web.de> Hello all, Data.List.Ordered is just a bunch of functions operating on ordinary Lists. Fmapping a function over an ordered list has the potential of blowing the ordering. Would it be possible to define a newtype for ordered lists where the order is guaranteed to be maintained? The functor instance then may have to re-order the elements. The problem I see is that data Ordlist a = ... would certainly require an Ord constraint on a, but where would I put it? I can put it on all the functions manipulating OrdLists, but I still wouldn't know how to define a functor instance, because a Functor a does not require Ord a. From imantc at gmail.com Mon Jan 4 10:45:52 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 4 Jan 2016 11:45:52 +0100 Subject: [Haskell-beginners] Functor instance for ordered lists In-Reply-To: <568A4207.9040809@web.de> References: <568A4207.9040809@web.de> Message-ID: > a newtype for ordered lists why not: newtype Ordlist a = Ordlist [a] and a ctor: ordList::[a]->OrdList a ordList = OrdList . sort sort :: Ord a => [a] -> [a] from Data.List From martin.drautzburg at web.de Mon Jan 4 14:26:19 2016 From: martin.drautzburg at web.de (martin) Date: Mon, 4 Jan 2016 15:26:19 +0100 Subject: [Haskell-beginners] Functor instance for ordered lists In-Reply-To: References: <568A4207.9040809@web.de> Message-ID: <568A810B.8010608@web.de> Am 01/04/2016 um 11:45 AM schrieb Imants Cekusins: >> a newtype for ordered lists > > why not: > newtype Ordlist a = Ordlist [a] All nice and dandy, but at first you already need an Ord constraint for your smart constructor -- and a ctor: ordList::(Ord a) => [a]-> OrdList a ordList = OrdList . sort but this is still not the main problem. When you try to define a Functor instance, you'd be tempted to do this (at least I was): instance Functor OrdList where fmap f (OrdList xs) = OrdList $ sort $ map f xs but you can't do this, because of: "No instance for (Ord b) arising from a use of ?sort?", where b is the return type of f :: (a->b). This does make sense, the function has to return something which can be sorted. So my question is: is it impossible to write a functor instance for ordered lists? It appears so, because a Functor does not impose any constraints of f. But my knowledge is quite limited and maybe a well-set class constraint can fix things. From edwards.benj at gmail.com Mon Jan 4 14:46:20 2016 From: edwards.benj at gmail.com (Benjamin Edwards) Date: Mon, 04 Jan 2016 14:46:20 +0000 Subject: [Haskell-beginners] Functor instance for ordered lists In-Reply-To: <568A810B.8010608@web.de> References: <568A4207.9040809@web.de> <568A810B.8010608@web.de> Message-ID: It is impossible. You can make a new functor class using contraint kinds that allows what you want. There is probably a package out there already that does! http://www.cl.cam.ac.uk/~dao29/publ/constraint-families.pdf Sections 2.2 and 5.1 have the relevant stuff. I realise this is a bit err, dense for the beginners list. There are probably better references out there. Ben On Mon, 4 Jan 2016 at 14:30 martin wrote: > Am 01/04/2016 um 11:45 AM schrieb Imants Cekusins: > >> a newtype for ordered lists > > > > why not: > > newtype Ordlist a = Ordlist [a] > > All nice and dandy, but at first you already need an Ord constraint for > your smart constructor > > -- and a ctor: > ordList::(Ord a) => [a]-> OrdList a > ordList = OrdList . sort > > but this is still not the main problem. When you try to define a Functor > instance, you'd be tempted to do this (at least > I was): > > instance Functor OrdList where > fmap f (OrdList xs) = OrdList $ sort $ map f xs > > but you can't do this, because of: "No instance for (Ord b) arising from a > use of ?sort?", where b is the return type of > f :: (a->b). This does make sense, the function has to return something > which can be sorted. > > So my question is: is it impossible to write a functor instance for > ordered lists? It appears so, because a Functor does > not impose any constraints of f. But my knowledge is quite limited and > maybe a well-set class constraint can fix things. > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From edwards.benj at gmail.com Mon Jan 4 14:49:38 2016 From: edwards.benj at gmail.com (Benjamin Edwards) Date: Mon, 04 Jan 2016 14:49:38 +0000 Subject: [Haskell-beginners] Functor instance for ordered lists In-Reply-To: References: <568A4207.9040809@web.de> <568A810B.8010608@web.de> Message-ID: This is a bit better: https://dorchard.wordpress.com/2011/10/18/subcategories-in-haskell-exofunctors/ On Mon, 4 Jan 2016 at 14:46 Benjamin Edwards wrote: > It is impossible. > > You can make a new functor class using contraint kinds that allows what > you want. There is probably a package out there already that does! > > http://www.cl.cam.ac.uk/~dao29/publ/constraint-families.pdf > > Sections 2.2 and 5.1 have the relevant stuff. I realise this is a bit err, > dense for the beginners list. There are probably better references out > there. > > Ben > > On Mon, 4 Jan 2016 at 14:30 martin wrote: > >> Am 01/04/2016 um 11:45 AM schrieb Imants Cekusins: >> >> a newtype for ordered lists >> > >> > why not: >> > newtype Ordlist a = Ordlist [a] >> >> All nice and dandy, but at first you already need an Ord constraint for >> your smart constructor >> >> -- and a ctor: >> ordList::(Ord a) => [a]-> OrdList a >> ordList = OrdList . sort >> >> but this is still not the main problem. When you try to define a Functor >> instance, you'd be tempted to do this (at least >> I was): >> >> instance Functor OrdList where >> fmap f (OrdList xs) = OrdList $ sort $ map f xs >> >> but you can't do this, because of: "No instance for (Ord b) arising from >> a use of ?sort?", where b is the return type of >> f :: (a->b). This does make sense, the function has to return something >> which can be sorted. >> >> So my question is: is it impossible to write a functor instance for >> ordered lists? It appears so, because a Functor does >> not impose any constraints of f. But my knowledge is quite limited and >> maybe a well-set class constraint can fix things. >> >> >> _______________________________________________ >> 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 imantc at gmail.com Mon Jan 4 14:53:34 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 4 Jan 2016 15:53:34 +0100 Subject: [Haskell-beginners] Functor instance for ordered lists In-Reply-To: <568A810B.8010608@web.de> References: <568A4207.9040809@web.de> <568A810B.8010608@web.de> Message-ID: > is it impossible to write a functor instance for ordered lists? is such specialized functor instance necessary? I mean, why not fmap over unconstrained list and init OrdList before passing it to a fun where sorted list is really essential? this would eliminate the need to maintain sorted order at every step in list processing. This way, OrdList type would ensure that sort-critical consumer fun gets a sorted list, and every other fun - fmap or not - would not care. From imantc at gmail.com Mon Jan 4 15:21:46 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 4 Jan 2016 16:21:46 +0100 Subject: [Haskell-beginners] Functor instance for ordered lists In-Reply-To: <568A810B.8010608@web.de> References: <568A4207.9040809@web.de> <568A810B.8010608@web.de> Message-ID: > Functor does not impose any constraints of f. it seems so. I ran into this too. not that i wrote many functor instances but I could not figure out how to add (any kind of) constraint to a functor. Ben already wrote about this - if I understand him correctly. From waka.2015 at eisenbits.com Mon Jan 4 15:59:13 2016 From: waka.2015 at eisenbits.com (Stanislaw Findeisen) Date: Mon, 4 Jan 2016 16:59:13 +0100 Subject: [Haskell-beginners] Ambiguous module name `Prelude': it was found in multiple packages (trying to install HXQ) Message-ID: <568A96D1.8050402@eisenbits.com> Hi! I am trying to install HXQ: https://hackage.haskell.org/package/HXQ . But somehow it doesn't work: $ cabal install hxq Resolving dependencies... Configuring HXQ-0.19.0... Building HXQ-0.19.0... Failed to install HXQ-0.19.0 Build log ( /home/ct/.cabal/logs/HXQ-0.19.0.log ): Configuring HXQ-0.19.0... Building HXQ-0.19.0... Preprocessing library HXQ-0.19.0... src/Text/XML/HXQ/XQuery.hs:1:1: Ambiguous module name `Prelude': it was found in multiple packages: base haskell98-2.0.0.2 cabal: Error: some packages failed to install: HXQ-0.19.0 failed during the building phase. The exception was: ExitFailure 1 Why? Thanks! -- http://people.eisenbits.com/~stf/ http://www.eisenbits.com/ OpenPGP: 9EC2 5620 2355 B1DC 4A8F 8C79 0EC7 C214 E5AE 3B4E From julian.rohrhuber at musikundmedien.net Mon Jan 4 15:59:26 2016 From: julian.rohrhuber at musikundmedien.net (Julian Rohrhuber) Date: Mon, 04 Jan 2016 16:59:26 +0100 Subject: [Haskell-beginners] infinite type In-Reply-To: References: <17B0B5CA-F769-463D-B16D-DF876F620BAB@musikundmedien.net> <8107590B-CA6B-4A9D-A845-9A97BADB8B6E@musikundmedien.net> Message-ID: > On 03.01.2016, at 22:30, Theodore Lief Gannon wrote: > > sum :: Num a => a -> (a -> a) > f :: (a -> a) -> (a -> a) > > To really drive it home, let's play with synonyms. > > type Endo' a = (a -> a) > > Endo already exists as a newtype in Data.Monoid, thus Endo' here. Now: > > sum :: Num a => a -> Endo' a > f :: Endo' a -> Endo? a ok, this makes sense to me now ? thank you very much for your patience. I?m trying to make the conclusion explicit, so please correct me if I?m wrong. if type checking of "f sum" assumes the type variable "a" to be of type Endo' in f, it concludes: sum takes Endo' to Endo' Endo' which looks equivalent to trying to construct an infinite type. The type checker seems not to worry about the more obvious arity/Num restriction of sum, which makes the result more interesting. More generally, if 1) f is a function that maps a function to a function of the same type (a -> a) -> (a -> a) 2) sum is a function that maps a value of type b to a function from (b -> b) 3) then their composition ?f sum? would have two constraints: sum maps value a into function b = (a -> a) but f assumes equality between a and b, so that the required type would be one where a = (a -> a). which is possibly inconsistent, e.g. when it is interpreted as a definition of a set which has as its elements all sets of pairs of elements of that same set. > On 03.01.2016, at 22:50, Imants Cekusins wrote: > Could you think of a useful practical example of > > (a->a->a) . (a->a->a) Good question. I indeed had nothing else in mind but to reason about functions. Which is quite practical if you are trying to understand haskell! I could imagine useful variants of function application, but that is pure speculation. From martin.drautzburg at web.de Mon Jan 4 16:18:16 2016 From: martin.drautzburg at web.de (martin) Date: Mon, 4 Jan 2016 17:18:16 +0100 Subject: [Haskell-beginners] Functor instance for ordered lists In-Reply-To: References: <568A4207.9040809@web.de> <568A810B.8010608@web.de> Message-ID: <568A9B48.8060508@web.de> Am 01/04/2016 um 03:53 PM schrieb Imants Cekusins: >> is it impossible to write a functor instance for ordered lists? > > is such specialized functor instance necessary? > > I mean, why not fmap over unconstrained list and init OrdList before > passing it to a fun where sorted list is really essential? > > this would eliminate the need to maintain sorted order at every step > in list processing. > > This way, OrdList type would ensure that sort-critical consumer fun > gets a sorted list, and every other fun - fmap or not - would not > care. I see. The reason why I am asking is I tried to model a predicate on nested items and I came up with this: data Product a = Prod (a -> Maybe (Product a)) | Pany The idea was that given an Item a, a Product would return Nothing if the toplevel Item (the "container") does not statisfy the predicate. Otherwise it returns Just a new Product which captures the condition which each of the contained items must satisfy. That alone did not buy me much, particularly becuase I needed a way to "show" a product. So I needed a showable data structure, which can be used like a Product, i.e. which can be converted into a Product. I came up with data MP a = MPacked (M.Map a (MP a)) | MPany deriving (Show) Then I tried to define a Functor instance and failed for the afforementioned reasons: a Map needs Ord keys. I found this puzzling because a Functor on Product makes perfect sense to me. I assume, this is because M.Map is implemented in such a way, that Ord a is required. Had I used a List of Pairs instead of a Map, then no Ord constraint would have been required. Does this make some sense? From marcin.jan.mrotek at gmail.com Mon Jan 4 16:33:10 2016 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Mon, 4 Jan 2016 17:33:10 +0100 Subject: [Haskell-beginners] Functor instance for ordered lists In-Reply-To: <568A4207.9040809@web.de> References: <568A4207.9040809@web.de> Message-ID: > would certainly require an Ord constraint on a, but where would I put it? I can put it on all the functions manipulating > OrdLists, but I still wouldn't know how to define a functor instance, because a Functor a does not require Ord a. It's of questionable utility, as it still doesn't let you define a Functor instance (and can no longer be a newtype), but if you want, you can use a GADT: data OrdList a where OrdList :: Ord a => a -> OrdList a Best regards Marcin Mrotek From julian.rohrhuber at musikundmedien.net Mon Jan 4 15:59:17 2016 From: julian.rohrhuber at musikundmedien.net (Julian Rohrhuber) Date: Mon, 04 Jan 2016 16:59:17 +0100 Subject: [Haskell-beginners] infinite type In-Reply-To: References: <17B0B5CA-F769-463D-B16D-DF876F620BAB@musikundmedien.net> <8107590B-CA6B-4A9D-A845-9A97BADB8B6E@musikundmedien.net> Message-ID: <0DE673F7-B0F5-4FD8-8E82-3591EFF0B3C9@musikundmedien.net> An HTML attachment was scrubbed... URL: From stephen.tetley at gmail.com Mon Jan 4 17:51:57 2016 From: stephen.tetley at gmail.com (Stephen Tetley) Date: Mon, 4 Jan 2016 17:51:57 +0000 Subject: [Haskell-beginners] Tree-like Structure with unique elements on each level In-Reply-To: <56882AB4.2090109@web.de> References: <56882AB4.2090109@web.de> Message-ID: Hi Martin The essence of a trie data structure is that all keys at each level are unique, so so lookup in a trie forms a search path. There are various implementations of tries on Hackage. Best wishes Stephen On 2 January 2016 at 19:53, martin wrote: > Hello all, > > I recently modeled a tree like this: > > data Predicate a = Any | Pred (S.Set a) > data Product a = Pany | Prod (S.Set(Predicate a, S.Set(Product a))) > > What I wanted to achieve was to have each element only once on each level. Hence the Sets. But this structure does not > achieve this. I can easily duplicate elements on a level as long as their subordinates are different, so I might as well > give up working with sets. > > Is there a way to construct a tree where each element can occur only once on each level? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From imantc at gmail.com Mon Jan 4 21:11:28 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 4 Jan 2016 22:11:28 +0100 Subject: [Haskell-beginners] Functor instance for ordered lists In-Reply-To: References: <568A4207.9040809@web.de> Message-ID: Is predicate a function specific to each product, used to compose product? Or is it used when querying products to filter them? I'd define data structures as records, sometimes with a couple variable types. Then if variable types are used, define classes to query, modify data. Why not define product as data Prod a c = Prod a [c] where a is product info and c is child item data. Then define predicate class. Then define a's and c's separately for each use case. Maybe add types for each specific product. Then add instances. This way future changes will be easy. It is easier to work on specifics when generics are simple. Specific products may be as complex as necessary. If you define product as a complex type with a few type variables, changes will be more difficult. -------------- next part -------------- An HTML attachment was scrubbed... URL: From martin.drautzburg at web.de Mon Jan 4 21:54:37 2016 From: martin.drautzburg at web.de (martin) Date: Mon, 4 Jan 2016 22:54:37 +0100 Subject: [Haskell-beginners] Functor instance for ordered lists In-Reply-To: References: <568A4207.9040809@web.de> Message-ID: <568AEA1D.5070909@web.de> Am 01/04/2016 um 10:11 PM schrieb Imants Cekusins: > Why not define product as > data Prod a c = Prod a [c] > > where a is product info and c is child item data. Well first the Product is not necessarily a single "thing". There can be various a's which satisfy the criteria to fall into a specific Product. So either a must be a set-like thing or a function a->Bool. Then there is not necessarily just one level of nesting. The c's can still be containers, and it matters what's inside them. It's like a carton of iPhones, which has iPhone packages inside and each iPhone package consists of an iPhone, a Charger, a Manual and ... and the Charger consists of a Cable, a circuit board ... If any of the conditions are not met, if e.g. you receive a carton of iPhones where one charger lacks its cable, you have reason to complain. From imantc at gmail.com Mon Jan 4 22:01:30 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 4 Jan 2016 23:01:30 +0100 Subject: [Haskell-beginners] Functor instance for ordered lists In-Reply-To: <568AEA1D.5070909@web.de> References: <568A4207.9040809@web.de> <568AEA1D.5070909@web.de> Message-ID: a and c can be anything: function, algebraic type, ... That's the thing. Prod a [c] leaves plenty of room. -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Mon Jan 4 23:50:57 2016 From: imantc at gmail.com (Imants Cekusins) Date: Tue, 5 Jan 2016 00:50:57 +0100 Subject: [Haskell-beginners] Ambiguous module name `Prelude': it was found in multiple packages (trying to install HXQ) In-Reply-To: <568A96D1.8050402@eisenbits.com> References: <568A96D1.8050402@eisenbits.com> Message-ID: > Ambiguous module name `Prelude': it was found in multiple packages: base haskell98-2.0.0.2 just guessing: https://hackage.haskell.org/package/HXQ -> https://hackage.haskell.org/package/haskell98 -> base (==4.7.*), what base version was installed on your pc before you tried to install HXQ? is it possible to install multiple base versions? From hjgtuyl at chello.nl Tue Jan 5 00:56:17 2016 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Tue, 05 Jan 2016 01:56:17 +0100 Subject: [Haskell-beginners] Ambiguous module name `Prelude': it was found in multiple packages (trying to install HXQ) In-Reply-To: <568A96D1.8050402@eisenbits.com> References: <568A96D1.8050402@eisenbits.com> Message-ID: On Mon, 04 Jan 2016 16:59:13 +0100, Stanislaw Findeisen wrote: [...] > src/Text/XML/HXQ/XQuery.hs:1:1: > Ambiguous module name `Prelude': > it was found in multiple packages: base haskell98-2.0.0.2 > cabal: Error: some packages failed to install: > HXQ-0.19.0 failed during the building phase. The exception was: > ExitFailure 1 I think the answer is given at: http://stackoverflow.com/questions/7339635/ambiguous-module-name-prelude HXQ is not updated since 2011; the package haskell98 should be removed from the dependencies. Regards, Henk-Jan van Tuyl -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From martin at vlkk.cz Tue Jan 5 11:44:32 2016 From: martin at vlkk.cz (Martin Vlk) Date: Tue, 5 Jan 2016 11:44:32 +0000 Subject: [Haskell-beginners] Ambiguous module name `Prelude': it was found in multiple packages (trying to install HXQ) In-Reply-To: References: <568A96D1.8050402@eisenbits.com> Message-ID: <568BACA0.8000600@vlkk.cz> Also it is recommended to install things into project specific sandboxes rather than globally. E.g. mkdir myProj cd myProj cabal sandbox init cabal install hxq Martin Imants Cekusins: >> Ambiguous module name `Prelude': > it was found in multiple packages: base haskell98-2.0.0.2 > > just guessing: > > https://hackage.haskell.org/package/HXQ > -> https://hackage.haskell.org/package/haskell98 > -> base (==4.7.*), > > what base version was installed on your pc before you tried to install HXQ? > > is it possible to install multiple base versions? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From 50295 at web.de Tue Jan 5 13:33:30 2016 From: 50295 at web.de (Olumide) Date: Tue, 5 Jan 2016 13:33:30 +0000 Subject: [Haskell-beginners] Parametrizing [] as an instance of the Functor type class In-Reply-To: <5685284A.3010702@web.de> References: <5685284A.3010702@web.de> Message-ID: <568BC62A.3070203@web.de> On 31/12/2015 13:06, Olumide wrote: > ... considering that Functor is defined as > > class Functor f > where fmap :: (a -> b) -> f a -> f b > Still on the subject, according to LYH, the above definition(?) is read thusly: "fmap takes a function from one type as to another and a functor value applied with one type and returns a functor value applied with another type". So if list is "a part of the part of the Functor type class" (quoting LYH) how am I to grok a list e.g. [1,2,3] as a "functor value applied to a type"? Thanks, - Olumide From 50295 at web.de Tue Jan 5 13:59:00 2016 From: 50295 at web.de (Olumide) Date: Tue, 5 Jan 2016 13:59:00 +0000 Subject: [Haskell-beginners] Parametrizing [] as an instance of the Functor type class In-Reply-To: <5686D679.1000909@plaimi.net> References: <5685284A.3010702@web.de> <5685293A.7020104@plaimi.net> <5686D0D0.4070004@web.de> <5686D679.1000909@plaimi.net> Message-ID: <568BCC24.4020009@web.de> On 01/01/2016 19:41, Alexander Berntsen wrote: >> Can you please give an example of [] used as a type constructor? > Whenever you write a list type, e.g. [Int], you are using [] as a type > constructor. The fact that you can write [Int] instead of '[] Int' is > simply syntax sugar. > > We can imagine the simple function that returns the first element of a > list, if there is one. > > head :: [a] -> Maybe a > head [] = Nothing > head (x:xs) = Just x > > Here we use [] both on type and term level. On type level we use it to > mean a list of 'a's, and on term level we use it to mean the empty list. Out of curiosity, is [] defined as type constructor _and_ term level at the library level or in the language/compiler? (BTW, google tells me "term-level" has a special meaning that I do not yet know.) Note: I've deferred reading your explanation of kinds because (1) I am still trying to get to grips with Functors and (2) the section on kinds is just two pages away from where I am in the book. So if these questions are answered by kinds please let me know. Thanks for your patience, - Olumide From waka.2015 at eisenbits.com Tue Jan 5 17:24:15 2016 From: waka.2015 at eisenbits.com (Stanislaw Findeisen) Date: Tue, 5 Jan 2016 18:24:15 +0100 Subject: [Haskell-beginners] Ambiguous module name `Prelude': it was found in multiple packages (trying to install HXQ) In-Reply-To: <568BACA0.8000600@vlkk.cz> References: <568A96D1.8050402@eisenbits.com> <568BACA0.8000600@vlkk.cz> Message-ID: <568BFC3F.5090103@eisenbits.com> On 2016-01-05 12:44, Martin Vlk wrote: > Also it is recommended to install things into project specific sandboxes > rather than globally. > > E.g. > > mkdir myProj > cd myProj > cabal sandbox init > cabal install hxq Thanks but it doesn't help. :/ -- http://people.eisenbits.com/~stf/ http://www.eisenbits.com/ OpenPGP: 9EC2 5620 2355 B1DC 4A8F 8C79 0EC7 C214 E5AE 3B4E From waka.2015 at eisenbits.com Tue Jan 5 17:25:10 2016 From: waka.2015 at eisenbits.com (Stanislaw Findeisen) Date: Tue, 5 Jan 2016 18:25:10 +0100 Subject: [Haskell-beginners] Ambiguous module name `Prelude': it was found in multiple packages (trying to install HXQ) In-Reply-To: References: <568A96D1.8050402@eisenbits.com> Message-ID: <568BFC76.4000506@eisenbits.com> On 2016-01-05 01:56, Henk-Jan van Tuyl wrote: > On Mon, 04 Jan 2016 16:59:13 +0100, Stanislaw Findeisen > wrote: > > [...] >> src/Text/XML/HXQ/XQuery.hs:1:1: >> Ambiguous module name `Prelude': >> it was found in multiple packages: base haskell98-2.0.0.2 >> cabal: Error: some packages failed to install: >> HXQ-0.19.0 failed during the building phase. The exception was: >> ExitFailure 1 > > I think the answer is given at: > http://stackoverflow.com/questions/7339635/ambiguous-module-name-prelude > > HXQ is not updated since 2011; the package haskell98 should be removed > from the dependencies. Ok, so how can one use HXQ in a project? -- http://people.eisenbits.com/~stf/ http://www.eisenbits.com/ OpenPGP: 9EC2 5620 2355 B1DC 4A8F 8C79 0EC7 C214 E5AE 3B4E From rein.henrichs at gmail.com Tue Jan 5 18:57:09 2016 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Tue, 05 Jan 2016 18:57:09 +0000 Subject: [Haskell-beginners] Parametrizing [] as an instance of the Functor type class In-Reply-To: <568BCC24.4020009@web.de> References: <5685284A.3010702@web.de> <5685293A.7020104@plaimi.net> <5686D0D0.4070004@web.de> <5686D679.1000909@plaimi.net> <568BCC24.4020009@web.de> Message-ID: [1,2,3] is [Int] or [] Int (if we take the numbers to be Ints for simplicity). It is the [] type constructor applied to the Int type. On Tue, Jan 5, 2016 at 5:59 AM Olumide <50295 at web.de> wrote: > On 01/01/2016 19:41, Alexander Berntsen wrote: > >> Can you please give an example of [] used as a type constructor? > > Whenever you write a list type, e.g. [Int], you are using [] as a type > > constructor. The fact that you can write [Int] instead of '[] Int' is > > simply syntax sugar. > > > > We can imagine the simple function that returns the first element of a > > list, if there is one. > > > > head :: [a] -> Maybe a > > head [] = Nothing > > head (x:xs) = Just x > > > > Here we use [] both on type and term level. On type level we use it to > > mean a list of 'a's, and on term level we use it to mean the empty list. > > Out of curiosity, is [] defined as type constructor _and_ term level at > the library level or in the language/compiler? (BTW, google tells me > "term-level" has a special meaning that I do not yet know.) > > Note: I've deferred reading your explanation of kinds because (1) I am > still trying to get to grips with Functors and (2) the section on kinds > is just two pages away from where I am in the book. So if these > questions are answered by kinds please let me know. > > Thanks for your patience, > > - Olumide > > _______________________________________________ > 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 hjgtuyl at chello.nl Tue Jan 5 21:16:57 2016 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Tue, 05 Jan 2016 22:16:57 +0100 Subject: [Haskell-beginners] Ambiguous module name `Prelude': it was found in multiple packages (trying to install HXQ) In-Reply-To: <568BFC76.4000506@eisenbits.com> References: <568A96D1.8050402@eisenbits.com> <568BFC76.4000506@eisenbits.com> Message-ID: On Tue, 05 Jan 2016 18:25:10 +0100, Stanislaw Findeisen wrote: > On 2016-01-05 01:56, Henk-Jan van Tuyl wrote: >> On Mon, 04 Jan 2016 16:59:13 +0100, Stanislaw Findeisen >> wrote: >> >> [...] >>> src/Text/XML/HXQ/XQuery.hs:1:1: >>> Ambiguous module name `Prelude': >>> it was found in multiple packages: base haskell98-2.0.0.2 >>> cabal: Error: some packages failed to install: >>> HXQ-0.19.0 failed during the building phase. The exception was: >>> ExitFailure 1 >> >> I think the answer is given at: >> http://stackoverflow.com/questions/7339635/ambiguous-module-name-prelude >> >> HXQ is not updated since 2011; the package haskell98 should be removed >> from the dependencies. > > Ok, so how can one use HXQ in a project? > You can do "cabal unpack hxq" and update the file hxq.cabal; I tried it and there are many more things that need updates. Your best bet would be to ask the author to update the package. Otherwise, you could ask the Haskell Caf? if someone would like to take over maintenance of HXQ. Regards, Henk-Jan van Tuyl -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From bergey at alum.mit.edu Wed Jan 6 14:50:42 2016 From: bergey at alum.mit.edu (bergey at alum.mit.edu) Date: Wed, 06 Jan 2016 09:50:42 -0500 Subject: [Haskell-beginners] Parametrizing [] as an instance of the Functor type class In-Reply-To: <568BCC24.4020009@web.de> References: <5685284A.3010702@web.de> <5685293A.7020104@plaimi.net> <5686D0D0.4070004@web.de> <5686D679.1000909@plaimi.net> <568BCC24.4020009@web.de> Message-ID: <87h9iqrccd.fsf@wonderlust.i-did-not-set--mail-host-address--so-tickle-me> On 2016-01-05 at 08:59, Olumide <50295 at web.de> wrote: > On 01/01/2016 19:41, Alexander Berntsen wrote: >> Here we use [] both on type and term level. On type level we use it to >> mean a list of 'a's, and on term level we use it to mean the empty list. > > Out of curiosity, is [] defined as type constructor _and_ term level at > the library level or in the language/compiler? (BTW, google tells me > "term-level" has a special meaning that I do not yet know.) The special syntax of [] requires that the compiler (specifically, the parser) treat lists specially. We could define our own data type that behaves like lists, List a = Nil | Cons a (List a) but writing out literal lists would be a little clunky. It's nice that we can write: [] [1] [1,2,3] instead of: Nil Cons 1 Nil Cons 1 (Cons 2 (Cons 3 Nil)) The [1,2,3] syntax requres that the Haskell parser be aware of this type. At the type level, we can write [Int], [Char], and so forth, instead of List Int, List Char. This also requires support in the parser. bergey From bergey at alum.mit.edu Wed Jan 6 14:58:33 2016 From: bergey at alum.mit.edu (bergey at alum.mit.edu) Date: Wed, 06 Jan 2016 09:58:33 -0500 Subject: [Haskell-beginners] Parametrizing [] as an instance of the Functor type class In-Reply-To: <568BC62A.3070203@web.de> References: <5685284A.3010702@web.de> <568BC62A.3070203@web.de> Message-ID: <87egdurbza.fsf@wonderlust.i-did-not-set--mail-host-address--so-tickle-me> On 2016-01-05 at 08:33, Olumide <50295 at web.de> wrote: > On 31/12/2015 13:06, Olumide wrote: >> ... considering that Functor is defined as >> >> class Functor f > > where fmap :: (a -> b) -> f a -> f b >> > > Still on the subject, according to LYH, the above definition(?) is read > thusly: "fmap takes a function from one type as to another and a functor > value applied with one type and returns a functor value applied with > another type". > > So if list is "a part of the part of the Functor type class" (quoting > LYH) how am I to grok a list e.g. [1,2,3] as a "functor value applied to > a type"? The type of [1,2,3] is [Int] (or possibly [Integer], [Float], [Double], or similar). We read [Int] as "list of Ints". "List" is the instance of Functor, Int is the type to which "list" is applied. This may be easier to understand for types which are written prefix, rather than [], which is written around Int. "List Int" or "Maybe Int" look like a function List or Maybe applied to the argument Int, except that the capitalization reminds us that these are types, not values / terms. The section on kinds, may help here. Kinds give us a formal syntax for expressing things like "list takes a type as input and gives back a new type". bergey From lists0 at freea2a.de Thu Jan 7 21:27:44 2016 From: lists0 at freea2a.de (Puck) Date: Thu, 7 Jan 2016 22:27:44 +0100 Subject: [Haskell-beginners] wxHaskell: add an external event from another thread Message-ID: <20160107222744.283494eb@noordzee> Hello all, how is it possible to process external events, for example a succeeded getLine or a takeMVar with its values in the wxHaskell framework? The reason is, that I want to connect a erlang node to wxHaskell. I have found the functions Graphics.UI.WX.Events.newEvent :: String -> (w -> IO a) -> (w -> a -> IO ()) -> Event w a "Create a new event from a get and set function." Beside from, that I don't know what the get and set function shall do, I don't know, how I can add the new event to the event-loop of wx, and when it "fires". Do you know any possibilities? Thank you in advance From jykang22 at gmail.com Thu Jan 7 21:54:47 2016 From: jykang22 at gmail.com (Jeon-Young Kang) Date: Thu, 7 Jan 2016 16:54:47 -0500 Subject: [Haskell-beginners] Pattern Matching for record syntax Message-ID: Dear All. Hope your 2016 is off to a great start. I would like to get results from pattern matching or something. Here is the my code. data Person = Person {name :: String, age :: Int} names = ["tom", "sara"] -- list of names, String persons = [Person {name = "tom", age = 10}, Person {name="sara", age=9}, Person {name = "susan", age = 8}]. Is there any solution to get the age of "tom" and "sara"? I have no idea of pattern matching for this one. I've tried to use recursion, but I couldn't find any solution for list of records. Sincerely, Young -------------- next part -------------- An HTML attachment was scrubbed... URL: From magnus at therning.org Thu Jan 7 22:24:18 2016 From: magnus at therning.org (Magnus Therning) Date: Thu, 07 Jan 2016 23:24:18 +0100 Subject: [Haskell-beginners] Pattern Matching for record syntax In-Reply-To: References: Message-ID: <871t9tkoz1.fsf@therning.org> Jeon-Young Kang writes: > Dear All. > > Hope your 2016 is off to a great start. > > I would like to get results from pattern matching or something. > > Here is the my code. > > data Person = Person {name :: String, age :: Int} > > names = ["tom", "sara"] -- list of names, String > > persons = [Person {name = "tom", age = 10}, Person {name="sara", age=9}, > Person {name = "susan", age = 8}]. > > Is there any solution to get the age of "tom" and "sara"? > > I have no idea of pattern matching for this one. > > I've tried to use recursion, but I couldn't find any solution for list of > records. How about using `filter`[1] over `persons` with a function checking if the name is in `names`? I'm sorry, but this sounds like home work so you won't get more than this from me. /M [1]: http://hackage.haskell.org/package/base-4.8.1.0/docs/Data-List.html#v:filter -- Magnus Therning OpenPGP: 0x927912051716CE39 email: magnus at therning.org jabber: magnus at therning.org twitter: magthe http://therning.org/magnus Would you go to war without a helmet? Would you drive without the seat belt? Then why do you develop software as if shit doesn?t happen? -- Alberto G ( http://makinggoodsoftware.com/2009/05/12/hdd/ ) -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 800 bytes Desc: not available URL: From imantc at gmail.com Thu Jan 7 22:28:54 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 7 Jan 2016 23:28:54 +0100 Subject: [Haskell-beginners] Pattern Matching for record syntax In-Reply-To: References: Message-ID: you could filter record list http://hackage.haskell.org/package/base-4.8.1.0/docs/Prelude.html#v:filter \r -> elem (name r) names then fmap the filtered list to extract age age <$> list1 -------------- next part -------------- An HTML attachment was scrubbed... URL: From jykang22 at gmail.com Thu Jan 7 22:29:10 2016 From: jykang22 at gmail.com (Jeon-Young Kang) Date: Thu, 7 Jan 2016 17:29:10 -0500 Subject: [Haskell-beginners] Pattern Matching for record syntax In-Reply-To: <871t9tkoz1.fsf@therning.org> References: <871t9tkoz1.fsf@therning.org> Message-ID: Thanks Magnus Therning. Actually, this is NOT homework. I am just studying Haskell for my current research. I've tried "filter" before. But I couldn't reach what I want to do. it seems that filter is only applicable to list, not "record syntax". Do I need functor for this?? Best, On Thu, Jan 7, 2016 at 5:24 PM, Magnus Therning wrote: > > Jeon-Young Kang writes: > > > Dear All. > > > > Hope your 2016 is off to a great start. > > > > I would like to get results from pattern matching or something. > > > > Here is the my code. > > > > data Person = Person {name :: String, age :: Int} > > > > names = ["tom", "sara"] -- list of names, String > > > > persons = [Person {name = "tom", age = 10}, Person {name="sara", age=9}, > > Person {name = "susan", age = 8}]. > > > > Is there any solution to get the age of "tom" and "sara"? > > > > I have no idea of pattern matching for this one. > > > > I've tried to use recursion, but I couldn't find any solution for list of > > records. > > How about using `filter`[1] over `persons` with a function checking if > the name is in `names`? > > I'm sorry, but this sounds like home work so you won't get more than > this from me. > > /M > > [1]: > http://hackage.haskell.org/package/base-4.8.1.0/docs/Data-List.html#v:filter > > -- > Magnus Therning OpenPGP: 0x927912051716CE39 > email: magnus at therning.org jabber: magnus at therning.org > twitter: magthe http://therning.org/magnus > > Would you go to war without a helmet? Would you drive without the seat > belt? Then why do you develop software as if shit doesn?t happen? > -- Alberto G ( http://makinggoodsoftware.com/2009/05/12/hdd/ ) > > _______________________________________________ > 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 imantc at gmail.com Thu Jan 7 22:33:55 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 7 Jan 2016 23:33:55 +0100 Subject: [Haskell-beginners] Pattern Matching for record syntax In-Reply-To: References: Message-ID: if you must use pattern matching, here is a tip: (Person name0 age0) i.e. records are like tuples with values in the order of declared record fields. name0 can be named anything else. To match any field value, use _ for that field -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Thu Jan 7 22:37:44 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 7 Jan 2016 23:37:44 +0100 Subject: [Haskell-beginners] Pattern Matching for record syntax In-Reply-To: References: <871t9tkoz1.fsf@therning.org> Message-ID: > filter is only applicable to list, not "record syntax". but [Person] is the input, isn't it? > Do I need functor for this?? no need to define new functor instance to filter over a list of records. but you could use fmap over list, yes -------------- next part -------------- An HTML attachment was scrubbed... URL: From jykang22 at gmail.com Thu Jan 7 22:43:19 2016 From: jykang22 at gmail.com (Jeon-Young Kang) Date: Thu, 7 Jan 2016 17:43:19 -0500 Subject: [Haskell-beginners] Pattern Matching for record syntax In-Reply-To: References: <871t9tkoz1.fsf@therning.org> Message-ID: For pattern matching.. I implemented like this. compareName a (Person name age) | (a == name) = age but, I got stuck how to apply pattern matching for the two lists. i.e., both names and persons are lists. I really appreciate your advice.. On Thu, Jan 7, 2016 at 5:37 PM, Imants Cekusins wrote: > > filter is only applicable to list, not "record syntax". > > but [Person] is the input, isn't it? > > > Do I need functor for this?? > > no need to define new functor instance to filter over a list of records. > > but you could use fmap over list, yes > > _______________________________________________ > 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 imantc at gmail.com Thu Jan 7 22:50:32 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 7 Jan 2016 23:50:32 +0100 Subject: [Haskell-beginners] Pattern Matching for record syntax In-Reply-To: References: <871t9tkoz1.fsf@therning.org> Message-ID: Could you filter, then map? I'd try that instead of pattern matching. -------------- next part -------------- An HTML attachment was scrubbed... URL: From magnus at therning.org Thu Jan 7 22:51:59 2016 From: magnus at therning.org (Magnus Therning) Date: Thu, 07 Jan 2016 23:51:59 +0100 Subject: [Haskell-beginners] Pattern Matching for record syntax In-Reply-To: References: <871t9tkoz1.fsf@therning.org> Message-ID: <87wprlj94g.fsf@therning.org> Jeon-Young Kang writes: > For pattern matching.. I implemented like this. > > compareName a (Person name age) > | (a == name) = age > > but, I got stuck how to apply pattern matching for the two lists. > i.e., both names and persons are lists. > > I really appreciate your advice.. Something like this works: map age $ filter (\ p -> (name p) `elem` names) persons /M -- Magnus Therning OpenPGP: 0x927912051716CE39 email: magnus at therning.org jabber: magnus at therning.org twitter: magthe http://therning.org/magnus Finagle's Fifth Law: Always draw your curves, then plot your readings. -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 800 bytes Desc: not available URL: From jykang22 at gmail.com Thu Jan 7 23:02:12 2016 From: jykang22 at gmail.com (Jeon-Young Kang) Date: Thu, 7 Jan 2016 18:02:12 -0500 Subject: [Haskell-beginners] Pattern Matching for record syntax In-Reply-To: <87wprlj94g.fsf@therning.org> References: <871t9tkoz1.fsf@therning.org> <87wprlj94g.fsf@therning.org> Message-ID: I figured out.. Thank you so much. On Thu, Jan 7, 2016 at 5:51 PM, Magnus Therning wrote: > > Jeon-Young Kang writes: > > > For pattern matching.. I implemented like this. > > > > compareName a (Person name age) > > | (a == name) = age > > > > but, I got stuck how to apply pattern matching for the two lists. > > i.e., both names and persons are lists. > > > > I really appreciate your advice.. > > Something like this works: > > map age $ filter (\ p -> (name p) `elem` names) persons > > /M > > -- > Magnus Therning OpenPGP: 0x927912051716CE39 > email: magnus at therning.org jabber: magnus at therning.org > twitter: magthe http://therning.org/magnus > > Finagle's Fifth Law: > Always draw your curves, then plot your readings. > > _______________________________________________ > 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 frantisek.kocun at gmail.com Fri Jan 8 03:46:11 2016 From: frantisek.kocun at gmail.com (frantisek kocun) Date: Thu, 7 Jan 2016 22:46:11 -0500 Subject: [Haskell-beginners] stack issues Message-ID: Hi, I'm new to cabal/stack. I want to use "stack build" to build my project. I can not use latest gkt >= 0.14.2 because of setup: The pkg-config package 'cairo' version >=1.2.0 is required but it could Neither can I now use older version gtk >=0.12.0 && < 0.13 While constructing the BuildPlan the following exceptions were encountered: -- Failure when adding dependencies: gtk: needed (>=0.12.0 && <0.13), 0.14.2 found (latest version available) needed for package: ships-0.1.0.0 What can i do? Thanks -------------- next part -------------- An HTML attachment was scrubbed... URL: From frantisek.kocun at gmail.com Fri Jan 8 04:13:36 2016 From: frantisek.kocun at gmail.com (frantisek kocun) Date: Thu, 7 Jan 2016 23:13:36 -0500 Subject: [Haskell-beginners] stack issues In-Reply-To: References: Message-ID: Found that gtk was not installed. So I did brew install gtk but I got different problem [ 22 of 209] Compiling Graphics.UI.Gtk.Embedding.Plug ( .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/Graphics/UI/Gtk/Embedding/Plug.hs, .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/Graphics/UI/Gtk/Embedding/Plug.o ) Graphics/UI/Gtk/Embedding/Plug.chs:120:6: Couldn't match expected type ?Ptr ()? with actual type ?Maybe DrawWindow? In the first argument of ?gtk_plug_new?, namely ?(fromNativeWindowId (fromMaybe nativeWindowIdNone socketId))? In the second argument of ?($)?, namely ?gtk_plug_new (fromNativeWindowId (fromMaybe nativeWindowIdNone socketId))? On Thu, Jan 7, 2016 at 10:46 PM, frantisek kocun wrote: > Hi, > > I'm new to cabal/stack. I want to use "stack build" to build my project. > > I can not use latest gkt >= 0.14.2 because of > setup: The pkg-config package 'cairo' version >=1.2.0 is required but > it could > > Neither can I now use older version gtk >=0.12.0 && < 0.13 > > While constructing the BuildPlan the following exceptions were encountered: > > -- Failure when adding dependencies: > > gtk: needed (>=0.12.0 && <0.13), 0.14.2 found (latest version > available) > > needed for package: ships-0.1.0.0 > > > > What can i do? Thanks > -------------- next part -------------- An HTML attachment was scrubbed... URL: From frantisek.kocun at gmail.com Fri Jan 8 05:16:52 2016 From: frantisek.kocun at gmail.com (frantisek kocun) Date: Fri, 8 Jan 2016 00:16:52 -0500 Subject: [Haskell-beginners] stack issues In-Reply-To: References: Message-ID: I found this cabal install gtk -fhave-quartz-gtk --reinstall but it does not help me when I run stack build afterwards.. On Thu, Jan 7, 2016 at 11:13 PM, frantisek kocun wrote: > Found that gtk was not installed. So I did > brew install gtk > > but I got different problem > > [ 22 of 209] Compiling Graphics.UI.Gtk.Embedding.Plug ( > .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/Graphics/UI/Gtk/Embedding/Plug.hs, > .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/Graphics/UI/Gtk/Embedding/Plug.o > ) > > > > Graphics/UI/Gtk/Embedding/Plug.chs:120:6: > > Couldn't match expected type ?Ptr ()? > > with actual type ?Maybe DrawWindow? > > In the first argument of ?gtk_plug_new?, namely > > ?(fromNativeWindowId (fromMaybe nativeWindowIdNone socketId))? > > In the second argument of ?($)?, namely > > ?gtk_plug_new > > (fromNativeWindowId (fromMaybe nativeWindowIdNone socketId))? > > On Thu, Jan 7, 2016 at 10:46 PM, frantisek kocun < > frantisek.kocun at gmail.com> wrote: > >> Hi, >> >> I'm new to cabal/stack. I want to use "stack build" to build my project. >> >> I can not use latest gkt >= 0.14.2 because of >> setup: The pkg-config package 'cairo' version >=1.2.0 is required but >> it could >> >> Neither can I now use older version gtk >=0.12.0 && < 0.13 >> >> While constructing the BuildPlan the following exceptions were >> encountered: >> >> -- Failure when adding dependencies: >> >> gtk: needed (>=0.12.0 && <0.13), 0.14.2 found (latest version >> available) >> >> needed for package: ships-0.1.0.0 >> >> >> >> What can i do? Thanks >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From frantisek.kocun at gmail.com Fri Jan 8 05:43:19 2016 From: frantisek.kocun at gmail.com (frantisek kocun) Date: Fri, 8 Jan 2016 00:43:19 -0500 Subject: [Haskell-beginners] stack issues In-Reply-To: References: Message-ID: This works for me $ stack build gtk --flag gtk:have-quartz-gtk but I sitll need to specify gtk also in cabal file (having it only in stack.yaml do not find the package) but then I get $ stack build gtk-0.13.9: unregistering (flags changed from ["-fhave-quartz-gtk"] to []) On Fri, Jan 8, 2016 at 12:16 AM, frantisek kocun wrote: > I found this > > cabal install gtk -fhave-quartz-gtk --reinstall > > but it does not help me when I run stack build afterwards.. > > On Thu, Jan 7, 2016 at 11:13 PM, frantisek kocun < > frantisek.kocun at gmail.com> wrote: > >> Found that gtk was not installed. So I did >> brew install gtk >> >> but I got different problem >> >> [ 22 of 209] Compiling Graphics.UI.Gtk.Embedding.Plug ( >> .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/Graphics/UI/Gtk/Embedding/Plug.hs, >> .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/Graphics/UI/Gtk/Embedding/Plug.o >> ) >> >> >> >> Graphics/UI/Gtk/Embedding/Plug.chs:120:6: >> >> Couldn't match expected type ?Ptr ()? >> >> with actual type ?Maybe DrawWindow? >> >> In the first argument of ?gtk_plug_new?, namely >> >> ?(fromNativeWindowId (fromMaybe nativeWindowIdNone socketId))? >> >> In the second argument of ?($)?, namely >> >> ?gtk_plug_new >> >> (fromNativeWindowId (fromMaybe nativeWindowIdNone socketId))? >> >> On Thu, Jan 7, 2016 at 10:46 PM, frantisek kocun < >> frantisek.kocun at gmail.com> wrote: >> >>> Hi, >>> >>> I'm new to cabal/stack. I want to use "stack build" to build my project. >>> >>> I can not use latest gkt >= 0.14.2 because of >>> setup: The pkg-config package 'cairo' version >=1.2.0 is required but >>> it could >>> >>> Neither can I now use older version gtk >=0.12.0 && < 0.13 >>> >>> While constructing the BuildPlan the following exceptions were >>> encountered: >>> >>> -- Failure when adding dependencies: >>> >>> gtk: needed (>=0.12.0 && <0.13), 0.14.2 found (latest version >>> available) >>> >>> needed for package: ships-0.1.0.0 >>> >>> >>> >>> What can i do? Thanks >>> >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From frantisek.kocun at gmail.com Fri Jan 8 05:45:24 2016 From: frantisek.kocun at gmail.com (frantisek kocun) Date: Fri, 8 Jan 2016 00:45:24 -0500 Subject: [Haskell-beginners] stack issues In-Reply-To: References: Message-ID: Is there a way to specify these flags in cabal file? I'm sure this will resolve my issue On Fri, Jan 8, 2016 at 12:43 AM, frantisek kocun wrote: > This works for me > > $ stack build gtk --flag gtk:have-quartz-gtk > > but I sitll need to specify gtk also in cabal file (having it only in > stack.yaml do not find the package) > > but then I get > > $ stack build > > gtk-0.13.9: unregistering (flags changed from ["-fhave-quartz-gtk"] to []) > > On Fri, Jan 8, 2016 at 12:16 AM, frantisek kocun < > frantisek.kocun at gmail.com> wrote: > >> I found this >> >> cabal install gtk -fhave-quartz-gtk --reinstall >> >> but it does not help me when I run stack build afterwards.. >> >> On Thu, Jan 7, 2016 at 11:13 PM, frantisek kocun < >> frantisek.kocun at gmail.com> wrote: >> >>> Found that gtk was not installed. So I did >>> brew install gtk >>> >>> but I got different problem >>> >>> [ 22 of 209] Compiling Graphics.UI.Gtk.Embedding.Plug ( >>> .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/Graphics/UI/Gtk/Embedding/Plug.hs, >>> .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/Graphics/UI/Gtk/Embedding/Plug.o >>> ) >>> >>> >>> >>> Graphics/UI/Gtk/Embedding/Plug.chs:120:6: >>> >>> Couldn't match expected type ?Ptr ()? >>> >>> with actual type ?Maybe DrawWindow? >>> >>> In the first argument of ?gtk_plug_new?, namely >>> >>> ?(fromNativeWindowId (fromMaybe nativeWindowIdNone socketId))? >>> >>> In the second argument of ?($)?, namely >>> >>> ?gtk_plug_new >>> >>> (fromNativeWindowId (fromMaybe nativeWindowIdNone >>> socketId))? >>> >>> On Thu, Jan 7, 2016 at 10:46 PM, frantisek kocun < >>> frantisek.kocun at gmail.com> wrote: >>> >>>> Hi, >>>> >>>> I'm new to cabal/stack. I want to use "stack build" to build my project. >>>> >>>> I can not use latest gkt >= 0.14.2 because of >>>> setup: The pkg-config package 'cairo' version >=1.2.0 is required >>>> but it could >>>> >>>> Neither can I now use older version gtk >=0.12.0 && < 0.13 >>>> >>>> While constructing the BuildPlan the following exceptions were >>>> encountered: >>>> >>>> -- Failure when adding dependencies: >>>> >>>> gtk: needed (>=0.12.0 && <0.13), 0.14.2 found (latest version >>>> available) >>>> >>>> needed for package: ships-0.1.0.0 >>>> >>>> >>>> >>>> What can i do? Thanks >>>> >>> >>> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From michael at snoyman.com Fri Jan 8 06:55:00 2016 From: michael at snoyman.com (Michael Snoyman) Date: Fri, 8 Jan 2016 08:55:00 +0200 Subject: [Haskell-beginners] stack issues In-Reply-To: References: Message-ID: You need to specify the flag in the stack.yaml file, via something like: flags: gtk: have-quartz-gtk: true On Fri, Jan 8, 2016 at 7:45 AM, frantisek kocun wrote: > Is there a way to specify these flags in cabal file? I'm sure this will > resolve my issue > > > On Fri, Jan 8, 2016 at 12:43 AM, frantisek kocun < > frantisek.kocun at gmail.com> wrote: > >> This works for me >> >> $ stack build gtk --flag gtk:have-quartz-gtk >> >> but I sitll need to specify gtk also in cabal file (having it only in >> stack.yaml do not find the package) >> >> but then I get >> >> $ stack build >> >> gtk-0.13.9: unregistering (flags changed from ["-fhave-quartz-gtk"] to []) >> >> On Fri, Jan 8, 2016 at 12:16 AM, frantisek kocun < >> frantisek.kocun at gmail.com> wrote: >> >>> I found this >>> >>> cabal install gtk -fhave-quartz-gtk --reinstall >>> >>> but it does not help me when I run stack build afterwards.. >>> >>> On Thu, Jan 7, 2016 at 11:13 PM, frantisek kocun < >>> frantisek.kocun at gmail.com> wrote: >>> >>>> Found that gtk was not installed. So I did >>>> brew install gtk >>>> >>>> but I got different problem >>>> >>>> [ 22 of 209] Compiling Graphics.UI.Gtk.Embedding.Plug ( >>>> .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/Graphics/UI/Gtk/Embedding/Plug.hs, >>>> .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/Graphics/UI/Gtk/Embedding/Plug.o >>>> ) >>>> >>>> >>>> >>>> Graphics/UI/Gtk/Embedding/Plug.chs:120:6: >>>> >>>> Couldn't match expected type ?Ptr ()? >>>> >>>> with actual type ?Maybe DrawWindow? >>>> >>>> In the first argument of ?gtk_plug_new?, namely >>>> >>>> ?(fromNativeWindowId (fromMaybe nativeWindowIdNone socketId))? >>>> >>>> In the second argument of ?($)?, namely >>>> >>>> ?gtk_plug_new >>>> >>>> (fromNativeWindowId (fromMaybe nativeWindowIdNone >>>> socketId))? >>>> >>>> On Thu, Jan 7, 2016 at 10:46 PM, frantisek kocun < >>>> frantisek.kocun at gmail.com> wrote: >>>> >>>>> Hi, >>>>> >>>>> I'm new to cabal/stack. I want to use "stack build" to build my >>>>> project. >>>>> >>>>> I can not use latest gkt >= 0.14.2 because of >>>>> setup: The pkg-config package 'cairo' version >=1.2.0 is required >>>>> but it could >>>>> >>>>> Neither can I now use older version gtk >=0.12.0 && < 0.13 >>>>> >>>>> While constructing the BuildPlan the following exceptions were >>>>> encountered: >>>>> >>>>> -- Failure when adding dependencies: >>>>> >>>>> gtk: needed (>=0.12.0 && <0.13), 0.14.2 found (latest version >>>>> available) >>>>> >>>>> needed for package: ships-0.1.0.0 >>>>> >>>>> >>>>> >>>>> What can i do? Thanks >>>>> >>>> >>>> >>> >> > > _______________________________________________ > 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 alexander at plaimi.net Fri Jan 8 11:10:46 2016 From: alexander at plaimi.net (Alexander Berntsen) Date: Fri, 8 Jan 2016 12:10:46 +0100 Subject: [Haskell-beginners] Parametrizing [] as an instance of the Functor type class In-Reply-To: <568BCC24.4020009@web.de> References: <5685284A.3010702@web.de> <5685293A.7020104@plaimi.net> <5686D0D0.4070004@web.de> <5686D679.1000909@plaimi.net> <568BCC24.4020009@web.de> Message-ID: <568F9936.1000405@plaimi.net> -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA512 Rein and bergey covered most of it. As for On 05/01/16 14:59, Olumide wrote: > (BTW, google tells me "term-level" has a special meaning that I do > not yet know.) Term-level is the level "below" types. A term has a type and a type has a kind. - -- 3 is a term with type Int. 3 :: Int -- Here :: can be read "has-type" - -- Int is a type with kind *. Int :: * -- Whilst here :: is "has-kind" - -- Alexander alexander at plaimi.net https://secure.plaimi.net/~alexander -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQIcBAEBCgAGBQJWj5k1AAoJENQqWdRUGk8BmLwP/1yCHs4TMwyZf3IjrQwYf+TN CKj//05T6vxctnNeehP2B4088lW/0nJNBpOx1MxFe0TDDREpL7uts5CRW5I2xhhu a5rn0hdshvlFXNXJ7OA+P+Rvlm+zAt0hbLkOst9/dVl70w3s2UqRiskkib0pMUsW 7R8GOX9aS4qUqQi5XH8JG2A2naKSGqWdtz8vI2AJ2jujGIx80zRUKIOrkDf5O6i/ DgQ4d019OaxUAyLJZP9CyuLAhg8up29VVPq0JxV9t3j7BYGnNK3AawEzisklUKlY M3EfJqbV8OH1Munu/dxHdPzD+XtMEuWkfXe6qWEEytDn1jLcdEYb7YowKRykJron 5OJXLAB1jppO2KvjtZNA6YhVmf8WeEEtdZw6zHtkWgb4M6DHBV5sQ9Gg0R/M3C2u NKHG+UPq2xL+S3CSQN9PbpVZPQuGuB3heqhfCHtQasvNqJPdqYkgsxRm3TmjW83k 6lvdHSzKWdowUHX72KMkoDGb0obG4ivXfTn2HkCJiVFAuoYwwwWOfzxJAlrmOvFk 7Dv0ZHuHu3AQUqz6IeybkLibFLYoQOqpj1ipKVDxb286CTpx80aF3ZvWkJv2rwoT V9h8g/wO9gudRTPFS61uEZ9YEcWmAgzKNisMAmicAFATKH+/1Ezr4mh9JyNeafF8 bc5W94c5sGR9etkR8Y4p =zgxs -----END PGP SIGNATURE----- From abhisandhyasp.ap at gmail.com Fri Jan 8 13:42:47 2016 From: abhisandhyasp.ap at gmail.com (Abhijit Patel) Date: Fri, 8 Jan 2016 19:12:47 +0530 Subject: [Haskell-beginners] error while setting it up Message-ID: for the below command I am getting errror !! please suggest me a solution $make ===--- building phase 0 make --no-print-directory -f ghc.mk phase=0 phase_0_builds ghc.mk:159: *** dyn is not in $(GhcLibWays), but $(DYNAMIC_GHC_PROGRAMS) is YES. Stop. make: *** [all] Error 2 -------------- next part -------------- An HTML attachment was scrubbed... URL: From t_gass at gmx.de Fri Jan 8 16:20:23 2016 From: t_gass at gmx.de (Tilmann) Date: Fri, 8 Jan 2016 17:20:23 +0100 Subject: [Haskell-beginners] wxHaskell: add an external event from another thread In-Reply-To: <20160107222744.283494eb@noordzee> References: <20160107222744.283494eb@noordzee> Message-ID: <568FE1C7.3020606@gmx.de> Hi, this post might be helpful. http://snipplr.com/view/17538/wxhaskell-multithread--custom-event-example/ I needed something similar and came up with this. As far as I know there is now wxhaskell internal way of doing this. import Graphics.UI.WX import Graphics.UI.WXCore import Control.Concurrent eventId :: Int eventId = wxID_HIGHEST + 2 main :: IO () main = do chan <- newChan forkIO $ externalEventLoop chan start $ gui chan externalEventLoop :: Chan String -> IO () externalEventLoop chan = do writeChan chan "foobar" threadDelay $ 10 ^ 6 externalEventLoop chan gui :: Chan String -> IO () gui chan = do vCmd <- newEmptyMVar f <- frame [] st <- textCtrl f [] forkIO $ eventLoop eventId chan vCmd f evtHandlerOnMenuCommand f eventId $ takeMVar vCmd >>= \text -> appendText st $ text ++ "\n" set f [layout := fill $ minsize (Size 100 100) $ widget st] eventLoop :: Int -> Chan String -> MVar String -> Frame () -> IO () eventLoop eventId chan vCmd f = do content <- readChan chan putMVar vCmd content e <- commandEventCreate wxEVT_COMMAND_MENU_SELECTED eventId evtHandlerAddPendingEvent f e eventLoop eventId chan vCmd f Am 07.01.16 um 22:27 schrieb Puck: > Hello all, > > how is it possible to process external events, for example a > succeeded getLine or a takeMVar with its values in the wxHaskell > framework? > > The reason is, that I want to connect a erlang node to wxHaskell. > > I have found the functions > Graphics.UI.WX.Events.newEvent :: String -> (w -> IO a) -> (w -> a -> > IO ()) -> Event w a > "Create a new event from a get and set function." > > Beside from, that I don't know what the get and set function shall do, I > don't know, how I can add the new event to the event-loop of wx, and > when it "fires". > > Do you know any possibilities? > > Thank you in advance > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From frantisek.kocun at gmail.com Fri Jan 8 18:25:37 2016 From: frantisek.kocun at gmail.com (frantisek kocun) Date: Fri, 8 Jan 2016 13:25:37 -0500 Subject: [Haskell-beginners] stack issues In-Reply-To: References: Message-ID: Thanks Michael Having this in stack.yaml extra-deps: - gtk-0.14.2 # Override default flag values for local packages and extra-deps flags: { gtk: { have-quartz-gtk: true } } and adding gtk to cabal file helped me to resolve this issue! I still have different problem. I will try to find the solution or ask later when I'm out of ideas. [1 of 1] Compiling Main ( app/Main.hs, .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/ships-exe/ships-exe-tmp/Main.o ) Linking .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/ships-exe/ships-exe ... Undefined symbols for architecture x86_64: "_shipszuKPBflZZ3qlkXJFnVVcHORae_Gtk2hsziUtils_zdwa1_closure", referenced from: _SkK4_srt in libHSships-0.1.0.0-KPBflZ3qlkXJFnVVcHORae.a(GUI.o) "_shipszuKPBflZZ3qlkXJFnVVcHORae_Gtk2hsziUtils_zdwa1_info", referenced from: _clGK_info in libHSships-0.1.0.0-KPBflZ3qlkXJFnVVcHORae.a(GUI.o) On Fri, Jan 8, 2016 at 1:55 AM, Michael Snoyman wrote: > You need to specify the flag in the stack.yaml file, via something like: > > flags: > gtk: > have-quartz-gtk: true > > On Fri, Jan 8, 2016 at 7:45 AM, frantisek kocun > wrote: > >> Is there a way to specify these flags in cabal file? I'm sure this will >> resolve my issue >> >> >> On Fri, Jan 8, 2016 at 12:43 AM, frantisek kocun < >> frantisek.kocun at gmail.com> wrote: >> >>> This works for me >>> >>> $ stack build gtk --flag gtk:have-quartz-gtk >>> >>> but I sitll need to specify gtk also in cabal file (having it only in >>> stack.yaml do not find the package) >>> >>> but then I get >>> >>> $ stack build >>> >>> gtk-0.13.9: unregistering (flags changed from ["-fhave-quartz-gtk"] to >>> []) >>> >>> On Fri, Jan 8, 2016 at 12:16 AM, frantisek kocun < >>> frantisek.kocun at gmail.com> wrote: >>> >>>> I found this >>>> >>>> cabal install gtk -fhave-quartz-gtk --reinstall >>>> >>>> but it does not help me when I run stack build afterwards.. >>>> >>>> On Thu, Jan 7, 2016 at 11:13 PM, frantisek kocun < >>>> frantisek.kocun at gmail.com> wrote: >>>> >>>>> Found that gtk was not installed. So I did >>>>> brew install gtk >>>>> >>>>> but I got different problem >>>>> >>>>> [ 22 of 209] Compiling Graphics.UI.Gtk.Embedding.Plug ( >>>>> .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/Graphics/UI/Gtk/Embedding/Plug.hs, >>>>> .stack-work/dist/x86_64-osx/Cabal-1.22.5.0/build/Graphics/UI/Gtk/Embedding/Plug.o >>>>> ) >>>>> >>>>> >>>>> >>>>> Graphics/UI/Gtk/Embedding/Plug.chs:120:6: >>>>> >>>>> Couldn't match expected type ?Ptr ()? >>>>> >>>>> with actual type ?Maybe DrawWindow? >>>>> >>>>> In the first argument of ?gtk_plug_new?, namely >>>>> >>>>> ?(fromNativeWindowId (fromMaybe nativeWindowIdNone >>>>> socketId))? >>>>> >>>>> In the second argument of ?($)?, namely >>>>> >>>>> ?gtk_plug_new >>>>> >>>>> (fromNativeWindowId (fromMaybe nativeWindowIdNone >>>>> socketId))? >>>>> >>>>> On Thu, Jan 7, 2016 at 10:46 PM, frantisek kocun < >>>>> frantisek.kocun at gmail.com> wrote: >>>>> >>>>>> Hi, >>>>>> >>>>>> I'm new to cabal/stack. I want to use "stack build" to build my >>>>>> project. >>>>>> >>>>>> I can not use latest gkt >= 0.14.2 because of >>>>>> setup: The pkg-config package 'cairo' version >=1.2.0 is required >>>>>> but it could >>>>>> >>>>>> Neither can I now use older version gtk >=0.12.0 && < 0.13 >>>>>> >>>>>> While constructing the BuildPlan the following exceptions were >>>>>> encountered: >>>>>> >>>>>> -- Failure when adding dependencies: >>>>>> >>>>>> gtk: needed (>=0.12.0 && <0.13), 0.14.2 found (latest version >>>>>> available) >>>>>> >>>>>> needed for package: ships-0.1.0.0 >>>>>> >>>>>> >>>>>> >>>>>> What can i do? Thanks >>>>>> >>>>> >>>>> >>>> >>> >> >> _______________________________________________ >> 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 hjgtuyl at chello.nl Fri Jan 8 22:12:05 2016 From: hjgtuyl at chello.nl (Henk-Jan van Tuyl) Date: Fri, 08 Jan 2016 23:12:05 +0100 Subject: [Haskell-beginners] [Haskell-cafe] error while setting it up In-Reply-To: References: Message-ID: On Fri, 08 Jan 2016 14:42:47 +0100, Abhijit Patel wrote: > for the below command I am getting errror !! > please suggest me a solution > $make > ===--- building phase 0 > make --no-print-directory -f ghc.mk phase=0 phase_0_builds > ghc.mk:159: *** dyn is not in $(GhcLibWays), but $(DYNAMIC_GHC_PROGRAMS) > is > YES. Stop. > make: *** [all] Error 2 A search on Internet for the message "dyn is not in $(GhcLibWays)" lead me to https://mail.haskell.org/pipermail/ghc-devs/2013-May/001306.html Regards, Henk-Jan van Tuyl -- Folding at home What if you could share your unused computer power to help find a cure? In just 5 minutes you can join the world's biggest networked computer and get us closer sooner. Watch the video. http://folding.stanford.edu/ http://Van.Tuyl.eu/ http://members.chello.nl/hjgtuyl/tourdemonad.html Haskell programming -- From theedge456 at free.fr Sat Jan 9 15:21:46 2016 From: theedge456 at free.fr (Fabien R) Date: Sat, 9 Jan 2016 16:21:46 +0100 Subject: [Haskell-beginners] question on evaluation Message-ID: <5691258A.2060907@free.fr> Hello, I want to define a function blowup that takes "bang" as input and returns "baannngggg". I come up with these functions; myReverse :: [a] -> [a] myReverse [] = [] myReverse (x:xs) = myReverse xs ++ [x] buildLenList :: String -> [Int] buildLenList "" = [] buildLenList (_:xs) = [1 + length xs ] ++ buildLenList xs myRepeat :: Char -> Int -> String myRepeat x 0 = [] myRepeat x n = [x] ++ myRepeat x (n - 1) blowup :: String -> String blowup [] = [] blowup (x:xs) = myRepeat x (head ( (buildLenList (x:xs)))) ++ blowup xs With this code, blowup "bang" returns "bbbbaaanng". So I thought to insert myReverse between head and buildLenList but in that case, the result is only "bang". It seems that the evaluation of buildLenList is not working as I thought. I tried to debug that using ghci debugger but failed (still learning). Can someone explain how the evaluation is done here ? -- Fabien From tanuki at gmail.com Sat Jan 9 23:54:41 2016 From: tanuki at gmail.com (Theodore Lief Gannon) Date: Sat, 9 Jan 2016 15:54:41 -0800 Subject: [Haskell-beginners] question on evaluation In-Reply-To: <5691258A.2060907@free.fr> References: <5691258A.2060907@free.fr> Message-ID: Here's why you're getting the longer repetition first: buildLenList "bang" = buildLenList (_:"ang") = [1 + length "ang"] ++ buildLenList "ang" = [4] ++ buildLenList "ang" (...) = [4, 3, 2, 1] And the reason calling myReverse on that doesn't give you [1, 2, 3, 4] is that you're reversing a different list every time: blowup "bang" = blowup ('b':"ang") = myRepeat 'b' (head (myReverse (buildLenList ('b':"ang"))) ++ blowup "ang" = myRepeat 'b' (head (myReverse [4, 3, 2, 1]) ++ blowup "ang" = myRepeat 'b' (head [1, 2, 3, 4] ++ blowup "ang" = myRepeat 'b' 1 ++ blowup "ang" = "b" ++ blowup "ang" = "b" ++ blowup ('a':"ng") = "b" ++ myRepeat 'a' (head (myReverse (buildLenList ('a':"ng"))) ++ blowup "ng" = "b" ++ myRepeat 'a' (head (myReverse [3, 2, 1]) ++ blowup "ng" = "b" ++ myRepeat 'a' (head [1, 2, 3] ++ blowup "ng" (...) Since you only asked for help with how it evaluates, I'll withhold further spoilers. :) However, I strongly recommend getting more comfortable using the (:) operator for construction instead of just pattern matching; in a couple of your functions it would be a better tool than (++). Also, "at-patterns" are great: blowup l@(x:xs) = myRepeat x (head (buildLenList l)) ++ blowup xs On Sat, Jan 9, 2016 at 7:21 AM, Fabien R wrote: > Hello, > > I want to define a function blowup that takes "bang" as input and returns > "baannngggg". > I come up with these functions; > > myReverse :: [a] -> [a] > myReverse [] = [] > myReverse (x:xs) = myReverse xs ++ [x] > > buildLenList :: String -> [Int] > buildLenList "" = [] > buildLenList (_:xs) = [1 + length xs ] ++ buildLenList xs > > myRepeat :: Char -> Int -> String > myRepeat x 0 = [] > myRepeat x n = [x] ++ myRepeat x (n - 1) > > blowup :: String -> String > blowup [] = [] > blowup (x:xs) = myRepeat x (head ( (buildLenList (x:xs)))) ++ blowup xs > > With this code, blowup "bang" returns "bbbbaaanng". > > So I thought to insert myReverse between head and buildLenList but in that > case, the result is only "bang". > > It seems that the evaluation of buildLenList is not working as I thought. > I tried to debug that using ghci debugger but failed (still learning). > Can someone explain how the evaluation is done here ? > > -- > Fabien > _______________________________________________ > 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 theedge456 at free.fr Sun Jan 10 21:32:47 2016 From: theedge456 at free.fr (Fabien R) Date: Sun, 10 Jan 2016 22:32:47 +0100 Subject: [Haskell-beginners] question on evaluation In-Reply-To: References: <5691258A.2060907@free.fr> Message-ID: <5692CDFF.8030805@free.fr> On 10/01/16 00:54, Theodore Lief Gannon wrote: > And the reason calling myReverse on that doesn't give you [1, 2, 3, 4] is > that you're reversing a different list every time: Got it. > > (...) > > Since you only asked for help with how it evaluates, I'll withhold further > spoilers. :) However, I strongly recommend getting more comfortable using > the (:) operator for construction instead of just pattern matching; in a > couple of your functions it would be a better tool than (++). I'll dig further into that. Also, > "at-patterns" are great: > > blowup l@(x:xs) = myRepeat x (head (buildLenList l)) ++ blowup xs This is handy. Thanks Theodore, -- Fabien > On Sat, Jan 9, 2016 at 7:21 AM, Fabien R wrote: > >> Hello, >> >> I want to define a function blowup that takes "bang" as input and returns >> "baannngggg". >> I come up with these functions; >> >> myReverse :: [a] -> [a] >> myReverse [] = [] >> myReverse (x:xs) = myReverse xs ++ [x] >> >> buildLenList :: String -> [Int] >> buildLenList "" = [] >> buildLenList (_:xs) = [1 + length xs ] ++ buildLenList xs >> >> myRepeat :: Char -> Int -> String >> myRepeat x 0 = [] >> myRepeat x n = [x] ++ myRepeat x (n - 1) >> >> blowup :: String -> String >> blowup [] = [] >> blowup (x:xs) = myRepeat x (head ( (buildLenList (x:xs)))) ++ blowup xs >> >> With this code, blowup "bang" returns "bbbbaaanng". >> >> So I thought to insert myReverse between head and buildLenList but in that >> case, the result is only "bang". >> >> It seems that the evaluation of buildLenList is not working as I thought. >> I tried to debug that using ghci debugger but failed (still learning). >> Can someone explain how the evaluation is done here ? >> >> -- >> Fabien >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From rein.henrichs at gmail.com Mon Jan 11 05:24:31 2016 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Mon, 11 Jan 2016 05:24:31 +0000 Subject: [Haskell-beginners] question on evaluation In-Reply-To: <5692CDFF.8030805@free.fr> References: <5691258A.2060907@free.fr> <5692CDFF.8030805@free.fr> Message-ID: Now that you understand what's going on with your version, here's an idiomatic definition of blowup for you to consider: blowup :: String -> String blowup = join . zipWith replicate [1..] > blowup "bang" "baannngggg" On Sun, Jan 10, 2016 at 1:33 PM Fabien R wrote: > On 10/01/16 00:54, Theodore Lief Gannon wrote: > > And the reason calling myReverse on that doesn't give you [1, 2, 3, 4] is > > that you're reversing a different list every time: > Got it. > > > > (...) > > > > Since you only asked for help with how it evaluates, I'll withhold > further > > spoilers. :) However, I strongly recommend getting more comfortable > using > > the (:) operator for construction instead of just pattern matching; in a > > couple of your functions it would be a better tool than (++). > I'll dig further into that. > > Also, > > "at-patterns" are great: > > > > blowup l@(x:xs) = myRepeat x (head (buildLenList l)) ++ blowup xs > This is handy. > > Thanks Theodore, > > -- > Fabien > > > On Sat, Jan 9, 2016 at 7:21 AM, Fabien R wrote: > > > >> Hello, > >> > >> I want to define a function blowup that takes "bang" as input and > returns > >> "baannngggg". > >> I come up with these functions; > >> > >> myReverse :: [a] -> [a] > >> myReverse [] = [] > >> myReverse (x:xs) = myReverse xs ++ [x] > >> > >> buildLenList :: String -> [Int] > >> buildLenList "" = [] > >> buildLenList (_:xs) = [1 + length xs ] ++ buildLenList xs > >> > >> myRepeat :: Char -> Int -> String > >> myRepeat x 0 = [] > >> myRepeat x n = [x] ++ myRepeat x (n - 1) > >> > >> blowup :: String -> String > >> blowup [] = [] > >> blowup (x:xs) = myRepeat x (head ( (buildLenList (x:xs)))) ++ blowup > xs > >> > >> With this code, blowup "bang" returns "bbbbaaanng". > >> > >> So I thought to insert myReverse between head and buildLenList but in > that > >> case, the result is only "bang". > >> > >> It seems that the evaluation of buildLenList is not working as I > thought. > >> I tried to debug that using ghci debugger but failed (still learning). > >> Can someone explain how the evaluation is done here ? > >> > >> -- > >> Fabien > >> _______________________________________________ > >> 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 theedge456 at free.fr Mon Jan 11 08:41:07 2016 From: theedge456 at free.fr (Fabien R) Date: Mon, 11 Jan 2016 09:41:07 +0100 Subject: [Haskell-beginners] question on evaluation In-Reply-To: References: <5691258A.2060907@free.fr> <5692CDFF.8030805@free.fr> Message-ID: <56936AA3.3010409@free.fr> On 11/01/2016 06:24, Rein Henrichs wrote: > Now that you understand what's going on with your version, here's an > idiomatic definition of blowup for you to consider: > > blowup :: String -> String > blowup = join . zipWith replicate [1..] > > > blowup "bang" > "baannngggg" Thanks for this "hint" Rein. But, for now, it's a kind of "forward reference". I will certainly come up with a similar solution later. -- Fabien From pmcilroy at gmail.com Mon Jan 11 23:18:05 2016 From: pmcilroy at gmail.com (Peter McIlroy) Date: Mon, 11 Jan 2016 15:18:05 -0800 Subject: [Haskell-beginners] questions on evaluation. Message-ID: Fabian, For your problem of bang -> baanngggg You can derive Rein's hairy idiom from a more straightforward technique for getting a recursive definition: First get a basic implementation using ++ and recursion: * add a helper function with any "state variables" as arguments. * Ignore concatenation while thinking about a problem. * Use pattern matching for recursion step. This gives the basic (na?ve) implementation: blowup :: [a] -> [a] blowup x = concat (blowup' 1 x) -- returns (e.g.) ["b", "aa", "nnn", "gggg" ] blowup' a b :: Integer a => a -> [b] -> [[b]] blowup' n (x:xs) = (replicate n x : blowup' n+1 xs) blowup' _ _ = [] -- base case You can distribute concatenation into blowup', to get recursion over concatenation, but this really is going the wrong direction: blowup' n (x:xs) = (replicate n x) ++ (blowup' n+1 xs) blowup' _ _ = [] Instead, derive Rein's hairy-looking version by (as always) ignoring concatenation and replacing the state variable in blowup' with zip or zipWith. observe: > zip [1..] "bang" [(1,'b'),(2,'a'),(3,'n'),(4,'g')] So blowup' n x becomes blowup' x: blowup x = concat (blowup' x) blowup' x = map (\(a,b) replicate a b) zip [1..] x ==> definition of zipWith blowup' x = zipWith replicate [1..] x ==> blowup x = concat (zipWith replicate [1..] x) You can always push concat down into a function by unwrapping it with join, getting a more efficient version that creates the result directly. blowup x = concat (zipWith replicate [1..] x) ==> blowup x = (join . zipWith replicate [1..] ) x ==> blowup = join . zipWith replicate [1..] -------------- next part -------------- An HTML attachment was scrubbed... URL: From jakep at arqux.com Mon Jan 11 23:18:42 2016 From: jakep at arqux.com (DJ) Date: Mon, 11 Jan 2016 18:18:42 -0500 Subject: [Haskell-beginners] haskell platform Message-ID: <56943852.90505@arqux.com> Getting back to Haskell after giving up three years ago. I am running Linux Mint 17.1. Why is the Haskell Platform for linux (or my distro anyway) stuck at 2013? I see that ghc is several versions newer than what comes with Haskell Platform. That seems like a rather severe lag. Why is that? Does it matter? Best, - Jake - From michael at schmong.org Mon Jan 11 23:31:20 2016 From: michael at schmong.org (Michael Litchard) Date: Mon, 11 Jan 2016 15:31:20 -0800 Subject: [Haskell-beginners] haskell platform In-Reply-To: <56943852.90505@arqux.com> References: <56943852.90505@arqux.com> Message-ID: Welcome Back! Word on the street is to not use Haskell Platform. Make your life easier by using stack. https://github.com/commercialhaskell/stack/blob/master/doc/GUIDE.md On Mon, Jan 11, 2016 at 3:18 PM, DJ wrote: > Getting back to Haskell after giving up three years ago. > > I am running Linux Mint 17.1. > > Why is the Haskell Platform for linux (or my distro anyway) stuck at 2013? > I see that ghc is several versions newer than what comes with Haskell > Platform. That seems like a rather severe lag. > > Why is that? Does it matter? > > Best, > > - Jake - > _______________________________________________ > 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 jakep at arqux.com Mon Jan 11 23:43:57 2016 From: jakep at arqux.com (DJ) Date: Mon, 11 Jan 2016 18:43:57 -0500 Subject: [Haskell-beginners] haskell platform In-Reply-To: References: <56943852.90505@arqux.com> Message-ID: <56943E3D.7000303@arqux.com> On 16-01-11 06:31 PM, Michael Litchard wrote: > Welcome Back! > > Word on the street is to not use Haskell Platform. Make your life > easier by using stack. > https://github.com/commercialhaskell/stack/blob/master/doc/GUIDE.md > Ah, cool thanks. I'll check it out. An acquaintance mentioned something about this to me a few days ago, but I didn't know what he was talking about so it didn't register. Best, - Jake - From rein.henrichs at gmail.com Tue Jan 12 00:10:51 2016 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Tue, 12 Jan 2016 00:10:51 +0000 Subject: [Haskell-beginners] questions on evaluation. In-Reply-To: References: Message-ID: (blowup' n+1 xs) should be (blowup' (n+1) xs) but otherwise this is spot on. On Mon, Jan 11, 2016 at 3:18 PM Peter McIlroy wrote: > > Fabian, > > For your problem of bang -> baanngggg > You can derive Rein's hairy idiom from a more straightforward technique > for getting a recursive definition: > > First get a basic implementation using ++ and recursion: > > * add a helper function with any "state variables" as arguments. > * Ignore concatenation while thinking about a problem. > * Use pattern matching for recursion step. > > This gives the basic (na?ve) implementation: > > blowup :: [a] -> [a] > blowup x = concat (blowup' 1 x) > > -- returns (e.g.) ["b", "aa", "nnn", "gggg" ] > blowup' a b :: Integer a => a -> [b] -> [[b]] > blowup' n (x:xs) = (replicate n x : blowup' n+1 xs) > blowup' _ _ = [] -- base case > > You can distribute concatenation into blowup', to get recursion over > concatenation, but this really is going the wrong direction: > > blowup' n (x:xs) = (replicate n x) ++ (blowup' n+1 xs) > blowup' _ _ = [] > > Instead, derive Rein's hairy-looking version by (as always) ignoring > concatenation and replacing the state variable in blowup' with zip or > zipWith. > observe: > > zip [1..] "bang" > [(1,'b'),(2,'a'),(3,'n'),(4,'g')] > > So blowup' n x becomes blowup' x: > blowup x = concat (blowup' x) > > blowup' x = map (\(a,b) replicate a b) zip [1..] x > ==> definition of zipWith > blowup' x = zipWith replicate [1..] x > ==> > blowup x = concat (zipWith replicate [1..] x) > > You can always push concat down into a function by unwrapping it with > join, getting a more efficient version that creates the result directly. > > blowup x = concat (zipWith replicate [1..] x) > ==> > blowup x = (join . zipWith replicate [1..] ) x > ==> > blowup = join . zipWith replicate [1..] > _______________________________________________ > 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 Tue Jan 12 00:11:28 2016 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Tue, 12 Jan 2016 00:11:28 +0000 Subject: [Haskell-beginners] questions on evaluation. In-Reply-To: References: Message-ID: And really, I should have used concat instead of join there. On Mon, Jan 11, 2016 at 4:10 PM Rein Henrichs wrote: > (blowup' n+1 xs) should be (blowup' (n+1) xs) but otherwise this is spot > on. > > On Mon, Jan 11, 2016 at 3:18 PM Peter McIlroy wrote: > >> >> Fabian, >> >> For your problem of bang -> baanngggg >> You can derive Rein's hairy idiom from a more straightforward technique >> for getting a recursive definition: >> >> First get a basic implementation using ++ and recursion: >> >> * add a helper function with any "state variables" as arguments. >> * Ignore concatenation while thinking about a problem. >> * Use pattern matching for recursion step. >> >> This gives the basic (na?ve) implementation: >> >> blowup :: [a] -> [a] >> blowup x = concat (blowup' 1 x) >> >> -- returns (e.g.) ["b", "aa", "nnn", "gggg" ] >> blowup' a b :: Integer a => a -> [b] -> [[b]] >> blowup' n (x:xs) = (replicate n x : blowup' n+1 xs) >> blowup' _ _ = [] -- base case >> >> You can distribute concatenation into blowup', to get recursion over >> concatenation, but this really is going the wrong direction: >> >> blowup' n (x:xs) = (replicate n x) ++ (blowup' n+1 xs) >> blowup' _ _ = [] >> >> Instead, derive Rein's hairy-looking version by (as always) ignoring >> concatenation and replacing the state variable in blowup' with zip or >> zipWith. >> observe: >> > zip [1..] "bang" >> [(1,'b'),(2,'a'),(3,'n'),(4,'g')] >> >> So blowup' n x becomes blowup' x: >> blowup x = concat (blowup' x) >> >> blowup' x = map (\(a,b) replicate a b) zip [1..] x >> ==> definition of zipWith >> blowup' x = zipWith replicate [1..] x >> ==> >> blowup x = concat (zipWith replicate [1..] x) >> >> You can always push concat down into a function by unwrapping it with >> join, getting a more efficient version that creates the result directly. >> >> blowup x = concat (zipWith replicate [1..] x) >> ==> >> blowup x = (join . zipWith replicate [1..] ) x >> ==> >> blowup = join . zipWith replicate [1..] >> _______________________________________________ >> 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 michael at schmong.org Tue Jan 12 00:24:38 2016 From: michael at schmong.org (Michael Litchard) Date: Mon, 11 Jan 2016 16:24:38 -0800 Subject: [Haskell-beginners] haskell platform In-Reply-To: <56943E3D.7000303@arqux.com> References: <56943852.90505@arqux.com> <56943E3D.7000303@arqux.com> Message-ID: I would only be engaging in slight hyperbole if I said, "Stack changed my life." :) On Mon, Jan 11, 2016 at 3:43 PM, DJ wrote: > > > On 16-01-11 06:31 PM, Michael Litchard wrote: > >> Welcome Back! >> >> Word on the street is to not use Haskell Platform. Make your life easier >> by using stack. >> https://github.com/commercialhaskell/stack/blob/master/doc/GUIDE.md >> >> Ah, cool thanks. I'll check it out. > > An acquaintance mentioned something about this to me a few days ago, but I > didn't know what he was talking about so it didn't register. > > > Best, > > - Jake - > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From strombrg at gmail.com Tue Jan 12 04:02:19 2016 From: strombrg at gmail.com (Dan Stromberg) Date: Mon, 11 Jan 2016 20:02:19 -0800 Subject: [Haskell-beginners] haskell platform In-Reply-To: <56943852.90505@arqux.com> References: <56943852.90505@arqux.com> Message-ID: FWIW, that's kind of an old Mint. https://en.wikipedia.org/wiki/List_of_Linux_Mint_releases On Mon, Jan 11, 2016 at 3:18 PM, DJ wrote: > Getting back to Haskell after giving up three years ago. > > I am running Linux Mint 17.1. > > Why is the Haskell Platform for linux (or my distro anyway) stuck at 2013? > I see that ghc is several versions newer than what comes with Haskell > Platform. That seems like a rather severe lag. > > Why is that? Does it matter? > > Best, > > - Jake - > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Dan Stromberg -------------- next part -------------- An HTML attachment was scrubbed... URL: From amindfv at gmail.com Tue Jan 12 04:12:53 2016 From: amindfv at gmail.com (amindfv at gmail.com) Date: Mon, 11 Jan 2016 23:12:53 -0500 Subject: [Haskell-beginners] haskell platform In-Reply-To: References: <56943852.90505@arqux.com> Message-ID: "Use stack" is one solution but the Haskell Platform is alive and well too. Your distro has an old version of the HP but the current HP has a recent GHC. Tom > El 11 ene 2016, a las 23:02, Dan Stromberg escribi?: > > > FWIW, that's kind of an old Mint. > https://en.wikipedia.org/wiki/List_of_Linux_Mint_releases > >> On Mon, Jan 11, 2016 at 3:18 PM, DJ wrote: >> Getting back to Haskell after giving up three years ago. >> >> I am running Linux Mint 17.1. >> >> Why is the Haskell Platform for linux (or my distro anyway) stuck at 2013? I see that ghc is several versions newer than what comes with Haskell Platform. That seems like a rather severe lag. >> >> Why is that? Does it matter? >> >> Best, >> >> - Jake - >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > > -- > Dan Stromberg > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners -------------- next part -------------- An HTML attachment was scrubbed... URL: From haskell-beginners at brisammon.fastmail.fm Tue Jan 12 08:06:21 2016 From: haskell-beginners at brisammon.fastmail.fm (Brian Sammon) Date: Tue, 12 Jan 2016 03:06:21 -0500 Subject: [Haskell-beginners] haskell platform In-Reply-To: <56943852.90505@arqux.com> References: <56943852.90505@arqux.com> Message-ID: <20160112030621.53d1a6635c2a3c9f48a139c9@brisammon.fastmail.fm> On Mon, 11 Jan 2016 18:18:42 -0500 DJ wrote: > Why is the Haskell Platform for linux (or my distro anyway) stuck at > 2013? I see that ghc is several versions newer than what comes with > Haskell Platform. That seems like a rather severe lag. > > Why is that? Does it matter? Seeing as nobody has addressed the second question (Does it matter) here, I'll put my two cents in. I've only been using haskell for a few months, on Debian Stable, with the GHC 7.6.3 that comes with Debian Stable. In my limited experience, (especially as regards my learning process), it hasn't much mattered. (Actually, if anything, occasionally it seemed it wasn't old enough -- sometimes googling an issue would turn up articles referencing GHC 6) But I'd be interested in hearing other opinions. P.S. As a Debian user/enthusiast, I haven't seen any need for bothering with Platform or Stack--dpkg/apt got everything (I didn't bother with the "haskell-platform" meta-packages) installed pretty straightforwardly. From theedge456 at free.fr Tue Jan 12 08:42:48 2016 From: theedge456 at free.fr (Fabien R) Date: Tue, 12 Jan 2016 09:42:48 +0100 Subject: [Haskell-beginners] questions on evaluation. In-Reply-To: References: Message-ID: <5694BC88.5030604@free.fr> On 12/01/2016 00:18, Peter McIlroy wrote: > Fabian, > > For your problem of bang -> baanngggg > You can derive Rein's hairy idiom from a more straightforward technique for > getting a recursive definition: > > First get a basic implementation using ++ and recursion: > > * add a helper function with any "state variables" as arguments. > * Ignore concatenation while thinking about a problem. > * Use pattern matching for recursion step. Thanks for the hint Peter -- Fabien From pmcilroy at gmail.com Wed Jan 13 03:39:34 2016 From: pmcilroy at gmail.com (pmcilroy at gmail.com) Date: Tue, 12 Jan 2016 19:39:34 -0800 Subject: [Haskell-beginners] Profiling tiny executions in ghc Message-ID: <5695c6ef.48a0420a.1634f.6271@mx.google.com> Is there a way to count numbers of calls, allocations or constructions to get an estimate of program performance in ghc? I am curious about the performance of the various implementations of blowup in previous discussions. Timing and profile sampling is not convenient. -------------- next part -------------- An HTML attachment was scrubbed... URL: From rein.henrichs at gmail.com Wed Jan 13 03:44:00 2016 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Wed, 13 Jan 2016 03:44:00 +0000 Subject: [Haskell-beginners] Profiling tiny executions in ghc In-Reply-To: <5695c6ef.48a0420a.1634f.6271@mx.google.com> References: <5695c6ef.48a0420a.1634f.6271@mx.google.com> Message-ID: Simon Marlow's book *Parallel and Concurrent Programming in Haskell*, which is freely available online, demonstrates a variety of Haskell profiling tools and an exceptional book that every Haskell programmer should read anyway imo. On Tue, Jan 12, 2016 at 7:39 PM wrote: > Is there a way to count numbers of calls, allocations or constructions to > get an estimate of program performance in ghc? > > I am curious about the performance of the various implementations of > blowup in previous discussions. Timing and profile sampling is not > convenient. > _______________________________________________ > 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 Wed Jan 13 03:44:19 2016 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Wed, 13 Jan 2016 03:44:19 +0000 Subject: [Haskell-beginners] Profiling tiny executions in ghc In-Reply-To: References: <5695c6ef.48a0420a.1634f.6271@mx.google.com> Message-ID: s/and an/and is an On Tue, Jan 12, 2016 at 7:44 PM Rein Henrichs wrote: > Simon Marlow's book *Parallel and Concurrent Programming in Haskell*, > which is freely available online, demonstrates a variety of Haskell > profiling tools and an exceptional book that every Haskell programmer > should read anyway imo. > > On Tue, Jan 12, 2016 at 7:39 PM wrote: > >> Is there a way to count numbers of calls, allocations or constructions to >> get an estimate of program performance in ghc? >> >> I am curious about the performance of the various implementations of >> blowup in previous discussions. Timing and profile sampling is not >> convenient. >> _______________________________________________ >> 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 jakep at arqux.com Wed Jan 13 20:15:28 2016 From: jakep at arqux.com (DJ) Date: Wed, 13 Jan 2016 15:15:28 -0500 Subject: [Haskell-beginners] haskell platform In-Reply-To: References: <56943852.90505@arqux.com> Message-ID: <5696B060.5090105@arqux.com> On 16-01-11 11:12 PM, amindfv at gmail.com wrote: > "Use stack" is one solution but the Haskell Platform is alive and well > too. Your distro has an old version of the HP but the current HP has a > recent GHC. > > Tom > Right - thanks for pointing that out. I see that I can download a current one from the "generic" link on the HP page. No doubt that is what I should use if I stick with HP. Now I am left to wonder why package maintainers are so far behind on Ubuntu and Mint. Which I actually don't care enough about to find the answer, since I have two options. Best, - DJ - -------------- next part -------------- An HTML attachment was scrubbed... URL: From rein.henrichs at gmail.com Wed Jan 13 20:44:49 2016 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Wed, 13 Jan 2016 20:44:49 +0000 Subject: [Haskell-beginners] haskell platform In-Reply-To: <5696B060.5090105@arqux.com> References: <56943852.90505@arqux.com> <5696B060.5090105@arqux.com> Message-ID: DJ, FWIW: The policies of the various OS-level package managers tend to make it difficult for maintainers to update packages frequently. Taking Ubuntu as an example, packages in ubuntu repos stay at the same version for *the entire release cycle* of the Ubuntu release that they are on unless a newer version is backported via the backport repository. In practice, this generally means that most packages are up to 6 months out of date most of the time?and packages on older releases can be *years* out of date. (Other distros such as Arch use a rolling release model that effectively means that packages tend to get update every few weeks rather than every few quarters.) For any software whose rate of change exceeds the rate of change allowed for by the release cycle or other maintenance practices of your distro, it's best to seek alternate sources if you intend to use latest versions. The general strategy for acquiring newer versions of software through your OS-level package manager is to find alternative repositories. For Ubuntu, this means the use of PPAs. However, if you combine the difficulty in installing the latest HP with the fact that it has more or less fallen into disfavor with the introduction of Stack, which manages its own installation separately from your OS-level package manager, the best solution for most people is probably just to use Stack at this point. On Wed, Jan 13, 2016 at 12:15 PM DJ wrote: > > > On 16-01-11 11:12 PM, amindfv at gmail.com wrote: > > "Use stack" is one solution but the Haskell Platform is alive and well > too. Your distro has an old version of the HP but the current HP has a > recent GHC. > > Tom > > Right - thanks for pointing that out. I see that I can download a current > one from the "generic" link on the HP page. No doubt that is what I should > use if I stick with HP. > > Now I am left to wonder why package maintainers are so far behind on > Ubuntu and Mint. Which I actually don't care enough about to find the > answer, since I have two options. > > Best, > > - DJ - > _______________________________________________ > 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 alanbuxton at gmail.com Wed Jan 13 21:53:00 2016 From: alanbuxton at gmail.com (Alan Buxton) Date: Wed, 13 Jan 2016 21:53:00 -0000 Subject: [Haskell-beginners] Typeclass question Message-ID: <005501d14e4c$c619b6b0$524d2410$@gmail.com> What am I doing wrong in this admittedly contrived example? The code below will compile. It works as expected, unless I try to do "toMyParam Nothing". See below: ?: let arr = [P1 3.0, P2 'x'] ?: toMyParam False P2 'F' ?: toMyParam (Just 'x') P2 'x' ?: toMyParam Nothing :38:1: No instance for (ToMyParam a0) arising from a use of `toMyParam' The type variable `a0' is ambiguous Code below: data MyParam = P1 Double | P2 Char deriving Show class ToMyParam a where toMyParam :: a -> MyParam instance ToMyParam Bool where toMyParam False = P2 'F' toMyParam True = P2 'T' instance ToMyParam Char where toMyParam = P2 instance ToMyParam Double where toMyParam = P1 instance ToMyParam a => ToMyParam (Maybe a) where toMyParam Nothing = P1 0.0 toMyParam (Just x) = toMyParam x -------------- next part -------------- An HTML attachment was scrubbed... URL: From toad3k at gmail.com Wed Jan 13 21:59:33 2016 From: toad3k at gmail.com (David McBride) Date: Wed, 13 Jan 2016 16:59:33 -0500 Subject: [Haskell-beginners] Typeclass question In-Reply-To: <005501d14e4c$c619b6b0$524d2410$@gmail.com> References: <005501d14e4c$c619b6b0$524d2410$@gmail.com> Message-ID: "toMyParam Nothing" is of type "ToMyParam a => Maybe a", but because you used Nothing and not Just (something of type a) doesn't know what the "a" is and so you have to tell it. The fact that you don't reference the a in the Nothing case does not exempt you from this requirement. toMyParam (Nothing :: Maybe Char) will fix your error. I think there might be a way to get rid of this ambiguity via a type extension but I'm not entirely sure. On Wed, Jan 13, 2016 at 4:53 PM, Alan Buxton wrote: > What am I doing wrong in this admittedly contrived example? > > > > The code below will compile. It works as expected, unless I try to do > ?toMyParam Nothing?. See below: > > ?: let arr = [P1 3.0, P2 'x'] > > ?: toMyParam False > > P2 'F' > > ?: toMyParam (Just 'x') > > P2 'x' > > ?: toMyParam Nothing > > > > :38:1: > > No instance for (ToMyParam a0) arising from a use of `toMyParam' > > The type variable `a0' is ambiguous > > > Code below: > > > > > > data MyParam = P1 Double | P2 Char deriving Show > > > > class ToMyParam a where > > toMyParam :: a -> MyParam > > > > instance ToMyParam Bool where > > toMyParam False = P2 'F' > > toMyParam True = P2 'T' > > > > instance ToMyParam Char where > > toMyParam = P2 > > > > instance ToMyParam Double where > > toMyParam = P1 > > > > instance ToMyParam a => ToMyParam (Maybe a) where > > toMyParam Nothing = P1 0.0 > > toMyParam (Just x) = toMyParam x > > > > > > _______________________________________________ > 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 jakep at arqux.com Thu Jan 14 02:01:05 2016 From: jakep at arqux.com (DJ) Date: Wed, 13 Jan 2016 21:01:05 -0500 Subject: [Haskell-beginners] haskell platform In-Reply-To: References: <56943852.90505@arqux.com> <5696B060.5090105@arqux.com> Message-ID: <56970161.6000909@arqux.com> On 16-01-13 03:44 PM, Rein Henrichs wrote: > DJ, FWIW: > > The policies of the various OS-level package managers tend to make it > difficult for maintainers to update Ok, thanks for explanation. I happily use Linux Mint for all kinds of stuff with no problems relating to package versions. But it looks like stack is the way to go. Rambling here: I left Haskell three years ago or so in disgust. I was in grad school at the time and was compelled to use it by my supervisor. IMHO the Haskell ecosystem back then was a fucking pile of shit. It was fine for the researchy stuff I was doing (not in programming languages, exactly). But a total uphill battle to actually write anything else in. And no, this is NOT just about struggling to overcome imperative PL mindset. I felt that learning Haskell gave me all the wonderful advantages of being fluent in Esperanto. It turns out that /to this very day/ I am totally devoid of fucks to give about Haskell's theoretical beauty and "if it compiles I just know it's right". I now need to interface to a huge amount of stuff for scientific, numerical, and graphical software that is already written in C, C++ (which I detest) and sometimes Fortran. I guess that means I mostly need glue, which means one thing: Python. and when I /do/ have to write something from scratch I am much more comfortable in (gasp) Common Lisp: a little-used language with (compared to Haskell) very few theoretical scruples. I tend to use an sorta-kinda functional style in CL. I must admit that I sometimes do miss a good type system. But not must-do-state-in-monads. So anyway if there has been some kind of reasonable improvement in the ecosystem I may recover some of the investment I put into learning FP. Or not. Maybe it's sunk costs. I have know idea why I wasted my time and yours by blurting all this out in response to your helpful post. Perhaps I had a minor stroke that destroyed the neurons responsible for self-editing and self-awareness. So I guess I'll be joining the Tea Party soon. Bye for now.... - DJ - -------------- next part -------------- An HTML attachment was scrubbed... URL: From chaddai.fouche at gmail.com Sat Jan 16 21:05:06 2016 From: chaddai.fouche at gmail.com (=?UTF-8?B?Q2hhZGRhw68gRm91Y2jDqQ==?=) Date: Sat, 16 Jan 2016 21:05:06 +0000 Subject: [Haskell-beginners] Implementing instance of '^' operator In-Reply-To: References: <5688c5ec.e93e420a.22e11.5725@mx.google.com> Message-ID: (^) is _not_ a method of Num, it is simply a function with a Num constraint. It will work on your new numbers as well as it would on any other that implements (*) correctly, you don't need to rewrite it. By the way, your functions are dangerously partial, it would seem useful to put the prime into the type so that you can't add or multiply different Mod p. Of course this demands a bit more knowledge of Haskell type system than is likely in a beginner, but if you're motivated, I encourage you to look at numbers in type (see GHC.TypeLits maybe). -- Jeda? Le dim. 3 janv. 2016 ? 14:07, Harald Hanche-Olsen a ?crit : > -----Original Message----- > From: pmcilroy at gmail.com > Date: 3 January 2016 at 07:55:53 > > > As a ?hello world? example for type definitions, I like to define a > numeric type that can > > handle the mod p multiplicative group, where p is prime. This requires: > > ? Implementing interface functions > > [?] > > I can?t help with the question you?re asking, but I have a minor nitpick: > You want to have > negate (Modp p 0) = Modp p 0, > and not Modp p p as in your current implementation. > > ? Harald > _______________________________________________ > 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 chaddai.fouche at gmail.com Sat Jan 16 21:14:47 2016 From: chaddai.fouche at gmail.com (=?UTF-8?B?Q2hhZGRhw68gRm91Y2jDqQ==?=) Date: Sat, 16 Jan 2016 21:14:47 +0000 Subject: [Haskell-beginners] Ambiguous module name `Prelude': it was found in multiple packages (trying to install HXQ) In-Reply-To: References: <568A96D1.8050402@eisenbits.com> <568BFC76.4000506@eisenbits.com> Message-ID: Le mar. 5 janv. 2016 ? 22:16, Henk-Jan van Tuyl a ?crit : > You can do "cabal unpack hxq" and update the file hxq.cabal; I tried it > and there are many more things that need updates. Your best bet would be > to ask the author to update the package. Otherwise, you could ask the > Haskell Caf? if someone would like to take over maintenance of HXQ. Apparently someone did update HXQ : Leonidas Fegaras, the original maintainer, updated HXQ on the 7 january 2016. I can only assume that Stanislaw contacted him directly. Just to conclude the discussion on a positive note ! -- Jeda? -------------- next part -------------- An HTML attachment was scrubbed... URL: From traqueofziche at gmail.com Sun Jan 17 03:17:59 2016 From: traqueofziche at gmail.com (=?UTF-8?B?6bKN5Yev5paH?=) Date: Sat, 16 Jan 2016 19:17:59 -0800 Subject: [Haskell-beginners] proving fmap law for recursive data types Message-ID: Hi, Suppose you have something like: data Tree a = Leaf a | Branch (Tree a) (Tree a) instance Functor Tree where fmap f (Leaf a) = Leaf $ f a fmap f (Branch l r) = Branch (fmap f l) (fmap f r) To check that fmap id = id, I can see that the case for Leaf is ok: fmap id (Leaf a) = Leaf $ id a = Leaf a How would you prove it for the second case? Is some sort of inductive proof necessary? I found this: http://ssomayyajula.github.io/posts/2015-11-07-proofs-of-functor-laws-with-Haskell.html, which goes over an inductive (on the length of the list) proof for the list type, but I'm not sure how to do it for a Tree. Thanks, toz -------------- next part -------------- An HTML attachment was scrubbed... URL: From ky3 at atamo.com Sun Jan 17 04:47:33 2016 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Sun, 17 Jan 2016 11:47:33 +0700 Subject: [Haskell-beginners] proving fmap law for recursive data types In-Reply-To: References: Message-ID: On Sun, Jan 17, 2016 at 10:17 AM, ??? wrote: How would you prove it for the second case? Is some sort of inductive proof > necessary? I found this: > http://ssomayyajula.github.io/posts/2015-11-07-proofs-of-functor-laws-with-Haskell.html, > which goes over an inductive (on the length of the list) proof for the list > type, but I'm not sure how to do it for a Tree. > You've got the right idea. The general outline of a simple inductive proof is this: 1. Prove for the smallest case (in this case, a tree with just one Leaf) 2. While assuming that the hypothesis holds for a small case, prove hypothesis for the next case one up in size 3. Put 1 and 2 together to claim hypothesis for all cases You've done 1. You're stuck at 2 because you haven't yet found some measure of a "size" of a Tree. What are some common Tree measures you've seen? -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From Robert.Weisser at gmx.com Tue Jan 19 16:54:31 2016 From: Robert.Weisser at gmx.com (Robert Weisser) Date: Tue, 19 Jan 2016 17:54:31 +0100 Subject: [Haskell-beginners] Problem using stack Message-ID: I recently installed stack via Haskell for Mac OS X (https://ghcformacosx.github.io/), which gave me stack 0.1.8.0 x86_64 and ghc 7.10.2. Following the User Guide (http://docs.haskellstack.org/en/stable/GUIDE.html), I tried to create the first example (hello world, naturally). Everything went according to plan until I entered 'stack test', which failed. The output was supposed to be, 'Test suite not yet implemented.' I tried to find information online, but was unsuccessful. I play with Haskell for fun and know nothing about cabal, so I don't know if it is a cabal issue. The error message includes 'helloworld-test: executable not found'. helloworld-test is indeed missing. I searched for it using find: find . -name '*test' Here is the terminal session, followed by the contents of the generated helloworld.cabal file (with some user info removed): $ stack new helloworld new-template Downloading template "new-template" to create project "helloworld" in helloworld/ ... Writing default config file to: /Users/rpw/self/haskell/stack/user_guide/helloworld/stack.yaml Basing on cabal files: - /Users/rpw/self/haskell/stack/user_guide/helloworld/helloworld.cabal Checking against build plan lts-3.13 Selected resolver: lts-3.13 Wrote project config to: /Users/rpw/self/haskell/stack/user_guide/helloworld/stack.yaml $ cd helloworld/ $ stack setup stack will use the GHC on your PATH For more information on paths, see 'stack path' and 'stack exec env' To use this GHC and packages outside of a project, consider using: stack ghc, stack ghci, stack runghc, or stack exec $ stack build helloworld-0.1.0.0: configure Configuring helloworld-0.1.0.0... helloworld-0.1.0.0: build Preprocessing library helloworld-0.1.0.0... [1 of 1] Compiling Lib ( src/Lib.hs, .stack-work/dist/x86_64-osx/Cabal-1.22.4.0/build/Lib.o ) In-place registering helloworld-0.1.0.0... Preprocessing executable 'helloworld-exe' for helloworld-0.1.0.0... [1 of 1] Compiling Main ( app/Main.hs, .stack-work/dist/x86_64-osx/Cabal-1.22.4.0/build/helloworld-exe/helloworld-exe-tmp/Main.o ) Linking .stack-work/dist/x86_64-osx/Cabal-1.22.4.0/build/helloworld-exe/helloworld-exe ... helloworld-0.1.0.0: copy/register Installing library in /Users/rpw/self/haskell/stack/user_guide/helloworld/.stack-work/install/x86_64-osx/lts-3.13/7.10.2/lib/x86_64-osx-ghc-7.10.2/helloworld-0.1.0.0-6urpPe0MO7OHasGCFSyIAT Installing executable(s) in /Users/rpw/self/haskell/stack/user_guide/helloworld/.stack-work/install/x86_64-osx/lts-3.13/7.10.2/bin Registering helloworld-0.1.0.0... $ stack exec helloworld-exe someFunc $ stack test Test suite helloworld-test executable not found for helloworld Test suite failure for package helloworld-0.1.0.0 helloworld-test: executable not found Logs printed to console $ cat helloworld.cabal name: helloworld version: 0.1.0.0 synopsis: Initial project template from stack description: Please see README.md homepage: ... license: BSD3 license-file: LICENSE author: ... maintainer: ... copyright: None category: Example build-type: Simple -- extra-source-files: cabal-version: >=1.10 library hs-source-dirs: src exposed-modules: Lib build-depends: base >= 4.7 && < 5 default-language: Haskell2010 executable helloworld-exe hs-source-dirs: app main-is: Main.hs ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base , helloworld default-language: Haskell2010 test-suite helloworld-test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs build-depends: base , helloworld ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 source-repository head type: git location: ... $ Robert Weisser From simon.jakobi at googlemail.com Tue Jan 19 18:21:52 2016 From: simon.jakobi at googlemail.com (Simon Jakobi) Date: Tue, 19 Jan 2016 19:21:52 +0100 Subject: [Haskell-beginners] Problem using stack In-Reply-To: References: Message-ID: Hi Robert, The reason for the "Test suite not yet implemented" message is that this is the default behaviour of the test suite that comes with "new-template": $ cat test/Spec.hs main :: IO () main = putStrLn "Test suite not yet implemented" BTW, stack 0.1.8.0 is fairly outdated by now, so try to run "stack upgrade". Cheers, Simon 2016-01-19 17:54 GMT+01:00 Robert Weisser : > I recently installed stack via Haskell for Mac OS X > (https://ghcformacosx.github.io/), which gave me stack 0.1.8.0 x86_64 and > ghc > 7.10.2. > > Following the User Guide ( > http://docs.haskellstack.org/en/stable/GUIDE.html), > I tried to create the first example (hello world, naturally). Everything > went > according to plan until I entered 'stack test', which failed. The output > was > supposed to be, 'Test suite not yet implemented.' I tried to find > information > online, but was unsuccessful. I play with Haskell for fun and know nothing > about cabal, so I don't know if it is a cabal issue. > > The error message includes 'helloworld-test: executable not found'. > helloworld-test is indeed missing. I searched for it using find: > > find . -name '*test' > > Here is the terminal session, followed by the contents of the generated > helloworld.cabal file (with some user info removed): > > $ stack new helloworld new-template > Downloading template "new-template" to create project "helloworld" in > helloworld/ ... > Writing default config file to: > /Users/rpw/self/haskell/stack/user_guide/helloworld/stack.yaml > Basing on cabal files: > - /Users/rpw/self/haskell/stack/user_guide/helloworld/helloworld.cabal > > Checking against build plan lts-3.13 > Selected resolver: lts-3.13 > Wrote project config to: > /Users/rpw/self/haskell/stack/user_guide/helloworld/stack.yaml > > $ cd helloworld/ > > $ stack setup > stack will use the GHC on your PATH > For more information on paths, see 'stack path' and 'stack exec env' > To use this GHC and packages outside of a project, consider using: > stack ghc, stack ghci, stack runghc, or stack exec > > $ stack build > helloworld-0.1.0.0: configure > Configuring helloworld-0.1.0.0... > helloworld-0.1.0.0: build > Preprocessing library helloworld-0.1.0.0... > [1 of 1] Compiling Lib ( src/Lib.hs, > .stack-work/dist/x86_64-osx/Cabal-1.22.4.0/build/Lib.o ) > In-place registering helloworld-0.1.0.0... > Preprocessing executable 'helloworld-exe' for helloworld-0.1.0.0... > [1 of 1] Compiling Main ( app/Main.hs, > .stack-work/dist/x86_64-osx/Cabal-1.22.4.0/build/helloworld-exe/helloworld-exe-tmp/Main.o > ) > Linking > .stack-work/dist/x86_64-osx/Cabal-1.22.4.0/build/helloworld-exe/helloworld-exe > ... > helloworld-0.1.0.0: copy/register > Installing library in > > /Users/rpw/self/haskell/stack/user_guide/helloworld/.stack-work/install/x86_64-osx/lts-3.13/7.10.2/lib/x86_64-osx-ghc-7.10.2/helloworld-0.1.0.0-6urpPe0MO7OHasGCFSyIAT > Installing executable(s) in > > /Users/rpw/self/haskell/stack/user_guide/helloworld/.stack-work/install/x86_64-osx/lts-3.13/7.10.2/bin > Registering helloworld-0.1.0.0... > > $ stack exec helloworld-exe > someFunc > > $ stack test > Test suite helloworld-test executable not found for helloworld > Test suite failure for package helloworld-0.1.0.0 > helloworld-test: executable not found > Logs printed to console > > $ cat helloworld.cabal > name: helloworld > version: 0.1.0.0 > synopsis: Initial project template from stack > description: Please see README.md > homepage: ... > license: BSD3 > license-file: LICENSE > author: ... > maintainer: ... > copyright: None > category: Example > build-type: Simple > -- extra-source-files: > cabal-version: >=1.10 > > library > hs-source-dirs: src > exposed-modules: Lib > build-depends: base >= 4.7 && < 5 > default-language: Haskell2010 > > executable helloworld-exe > hs-source-dirs: app > main-is: Main.hs > ghc-options: -threaded -rtsopts -with-rtsopts=-N > build-depends: base > , helloworld > default-language: Haskell2010 > > test-suite helloworld-test > type: exitcode-stdio-1.0 > hs-source-dirs: test > main-is: Spec.hs > build-depends: base > , helloworld > ghc-options: -threaded -rtsopts -with-rtsopts=-N > default-language: Haskell2010 > > source-repository head > type: git > location: ... > $ > > > Robert Weisser > _______________________________________________ > 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 Robert.Weisser at gmx.com Wed Jan 20 05:15:41 2016 From: Robert.Weisser at gmx.com (Robert Weisser) Date: Wed, 20 Jan 2016 06:15:41 +0100 Subject: [Haskell-beginners] Problem using stack In-Reply-To: References: , Message-ID: An HTML attachment was scrubbed... URL: From masonmlai at gmail.com Thu Jan 21 00:53:02 2016 From: masonmlai at gmail.com (Mason Lai) Date: Wed, 20 Jan 2016 16:53:02 -0800 Subject: [Haskell-beginners] program not running lazily Message-ID: Hi, I'm teaching myself Haskell and attempting to use it for day-to-day tasks at work. I signed up for this list a few weeks ago, and this is my first post. Here's my problem: I'm given a list of 45 Strings, each nine Chars long. The only characters are 'A', 'C', 'G' and 'T'. (This is for a bioinformatics application.) I'll refer to any nine-length String composed of these Chars as a "9-mer". I need to generate a larger list of 9-mers such that no two 9-mers have a Levenshtein distance of less than 3. (The list I start with satisfies this requirement.) I can generate as many 9-mers as I possibly can, but this process is very slow. It's also not being computed lazily; calling head on the output list forces the entire list of 9-mers to be computed. *I'd like to understand why this list isn't being computed lazily, and how I can change my code to make it so. *My knowledge of monads is pretty poor as well, so a digression or a series of questions about why the line [9] >>= (`replicateM` "ACGT") works would also be helpful, as would general tips about writing clean code. This is an O(n^2) operation, so I'm not expecting it to be slow. However, I figured that I'd just be able to take the first N elements from the output list. Here's what I have: import Control.Monad main :: IO () main = interact processData processData :: String -> String processData = unlines . (`merge` ([9] >>= (`replicateM` "ACGT"))) . lines -- Merges two lists of things into a single list merge :: Eq a => [[a]] -> [[a]] -> [[a]] merge xs [] = xs merge xs ys = merge ((head ys) `addInto` xs) $ tail ys -- Adds a thing into a list if it is "different" enough addInto :: Eq a => [a] -> [[a]] -> [[a]] y `addInto` ys = if ((minimum $ map (dist y) ys) < 3) then ys else y:ys -- Calculate the Levenshtein distance -- Lloyd Allison algorithm. See Haskell wiki -- code omitted dist :: Eq a => [a] -> [a] -> Int My workaround to getting a smaller subset of the whole list is to replace [9] >>= (`replicateM` "ACGT") with take 10000 $ [9] >>= (`replicateM` "ACGT") Thanks! Mason Lai -------------- next part -------------- An HTML attachment was scrubbed... URL: From doug at cs.dartmouth.edu Thu Jan 21 13:43:37 2016 From: doug at cs.dartmouth.edu (Doug McIlroy) Date: Thu, 21 Jan 2016 08:43:37 -0500 Subject: [Haskell-beginners] program not running lazily Message-ID: <201601211343.u0LDhbQj030008@coolidge.cs.Dartmouth.EDU> Each time you find another good 9-mer, you add it to the head of the list. This means that the ultimate list will be in reverse order of discovery: the first element to be printed is the last one to be found. To get output in the order it was discovered, build the output by ys++[y] rather than y:ys. From rein.henrichs at gmail.com Thu Jan 21 18:42:43 2016 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Thu, 21 Jan 2016 18:42:43 +0000 Subject: [Haskell-beginners] program not running lazily In-Reply-To: <201601211343.u0LDhbQj030008@coolidge.cs.Dartmouth.EDU> References: <201601211343.u0LDhbQj030008@coolidge.cs.Dartmouth.EDU> Message-ID: But not that doing so will cause the program to have an exponential runtime as each new ys must be repeatedly traversed to append a [y].. The alternative is to *unfold* your list by recursing on the right hand side of the (:) to add new elements. On Thu, Jan 21, 2016 at 5:43 AM Doug McIlroy wrote: > Each time you find another good 9-mer, you add it to > the head of the list. This means that the ultimate > list will be in reverse order of discovery: the first element > to be printed is the last one to be found. To get > output in the order it was discovered, build the > output by ys++[y] rather than y:ys. > _______________________________________________ > 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 Thu Jan 21 19:05:17 2016 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Thu, 21 Jan 2016 19:05:17 +0000 Subject: [Haskell-beginners] program not running lazily In-Reply-To: References: <201601211343.u0LDhbQj030008@coolidge.cs.Dartmouth.EDU> Message-ID: s/not/note, sorry On Thu, Jan 21, 2016 at 10:42 AM Rein Henrichs wrote: > But not that doing so will cause the program to have an exponential > runtime as each new ys must be repeatedly traversed to append a [y].. The > alternative is to *unfold* your list by recursing on the right hand side of > the (:) to add new elements. > > On Thu, Jan 21, 2016 at 5:43 AM Doug McIlroy > wrote: > >> Each time you find another good 9-mer, you add it to >> the head of the list. This means that the ultimate >> list will be in reverse order of discovery: the first element >> to be printed is the last one to be found. To get >> output in the order it was discovered, build the >> output by ys++[y] rather than y:ys. >> _______________________________________________ >> 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 masonmlai at gmail.com Thu Jan 21 19:34:35 2016 From: masonmlai at gmail.com (Mason Lai) Date: Thu, 21 Jan 2016 11:34:35 -0800 Subject: [Haskell-beginners] program not running lazily In-Reply-To: References: <201601211343.u0LDhbQj030008@coolidge.cs.Dartmouth.EDU> Message-ID: I've changed the "if minimum < 3" line with an "any (< 3)" line. This has sped up the performance to be good enough. (I assume that I have to calculate the Lev. distance of all the 9-mers in order to take the minimum. I really only care if any element has a Lev. distance less than three, so I can stop when I find the first.) The rest of this discussion is purely for fun. I've swapped "y:ys" for "ys ++ [y]", and while the output is reversed, I don't appear to be able to take the first n elements still. I haven't timed how long the program takes now to see if it blows up. Rein, I don't quite understand your answer; I may need you to be more explicit if I don't figure this out. Part of what confuses me is that the recursion takes place in merge, and the (:) is in addInto. I think your comment has given me an idea, so I'm going to take some time to play with this in the afternoon, so I'll send an update tonight. Thanks for looking at this! -- Mason On Thu, Jan 21, 2016 at 11:05 AM, Rein Henrichs wrote: > s/not/note, sorry > > On Thu, Jan 21, 2016 at 10:42 AM Rein Henrichs > wrote: > >> But not that doing so will cause the program to have an exponential >> runtime as each new ys must be repeatedly traversed to append a [y].. The >> alternative is to *unfold* your list by recursing on the right hand side of >> the (:) to add new elements. >> >> On Thu, Jan 21, 2016 at 5:43 AM Doug McIlroy >> wrote: >> >>> Each time you find another good 9-mer, you add it to >>> the head of the list. This means that the ultimate >>> list will be in reverse order of discovery: the first element >>> to be printed is the last one to be found. To get >>> output in the order it was discovered, build the >>> output by ys++[y] rather than y:ys. >>> _______________________________________________ >>> 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 tkoster at gmail.com Fri Jan 22 06:33:33 2016 From: tkoster at gmail.com (Thomas Koster) Date: Fri, 22 Jan 2016 17:33:33 +1100 Subject: [Haskell-beginners] Increasing capabilities dramatically increases execution time Message-ID: Hi friends, I have encountered a situation in a concurrent program where I see an unexpected, dramatic increase in execution time when I add additional capabilities. On a multi-core CPU, "-N1" is fastest by an order of magnitude and the program increasingly slows for an increasing number of capabilities (still fewer than the number of real cores, of course). My question is, why is this so and what can I do to improve this? Some details: I have a shared data structure which I call a "store", which is basically a strict HashMap String Value. This structure is shared between Haskell threads using an IORef/MVar pair: data Store = Store (IORef (HashMap Key Value)) (MVar ()) Focus on the IORef/MVar pair - the HashMap itself is not important. My intention is that read-only transactions can take the pure value straight from the IORef without blocking writers or other readers, whereas mutating transactions (those that will update the IORef when they complete) are serialized using the MVar. Alternatively, you can regard the read-only transaction as working with a private snapshot of the store that is discarded after it completes. It is my hope that this technique will allow my program to exploit a multi-core CPU by running several read-only transactions and at most one mutating transaction in parallel. I am also assuming that this technique is marginally more efficient than STM for this use case, especially for write-heavy loads where I am assuming STM would waste some time on retries (I did not test this). -- | Execute a read-only transaction that returns a value. withStore :: Store -> (HashMap Key Value -> a) -> IO a withStore (Store ioref _) f = do store <- readIORef ioref return (f store) -- | Execute a transaction that updates the store and returns a value. modifyStore :: Store -> (HashMap Key Value -> (HashMap Key Value, a)) -> IO a modifyStore (Store ioref mvar) f = modifyMVar mvar $ \ z -> do store <- readIORef ioref let (store', x) = f store store' `seq` writeIORef ioref store' return (z, x) Stop me right here if this is a silly way to do this. I have a test that forks 4 threads that each increment a counter in the store 100000 times, with the expectation that the final answer is 400000. I use the "async" package for this. This test is not necessarily pathological. I expect simple operations like incrementing counters and concatenating text to be typical transactions. threads <- replicateM 4 $ async $ replicateM_ 100000 $ modifyStore store (...increment a counter...) forM_ threads wait In this test, while any thread is busy modifying the store, the other three are blocked on the empty MVar, irrespective of how many capabilities I have. Therefore, I expect the execution time with -N4 to be similar to -N1. I expect the only difference to be attributable to the runtime's scheduling overheads, which I assume are relatively insignificant. Instead, I see a dramatic increase in execution time with increasing capabilities (typical measurements below). By the way, I say I assume scheduling overheads are "relatively insignificant" compared to incrementing the counter because in my program, the counter is incremented by interpreting an imperative EDSL, which I assume is relatively inefficient compared to e.g. "succ", but perhaps I am mistaken. In a way, my whole question probably centres around this assumption. I would be grateful is anyone can illuminate the reason for this dramatic increase in execution time when I increase the number of capabilities, and any hints on how I can mitigate it. I am using GHC 7.10.2 and compile with -O -threaded. All library versions are as at Stackage LTS 3.2. A typical measurement, with -N1: Tot time (elapsed) Avg pause Max pause Gen 0 516 colls, 0 par 0.000s 0.003s 0.0000s 0.0001s Gen 1 2 colls, 0 par 0.000s 0.001s 0.0003s 0.0003s TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.000s ( 0.001s elapsed) MUT time 0.136s ( 0.139s elapsed) GC time 0.000s ( 0.003s elapsed) EXIT time 0.000s ( 0.001s elapsed) Total time 0.136s ( 0.144s elapsed) With -N2: Tot time (elapsed) Avg pause Max pause Gen 0 334 colls, 334 par 0.012s 0.006s 0.0000s 0.0001s Gen 1 2 colls, 1 par 0.000s 0.000s 0.0002s 0.0003s Parallel GC work balance: 39.33% (serial 0%, perfect 100%) TASKS: 6 (1 bound, 5 peak workers (5 total), using -N2) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.000s ( 0.002s elapsed) MUT time 2.032s ( 2.456s elapsed) GC time 0.012s ( 0.007s elapsed) EXIT time 0.000s ( 0.000s elapsed) Total time 2.044s ( 2.465s elapsed) With -N4: Tot time (elapsed) Avg pause Max pause Gen 0 133 colls, 133 par 0.032s 0.005s 0.0000s 0.0001s Gen 1 2 colls, 1 par 0.000s 0.001s 0.0003s 0.0003s Parallel GC work balance: 41.33% (serial 0%, perfect 100%) TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.000s ( 0.003s elapsed) MUT time 3.516s ( 4.431s elapsed) GC time 0.032s ( 0.005s elapsed) EXIT time 0.000s ( 0.001s elapsed) Total time 3.548s ( 4.439s elapsed) Thanks, Thomas Koster From pmcilroy at gmail.com Fri Jan 22 07:34:34 2016 From: pmcilroy at gmail.com (pmcilroy at gmail.com) Date: Thu, 21 Jan 2016 23:34:34 -0800 Subject: [Haskell-beginners] FW: Beginners Digest, Vol 91, Issue 26 In-Reply-To: References: Message-ID: <56a1db90.ce1f620a.fbe82.fffffad4@mx.google.com> Don?t worry about the time to append rather than pretend, it is not ?exponential? nor even cubic. You are making a list of length in an N^2 algorithm. Appending to a list adds another tiny O(N^2) step, which is dominated by the main algorithm (also O(N^2), which both takes longer and evaluates vastly more values (failures as well as successes.) Message: 3 Date: Thu, 21 Jan 2016 19:05:17 +0000 From: Rein Henrichs To: The Haskell-Beginners Mailing List - Discussion of primarily beginner-level topics related to Haskell , masonmlai at gmail.com Subject: Re: [Haskell-beginners] program not running lazily Message-ID: Content-Type: text/plain; charset="utf-8" s/not/note, sorry On Thu, Jan 21, 2016 at 10:42 AM Rein Henrichs wrote: > But not that doing so will cause the program to have an exponential > runtime as each new ys must be repeatedly traversed to append a [y].. The > alternative is to *unfold* your list by recursing on the right hand side of > the (:) to add new elements. > > On Thu, Jan 21, 2016 at 5:43 AM Doug McIlroy > wrote: > >> Each time you find another good 9-mer, you add it to >> the head of the list. This means that the ultimate >> list will be in reverse order of discovery: the first element >> to be printed is the last one to be found. To get >> output in the order it was discovered, build the >> output by ys++[y] rather than y:ys. >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: ------------------------------ Message: 4 Date: Thu, 21 Jan 2016 11:34:35 -0800 From: Mason Lai To: Rein Henrichs , doug at cs.dartmouth.edu Cc: The Haskell-Beginners Mailing List - Discussion of primarily beginner-level topics related to Haskell Subject: Re: [Haskell-beginners] program not running lazily Message-ID: Content-Type: text/plain; charset="utf-8" I've changed the "if minimum < 3" line with an "any (< 3)" line. This has sped up the performance to be good enough. (I assume that I have to calculate the Lev. distance of all the 9-mers in order to take the minimum. I really only care if any element has a Lev. distance less than three, so I can stop when I find the first.) The rest of this discussion is purely for fun. I've swapped "y:ys" for "ys ++ [y]", and while the output is reversed, I don't appear to be able to take the first n elements still. I haven't timed how long the program takes now to see if it blows up. Rein, I don't quite understand your answer; I may need you to be more explicit if I don't figure this out. Part of what confuses me is that the recursion takes place in merge, and the (:) is in addInto. I think your comment has given me an idea, so I'm going to take some time to play with this in the afternoon, so I'll send an update tonight. Thanks for looking at this! -- Mason On Thu, Jan 21, 2016 at 11:05 AM, Rein Henrichs wrote: > s/not/note, sorry > > On Thu, Jan 21, 2016 at 10:42 AM Rein Henrichs > wrote: > >> But not that doing so will cause the program to have an exponential >> runtime as each new ys must be repeatedly traversed to append a [y].. The >> alternative is to *unfold* your list by recursing on the right hand side of >> the (:) to add new elements. >> >> On Thu, Jan 21, 2016 at 5:43 AM Doug McIlroy >> wrote: >> >>> Each time you find another good 9-mer, you add it to >>> the head of the list. This means that the ultimate >>> list will be in reverse order of discovery: the first element >>> to be printed is the last one to be found. To get >>> output in the order it was discovered, build the >>> output by ys++[y] rather than y:ys. >>> _______________________________________________ >>> Beginners mailing list >>> Beginners at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >>> >> -------------- next part -------------- An HTML attachment was scrubbed... URL: ------------------------------ Message: 5 Date: Fri, 22 Jan 2016 17:33:33 +1100 From: Thomas Koster To: beginners at haskell.org Subject: [Haskell-beginners] Increasing capabilities dramatically increases execution time Message-ID: Content-Type: text/plain; charset=UTF-8 Hi friends, I have encountered a situation in a concurrent program where I see an unexpected, dramatic increase in execution time when I add additional capabilities. On a multi-core CPU, "-N1" is fastest by an order of magnitude and the program increasingly slows for an increasing number of capabilities (still fewer than the number of real cores, of course). My question is, why is this so and what can I do to improve this? Some details: I have a shared data structure which I call a "store", which is basically a strict HashMap String Value. This structure is shared between Haskell threads using an IORef/MVar pair: data Store = Store (IORef (HashMap Key Value)) (MVar ()) Focus on the IORef/MVar pair - the HashMap itself is not important. My intention is that read-only transactions can take the pure value straight from the IORef without blocking writers or other readers, whereas mutating transactions (those that will update the IORef when they complete) are serialized using the MVar. Alternatively, you can regard the read-only transaction as working with a private snapshot of the store that is discarded after it completes. It is my hope that this technique will allow my program to exploit a multi-core CPU by running several read-only transactions and at most one mutating transaction in parallel. I am also assuming that this technique is marginally more efficient than STM for this use case, especially for write-heavy loads where I am assuming STM would waste some time on retries (I did not test this). -- | Execute a read-only transaction that returns a value. withStore :: Store -> (HashMap Key Value -> a) -> IO a withStore (Store ioref _) f = do store <- readIORef ioref return (f store) -- | Execute a transaction that updates the store and returns a value. modifyStore :: Store -> (HashMap Key Value -> (HashMap Key Value, a)) -> IO a modifyStore (Store ioref mvar) f = modifyMVar mvar $ \ z -> do store <- readIORef ioref let (store', x) = f store store' `seq` writeIORef ioref store' return (z, x) Stop me right here if this is a silly way to do this. I have a test that forks 4 threads that each increment a counter in the store 100000 times, with the expectation that the final answer is 400000. I use the "async" package for this. This test is not necessarily pathological. I expect simple operations like incrementing counters and concatenating text to be typical transactions. threads <- replicateM 4 $ async $ replicateM_ 100000 $ modifyStore store (...increment a counter...) forM_ threads wait In this test, while any thread is busy modifying the store, the other three are blocked on the empty MVar, irrespective of how many capabilities I have. Therefore, I expect the execution time with -N4 to be similar to -N1. I expect the only difference to be attributable to the runtime's scheduling overheads, which I assume are relatively insignificant. Instead, I see a dramatic increase in execution time with increasing capabilities (typical measurements below). By the way, I say I assume scheduling overheads are "relatively insignificant" compared to incrementing the counter because in my program, the counter is incremented by interpreting an imperative EDSL, which I assume is relatively inefficient compared to e.g. "succ", but perhaps I am mistaken. In a way, my whole question probably centres around this assumption. I would be grateful is anyone can illuminate the reason for this dramatic increase in execution time when I increase the number of capabilities, and any hints on how I can mitigate it. I am using GHC 7.10.2 and compile with -O -threaded. All library versions are as at Stackage LTS 3.2. A typical measurement, with -N1: Tot time (elapsed) Avg pause Max pause Gen 0 516 colls, 0 par 0.000s 0.003s 0.0000s 0.0001s Gen 1 2 colls, 0 par 0.000s 0.001s 0.0003s 0.0003s TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.000s ( 0.001s elapsed) MUT time 0.136s ( 0.139s elapsed) GC time 0.000s ( 0.003s elapsed) EXIT time 0.000s ( 0.001s elapsed) Total time 0.136s ( 0.144s elapsed) With -N2: Tot time (elapsed) Avg pause Max pause Gen 0 334 colls, 334 par 0.012s 0.006s 0.0000s 0.0001s Gen 1 2 colls, 1 par 0.000s 0.000s 0.0002s 0.0003s Parallel GC work balance: 39.33% (serial 0%, perfect 100%) TASKS: 6 (1 bound, 5 peak workers (5 total), using -N2) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.000s ( 0.002s elapsed) MUT time 2.032s ( 2.456s elapsed) GC time 0.012s ( 0.007s elapsed) EXIT time 0.000s ( 0.000s elapsed) Total time 2.044s ( 2.465s elapsed) With -N4: Tot time (elapsed) Avg pause Max pause Gen 0 133 colls, 133 par 0.032s 0.005s 0.0000s 0.0001s Gen 1 2 colls, 1 par 0.000s 0.001s 0.0003s 0.0003s Parallel GC work balance: 41.33% (serial 0%, perfect 100%) TASKS: 10 (1 bound, 9 peak workers (9 total), using -N4) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.000s ( 0.003s elapsed) MUT time 3.516s ( 4.431s elapsed) GC time 0.032s ( 0.005s elapsed) EXIT time 0.000s ( 0.001s elapsed) Total time 3.548s ( 4.439s elapsed) Thanks, Thomas Koster ------------------------------ Subject: Digest Footer _______________________________________________ Beginners mailing list Beginners at haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners ------------------------------ End of Beginners Digest, Vol 91, Issue 26 ***************************************** -------------- next part -------------- An HTML attachment was scrubbed... URL: From frederic-emmanuel.picca at synchrotron-soleil.fr Sun Jan 24 09:15:26 2016 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Sun, 24 Jan 2016 09:15:26 +0000 Subject: [Haskell-beginners] FFI and opac struct Message-ID: Hello Here the code I try to use I get an array of (HklFactory *) via the GetAll method and I want to read for each of these HklFactory the name of the factory with the NameGet method. -- data HklFactory newtype HklFactory = HklFactory (Ptr HklFactory) deriving (Show, Storable) hklFactoryGetAll :: IO [HklFactory] hklFactoryGetAll = alloca $ \ptr -> do factories <- c_hkl_factory_get_all ptr n <- peek ptr peekArray n factories foreign import ccall unsafe "hkl.h hkl_factory_get_all" c_hkl_factory_get_all :: Ptr Int -> IO (Ptr HklFactory) hklFactoryNameGet :: Ptr HklFactory -> IO String hklFactoryNameGet factory = do name <- c_hkl_factory_name_get factory peekCString name foreign import ccall unsafe "hkl.h hkl_factory_name_get" c_hkl_factory_name_get :: Ptr HklFactory -> IO CString main :: IO () main = do initGUI factories <- hklFactoryGetAll names <- mapM hklFactoryNameGet factories print factories print names the signature of the C method are: typedef struct _HklFactory HklFactory; HKLAPI HklFactory **hkl_factory_get_all(size_t *n) HKL_ARG_NONNULL(1); HKLAPI const char *hkl_factory_name_get(const HklFactory *self) HKL_ARG_NONNULL(1); when I run the haskell code, I just get garbage when I try to extract the name of all HklFActoies here the output [HklFactory 0xb777b920,HklFactory 0xb777ba6c,HklFactory 0xb777ba98,HklFactory 0xb777bac4,HklFactory 0xb777bbf8,HklFactory 0xb777bef8,HklFactory 0xb777c4f0,HklFactory 0xb777c524,HklFactory 0xb777c6c0,HklFactory 0xb777c784,HklFactory 0xb777c8a8,HklFactory 0xb777c8dc,HklFactory 0xb777c908,HklFactory 0xb777c9cc] [",v+v References: Message-ID: I found the error [HklFactory 0xb7772920,HklFactory 0xb7772a6c,HklFactory 0xb7772a98,HklFactory 0xb7772ac4,HklFactory 0xb7772bf8,HklFactory 0xb7772ef8,HklFactory 0xb77734f0,HklFactory 0xb7773524,HklFactory 0xb77736c0,HklFactory 0xb7773784,HklFactory 0xb77738a8,HklFactory 0xb77738dc,HklFactory 0xb7773908,HklFactory 0xb77739cc] ["TwoC","E4CH","SOLEIL MARS","E4CV","K4CV","E6C","SOLEIL SIRIUS KAPPA","K6C","PETRA3 P09 EH2","SOLEIL SIRIUS TURRET","SOLEIL SIXS MED2+3","SOLEIL SIXS MED1+2","SOLEIL SIXS MED2+2","ZAXIS"] the signature of the C methode was wrong Ptr HklFactory -> HklFactory foreign import ccall unsafe "hkl.h hkl_factory_name_get" c_hkl_factory_name_get :: HklFactory -> IO CString thanks for your help ;) From theedge456 at free.fr Sun Jan 24 12:05:16 2016 From: theedge456 at free.fr (Fabien R) Date: Sun, 24 Jan 2016 13:05:16 +0100 Subject: [Haskell-beginners] compilation error for jhc Message-ID: <56A4BDFC.8070400@free.fr> Hello, I want to build jhc 0.82 on debian/amd64. I downloaded the sources and successfully configured the build. The compilation fails with this error: [149 of 186] Compiling Ho.Binary ( src/Ho/Binary.hs, src/Ho/Binary.o ) src/Ho/Binary.hs:164:10: Duplicate instance declarations: instance [overlap ok] Binary Data.Version.Version -- Defined at src/Ho/Binary.hs:164:10 instance [safe] Binary Data.Version.Version -- Defined in `binary-0.8.0.0:Data.Binary.Class' Makefile:1441: recipe for target 'jhc' failed The corresponding source code in src/Ho/Binary.hs is: import Data.Binary import qualified Data.Version instance Binary Data.Version.Version where put (Data.Version.Version a b) = put a >> put b get = liftM2 Data.Version.Version get get In the package binary, is this error due to this line ? import Data.Version (Version(..)) Any hint to solve this ? -- Fabien From toad3k at gmail.com Sun Jan 24 13:59:03 2016 From: toad3k at gmail.com (David McBride) Date: Sun, 24 Jan 2016 08:59:03 -0500 Subject: [Haskell-beginners] compilation error for jhc In-Reply-To: <56A4BDFC.8070400@free.fr> References: <56A4BDFC.8070400@free.fr> Message-ID: It looks like the binary package got its own instance for the version datatype. You could probably make it build by just removing that instance from Binary.hs. And I don't want to dissuade you, but unless there is a reason for you to use jhc, just be aware that ghc has pretty much become the defacto haskell compiler and the others have started to bit rot. On Sun, Jan 24, 2016 at 7:05 AM, Fabien R wrote: > Hello, > I want to build jhc 0.82 on debian/amd64. > I downloaded the sources and successfully configured the build. > The compilation fails with this error: > > [149 of 186] Compiling Ho.Binary ( src/Ho/Binary.hs, > src/Ho/Binary.o ) > > src/Ho/Binary.hs:164:10: > Duplicate instance declarations: > instance [overlap ok] Binary Data.Version.Version > -- Defined at src/Ho/Binary.hs:164:10 > instance [safe] Binary Data.Version.Version > -- Defined in `binary-0.8.0.0:Data.Binary.Class' > Makefile:1441: recipe for target 'jhc' failed > > The corresponding source code in src/Ho/Binary.hs is: > > import Data.Binary > import qualified Data.Version > > instance Binary Data.Version.Version where > put (Data.Version.Version a b) = put a >> put b > get = liftM2 Data.Version.Version get get > > In the package binary, is this error due to this line ? > > import Data.Version (Version(..)) > > Any hint to solve this ? > > -- > Fabien > > _______________________________________________ > 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 simon.jakobi at googlemail.com Sun Jan 24 18:11:08 2016 From: simon.jakobi at googlemail.com (Simon Jakobi) Date: Sun, 24 Jan 2016 19:11:08 +0100 Subject: [Haskell-beginners] Parsing 'A's and then ('A's or 'B's) Message-ID: Hi! I want to test whether a sequence of the characters 'A' and 'B' can represent a sequence of the symbols x and y where x may be represented by one or more 'A's and y may be represented by one or more 'A's or one or more 'B's. In code, I would like to see the following: ?> "AABB" `represents` [x, y] True ?> "AA" `represents` [x, y] True But with my current implementation using attoparsec only the first example works as expected: import Control.Applicative import Data.Attoparsec.ByteString.Char8 import Data.ByteString import Data.Either import Data.Foldable import Data.Word type Symbol = Parser [Word8] x :: Symbol x = many1 (char8 'A') y :: Symbol y = many1 (char8 'A') <|> many1 (char8 'B') represents :: ByteString -> [Symbol] -> Bool bs `represents` symbols = isRight $ parseOnly ((sequenceA_ symbols) *> endOfInput) bs It seems that in "AA" `represents` [x, y] x consumes all the 'A's, leaving none for y. Is it possible to solve this with attoparsec or are there other parsing libraries that I could use instead? Cheers, Simon -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Sun Jan 24 19:19:42 2016 From: fa-ml at ariis.it (Francesco Ariis) Date: Sun, 24 Jan 2016 20:19:42 +0100 Subject: [Haskell-beginners] Parsing 'A's and then ('A's or 'B's) In-Reply-To: References: Message-ID: <20160124191942.GA1252@casa.casa> On Sun, Jan 24, 2016 at 07:11:08PM +0100, Simon Jakobi wrote: > I want to test whether a sequence of the characters 'A' and 'B' can > represent a sequence of the symbols x and y where x may be represented by > one or more 'A's and y may be represented by one or more 'A's or one or > more 'B's. > > In code, I would like to see the following: > > ?> "AABB" `represents` [x, y] > True > ?> "AA" `represents` [x, y] > True Hello Simon, if I understood your specification correctly, there would be multiple ways to parse the string "AAA": - 3 'x' elements ("A", "A", "A") - 2 'x' elements ("AA", "A") - 2 'x' elements again (first one shorter) ("A", "AA") - 1 'x' element ("AAA") Which of these four should we choose? Maybe "parse as many As as possible without consuming the A followed by a series of B"? If so, a useful combinator is `notFollowedBy` (present in parsec, pretty sure is in attoparsec too, if not it can be easily replicated). Does that help? From simon.jakobi at googlemail.com Sun Jan 24 21:56:31 2016 From: simon.jakobi at googlemail.com (Simon Jakobi) Date: Sun, 24 Jan 2016 22:56:31 +0100 Subject: [Haskell-beginners] Parsing 'A's and then ('A's or 'B's) In-Reply-To: <20160124191942.GA1252@casa.casa> References: <20160124191942.GA1252@casa.casa> Message-ID: Hi Francesco, Thanks for your response! > if I understood your specification correctly, there would be multiple > ways to parse the string "AAA": > > - 3 'x' elements ("A", "A", "A") > - 2 'x' elements ("AA", "A") > - 2 'x' elements again (first one shorter) ("A", "AA") > - 1 'x' element ("AAA") > There would be even more ways because 'y', too, can represent one or more 'A's. Which of these four should we choose?Maybe "parse as many As as possible > without consuming the A followed by a series of B"? I don't think that there could be a general rule. For the string "AABB" and the sequence of symbols [x, y, y] there would be two possible parses: [x: "AA", y: "B", y: "B"] or [x: "A", y: "A", y: "BB"]. I only care whether there are any valid parses. I've just tried to solve the problem with regular expressions (using pcre-light) and didn't come across the same problem. Is this due to attoparsec not being able to "backtrack" (not sure if this is the right term)? Is backtracking something that parsers generally are incapable of? Cheers, Simon -------------- next part -------------- An HTML attachment was scrubbed... URL: From kolsrud at gmail.com Sun Jan 24 22:35:01 2016 From: kolsrud at gmail.com (=?UTF-8?Q?=C3=98ystein_Kolsrud?=) Date: Sun, 24 Jan 2016 23:35:01 +0100 Subject: [Haskell-beginners] Functional Programming for the Object Oriented In-Reply-To: References: Message-ID: Great! I hope it was useful to you. Best regards, ?ystein Kolsrud On Tue, Dec 8, 2015 at 12:45 PM, David Moberg wrote: > Thanks I liked this video! :) > > 2015-11-18 20:35 GMT+01:00 ?ystein Kolsrud : >> >> I gave a presentation on functional programming a couple of weeks ago >> that I thought might be of interest to this community as well: >> >> https://www.youtube.com/watch?v=I2tMmsZC1ZU >> >> It's target audience is programmers familiar with object oriented >> programming, and it presents how concepts from the functional paradigm >> are relevant also in most modern OO languages. >> >> For more information about the presentation, please refer to the following >> site: >> >> >> http://www.foocafe.org/previous_event/functional-programming-for-the-object-oriented >> From i.caught.air at gmail.com Mon Jan 25 06:10:09 2016 From: i.caught.air at gmail.com (Alex Belanger) Date: Mon, 25 Jan 2016 01:10:09 -0500 Subject: [Haskell-beginners] Parsing 'A's and then ('A's or 'B's) In-Reply-To: References: <20160124191942.GA1252@casa.casa> Message-ID: If I understood properly, Have you considered breaking the input into some sort of pattern mask then validating it? map (length . group) "AAABB" === [3,2]. Then you can do the same thing grouping with the target [x, x, y] into [2, 1]. Then you can zip the lists and ensure the numbers are all smaller than the other respectively. Also, the lists themselves have the right lengths and order for their elements. Examples of successful patterns: [1,1] AAA,BB [1, 2] AAA,B,B [2,1] A,AA,BB AA,A,BB [2,2] A,AA,B,B AA,A,B,B Try with other examples I think this would work. On Jan 24, 2016 4:57 PM, "Simon Jakobi" wrote: > Hi Francesco, > > Thanks for your response! > > >> if I understood your specification correctly, there would be multiple >> ways to parse the string "AAA": >> >> - 3 'x' elements ("A", "A", "A") >> - 2 'x' elements ("AA", "A") >> - 2 'x' elements again (first one shorter) ("A", "AA") >> - 1 'x' element ("AAA") >> > > There would be even more ways because 'y', too, can represent one or more > 'A's. > > Which of these four should we choose?Maybe "parse as many As as possible >> without consuming the A followed by a series of B"? > > > I don't think that there could be a general rule. > > For the string "AABB" and the sequence of symbols [x, y, y] there would be > two possible parses: > > [x: "AA", y: "B", y: "B"] > or > [x: "A", y: "A", y: "BB"]. > > I only care whether there are any valid parses. > > I've just tried to solve the problem with regular expressions (using > pcre-light) and didn't come across the same problem. Is this due to > attoparsec not being able to "backtrack" (not sure if this is the right > term)? Is backtracking something that parsers generally are incapable of? > > Cheers, > Simon > > _______________________________________________ > 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 dhinojosa at evolutionnext.com Mon Jan 25 06:25:49 2016 From: dhinojosa at evolutionnext.com (Daniel Hinojosa) Date: Sun, 24 Jan 2016 23:25:49 -0700 Subject: [Haskell-beginners] Custom type classes Message-ID: I am pretty sure I have a good handle on type classes, but this one is perplexing me in Haskell. I created custom Tuples called Tuple2 and Tuple3 (I know Haskell already has Tuples, just thought I would create my own for this exercise). Then I wanted to create a type class that would have a method called first that would get the first element of the tuple regardless of what kind of Tuple it is. Tuple2, Tuple3, etc. Here is what I have: data Tuple3 a b c = Tuple3 a b c deriving (Show) data Tuple2 a b = Tuple2 a b deriving (Show) class Indexable idx where first :: idx c -> a instance Indexable (Tuple2 a) where first (Tuple2 a b) = a In my main, I try to get call putStrLn $ show $ first $ Tuple2 1 "One" I was greeted with the following trace: Couldn't match expected type ?a1? with actual type ?a? ?a? is a rigid type variable bound by the instance declaration at TypeClasses.hs:35:10 ?a1? is a rigid type variable bound by the type signature for first :: Tuple2 a c -> a1 at TypeClasses.hs:36:4 Relevant bindings include a :: a (bound at TypeClasses.hs:36:18) first :: Tuple2 a c -> a1 (bound at TypeClasses.hs:36:4) In the expression: a In an equation for ?first?: first (Tuple2 a b) = a Help is appreciated. -------------- next part -------------- An HTML attachment was scrubbed... URL: From dhinojosa at evolutionnext.com Mon Jan 25 06:39:11 2016 From: dhinojosa at evolutionnext.com (Daniel Hinojosa) Date: Sun, 24 Jan 2016 23:39:11 -0700 Subject: [Haskell-beginners] Custom type classes In-Reply-To: References: Message-ID: Quick adjustment, playing around too much with it, that should be: class Indexable idx where first :: idx a -> a Problem still exists. On Sun, Jan 24, 2016 at 11:25 PM, Daniel Hinojosa < dhinojosa at evolutionnext.com> wrote: > I am pretty sure I have a good handle on type classes, but this one is > perplexing me in Haskell. I created custom Tuples called Tuple2 and Tuple3 > (I know Haskell already has Tuples, just thought I would create my own for > this exercise). Then I wanted to create a type class that would have a > method called first that would get the first element of the tuple > regardless of what kind of Tuple it is. Tuple2, Tuple3, etc. > > Here is what I have: > > data Tuple3 a b c = Tuple3 a b c deriving (Show) > > data Tuple2 a b = Tuple2 a b deriving (Show) > > class Indexable idx where > first :: idx c -> a > > instance Indexable (Tuple2 a) where > first (Tuple2 a b) = a > > In my main, I try to get call putStrLn $ show $ first $ Tuple2 1 "One" > > I was greeted with the following trace: > Couldn't match expected type ?a1? with actual type ?a? > ?a? is a rigid type variable bound by > the instance declaration at TypeClasses.hs:35:10 > ?a1? is a rigid type variable bound by > the type signature for first :: Tuple2 a c -> a1 > at TypeClasses.hs:36:4 > Relevant bindings include > a :: a (bound at TypeClasses.hs:36:18) > first :: Tuple2 a c -> a1 (bound at TypeClasses.hs:36:4) > In the expression: a > In an equation for ?first?: first (Tuple2 a b) = a > > Help is appreciated. > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From dhinojosa at evolutionnext.com Mon Jan 25 06:43:23 2016 From: dhinojosa at evolutionnext.com (Daniel Hinojosa) Date: Sun, 24 Jan 2016 23:43:23 -0700 Subject: [Haskell-beginners] Custom type classes In-Reply-To: References: Message-ID: Got it to work this way but it got the wrong one. Still looking. instance Indexable (Tuple2 a) where first (Tuple2 b a) = a On Sun, Jan 24, 2016 at 11:39 PM, Daniel Hinojosa < dhinojosa at evolutionnext.com> wrote: > Quick adjustment, playing around too much with it, that should be: > > class Indexable idx where > first :: idx a -> a > > Problem still exists. > > On Sun, Jan 24, 2016 at 11:25 PM, Daniel Hinojosa < > dhinojosa at evolutionnext.com> wrote: > >> I am pretty sure I have a good handle on type classes, but this one is >> perplexing me in Haskell. I created custom Tuples called Tuple2 and Tuple3 >> (I know Haskell already has Tuples, just thought I would create my own for >> this exercise). Then I wanted to create a type class that would have a >> method called first that would get the first element of the tuple >> regardless of what kind of Tuple it is. Tuple2, Tuple3, etc. >> >> Here is what I have: >> >> data Tuple3 a b c = Tuple3 a b c deriving (Show) >> >> data Tuple2 a b = Tuple2 a b deriving (Show) >> >> class Indexable idx where >> first :: idx c -> a >> >> instance Indexable (Tuple2 a) where >> first (Tuple2 a b) = a >> >> In my main, I try to get call putStrLn $ show $ first $ Tuple2 1 "One" >> >> I was greeted with the following trace: >> Couldn't match expected type ?a1? with actual type ?a? >> ?a? is a rigid type variable bound by >> the instance declaration at TypeClasses.hs:35:10 >> ?a1? is a rigid type variable bound by >> the type signature for first :: Tuple2 a c -> a1 >> at TypeClasses.hs:36:4 >> Relevant bindings include >> a :: a (bound at TypeClasses.hs:36:18) >> first :: Tuple2 a c -> a1 (bound at TypeClasses.hs:36:4) >> In the expression: a >> In an equation for ?first?: first (Tuple2 a b) = a >> >> Help is appreciated. >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Mon Jan 25 07:42:10 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 25 Jan 2016 08:42:10 +0100 Subject: [Haskell-beginners] Custom type classes In-Reply-To: References: Message-ID: Hello Daniel, it works with these tweaks: -- begin {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-} module TupInst where data Tuple3 a b c = Tuple3 a b c deriving (Show) data Tuple2 a b = Tuple2 a b deriving (Show) class Indexable idx a where first :: idx -> a instance Indexable (Tuple2 a b) a where first (Tuple2 a0 b0) = a0 instance Indexable (Tuple3 a b c) a where first (Tuple3 a0 b0 c0) = a0 -- end call it in ghci like this: first $ Tuple3 (1::Int) 'a' False::Int From dhinojosa at evolutionnext.com Mon Jan 25 08:08:10 2016 From: dhinojosa at evolutionnext.com (Daniel Hinojosa) Date: Mon, 25 Jan 2016 01:08:10 -0700 Subject: [Haskell-beginners] Custom type classes In-Reply-To: References: Message-ID: Ah. I had a suspicion it had to do with extensions. Got to study up on it. Thanks On Jan 25, 2016 12:42 AM, "Imants Cekusins" wrote: > Hello Daniel, > > it works with these tweaks: > > -- begin > > {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-} > module TupInst where > > > data Tuple3 a b c = Tuple3 a b c deriving (Show) > > data Tuple2 a b = Tuple2 a b deriving (Show) > > class Indexable idx a where > first :: idx -> a > > > instance Indexable (Tuple2 a b) a where > first (Tuple2 a0 b0) = a0 > > > instance Indexable (Tuple3 a b c) a where > first (Tuple3 a0 b0 c0) = a0 > > -- end > > call it in ghci like this: > > first $ Tuple3 (1::Int) 'a' False::Int > _______________________________________________ > 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 theedge456 at free.fr Mon Jan 25 08:26:56 2016 From: theedge456 at free.fr (Fabien R) Date: Mon, 25 Jan 2016 09:26:56 +0100 Subject: [Haskell-beginners] compilation error for jhc In-Reply-To: References: <56A4BDFC.8070400@free.fr> Message-ID: <56A5DC50.2010502@free.fr> On 24/01/2016 14:59, David McBride wrote: > It looks like the binary package got its own instance for the version > datatype. You could probably make it build by just removing that instance > from Binary.hs. Thanks David, It worked fine. -- Fabien From fa-ml at ariis.it Mon Jan 25 09:15:13 2016 From: fa-ml at ariis.it (Francesco Ariis) Date: Mon, 25 Jan 2016 10:15:13 +0100 Subject: [Haskell-beginners] Parsing 'A's and then ('A's or 'B's) In-Reply-To: References: <20160124191942.GA1252@casa.casa> Message-ID: <20160125091513.GA5674@casa.casa> On Sun, Jan 24, 2016 at 10:56:31PM +0100, Simon Jakobi wrote: > > if I understood your specification correctly, there would be multiple > > ways to parse the string "AAA": > > > > - 3 'x' elements ("A", "A", "A") > > - 2 'x' elements ("AA", "A") > > - 2 'x' elements again (first one shorter) ("A", "AA") > > - 1 'x' element ("AAA") > > > > There would be even more ways because 'y', too, can represent one or more > 'A's. > > [...] > > Is this due to attoparsec not being able to "backtrack" (not sure if > this is the right term)? Is backtracking something that parsers generally > are incapable of? Ah, indeed you are right. attoparsec, parsec and friends handle failure with `try`. From Attoparsec documentation: Attempt a parse, but do not consume any input if the parse fails. One way to deal with cases like yours is for every parser to compute a "list of successes". Crude example: import Text.Parsec import Text.Parsec.String foo :: Parser [String] foo = anyChar >>= \h -> (foo <|> e) >>= \t -> return ([""] ++ map (h:) t) where e = return [""] -- ?> parseTest foo "bar" -- ["","b","ba","bar"] Then you can chain those with `try`/`choice` and compute your result(s) (I guess using the list monad to handle the mechanism could do). Ambiguous grammars are an age old problem, and some searching [1] leads me to believe there are already viable solution in Haskell. [1] http://stackoverflow.com/questions/13279087/parser-library-that-can-handle-ambiguity From guillaum.bouchard+haskell at gmail.com Wed Jan 27 00:23:52 2016 From: guillaum.bouchard+haskell at gmail.com (Guillaume Bouchard) Date: Wed, 27 Jan 2016 01:23:52 +0100 Subject: [Haskell-beginners] Custom type classes Message-ID: May I suggest using FunctionalDependencies https://wiki.haskell.org/Functional_dependencies The class declaration is changed to class Indexable idx a | idx -> a where first :: idx -> a This just means that *a* is fully determined by idx (your tuple). Hence, instead of using as suggested first $ Tuple3 (1::Int) 'a' False::Int You can simplify and let the inference do its magic and use: first $ Tuple3 1 'a' False On Mon, Jan 25, 2016 at 8:42 AM, Imants Cekusins wrote: > Hello Daniel, > > it works with these tweaks: > > -- begin > > {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-} > module TupInst where > > > data Tuple3 a b c = Tuple3 a b c deriving (Show) > > data Tuple2 a b = Tuple2 a b deriving (Show) > > class Indexable idx a where > first :: idx -> a > > > instance Indexable (Tuple2 a b) a where > first (Tuple2 a0 b0) = a0 > > > instance Indexable (Tuple3 a b c) a where > first (Tuple3 a0 b0 c0) = a0 > > -- end > > call it in ghci like this: > > first $ Tuple3 (1::Int) 'a' False::Int > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From tanuki at gmail.com Wed Jan 27 00:45:23 2016 From: tanuki at gmail.com (Theodore Lief Gannon) Date: Tue, 26 Jan 2016 16:45:23 -0800 Subject: [Haskell-beginners] Custom type classes In-Reply-To: References: Message-ID: > class Indexable idx a | idx -> a where > first :: idx -> a > > This just means that *a* is fully determined by idx (your tuple). Cutting in to say thanks -- I've had a vague notion of what fundeps do but this really gelled it for me! -------------- next part -------------- An HTML attachment was scrubbed... URL: From lists at webconect.ch Wed Jan 27 07:07:29 2016 From: lists at webconect.ch (Elias Diem) Date: Wed, 27 Jan 2016 08:07:29 +0100 Subject: [Haskell-beginners] Increasing capabilities dramatically increases execution time In-Reply-To: References: Message-ID: <20160127070729.GA16405@webconect.local> Hi Thomas On 2016-01-22, Thomas Koster wrote: >Hi friends, > >I have encountered a situation in a concurrent program where I see an >unexpected, dramatic increase in execution time when I add additional >capabilities. On a multi-core CPU, "-N1" is fastest by an order of >magnitude and the program increasingly slows for an increasing number >of capabilities (still fewer than the number of real cores, of >course). > > Maybe post this to the caf? list at: https://mail.haskell.org/mailman/listinfo/haskell-cafe -- Greetings Elias From imantc at gmail.com Wed Jan 27 08:41:06 2016 From: imantc at gmail.com (Imants Cekusins) Date: Wed, 27 Jan 2016 09:41:06 +0100 Subject: [Haskell-beginners] Custom type classes In-Reply-To: References: Message-ID: Thank you Guillaume fun deps are new for me too. quoting from the above wiki link: -- Read as: "container" type determines "elem" type. class Extract container elem | container -> elem where extract :: container -> elem The functional dependency "container -> elem" promises that we won't declare multiple instances with the same "container" type. Without the functional dependency, both instances above would be allowed, and the type of v would be potentially ambiguous. Even if only one instance is defined, the type system will not figure it out without the functional dependency. From martin.drautzburg at web.de Wed Jan 27 08:44:07 2016 From: martin.drautzburg at web.de (martin) Date: Wed, 27 Jan 2016 09:44:07 +0100 Subject: [Haskell-beginners] Ambigous type variable, why this error? Message-ID: <56A88357.7010608@web.de> Hello all, here is something where I don't understand the second error: *Main> (Open [1,2,3]) <: (Open ([1,2,4])) :94:8: No instance for (Num a0) arising from the literal ?1? The type variable ?a0? is ambiguous Note: there are several potential instances: instance Num Double -- Defined in ?GHC.Float? instance Num Float -- Defined in ?GHC.Float? instance Integral a => Num (GHC.Real.Ratio a) -- Defined in ?GHC.Real? ...plus 46 others In the expression: 1 In the first argument of ?Open?, namely ?[1, 2, 3]? In the first argument of ?(<:)?, namely ?(Open [1, 2, 3])? Okay, I understand this one, but why this: :94:16: No instance for (Poset a0) arising from a use of ?<:? The type variable ?a0? is ambiguous Note: there are several potential instances: instance (Eq a, Ord a, Poset a) => Poset (Crust a) -- <== yes, yes, yes, take this one -- Defined at /home/martin/projects/haskell/currychicken/opal/Poset.hs:83:10 instance (Eq a, Ord a, Poset a) => Poset (PsSet a) -- Defined at /home/martin/projects/haskell/currychicken/opal/Poset.hs:50:10 instance (Eq a, Ord a, Poset a) => Poset (PsList a) -- Defined at /home/martin/projects/haskell/currychicken/opal/Poset.hs:46:10 ...plus one other In the expression: (Open [1, 2, 3]) <: (Open ([1, 2, 4])) In an equation for ?it?: it = (Open [1, 2, 3]) <: (Open ([1, 2, 4])) The operands of (<:) are clearly Crusts, so (PsSet a) or (PsList a) shouldn't be options *Main> :t Open [1,2,3] Open [1,2,3] :: Num a => Crust a *Main> The problem goes away, when I make sure my list elements are Ints *Main> (Open [1::Int,2,3]) <: (Open ([1,2,4])) False But why do I see the second error at all? Here is the complete code: {-# Language FlexibleInstances #-} {-# Language UndecidableInstances #-} import qualified Data.List as L import qualified Data.Set as S import Debug.Trace import Test.QuickCheck hiding ((==>)) ------------------------------------------------------------ class Poset p where ------------------------------------------------------------ (<:) :: p -> p -> Bool instance Poset Int where (<:) = (==) ------------------------------------------------------------ -- Alternatives ------------------------------------------------------------ newtype PsList a = PsList [a] newtype PsSet a = PsSet (S.Set a) isSubPolist :: (Poset a) => [a] -> [a] ->Bool isSubPolist as bs = all includedInBs as where includedInBs a = any (a <:) bs instance (Eq a, Ord a, Poset a) => Poset (PsList a) where (PsList as) <: (PsList bs) = isSubPolist as bs instance (Eq a, Ord a, Poset a) => Poset (PsSet a) where (PsSet as) <: (PsSet bs) = isSubPolist (S.toList as) (S.toList bs) ------------------------------------------------------------ data Crust a = Open [a] | Closed [a] ------------------------------------------------------------ deriving (Eq, Ord, Show) instance (Eq a, Ord a, Poset a) => Poset (Crust a) where (<:) (Open as) (Closed bs) = False (<:) (Closed as) (Closed bs) = as == bs (<:) (Open _) (Open []) = True (<:) (Open []) (Open _) = False (<:) (Open (x:xs)) (Open (y:ys)) = x <: y && (Open xs) <: (Open ys) (<:) (Closed _) (Open []) = True (<:) (Closed []) (Open _) = False (<:) (Closed (x:xs)) (Open (y:ys)) = x <: y && (Closed xs) <: (Open ys) From guillaum.bouchard+haskell at gmail.com Wed Jan 27 09:17:47 2016 From: guillaum.bouchard+haskell at gmail.com (Guillaume Bouchard) Date: Wed, 27 Jan 2016 10:17:47 +0100 Subject: [Haskell-beginners] Custom type classes In-Reply-To: References: Message-ID: On Wed, Jan 27, 2016 at 9:41 AM, Imants Cekusins wrote: > Thank you Guillaume > > fun deps are new for me too. > > quoting from the above wiki link: > > > -- Read as: "container" type determines "elem" type. > class Extract container elem | container -> elem where > extract :: container -> elem > The functional dependency "container -> elem" promises that we won't > declare multiple instances with the same "container" type. > > > > Without the functional dependency, both instances above would be > allowed, and the type of v would be potentially ambiguous. Even if > only one instance is defined, the type system will not figure it out > without the functional dependency. At first this is weird because we have the feeling that `instance Indexable (Tuple2 a b) a` fully qualifie the second type "a" as equivalent to the first subtype "a" of Tuple2. This is True for this instance, but the typechecker does not try to find one instance which match, it tries to find if , knowing the class definition, it is possible to be sure that there will only be one instance matching, and this is not the case because someone can easily define `instance Indexable (Tuple2 a b) String`. That's something I really like about this mecanism, is that adding new instances later cannot change the behavior of previous one. [A bit of digression] Actually, I don't know why, but at first though I always think in the wrong direction when reasoning about types. FunctionalDependencies is one example, but I had the same issue when I tried to understand why `fmap` cannot work on unboxed Vector. When reading the types, `fmap :: Functor f => (a -> b) -> f a -> f b`, I was understanding that it accepts any `a` as input. It was working on `Vector a`, but not on `Unbox a => Vector a` which appears more constrained, so if `fmap` was accepting any `a` as argument, it will certainly accept an `Unbox a` which is more constrained. But actually it works the opposite, `fmap` types means that `a` should be anything, and not something constrained. From imantc at gmail.com Wed Jan 27 10:11:22 2016 From: imantc at gmail.com (Imants Cekusins) Date: Wed, 27 Jan 2016 11:11:22 +0100 Subject: [Haskell-beginners] Custom type classes In-Reply-To: References: Message-ID: > `fmap` types mean that `a` should be anything, and not something constrained. just wondering: is it something specific to Functor class or does this hold for any class declaration: (a -> b) is not the same as ... a => (a -> b) in other words, if class expects (a -> b) with any a, instance must not constrain a. as opposed to ... a => a -> b which seems ok From haskell at utr.dk Wed Jan 27 12:34:29 2016 From: haskell at utr.dk (Ulrik Rasmussen) Date: Wed, 27 Jan 2016 13:34:29 +0100 Subject: [Haskell-beginners] Parsing 'A's and then ('A's or 'B's) In-Reply-To: References: Message-ID: <56A8B955.5070104@utr.dk> The language is recognized by a relatively simple DFA (attached), so the simplest solution (I think) is to just encode that: module Main where import Text.Parsec import Text.Parsec.String p :: Parser () p = char 'A' >> ((char 'A' >> sA) <|> (char 'B' >> sB)) where sA = (char 'A' >> sA) <|> (char 'B' >> sB) <|> return () sB = (char 'B' >> sB) <|> return () Cheers, Ulrik On 2016-01-24 19:11, Simon Jakobi wrote: > Hi! > > I want to test whether a sequence of the characters 'A' and 'B' can > represent a sequence of the symbols x and y where x may be represented > by one or more 'A's and y may be represented by one or more 'A's or one > or more 'B's. > > In code, I would like to see the following: > > ?> "AABB" `represents` [x, y] > True > ?> "AA" `represents` [x, y] > True > > But with my current implementation using attoparsec only the first > example works as expected: > > import Control.Applicative > import Data.Attoparsec.ByteString.Char8 > import Data.ByteString > import Data.Either > import Data.Foldable > import Data.Word > > type Symbol = Parser [Word8] > > x :: Symbol > x = many1 (char8 'A') > > y :: Symbol > y = many1 (char8 'A') <|> many1 (char8 'B') > > represents :: ByteString -> [Symbol] -> Bool > bs `represents` symbols = > isRight $ parseOnly ((sequenceA_ symbols) *> endOfInput) bs > > > It seems that in > "AA" `represents` [x, y] > x consumes all the 'A's, leaving none for y. > > Is it possible to solve this with attoparsec or are there other parsing > libraries that I could use instead? > > Cheers, > Simon > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- A non-text attachment was scrubbed... Name: DFA.png Type: image/png Size: 26934 bytes Desc: not available URL: From frederic-emmanuel.picca at synchrotron-soleil.fr Wed Jan 27 12:50:17 2016 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Wed, 27 Jan 2016 12:50:17 +0000 Subject: [Haskell-beginners] FFI foreignPtr construction Message-ID: Hello, since the last time I think that I understand how to manage Ptr, now I woud like to masterize the ForeignPtr in order to let haskell managed the life of my C objects. So I try to create a Geoemtry object like this. -- data Geometry newtype Geometry = Geometry (Ptr Geometry) deriving (Show, Storable) newGeometry :: Factory -> ForeignPtr Geometry newGeometry f = unsafePerformIO $ do geometry <- c_hkl_factory_create_new_geometry f newForeignPtr c_hkl_geometry_free geometry foreign import ccall safe "hkl.h hkl_factory_create_new_geometry" c_hkl_factory_create_new_geometry :: Factory -> IO (Geometry) foreign import ccall safe "hkl.h &hkl_geometry_free" c_hkl_geometry_free :: FunPtr (Geometry -> IO ()) the C signature are HKLAPI HklGeometry *hkl_factory_create_new_geometry(const HklFactory *self) HKL_ARG_NONNULL(1); HKLAPI void hkl_geometry_free(HklGeometry *self) HKL_ARG_NONNULL(1); But when I try to compile this code, I get this error message 1 of 1] Compiling Hkl.C ( src/Hkl/C.hs, dist/build/Hkl/C.o ) src/Hkl/C.hs:51:33: Couldn't match type ?Geometry? with ?Ptr Geometry? Expected type: GHC.ForeignPtr.FinalizerPtr Geometry Actual type: FunPtr (Geometry -> IO ()) In the first argument of ?newForeignPtr?, namely ?c_hkl_geometry_free? In a stmt of a 'do' block: newForeignPtr c_hkl_geometry_free geometry src/Hkl/C.hs:51:53: Couldn't match expected type ?Ptr Geometry? with actual type ?Geometry? In the second argument of ?newForeignPtr?, namely ?geometry? In a stmt of a 'do' block: newForeignPtr c_hkl_geometry_free geometry I do not understand what is wrong in my code thanks if you can help Frederic From fa-ml at ariis.it Wed Jan 27 12:48:55 2016 From: fa-ml at ariis.it (Francesco Ariis) Date: Wed, 27 Jan 2016 13:48:55 +0100 Subject: [Haskell-beginners] Parsing 'A's and then ('A's or 'B's) In-Reply-To: <56A8B955.5070104@utr.dk> References: <56A8B955.5070104@utr.dk> Message-ID: <20160127124855.GA32727@casa.casa> On Wed, Jan 27, 2016 at 01:34:29PM +0100, Ulrik Rasmussen wrote: > The language is recognized by a relatively simple DFA (attached), so the > simplest solution (I think) is to just encode that: > > module Main where > > import Text.Parsec > import Text.Parsec.String > > p :: Parser () > p = char 'A' >> ((char 'A' >> sA) <|> (char 'B' >> sB)) > where > sA = (char 'A' >> sA) <|> (char 'B' >> sB) <|> return () > sB = (char 'B' >> sB) <|> return () I am probably missing something: say we have an "AAB" string, how does this check that it is `compatible` with [x,y] or [x,x,y] or [x,y,y] (or not compatible with [x,x,x], etc.)? From guillaum.bouchard+haskell at gmail.com Wed Jan 27 13:28:55 2016 From: guillaum.bouchard+haskell at gmail.com (Guillaume Bouchard) Date: Wed, 27 Jan 2016 14:28:55 +0100 Subject: [Haskell-beginners] Custom type classes In-Reply-To: References: Message-ID: On Wed, Jan 27, 2016 at 11:11 AM, Imants Cekusins wrote: >> `fmap` types mean that `a` should be anything, and not something > constrained. > > just wondering: is it something specific to Functor class or does this > hold for any class declaration: > > (a -> b) > is not the same as > ... a => (a -> b) a => (a -> b) does not really mean anything as far as I know because a is not a constraint (i.e: a typeclass). Perhaps you mean something such as Constraint a => (a -> b) > in other words, if class expects (a -> b) with any a, instance must > not constrain a. However I discovered the `ConstraintKinds` extension which may improve the situation. -- G. From toad3k at gmail.com Wed Jan 27 14:57:33 2016 From: toad3k at gmail.com (David McBride) Date: Wed, 27 Jan 2016 09:57:33 -0500 Subject: [Haskell-beginners] Ambigous type variable, why this error? In-Reply-To: <56A88357.7010608@web.de> References: <56A88357.7010608@web.de> Message-ID: If I had to guess, it is ambiguous because there are many valid instances it could use. >:t (Open [undefined :: Int]) <: (undefined) (Open [undefined :: Int]) <: (undefined) :: Bool >:t (Open [undefined :: Crust Int]) <: (undefined) (Open [undefined :: Crust Int]) <: (undefined) :: Bool >:t (Open [undefined :: Crust (Crust Int)]) <: (undefined) (Open [undefined :: Crust (Crust Int)]) <: (undefined) :: Bool However, I do not get the same error as you do on ghc 7.10.3, so I am unsure. :2:9: No instance for (Num a0) arising from the literal ?1? The type variable ?a0? is ambiguous Note: there are several potential instances: instance Num Integer -- Defined in ?GHC.Num? instance Num Double -- Defined in ?GHC.Float? instance Num Float -- Defined in ?GHC.Float? ...plus two others In the expression: 1 In the first argument of ?Open?, namely ?[1, 2, 3]? In the first argument of ?(<:)?, namely ?(Open [1, 2, 3])? :2:17: No instance for (Ord a0) arising from a use of ?<:? The type variable ?a0? is ambiguous Note: there are several potential instances: instance (Ord a, Ord b) => Ord (Either a b) -- Defined in ?Data.Either? instance forall (k :: BOX) (s :: k). Ord (Data.Proxy.Proxy s) -- Defined in ?Data.Proxy? instance (GHC.Arr.Ix i, Ord e) => Ord (GHC.Arr.Array i e) -- Defined in ?GHC.Arr? ...plus 28 others In the expression: (Open [1, 2, 3]) <: (Open ([1, 2, 4])) In an equation for ?it?: it = (Open [1, 2, 3]) <: (Open ([1, 2, 4])) If I remove the Ord constraint on the Poset (Crust a) instance, It changes from ambiguous Ord to ambiguous Eq. On Wed, Jan 27, 2016 at 3:44 AM, martin wrote: > Hello all, > > here is something where I don't understand the second error: > > *Main> (Open [1,2,3]) <: (Open ([1,2,4])) > > :94:8: > No instance for (Num a0) arising from the literal ?1? > The type variable ?a0? is ambiguous > Note: there are several potential instances: > instance Num Double -- Defined in ?GHC.Float? > instance Num Float -- Defined in ?GHC.Float? > instance Integral a => Num (GHC.Real.Ratio a) > -- Defined in ?GHC.Real? > ...plus 46 others > In the expression: 1 > In the first argument of ?Open?, namely ?[1, 2, 3]? > In the first argument of ?(<:)?, namely ?(Open [1, 2, 3])? > > Okay, I understand this one, but why this: > > :94:16: > No instance for (Poset a0) arising from a use of ?<:? > The type variable ?a0? is ambiguous > Note: there are several potential instances: > instance (Eq a, Ord a, Poset a) => Poset (Crust a) -- <== yes, > yes, yes, take this one > -- Defined at > /home/martin/projects/haskell/currychicken/opal/Poset.hs:83:10 > instance (Eq a, Ord a, Poset a) => Poset (PsSet a) > -- Defined at > /home/martin/projects/haskell/currychicken/opal/Poset.hs:50:10 > instance (Eq a, Ord a, Poset a) => Poset (PsList a) > -- Defined at > /home/martin/projects/haskell/currychicken/opal/Poset.hs:46:10 > ...plus one other > In the expression: (Open [1, 2, 3]) <: (Open ([1, 2, 4])) > In an equation for ?it?: > it = (Open [1, 2, 3]) <: (Open ([1, 2, 4])) > > The operands of (<:) are clearly Crusts, so (PsSet a) or (PsList a) > shouldn't be options > > *Main> :t Open [1,2,3] > Open [1,2,3] :: Num a => Crust a > *Main> > > The problem goes away, when I make sure my list elements are Ints > > *Main> (Open [1::Int,2,3]) <: (Open ([1,2,4])) > False > > But why do I see the second error at all? > > > Here is the complete code: > > {-# Language FlexibleInstances #-} > {-# Language UndecidableInstances #-} > > import qualified Data.List as L > import qualified Data.Set as S > import Debug.Trace > import Test.QuickCheck hiding ((==>)) > > ------------------------------------------------------------ > class Poset p where > ------------------------------------------------------------ > (<:) :: p -> p -> Bool > > instance Poset Int where (<:) = (==) > > ------------------------------------------------------------ > -- Alternatives > ------------------------------------------------------------ > newtype PsList a = PsList [a] > newtype PsSet a = PsSet (S.Set a) > > isSubPolist :: (Poset a) => [a] -> [a] ->Bool > isSubPolist as bs = all includedInBs as > where > includedInBs a = any (a <:) bs > > instance (Eq a, Ord a, Poset a) => Poset (PsList a) > where > (PsList as) <: (PsList bs) = isSubPolist as bs > > instance (Eq a, Ord a, Poset a) => Poset (PsSet a) > where > (PsSet as) <: (PsSet bs) = isSubPolist (S.toList as) (S.toList > bs) > > > ------------------------------------------------------------ > data Crust a = Open [a] | Closed [a] > ------------------------------------------------------------ > deriving (Eq, Ord, Show) > > instance (Eq a, Ord a, Poset a) => Poset (Crust a) > where > (<:) (Open as) (Closed bs) = False > (<:) (Closed as) (Closed bs) = as == bs > > (<:) (Open _) (Open []) = True > (<:) (Open []) (Open _) = False > (<:) (Open (x:xs)) (Open (y:ys)) = x <: y && > (Open xs) <: (Open ys) > > (<:) (Closed _) (Open []) = True > (<:) (Closed []) (Open _) = False > (<:) (Closed (x:xs)) (Open (y:ys)) = x <: y && > (Closed xs) <: (Open ys) > > > _______________________________________________ > 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 haskell at utr.dk Wed Jan 27 15:11:23 2016 From: haskell at utr.dk (Ulrik Rasmussen) Date: Wed, 27 Jan 2016 16:11:23 +0100 Subject: [Haskell-beginners] Parsing 'A's and then ('A's or 'B's) In-Reply-To: <20160127124855.GA32727@casa.casa> References: <56A8B955.5070104@utr.dk> <20160127124855.GA32727@casa.casa> Message-ID: <56A8DE1B.1010607@utr.dk> On 2016-01-27 13:48, Francesco Ariis wrote: > On Wed, Jan 27, 2016 at 01:34:29PM +0100, Ulrik Rasmussen wrote: > > The language is recognized by a relatively simple DFA (attached), so the > > simplest solution (I think) is to just encode that: > > > > module Main where > > > > import Text.Parsec > > import Text.Parsec.String > > > > p :: Parser () > > p = char 'A' >> ((char 'A' >> sA) <|> (char 'B' >> sB)) > > where > > sA = (char 'A' >> sA) <|> (char 'B' >> sB) <|> return () > > sB = (char 'B' >> sB) <|> return () > > I am probably missing something: say we have an "AAB" string, how does > this check that it is `compatible` with [x,y] or [x,x,y] or [x,y,y] > (or not compatible with [x,x,x], etc.)? > Oh, I read Simon's question as being constrained to the specific problem [x, y] (i.e. recognizing AA*(AA* + BB*)). If the problem is to run any list of parsers such as [x,y,x,x], then this won't work. From hsyl20 at gmail.com Wed Jan 27 18:37:00 2016 From: hsyl20 at gmail.com (Sylvain Henry) Date: Wed, 27 Jan 2016 19:37:00 +0100 Subject: [Haskell-beginners] FFI foreignPtr construction In-Reply-To: References: Message-ID: Hi, You can try something like this (not tested): data Geo = Geo -- this represents the HklGeometry C structure (for clarity) newtype Geometry = Geometry (ForeignPtr Geo) deriving (Show, Storable) newGeometry :: Factory -> IO Geometry newGeometry f = do -- avoid unsafePerformIO geometry <- c_hkl_factory_create_new_geometry f Geometry <$> newForeignPtr c_hkl_geometry_free geometry foreign import ccall safe "hkl.h hkl_factory_create_new_geometry" c_hkl_factory_create_new_geometry :: Factory -> IO (Ptr Geo) foreign import ccall safe "hkl.h &hkl_geometry_free" c_hkl_geometry_free :: FunPtr (Ptr Geo -> IO ()) 2016-01-27 13:50 GMT+01:00 PICCA Frederic-Emmanuel < frederic-emmanuel.picca at synchrotron-soleil.fr>: > Hello, > > since the last time I think that I understand how to manage Ptr, now I > woud like to masterize the ForeignPtr in order to let haskell managed the > life of my C objects. > So I try to create a Geoemtry object like this. > > -- data Geometry > newtype Geometry = Geometry (Ptr Geometry) deriving (Show, Storable) > > newGeometry :: Factory -> ForeignPtr Geometry > newGeometry f = unsafePerformIO $ do > geometry <- c_hkl_factory_create_new_geometry f > newForeignPtr c_hkl_geometry_free geometry > > foreign import ccall safe "hkl.h hkl_factory_create_new_geometry" > c_hkl_factory_create_new_geometry :: Factory > -> IO (Geometry) > > foreign import ccall safe "hkl.h &hkl_geometry_free" > c_hkl_geometry_free :: FunPtr (Geometry -> IO ()) > > > > the C signature are > > HKLAPI HklGeometry *hkl_factory_create_new_geometry(const HklFactory > *self) HKL_ARG_NONNULL(1); > > HKLAPI void hkl_geometry_free(HklGeometry *self) HKL_ARG_NONNULL(1); > > > But when I try to compile this code, I get this error message > > > 1 of 1] Compiling Hkl.C ( src/Hkl/C.hs, dist/build/Hkl/C.o ) > > src/Hkl/C.hs:51:33: > Couldn't match type ?Geometry? with ?Ptr Geometry? > Expected type: GHC.ForeignPtr.FinalizerPtr Geometry > Actual type: FunPtr (Geometry -> IO ()) > In the first argument of ?newForeignPtr?, namely > ?c_hkl_geometry_free? > In a stmt of a 'do' block: > newForeignPtr c_hkl_geometry_free geometry > > src/Hkl/C.hs:51:53: > Couldn't match expected type ?Ptr Geometry? > with actual type ?Geometry? > In the second argument of ?newForeignPtr?, namely ?geometry? > In a stmt of a 'do' block: > newForeignPtr c_hkl_geometry_free geometry > > I do not understand what is wrong in my code > > thanks if you can help > > Frederic > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From martin.drautzburg at web.de Wed Jan 27 20:40:18 2016 From: martin.drautzburg at web.de (martin) Date: Wed, 27 Jan 2016 21:40:18 +0100 Subject: [Haskell-beginners] Is it possible to use a <> constructor in analogy to [] ? Message-ID: <56A92B32.4090007@web.de> Hello all, I've written my own Read and Show instances for a type, which is essentially data Crust a = Open [a] | Closed [a] "Show" does something like *Main> Closed [1,2,3] <1,2,3> *Main> Open [1,2,3] <1,2,3..> And Read faithully parses each stings and turns it into a Crust again. Problem is: when I just type <1,2,3..> in GHCi I get a "parse error on input ? constructor, or something like it= From frederic-emmanuel.picca at synchrotron-soleil.fr Wed Jan 27 20:49:22 2016 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Wed, 27 Jan 2016 20:49:22 +0000 Subject: [Haskell-beginners] FFI foreignPtr construction In-Reply-To: References: , Message-ID: Thanks for your help I end up with this code which I find quite elegant :) -- data Geometry data HklGeometry newtype Geometry = Geometry (ForeignPtr HklGeometry) deriving (Show) newGeometry :: Factory -> IO Geometry newGeometry f = Geometry <$> (c_hkl_factory_create_new_geometry f >>= newForeignPtr c_hkl_geometry_free) foreign import ccall unsafe "hkl.h hkl_factory_create_new_geometry" c_hkl_factory_create_new_geometry :: Factory -> IO (Ptr HklGeometry) foreign import ccall unsafe "hkl.h &hkl_geometry_free" c_hkl_geometry_free :: FunPtr (Ptr HklGeometry -> IO ()) Cheers Frederic From tkoster at gmail.com Thu Jan 28 00:06:55 2016 From: tkoster at gmail.com (Thomas Koster) Date: Thu, 28 Jan 2016 11:06:55 +1100 Subject: [Haskell-beginners] Increasing capabilities dramatically increases execution time In-Reply-To: <20160127070729.GA16405@webconect.local> References: <20160127070729.GA16405@webconect.local> Message-ID: > On 2016-01-22, Thomas Koster wrote: > I have encountered a situation in a concurrent program where I see an > unexpected, dramatic increase in execution time when I add additional > capabilities. On a multi-core CPU, "-N1" is fastest by an order of > magnitude and the program increasingly slows for an increasing number > of capabilities (still fewer than the number of real cores, of > course). > > On 27 January 2016 at 18:07, Elias Diem wrote: > Maybe post this to the caf? list at: > > https://mail.haskell.org/mailman/listinfo/haskell-cafe Thanks, Elias. This is being discussed there in the thread "When are MVars better than STM?". https://mail.haskell.org/pipermail/haskell-cafe/2016-January/122785.html -- Thomas Koster From chaddai.fouche at gmail.com Thu Jan 28 20:14:21 2016 From: chaddai.fouche at gmail.com (=?UTF-8?B?Q2hhZGRhw68gRm91Y2jDqQ==?=) Date: Thu, 28 Jan 2016 20:14:21 +0000 Subject: [Haskell-beginners] Custom type classes In-Reply-To: References: Message-ID: Le mer. 27 janv. 2016 ? 14:29, Guillaume Bouchard < guillaum.bouchard+haskell at gmail.com> a ?crit : > However I discovered the `ConstraintKinds` extension which may improve > the situation. It does, it is in fact quite easy in modern Haskell to write a typeclass analogue to a functor but which may have further constraints on the types contained. But it won't be the historic "Functor" typeclass which is ubiquitous in the Haskell packages... {-# LANGUAGE ConstraintKinds, TypeFamilies #-} module ConstrainedFunctor where import GHC.Exts (Constraint) import qualified Data.Vector.Unboxed as V class CFunctor f where type FConstraint f x :: Constraint type instance FConstraint f x = () cfmap :: (FConstraint f a, FConstraint f b) => (a -> b) -> f a -> f b instance CFunctor V.Vector where type FConstraint V.Vector x = V.Unbox x cfmap f v = V.map f v doubleVector :: V.Vector Int -> V.Vector Int doubleVector = cfmap (*2) -- Jeda? -------------- next part -------------- An HTML attachment was scrubbed... URL: From eyeinsky9 at gmail.com Fri Jan 29 13:22:37 2016 From: eyeinsky9 at gmail.com (Carl Eyeinsky) Date: Fri, 29 Jan 2016 14:22:37 +0100 Subject: [Haskell-beginners] Is it possible to use a <> constructor in analogy to [] ? In-Reply-To: <56A92B32.4090007@web.de> References: <56A92B32.4090007@web.de> Message-ID: If you write the literal in a string, apply 'read' and specify the type, then it should work. If you write it in a string literal, then it might be that you need to use defaulting to get it to evaluate to Crust. If you write just a bare <...> in ghci then afaik that won't ever work, as there's a fixed set of literals ghc's parser accepts. On Jan 27, 2016 9:44 PM, "martin" wrote: > Hello all, > > I've written my own Read and Show instances for a type, which is > essentially > > data Crust a = Open [a] | Closed [a] > > "Show" does something like > > *Main> Closed [1,2,3] > <1,2,3> > *Main> Open [1,2,3] > <1,2,3..> > > And Read faithully parses each stings and turns it into a Crust again. > > Problem is: when I just type <1,2,3..> in GHCi I get a "parse error on > input ? custructor as above it parses it okay. > > Is it possible at all to write my own <> constructor, or something like it= > _______________________________________________ > 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 frederic-emmanuel.picca at synchrotron-soleil.fr Sat Jan 30 22:11:31 2016 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Sat, 30 Jan 2016 22:11:31 +0000 Subject: [Haskell-beginners] Strange type error with hsc2hs and cabal Message-ID: Hello, I am still playing with FFI. Now I create a real project with cabal end build a library and an executable for my project. ---hkl.cabal--- name: hkl version: 0.1.0.0 executable ghkl main-is: ghkl.hs build-depends: base >=4.8 && <4.9 , containers >=0.5 && <0.6 , filepath , gtk >=0.13 && <0.14 , hkl hs-source-dirs: src default-language: Haskell2010 pkgconfig-depends: hkl build-tools: hsc2hs library exposed-modules: Hkl, Hkl.Types, Hkl.C, Hkl.DArray other-extensions: CPP, ForeignFunctionInterface, EmptyDataDecls, TypeFamilies, FlexibleInstances, FlexibleContexts, RecordWildCards build-depends: base >=4.8 && <4.9, containers >=0.5 && <0.6 hs-source-dirs: src build-tools: hsc2hs default-language: Haskell2010 pkgconfig-depends: hkl --- --- but when I compile my project I get this errormessage which is really strange. $ cabal build Package has never been configured. Configuring with default flags. If this fails, please run configure manually. Warning: The package list for 'hackage.haskell.org' is 17.1 days old. Run 'cabal update' to get the latest list of available packages. Resolving dependencies... Configuring hkl-0.1.0.0... Warning: 'data-files: ../../gui/ghkl.ui' is a relative path outside of the source tree. This will not work when generating a tarball with 'sdist'. Building hkl-0.1.0.0... Preprocessing library hkl-0.1.0.0... [1 of 4] Compiling Hkl.Types ( src/Hkl/Types.hs, dist/build/Hkl/Types.o ) [2 of 4] Compiling Hkl.C ( src/Hkl/C.hs, dist/build/Hkl/C.o ) [3 of 4] Compiling Hkl.DArray ( dist/build/Hkl/DArray.hs, dist/build/Hkl/DArray.o ) [4 of 4] Compiling Hkl ( src/Hkl.hs, dist/build/Hkl.o ) In-place registering hkl-0.1.0.0... Preprocessing executable 'ghkl' for hkl-0.1.0.0... [1 of 4] Compiling Hkl.Types ( src/Hkl/Types.hs, dist/build/ghkl/ghkl-tmp/Hkl/Types.o ) [2 of 4] Compiling Hkl.C ( src/Hkl/C.hs, dist/build/ghkl/ghkl-tmp/Hkl/C.o ) [3 of 4] Compiling Hkl ( src/Hkl.hs, dist/build/ghkl/ghkl-tmp/Hkl.o ) [4 of 4] Compiling Main ( src/ghkl.hs, dist/build/ghkl/ghkl-tmp/Main.o ) src/ghkl.hs:44:39: Couldn't match expected type ?Hkl.Types.EngineList? with actual type ?Hkl.EngineList? NB: ?Hkl.Types.EngineList? is defined in ?Hkl.Types? in package ?hkl-0.1.0.0? ?Hkl.EngineList? is defined at src/Hkl/Types.hs:22:1-74 In the first argument of ?Hkl.engineListEnginesGet?, namely ?engines? In a stmt of a 'do' block: tmp <- Hkl.engineListEnginesGet engines if I add a other-modules to ghkl an remove the hkl dependecy it work great. so what is wrong with this project. PS: the DArray module is indeed the one using hsc2hs :) Thansk for your help Frederic From theedge456 at free.fr Sun Jan 31 20:53:22 2016 From: theedge456 at free.fr (Fabien R) Date: Sun, 31 Jan 2016 21:53:22 +0100 Subject: [Haskell-beginners] generating object file for ARM Message-ID: <56AE7442.4050706@free.fr> Hello, I would like to link my Haskell module with existing object files for armv7-m. I use ghc 7.4.1 on debian/amd64. This command seems incorrect: ghc -pgmcarm-none-eabi-gcc -pgmParm-none-eabi-cpp -pgmaarm-none-eabi-as -pgmlarm-none-eabi-ld -keep-tmp-files HaskellModule.hs A lot of errors appeared: [1 of 1] Compiling HaskellModule ( HaskellModule.hs, HaskellModule.o ) /tmp/ghc13654_0/ghc13654_0.s: Assembler messages: /tmp/ghc13654_0/ghc13654_0.s:5:0: Error: unrecognized symbol type "" /tmp/ghc13654_0/ghc13654_0.s:17:0: Error: unrecognized symbol type "" /tmp/ghc13654_0/ghc13654_0.s:29:0: Error: bad instruction `leaq -40(%rbp),%rax' /tmp/ghc13654_0/ghc13654_0.s:30:0: Error: bad instruction `cmpq %r15,%rax' Any hints ? -- Fabien