From 50295 at web.de Fri Feb 3 11:20:16 2017 From: 50295 at web.de (Olumide) Date: Fri, 3 Feb 2017 11:20:16 +0000 Subject: [Haskell-beginners] Question about example in 'using do notation with Writer' section of LYH In-Reply-To: References: <41fadc2e-e456-b4fb-3943-ed896812c648@web.de> Message-ID: <43a69956-d89e-492c-1a0d-c4659f7eeff3@web.de> On 27/01/2017 08:34, Theodore Lief Gannon wrote: > Fully expanding your program might help. One of the great things about > Haskell is equational reasoning: if two things have been declared equal, > you can substitute one for the other. > > First, let's desugar that do notation to the equivalent bind chain: > > multWithLog = > logNumber 3 >>= \a -> > logNumber 5 >>= \b -> > return (a*b) > > > Evaluate the logNumber and return calls to normal form from their > definitions, also considering the monoid definitions of (++) and mempty > for lists: > > multWithLog = > Writer (3, ["Got number: 3"]) >>= \a -> > Writer (5, ["Got number: 5"]) >>= \b -> > Writer (a*b, []) > > > Now, refer to the definition of (>>=) for Writer (as shown in LYAH): > > (Writer (x, v)) >>= f = let (Writer (y, v')) = f x in Writer (y, v > `mappend` v') > Thank you for your explanation. The substitutions helped a lot even though I wasn't able to follow the equational reasoning. The expansion gave me enough starting information to figure out what's going on by starting from the innermost bind. BTW, I thought the definition of (>>=) was supposed to come from Control.Monad.Writer. Regards, - Olumide From 50295 at web.de Fri Feb 3 11:31:32 2017 From: 50295 at web.de (Olumide) Date: Fri, 3 Feb 2017 11:31:32 +0000 Subject: [Haskell-beginners] Need help understanding the tell function in the Monad Writer example in LYAH Message-ID: <7195359e-cfb5-a3de-d473-76450f2d069d@web.de> Hello List, Would someone kindly explain how the tell function interacts with the Writer Monad as show below: (Example taken from chapter 14 of LYAH http://learnyouahaskell.com/for-a-few-monads-more#reader ) multWithLog :: Writer [String] Int multWithLog = do a <- logNumber 3 b <- logNumber 5 tell ["Gonna multiply these two"] return (a*b) Result: ghci> runWriter multWithLog (15,["Got number: 3","Got number: 5","Gonna multiply these two"]) I know that tell function binds to an argument that is discarded but I don't know how its argument "Gonna multiply these two" is concatenated with the other the Writer created by logNumber 3 and logNumber 5. Also, I don't understand the paragraph following the example: "It's important that return (a*b) is the last line, because the result of the last line in a do expression is the result of the whole do expression. Had we put tell as the last line, () would have been the result of this do expression. We'd lose the result of the multiplication. However, the log would be the same." Regards, - Olumide From fa-ml at ariis.it Fri Feb 3 13:54:20 2017 From: fa-ml at ariis.it (Francesco Ariis) Date: Fri, 3 Feb 2017 14:54:20 +0100 Subject: [Haskell-beginners] Need help understanding the tell function in the Monad Writer example in LYAH In-Reply-To: <7195359e-cfb5-a3de-d473-76450f2d069d@web.de> References: <7195359e-cfb5-a3de-d473-76450f2d069d@web.de> Message-ID: <20170203135420.GA23896@casa.casa> On Fri, Feb 03, 2017 at 11:31:32AM +0000, Olumide wrote: > Hello List, > > Would someone kindly explain how the tell function interacts with the Writer > Monad as show below: > (Example taken from chapter 14 of LYAH > http://learnyouahaskell.com/for-a-few-monads-more#reader ) > > multWithLog :: Writer [String] Int > multWithLog = do > a <- logNumber 3 > b <- logNumber 5 > tell ["Gonna multiply these two"] > return (a*b) > > Result: > ghci> runWriter multWithLog > (15,["Got number: 3","Got number: 5","Gonna multiply these two"]) > > I know that tell function binds to an argument that is discarded but I don't > know how its argument "Gonna multiply these two" is concatenated with the > other the Writer created by logNumber 3 and logNumber 5. > > Also, I don't understand the paragraph following the example: > > "It's important that return (a*b) is the last line, because the result of > the last line in a do expression is the result of the whole do expression. > Had we put tell as the last line, () would have been the result of this do > expression. We'd lose the result of the multiplication. However, the log > would be the same." > > > Regards, > > - Olumide Hello Olumide, a Writer do block can be read as a series of function which all have a "hidden parameter". This parameter is the pile of log messages. So you could as well substitute `tell ...` with myTell :: String -> Writer [String] () myTell s = writer ((), [s]) and then in the do block -- ... receiving a list of log messages c <- myTell "something" -- adding mine to the list (and binding -- a variable) return (a*b) -- c is not being used! -- but the log message *is* there You can verify this yourself by adding `logNumber` statement in a do block and not using them in the last return statement. There too log will appear even if the bound variable is unused. multWithLog :: Writer [String] Int multWithLog = do a <- logNumber 3 b <- logNumber 5 -- not used but logged -- equivalent to: logNumber 5 (without b <-) return (a) > Also, I don't understand the paragraph following the example: > > "It's important that return (a*b) is the last line, because the result of > the last line in a do expression is the result of the whole do expression. > Had we put tell as the last line, () would have been the result of this do > expression. We'd lose the result of the multiplication. However, the log > would be the same." `tell` is really not much different from `myTell`. Let's examine it again: myTell :: String -> Writer [String] () myTell s = writer ((), [s]) See the ()? It means it is *actually* returning something, a (). Remember that `return` isn't the same `return` as in some imperative languages: it only wraps a value in the monad we are using: return 5 -- takes `5` and 'lifts' so it is usable inside the Writer -- monad: `(5, [])` Putting a `tell "something"` after a return statement would overwrite that result (and gives us back a () instead). Did this help? My tip for really getting a Monad in your brain is to reimplement it. It is a very useful exercise. Also learning *not* to use the `do notation` helps too, as having operators instead of magic makes things easier to understand. From mike_k_houghton at yahoo.co.uk Fri Feb 3 21:47:04 2017 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Fri, 3 Feb 2017 21:47:04 +0000 Subject: [Haskell-beginners] Bit confused... Message-ID: I have ---------- import qualified Data.Map as M type Link a = (a, Int) data MChain a = Map a [Link a] deriving (Show) ------------------- and want to make a Monoid of MChain. So I have ------------------- instance Monoid (MChain a) where mempty = M.empty mappend = undefined ------------------- this won’t compile and I need M.empty to be Map a [Link a] The error is Couldn't match expected type ‘MChain a1’ with actual type ‘M.Map k0 a0’ • In the expression: M.empty :: MChain a In an equation for ‘mempty’: mempty = M.empty :: MChain a In the instance declaration for ‘Monoid (MChain a)’ This part confuses me "Couldn't match expected type ‘MChain a1 with actual type ‘M.Map k0 a0’ " How should I proceed. Many thanks Mike From fa-ml at ariis.it Fri Feb 3 21:59:48 2017 From: fa-ml at ariis.it (Francesco Ariis) Date: Fri, 3 Feb 2017 22:59:48 +0100 Subject: [Haskell-beginners] Bit confused... In-Reply-To: References: Message-ID: <20170203215948.GA11320@casa.casa> On Fri, Feb 03, 2017 at 09:47:04PM +0000, mike h wrote: > I have > > ---------- > import qualified Data.Map as M > > type Link a = (a, Int) > data MChain a = Map a [Link a] deriving (Show) > > ------------------- > > and want to make a Monoid of MChain. So I have > > ------------------- > instance Monoid (MChain a) where > mempty = M.empty > mappend = undefined > ------------------- > > this won’t compile and I need M.empty to be Map a [Link a] Hello Mike, I think the error lies in the confusion between `type` and `data` declaration. type Something = Int but data Something = SomeConstructor Int So I bet you wanted to write data MChain a = MChain (M.Map a [Link a]) deriving (Show) `M.empty` returns a Map. λ> :t M.empty M.empty :: M.Map k aj Hence this will work: instance Monoid (MChain a) where mempty = MChain M.empty mappend = undefined Does this help? From mike_k_houghton at yahoo.co.uk Sat Feb 4 08:13:09 2017 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Sat, 4 Feb 2017 08:13:09 +0000 Subject: [Haskell-beginners] Bit confused... In-Reply-To: <20170203215948.GA11320@casa.casa> References: <20170203215948.GA11320@casa.casa> Message-ID: <6F289E37-3F47-42F7-AD8D-A8C153C365D7@yahoo.co.uk> Yes, that’s exactly what I meant to write!!! :) Thank you Francesco. Mike > On 3 Feb 2017, at 21:59, Francesco Ariis wrote: > > On Fri, Feb 03, 2017 at 09:47:04PM +0000, mike h wrote: >> I have >> >> ---------- >> import qualified Data.Map as M >> >> type Link a = (a, Int) >> data MChain a = Map a [Link a] deriving (Show) >> >> ------------------- >> >> and want to make a Monoid of MChain. So I have >> >> ------------------- >> instance Monoid (MChain a) where >> mempty = M.empty >> mappend = undefined >> ------------------- >> >> this won’t compile and I need M.empty to be Map a [Link a] > > Hello Mike, I think the error lies in the confusion between > `type` and `data` declaration. > > type Something = Int > > but > > data Something = SomeConstructor Int > > So I bet you wanted to write > > data MChain a = MChain (M.Map a [Link a]) deriving (Show) > > `M.empty` returns a Map. > > λ> :t M.empty > M.empty :: M.Map k aj > > Hence this will work: > > instance Monoid (MChain a) where > mempty = MChain M.empty > mappend = undefined > > Does this help? > > > > _______________________________________________ > 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 50295 at web.de Mon Feb 6 14:50:25 2017 From: 50295 at web.de (Olumide) Date: Mon, 6 Feb 2017 14:50:25 +0000 Subject: [Haskell-beginners] Need help understanding the tell function in the Monad Writer example in LYAH In-Reply-To: <20170203135420.GA23896@casa.casa> References: <7195359e-cfb5-a3de-d473-76450f2d069d@web.de> <20170203135420.GA23896@casa.casa> Message-ID: I think I get it now. tell() is defined in Control.Monad.Writer as: tell :: w -> m () tell w = writer ((),w) *also* the result if the do notation is the last expression; and that's why the result of the computation will be lost (or disregarded) if tell() comes last. - Olumide On 03/02/2017 13:54, Francesco Ariis wrote: > a Writer do block can be read as a series of function which all have > a "hidden parameter". This parameter is the pile of log messages. > So you could as well substitute `tell ...` with > > myTell :: String -> Writer [String] () > myTell s = writer ((), [s]) > > and then in the do block > > -- ... receiving a list of log messages > c <- myTell "something" -- adding mine to the list (and binding > -- a variable) > return (a*b) -- c is not being used! > -- but the log message *is* there > > You can verify this yourself by adding `logNumber` statement in a do > block and not using them in the last return statement. There too log > will appear even if the bound variable is unused. > > multWithLog :: Writer [String] Int > multWithLog = do > a <- logNumber 3 > b <- logNumber 5 -- not used but logged > -- equivalent to: logNumber 5 (without b <-) > return (a) > >> Also, I don't understand the paragraph following the example: >> >> "It's important that return (a*b) is the last line, because the result of >> the last line in a do expression is the result of the whole do expression. >> Had we put tell as the last line, () would have been the result of this do >> expression. We'd lose the result of the multiplication. However, the log >> would be the same." > > `tell` is really not much different from `myTell`. Let's examine it again: > > myTell :: String -> Writer [String] () > myTell s = writer ((), [s]) > > See the ()? It means it is *actually* returning something, a (). > Remember that `return` isn't the same `return` as in some imperative > languages: it only wraps a value in the monad we are using: > > return 5 > -- takes `5` and 'lifts' so it is usable inside the Writer > -- monad: `(5, [])` > > Putting a `tell "something"` after a return statement would overwrite > that result (and gives us back a () instead). > > Did this help? > My tip for really getting a Monad in your brain is to reimplement it. > It is a very useful exercise. > Also learning *not* to use the `do notation` helps too, as having > operators instead of magic makes things easier to understand. > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From sylvain at haskus.fr Mon Feb 6 15:09:14 2017 From: sylvain at haskus.fr (Sylvain Henry) Date: Mon, 6 Feb 2017 16:09:14 +0100 Subject: [Haskell-beginners] Ambiguous type variable prevents the constraint `(Ord t0)' from being solved. In-Reply-To: <5152611485634149@web34j.yandex.ru> References: <5152611485634149@web34j.yandex.ru> Message-ID: <52a6bdf3-95df-93c9-9140-0787ff05f4b1@haskus.fr> Try removing the lambda: applyd f d x = let apply_listd l d x = [..] in let k = 5 -- hash x - todo [...] Regards, Sylvain On 28/01/2017 21:09, Ivan Kush wrote: > I get this error (full message at the end of the mail). How could I correct my code? > > > =================== > Code: > =================== > > module Intro where > > import Data.Bits -- for xor, .&. > > data Func a b > = Empty > | Leaf Int [(a, b)] > | Branch Int Int (Func a b) (Func a b) > > applyd = > let apply_listd l d x = > case l of > [] -> d x > (a, b) : t -> > let c = compare x a > in if c == EQ then b > else if c == GT then apply_listd t d x > else d x > > in \f d x -> > let k = 5 -- hash x - todo > in let look t = > case t of > Leaf h l | h == k -> > apply_listd l d x > Branch p b l r | (k `xor` p) .&. (b - 1) == 0 -> -- (Branch p b l r) | ((k xor p) .&. (b - 1)) == 0 -> > look (if k .&. b == 0 then l else r) > _ -> d x > in look f > > > > =================== > Error: > =================== > > Intro.hs:37:25: error: > * Ambiguous type variable `t0' arising from a use of `apply_listd' > prevents the constraint `(Ord t0)' from being solved. > Relevant bindings include > l :: [(t0, t)] (bound at Intro.hs:36:28) > t :: Func t0 t (bound at Intro.hs:34:21) > look :: Func t0 t -> t (bound at Intro.hs:34:16) > x :: t0 (bound at Intro.hs:32:15) > d :: t0 -> t (bound at Intro.hs:32:13) > f :: Func t0 t (bound at Intro.hs:32:11) > (Some bindings suppressed; use -fmax-relevant-binds=N or -fno-max-relevant-binds) > Probable fix: use a type annotation to specify what `t0' should be. > These potential instances exist: > instance Ord Ordering -- Defined in `GHC.Classes' > instance Ord Integer > -- Defined in `integer-gmp-1.0.0.1:GHC.Integer.Type' > instance Ord a => Ord (Maybe a) -- Defined in `GHC.Base' > ...plus 22 others > ...plus five instances involving out-of-scope types > (use -fprint-potential-instances to see them all) > * In the expression: apply_listd l d x > In a case alternative: Leaf h l | h == k -> apply_listd l d x > In the expression: > case t of { > Leaf h l | h == k -> apply_listd l d x > Branch p b l r > | (k `xor` p) .&. (b - 1) == 0 > -> look (if k .&. b == 0 then l else r) > _ -> d x } > > > -- > Best wishes, > Ivan Kush > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From mike_k_houghton at yahoo.co.uk Mon Feb 6 19:40:12 2017 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Mon, 6 Feb 2017 19:40:12 +0000 Subject: [Haskell-beginners] Applicative for State Message-ID: Hi, I have a State by another name, Stat, just to experiment and learn. newtype Stat s a = Stat { runStat :: s -> (a, s) } instance Functor (Stat s) where fmap f (Stat g) = Stat $ \s -> (f a, s) where (a, s) = g s instance Applicative (Stat s) where pure a = Stat $ \s -> (a, s) (Stat f) <*> (Stat g) = Stat $ \s -> (a, s) where (a, s) = undefined I really can’t get what the <*> in the Applicative should be! I just do see how I ‘get the f out of the Stat’ and then apply it. I’d be really grateful if someone would explain what it should be and the steps/reasoning needed to get there. Many thanks Mike From fa-ml at ariis.it Mon Feb 6 20:15:29 2017 From: fa-ml at ariis.it (Francesco Ariis) Date: Mon, 6 Feb 2017 21:15:29 +0100 Subject: [Haskell-beginners] Applicative for State In-Reply-To: References: Message-ID: <20170206201529.GA1034@casa.casa> On Mon, Feb 06, 2017 at 07:40:12PM +0000, mike h wrote: > I have a State by another name, Stat, just to experiment and learn. > [...] > I really can’t get what the <*> in the Applicative should be! > I just do see how I ‘get the f out of the Stat’ and then apply it. > > I’d be really grateful if someone would explain what it should be and > the steps/reasoning needed to get there. Hello Mike, when writing an instance, you always have to keep in mind: (a) the signature of the function you are writing and (b) what the instance is designed to do. In our case, (<*>) is: (<*>) :: Applicative f => f (a -> b) -> f a -> f b -- which we could 'rewrite' as (<*>) :: Stat s (a -> b) -> Stat s a -> Stat s b so we grab the results, one being a function and the other a value, and apply the first to the second. (b) is "pass the state around in the background". Good, let's put this in action: (Stat f) <*> (Stat g) = Stat $ \s -> let (h, s') = f s -- h is a function :: a -> b (a, s'') = g s' -- state passing b = h a in -- the application (b, s'') -- we're not returning just the tuple, we're returning -- even the bit before the 'let' statement And that is that. Was this clear? From mike_k_houghton at yahoo.co.uk Mon Feb 6 23:35:31 2017 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Mon, 6 Feb 2017 23:35:31 +0000 Subject: [Haskell-beginners] Applicative for State In-Reply-To: <20170206201529.GA1034@casa.casa> References: <20170206201529.GA1034@casa.casa> Message-ID: Thanks again Francesco. Part of my problem was confusing the data and type constructors. With your solution and my renaming of the data constructors it all became much clearer! :) Mike > On 6 Feb 2017, at 20:15, Francesco Ariis wrote: > > On Mon, Feb 06, 2017 at 07:40:12PM +0000, mike h wrote: >> I have a State by another name, Stat, just to experiment and learn. >> [...] >> I really can’t get what the <*> in the Applicative should be! >> I just do see how I ‘get the f out of the Stat’ and then apply it. >> >> I’d be really grateful if someone would explain what it should be and >> the steps/reasoning needed to get there. > > Hello Mike, > > when writing an instance, you always have to keep in mind: (a) the > signature of the function you are writing and (b) what the instance > is designed to do. > > In our case, (<*>) is: > > (<*>) :: Applicative f => f (a -> b) -> f a -> f b > > -- which we could 'rewrite' as > (<*>) :: Stat s (a -> b) -> Stat s a -> Stat s b > > so we grab the results, one being a function and the other a value, > and apply the first to the second. > > (b) is "pass the state around in the background". Good, let's put this > in action: > > (Stat f) <*> (Stat g) = Stat $ \s -> > let (h, s') = f s -- h is a function :: a -> b > (a, s'') = g s' -- state passing > b = h a in -- the application > (b, s'') -- we're not returning just the tuple, we're returning > -- even the bit before the 'let' statement > > And that is that. Was this clear? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From tanuki at gmail.com Mon Feb 6 23:56:33 2017 From: tanuki at gmail.com (Theodore Lief Gannon) Date: Mon, 6 Feb 2017 15:56:33 -0800 Subject: [Haskell-beginners] Semigroup Instances In-Reply-To: <82H33KLF09rxs-mmILyQ-aBsaKQFCiANhJ4FMZwOCjQ7AYiPtd3noxIcauSDVqrGs1xNbVMYNM_Vc5lrNgJPsN-mEe24my553xoFockn2kM=@protonmail.com> References: <82H33KLF09rxs-mmILyQ-aBsaKQFCiANhJ4FMZwOCjQ7AYiPtd3noxIcauSDVqrGs1xNbVMYNM_Vc5lrNgJPsN-mEe24my553xoFockn2kM=@protonmail.com> Message-ID: Gmail put you in spam. If you haven't figured this out since you asked -- it's a matter of confusing (IMO bad) variable names. Check the data definition: data Validation a b = Failure a | Success b deriving (Eq, Show) Failures are always type a, and successes are always type b. The type variables used in the first line correspond to these. But in the definitions of (<>), they are just local values. The instance could be rewritten like so: instance Semigroup a => Semigroup (Validation a b) where Success x <> Success y = Success x Failure x <> Success y = Success y Success x <> Failure y = Success x Failure x <> Failure y = Failure (x <> y) On Thu, Jan 26, 2017 at 1:55 PM, Atrudyjane wrote: > I'm currently studying semigroups and trying to figure out how to > determine which type variables need a semigroup instance. Here are a couple > of examples from Evan Cameron's github (https://github.com/leshow/ > haskell-programming-book/blob/master/src/Ch15ex.hs): > (1) > data Validation a b > = Failure a > | Success b > deriving (Eq, Show) > > instance Semigroup a => Semigroup (Validation a b) where > Success a <> Success b = Success a > Failure a <> Success b = Success b > Success a <> Failure b = Success a > Failure a <> Failure b = Failure (a <> b) > > * Why doesn't 'b' need an instance of semigroup? > (2) > newtype AccumulateRight a b = AccumulateRight (Validation a b) deriving ( > Eq, Show) > > instance Semigroup b => Semigroup (AccumulateRight a b) where > AccumulateRight (Success a) <>AccumulateRight (Failure b) =AccumulateRight > (Success a) > AccumulateRight (Failure a) <>AccumulateRight (Success b) =AccumulateRight > (Success b) > AccumulateRight (Failure a) <>AccumulateRight (Failure b) =AccumulateRight > (Failure a) > > AccumulateRight (Success a) <> AccumulateRight (Success b) = > AccumulateRight (Success (a <> b)) > > * Why doesn't 'a' need an instance of semigroup? > > > Thank you, > Andrea > > > Sent with ProtonMail Secure Email. > > > _______________________________________________ > 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 atrudyjane at protonmail.com Tue Feb 7 03:53:49 2017 From: atrudyjane at protonmail.com (Atrudyjane) Date: Mon, 06 Feb 2017 22:53:49 -0500 Subject: [Haskell-beginners] Semigroup Instances In-Reply-To: References: <82H33KLF09rxs-mmILyQ-aBsaKQFCiANhJ4FMZwOCjQ7AYiPtd3noxIcauSDVqrGs1xNbVMYNM_Vc5lrNgJPsN-mEe24my553xoFockn2kM=@protonmail.com> Message-ID: Thank you Theodore. Yes, changing the variable names makes it clearer. Also the fact that only failures are combined on the right hand side... Regards, Andrea Sent with [ProtonMail](https://protonmail.com) Secure Email. -------- Original Message -------- Subject: Re: [Haskell-beginners] Semigroup Instances Local Time: February 6, 2017 5:56 PM UTC Time: February 6, 2017 11:56 PM From: tanuki at gmail.com To: Atrudyjane , The Haskell-Beginners Mailing List - Discussion of primarily beginner-level topics related to Haskell Gmail put you in spam. If you haven't figured this out since you asked -- it's a matter of confusing (IMO bad) variable names. Check the data definition: data Validation a b = Failure a | Success b deriving (Eq, Show) Failures are always type a, and successes are always type b. The type variables used in the first line correspond to these. But in the definitions of (<>), they are just local values. The instance could be rewritten like so: instance Semigroup a => Semigroup (Validation a b) where Success x <> Success y = Success x Failure x <> Success y = Success y Success x <> Failure y = Success x Failure x <> Failure y = Failure (x <> y) On Thu, Jan 26, 2017 at 1:55 PM, Atrudyjane wrote: I'm currently studying semigroups and trying to figure out how to determine which type variables need a semigroup instance. Here are a couple of examples from Evan Cameron's github (https://github.com/leshow/haskell-programming-book/blob/master/src/Ch15ex.hs): (1) data Validation a b = Failure a | Success b deriving (Eq, Show) instance Semigroup a => Semigroup (Validation a b) where Success a <> Success b = Success a Failure a <> Success b = Success b Success a <> Failure b = Success a Failure a <> Failure b = Failure (a <> b) * Why doesn't 'b' need an instance of semigroup? (2) newtype AccumulateRight a b = AccumulateRight (Validation a b) deriving (Eq, Show) instance Semigroup b => Semigroup (AccumulateRight a b) where AccumulateRight (Success a) <>AccumulateRight (Failure b) =AccumulateRight (Success a) AccumulateRight (Failure a) <>AccumulateRight (Success b) =AccumulateRight (Success b) AccumulateRight (Failure a) <>AccumulateRight (Failure b) =AccumulateRight (Failure a) AccumulateRight (Success a) <> AccumulateRight (Success b) = AccumulateRight (Success (a <> b)) * Why doesn't 'a' need an instance of semigroup? Thank you, Andrea Sent with [ProtonMail](https://protonmail.com) Secure Email. _______________________________________________ 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 nicholls.mark at vimn.com Thu Feb 9 16:59:00 2017 From: nicholls.mark at vimn.com (Nicholls, Mark) Date: Thu, 9 Feb 2017 16:59:00 +0000 Subject: [Haskell-beginners] how do typeclasses work again? Message-ID: Sorry..I do haskell about once every 6 months for 2 hours...and then get on with my life. I always forget some nuance of typeclasses. Consider some simple typeclass > class Is isx x where > apply :: (x -> y) -> isx -> y We can make any type a member of it...mapping to itself > instance Is x x where > apply f = f But we can also make a tuple a member of it...and pull the 1st member.. > instance Is (x,y) x where > apply f (x,y) = f x Weird and largey useless...but I'm playing. Then construct a function to operate on it > foo2 :: (Is isx Integer) => isx -> String > foo2 = apply (\i -> "") And... • Could not deduce (Is isx x0) arising from a use of ‘apply’ from the context: Is isx Integer bound by the type signature for: foo2 :: Is isx Integer => isx -> String at prop.lhs:51:3-43 The type variable ‘x0’ is ambiguous Relevant bindings include foo2 :: isx -> String (bound at prop.lhs:52:3) These potential instances exist: instance Is x x -- Defined at prop.lhs:41:12 instance Is (x, y) x -- Defined at prop.lhs:45:12 • In the expression: apply (\ i -> "") In an equation for ‘foo2’: foo2 = apply (\ i -> "") What's it going on about? (my brain is locked in F# OO type mode) I've told it to expect a function "Integer -> String"...surely? Whats the problem. CONFIDENTIALITY NOTICE This e-mail (and any attached files) is confidential and protected by copyright (and other intellectual property rights). If you are not the intended recipient please e-mail the sender and then delete the email and any attached files immediately. Any further use or dissemination is prohibited. While MTV Networks Europe has taken steps to ensure that this email and any attachments are virus free, it is your responsibility to ensure that this message and any attachments are virus free and do not affect your systems / data. Communicating by email is not 100% secure and carries risks such as delay, data corruption, non-delivery, wrongful interception and unauthorised amendment. If you communicate with us by e-mail, you acknowledge and assume these risks, and you agree to take appropriate measures to minimise these risks when e-mailing us. MTV Networks International, MTV Networks UK & Ireland, Greenhouse, Nickelodeon Viacom Consumer Products, VBSi, Viacom Brand Solutions International, Be Viacom, Viacom International Media Networks and VIMN and Comedy Central are all trading names of MTV Networks Europe. MTV Networks Europe is a partnership between MTV Networks Europe Inc. and Viacom Networks Europe Inc. Address for service in Great Britain is 17-29 Hawley Crescent, London, NW1 8TT. From sylvain at haskus.fr Thu Feb 9 17:29:04 2017 From: sylvain at haskus.fr (Sylvain Henry) Date: Thu, 9 Feb 2017 18:29:04 +0100 Subject: [Haskell-beginners] how do typeclasses work again? In-Reply-To: References: Message-ID: > I've told it to expect a function "Integer -> String"...surely? No. The constraints only indicates that an instance matching "Is isx Integer" must exist but that's not what the compiler expects. You have: (\i -> "") :: x -> String the type `x` cannot be inferred. Hence when you write `apply (\i -> "")` the compiler expects an instance "Is isx x" for the ambiguous x. You have to declare the type of `i` to be Integer for your code to work: foo = apply (\(i :: Integer) -> "") -- Sylvain On 09/02/2017 17:59, Nicholls, Mark wrote: > Sorry..I do haskell about once every 6 months for 2 hours...and then get on with my life. > > I always forget some nuance of typeclasses. > > Consider some simple typeclass > >> class Is isx x where >> apply :: (x -> y) -> isx -> y > > We can make any type a member of it...mapping to itself > >> instance Is x x where >> apply f = f > But we can also make a tuple a member of it...and pull the 1st member.. > >> instance Is (x,y) x where >> apply f (x,y) = f x > Weird and largey useless...but I'm playing. > > Then construct a function to operate on it > >> foo2 :: (Is isx Integer) => isx -> String >> foo2 = apply (\i -> "") > And... > > • Could not deduce (Is isx x0) arising from a use of ‘apply’ > from the context: Is isx Integer > bound by the type signature for: > foo2 :: Is isx Integer => isx -> String > at prop.lhs:51:3-43 > The type variable ‘x0’ is ambiguous > Relevant bindings include > foo2 :: isx -> String (bound at prop.lhs:52:3) > These potential instances exist: > instance Is x x -- Defined at prop.lhs:41:12 > instance Is (x, y) x -- Defined at prop.lhs:45:12 > • In the expression: apply (\ i -> "") > In an equation for ‘foo2’: foo2 = apply (\ i -> "") > > > What's it going on about? > (my brain is locked in F# OO type mode) > > I've told it to expect a function "Integer -> String"...surely? > Whats the problem. > > CONFIDENTIALITY NOTICE > > This e-mail (and any attached files) is confidential and protected by copyright (and other intellectual property rights). If you are not the intended recipient please e-mail the sender and then delete the email and any attached files immediately. Any further use or dissemination is prohibited. > > While MTV Networks Europe has taken steps to ensure that this email and any attachments are virus free, it is your responsibility to ensure that this message and any attachments are virus free and do not affect your systems / data. > > Communicating by email is not 100% secure and carries risks such as delay, data corruption, non-delivery, wrongful interception and unauthorised amendment. If you communicate with us by e-mail, you acknowledge and assume these risks, and you agree to take appropriate measures to minimise these risks when e-mailing us. > > MTV Networks International, MTV Networks UK & Ireland, Greenhouse, Nickelodeon Viacom Consumer Products, VBSi, Viacom Brand Solutions International, Be Viacom, Viacom International Media Networks and VIMN and Comedy Central are all trading names of MTV Networks Europe. MTV Networks Europe is a partnership between MTV Networks Europe Inc. and Viacom Networks Europe Inc. Address for service in Great Britain is 17-29 Hawley Crescent, London, NW1 8TT. > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From toad3k at gmail.com Thu Feb 9 17:31:14 2017 From: toad3k at gmail.com (David McBride) Date: Thu, 9 Feb 2017 12:31:14 -0500 Subject: [Haskell-beginners] how do typeclasses work again? In-Reply-To: References: Message-ID: foo2 :: (Is isx Integer) => isx -> String isx -> String - That means that this function takes anything and returns a string. Is isx Integer => - That just means that whatever isx is, there should be an Is isx Integer instance that satisfies it. Putting those together this function takes anything and returns a string, so long as the anything (isx) satisfies the constraint I isx Integer. But there's nothing in the type or code that says what type x actually is. The Integer in the constraint just constrains what isx can be. To fix it add the ScopedTypeVariables extension and try this: foo2 :: (Is isx Integer) => isx -> String foo2 = apply (\(i :: Integer) -> "") Alternatively if you are using ghc 8, you can turn on TypeApplications and use this: foo2 :: (Is isx Integer) => isx -> String foo2 = apply @_ @Integer (\i -> "") On Thu, Feb 9, 2017 at 11:59 AM, Nicholls, Mark wrote: > > Sorry..I do haskell about once every 6 months for 2 hours...and then get on with my life. > > I always forget some nuance of typeclasses. > > Consider some simple typeclass > >> class Is isx x where >> apply :: (x -> y) -> isx -> y > > > We can make any type a member of it...mapping to itself > >> instance Is x x where >> apply f = f > > But we can also make a tuple a member of it...and pull the 1st member.. > >> instance Is (x,y) x where >> apply f (x,y) = f x > > Weird and largey useless...but I'm playing. > > Then construct a function to operate on it > >> foo2 :: (Is isx Integer) => isx -> String >> foo2 = apply (\i -> "") > > And... > > • Could not deduce (Is isx x0) arising from a use of ‘apply’ > from the context: Is isx Integer > bound by the type signature for: > foo2 :: Is isx Integer => isx -> String > at prop.lhs:51:3-43 > The type variable ‘x0’ is ambiguous > Relevant bindings include > foo2 :: isx -> String (bound at prop.lhs:52:3) > These potential instances exist: > instance Is x x -- Defined at prop.lhs:41:12 > instance Is (x, y) x -- Defined at prop.lhs:45:12 > • In the expression: apply (\ i -> "") > In an equation for ‘foo2’: foo2 = apply (\ i -> "") > > > What's it going on about? > (my brain is locked in F# OO type mode) > > I've told it to expect a function "Integer -> String"...surely? > Whats the problem. > > CONFIDENTIALITY NOTICE > > This e-mail (and any attached files) is confidential and protected by copyright (and other intellectual property rights). If you are not the intended recipient please e-mail the sender and then delete the email and any attached files immediately. Any further use or dissemination is prohibited. > > While MTV Networks Europe has taken steps to ensure that this email and any attachments are virus free, it is your responsibility to ensure that this message and any attachments are virus free and do not affect your systems / data. > > Communicating by email is not 100% secure and carries risks such as delay, data corruption, non-delivery, wrongful interception and unauthorised amendment. If you communicate with us by e-mail, you acknowledge and assume these risks, and you agree to take appropriate measures to minimise these risks when e-mailing us. > > MTV Networks International, MTV Networks UK & Ireland, Greenhouse, Nickelodeon Viacom Consumer Products, VBSi, Viacom Brand Solutions International, Be Viacom, Viacom International Media Networks and VIMN and Comedy Central are all trading names of MTV Networks Europe. MTV Networks Europe is a partnership between MTV Networks Europe Inc. and Viacom Networks Europe Inc. Address for service in Great Britain is 17-29 Hawley Crescent, London, NW1 8TT. > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From defigueiredo at ucdavis.edu Fri Feb 10 12:45:00 2017 From: defigueiredo at ucdavis.edu (Dimitri DeFigueiredo) Date: Fri, 10 Feb 2017 10:45:00 -0200 Subject: [Haskell-beginners] how do typeclasses work again? In-Reply-To: References: Message-ID: <1b62c0cc-5198-2048-18cc-942f2da2cc18@ucdavis.edu> I would like to make a general comment that is likely not useful to the specific question asked (which I think has already been nicely answered by others). But I would like to point out this video of an excellent lecture on typeclasses given by Simon Peyton-Jones a few years ago. https://channel9.msdn.com/posts/MDCC-TechTalk-Classes-Jim-but-not-as-we-know-them Cheers, Dimitri -- 2E45 D376 A744 C671 5100 A261 210B 8461 0FB0 CA1F From nicholls.mark at vimn.com Fri Feb 10 16:27:41 2017 From: nicholls.mark at vimn.com (Nicholls, Mark) Date: Fri, 10 Feb 2017 16:27:41 +0000 Subject: [Haskell-beginners] how do typeclasses work again? In-Reply-To: References: Message-ID: lovely so if I now go.... > foo4 = apply (\i -> show i) And :t foo4 is... > foo4 :: (Is isx a, Show a) => isx -> String So add that as a type...and we get the same sort of awfulness...."could not deduce" bla bla But how do you make this disappear > foo4 = apply (\(i :: a) -> show i) Doesn’t work... "could not deduce" bla bla I'd instinctively like to go.... > foo4 = apply (\(i :: ((Show a) => a)) -> show i) "Illegal qualified type: Show a => a" And this is really just > foo4 = apply show Where we end with "could not deduce" Sorry....I'm struggling. >-----Original Message----- >From: Beginners [mailto:beginners-bounces at haskell.org] On Behalf Of David >McBride >Sent: 09 February 2017 5:31 PM >To: The Haskell-Beginners Mailing List - Discussion of primarily beginner-level >topics related to Haskell >Subject: Re: [Haskell-beginners] how do typeclasses work again? > >foo2 :: (Is isx Integer) => isx -> String > > >isx -> String - That means that this function takes anything and returns a string. >Is isx Integer => - That just means that whatever isx is, there should be an Is isx >Integer instance that satisfies it. > >Putting those together this function takes anything and returns a string, so long >as the anything (isx) satisfies the constraint I isx Integer. > >But there's nothing in the type or code that says what type x actually is. The >Integer in the constraint just constrains what isx can be. > >To fix it add the ScopedTypeVariables extension and try this: > >foo2 :: (Is isx Integer) => isx -> String >foo2 = apply (\(i :: Integer) -> "") > >Alternatively if you are using ghc 8, you can turn on TypeApplications and use >this: > >foo2 :: (Is isx Integer) => isx -> String >foo2 = apply @_ @Integer (\i -> "") > >On Thu, Feb 9, 2017 at 11:59 AM, Nicholls, Mark >wrote: >> >> Sorry..I do haskell about once every 6 months for 2 hours...and then get on >with my life. >> >> I always forget some nuance of typeclasses. >> >> Consider some simple typeclass >> >>> class Is isx x where >>> apply :: (x -> y) -> isx -> y >> >> >> We can make any type a member of it...mapping to itself >> >>> instance Is x x where >>> apply f = f >> >> But we can also make a tuple a member of it...and pull the 1st member.. >> >>> instance Is (x,y) x where >>> apply f (x,y) = f x >> >> Weird and largey useless...but I'm playing. >> >> Then construct a function to operate on it >> >>> foo2 :: (Is isx Integer) => isx -> String >>> foo2 = apply (\i -> "") >> >> And... >> >> • Could not deduce (Is isx x0) arising from a use of ‘apply’ >> from the context: Is isx Integer >> bound by the type signature for: >> foo2 :: Is isx Integer => isx -> String >> at prop.lhs:51:3-43 >> The type variable ‘x0’ is ambiguous >> Relevant bindings include >> foo2 :: isx -> String (bound at prop.lhs:52:3) >> These potential instances exist: >> instance Is x x -- Defined at prop.lhs:41:12 >> instance Is (x, y) x -- Defined at prop.lhs:45:12 >> • In the expression: apply (\ i -> "") >> In an equation for ‘foo2’: foo2 = apply (\ i -> "") >> >> >> What's it going on about? >> (my brain is locked in F# OO type mode) >> >> I've told it to expect a function "Integer -> String"...surely? >> Whats the problem. >> >> CONFIDENTIALITY NOTICE >> >> This e-mail (and any attached files) is confidential and protected by copyright >(and other intellectual property rights). If you are not the intended recipient >please e-mail the sender and then delete the email and any attached files >immediately. Any further use or dissemination is prohibited. >> >> While MTV Networks Europe has taken steps to ensure that this email and any >attachments are virus free, it is your responsibility to ensure that this message >and any attachments are virus free and do not affect your systems / data. >> >> Communicating by email is not 100% secure and carries risks such as delay, >data corruption, non-delivery, wrongful interception and unauthorised >amendment. If you communicate with us by e-mail, you acknowledge and >assume these risks, and you agree to take appropriate measures to minimise >these risks when e-mailing us. >> >> MTV Networks International, MTV Networks UK & Ireland, Greenhouse, >Nickelodeon Viacom Consumer Products, VBSi, Viacom Brand Solutions >International, Be Viacom, Viacom International Media Networks and VIMN and >Comedy Central are all trading names of MTV Networks Europe. MTV Networks >Europe is a partnership between MTV Networks Europe Inc. and Viacom >Networks Europe Inc. Address for service in Great Britain is 17-29 Hawley >Crescent, London, NW1 8TT. >> _______________________________________________ >> 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 CONFIDENTIALITY NOTICE This e-mail (and any attached files) is confidential and protected by copyright (and other intellectual property rights). If you are not the intended recipient please e-mail the sender and then delete the email and any attached files immediately. Any further use or dissemination is prohibited. While MTV Networks Europe has taken steps to ensure that this email and any attachments are virus free, it is your responsibility to ensure that this message and any attachments are virus free and do not affect your systems / data. Communicating by email is not 100% secure and carries risks such as delay, data corruption, non-delivery, wrongful interception and unauthorised amendment. If you communicate with us by e-mail, you acknowledge and assume these risks, and you agree to take appropriate measures to minimise these risks when e-mailing us. MTV Networks International, MTV Networks UK & Ireland, Greenhouse, Nickelodeon Viacom Consumer Products, VBSi, Viacom Brand Solutions International, Be Viacom, Viacom International Media Networks and VIMN and Comedy Central are all trading names of MTV Networks Europe. MTV Networks Europe is a partnership between MTV Networks Europe Inc. and Viacom Networks Europe Inc. Address for service in Great Britain is 17-29 Hawley Crescent, London, NW1 8TT. From nicholls.mark at vimn.com Fri Feb 10 16:28:15 2017 From: nicholls.mark at vimn.com (Nicholls, Mark) Date: Fri, 10 Feb 2017 16:28:15 +0000 Subject: [Haskell-beginners] how do typeclasses work again? In-Reply-To: <1b62c0cc-5198-2048-18cc-942f2da2cc18@ucdavis.edu> References: <1b62c0cc-5198-2048-18cc-942f2da2cc18@ucdavis.edu> Message-ID: I'll take a look Thanks. >-----Original Message----- >From: Beginners [mailto:beginners-bounces at haskell.org] On Behalf Of Dimitri >DeFigueiredo >Sent: 10 February 2017 12:45 PM >To: beginners at haskell.org >Subject: Re: [Haskell-beginners] how do typeclasses work again? > >I would like to make a general comment that is likely not useful to the specific >question asked (which I think has already been nicely answered by others). >But I would like to point out this video of an excellent lecture on typeclasses >given by Simon Peyton-Jones a few years ago. > >https://channel9.msdn.com/posts/MDCC-TechTalk-Classes-Jim-but-not-as-we- >know-them > >Cheers, > >Dimitri > >-- >2E45 D376 A744 C671 5100 A261 210B 8461 0FB0 CA1F > >_______________________________________________ >Beginners mailing list >Beginners at haskell.org >http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners CONFIDENTIALITY NOTICE This e-mail (and any attached files) is confidential and protected by copyright (and other intellectual property rights). If you are not the intended recipient please e-mail the sender and then delete the email and any attached files immediately. Any further use or dissemination is prohibited. While MTV Networks Europe has taken steps to ensure that this email and any attachments are virus free, it is your responsibility to ensure that this message and any attachments are virus free and do not affect your systems / data. Communicating by email is not 100% secure and carries risks such as delay, data corruption, non-delivery, wrongful interception and unauthorised amendment. If you communicate with us by e-mail, you acknowledge and assume these risks, and you agree to take appropriate measures to minimise these risks when e-mailing us. MTV Networks International, MTV Networks UK & Ireland, Greenhouse, Nickelodeon Viacom Consumer Products, VBSi, Viacom Brand Solutions International, Be Viacom, Viacom International Media Networks and VIMN and Comedy Central are all trading names of MTV Networks Europe. MTV Networks Europe is a partnership between MTV Networks Europe Inc. and Viacom Networks Europe Inc. Address for service in Great Britain is 17-29 Hawley Crescent, London, NW1 8TT. From sylvain at haskus.fr Fri Feb 10 17:17:08 2017 From: sylvain at haskus.fr (Sylvain Henry) Date: Fri, 10 Feb 2017 18:17:08 +0100 Subject: [Haskell-beginners] how do typeclasses work again? In-Reply-To: References: Message-ID: Your `foo4`: 1) uses the instance `Isx isx a` to convert an `isx` into an `a` 2) then uses the instance `Show a` to convert an `a` into a String The problem is that the compiler cannot infer the actual `a` type. E.g., suppose you have the following instances: data X = X data Y = Y instance Is (x,y) x where ... instance Is (x,y) y where ... instance Show X where ... instance Show Y where ... If you write "foo4 (X,Y)", the compiler can't decide which instance to use. A solution: use AllowAmbiguousTypes as the compiler suggests and then use TypeApplications to select the "a" type: foo4 :: forall a isx. (Is isx a, Show a) => isx -> String foo4 = apply (\(i :: a) -> show a) main = print (foo4 @Y (X,Y)) -- Sylvain On 10/02/2017 17:27, Nicholls, Mark wrote: > lovely > > so if I now go.... > >> foo4 = apply (\i -> show i) > And :t foo4 is... > >> foo4 :: (Is isx a, Show a) => isx -> String > So add that as a type...and we get the same sort of awfulness...."could not deduce" bla bla > > But how do you make this disappear > >> foo4 = apply (\(i :: a) -> show i) > Doesn’t work... "could not deduce" bla bla > > I'd instinctively like to go.... > >> foo4 = apply (\(i :: ((Show a) => a)) -> show i) > "Illegal qualified type: Show a => a" > > And this is really just > >> foo4 = apply show > Where we end with "could not deduce" > > Sorry....I'm struggling. > > >> -----Original Message----- >> From: Beginners [mailto:beginners-bounces at haskell.org] On Behalf Of David >> McBride >> Sent: 09 February 2017 5:31 PM >> To: The Haskell-Beginners Mailing List - Discussion of primarily beginner-level >> topics related to Haskell >> Subject: Re: [Haskell-beginners] how do typeclasses work again? >> >> foo2 :: (Is isx Integer) => isx -> String >> >> >> isx -> String - That means that this function takes anything and returns a string. >> Is isx Integer => - That just means that whatever isx is, there should be an Is isx >> Integer instance that satisfies it. >> >> Putting those together this function takes anything and returns a string, so long >> as the anything (isx) satisfies the constraint I isx Integer. >> >> But there's nothing in the type or code that says what type x actually is. The >> Integer in the constraint just constrains what isx can be. >> >> To fix it add the ScopedTypeVariables extension and try this: >> >> foo2 :: (Is isx Integer) => isx -> String >> foo2 = apply (\(i :: Integer) -> "") >> >> Alternatively if you are using ghc 8, you can turn on TypeApplications and use >> this: >> >> foo2 :: (Is isx Integer) => isx -> String >> foo2 = apply @_ @Integer (\i -> "") >> >> On Thu, Feb 9, 2017 at 11:59 AM, Nicholls, Mark >> wrote: >>> Sorry..I do haskell about once every 6 months for 2 hours...and then get on >> with my life. >>> I always forget some nuance of typeclasses. >>> >>> Consider some simple typeclass >>> >>>> class Is isx x where >>>> apply :: (x -> y) -> isx -> y >>> >>> We can make any type a member of it...mapping to itself >>> >>>> instance Is x x where >>>> apply f = f >>> But we can also make a tuple a member of it...and pull the 1st member.. >>> >>>> instance Is (x,y) x where >>>> apply f (x,y) = f x >>> Weird and largey useless...but I'm playing. >>> >>> Then construct a function to operate on it >>> >>>> foo2 :: (Is isx Integer) => isx -> String >>>> foo2 = apply (\i -> "") >>> And... >>> >>> • Could not deduce (Is isx x0) arising from a use of ‘apply’ >>> from the context: Is isx Integer >>> bound by the type signature for: >>> foo2 :: Is isx Integer => isx -> String >>> at prop.lhs:51:3-43 >>> The type variable ‘x0’ is ambiguous >>> Relevant bindings include >>> foo2 :: isx -> String (bound at prop.lhs:52:3) >>> These potential instances exist: >>> instance Is x x -- Defined at prop.lhs:41:12 >>> instance Is (x, y) x -- Defined at prop.lhs:45:12 >>> • In the expression: apply (\ i -> "") >>> In an equation for ‘foo2’: foo2 = apply (\ i -> "") >>> >>> >>> What's it going on about? >>> (my brain is locked in F# OO type mode) >>> >>> I've told it to expect a function "Integer -> String"...surely? >>> Whats the problem. >>> >>> CONFIDENTIALITY NOTICE >>> >>> This e-mail (and any attached files) is confidential and protected by copyright >> (and other intellectual property rights). If you are not the intended recipient >> please e-mail the sender and then delete the email and any attached files >> immediately. Any further use or dissemination is prohibited. >>> While MTV Networks Europe has taken steps to ensure that this email and any >> attachments are virus free, it is your responsibility to ensure that this message >> and any attachments are virus free and do not affect your systems / data. >>> Communicating by email is not 100% secure and carries risks such as delay, >> data corruption, non-delivery, wrongful interception and unauthorised >> amendment. If you communicate with us by e-mail, you acknowledge and >> assume these risks, and you agree to take appropriate measures to minimise >> these risks when e-mailing us. >>> MTV Networks International, MTV Networks UK & Ireland, Greenhouse, >> Nickelodeon Viacom Consumer Products, VBSi, Viacom Brand Solutions >> International, Be Viacom, Viacom International Media Networks and VIMN and >> Comedy Central are all trading names of MTV Networks Europe. MTV Networks >> Europe is a partnership between MTV Networks Europe Inc. and Viacom >> Networks Europe Inc. Address for service in Great Britain is 17-29 Hawley >> Crescent, London, NW1 8TT. >>> _______________________________________________ >>> 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 > CONFIDENTIALITY NOTICE > > This e-mail (and any attached files) is confidential and protected by copyright (and other intellectual property rights). If you are not the intended recipient please e-mail the sender and then delete the email and any attached files immediately. Any further use or dissemination is prohibited. > > While MTV Networks Europe has taken steps to ensure that this email and any attachments are virus free, it is your responsibility to ensure that this message and any attachments are virus free and do not affect your systems / data. > > Communicating by email is not 100% secure and carries risks such as delay, data corruption, non-delivery, wrongful interception and unauthorised amendment. If you communicate with us by e-mail, you acknowledge and assume these risks, and you agree to take appropriate measures to minimise these risks when e-mailing us. > > MTV Networks International, MTV Networks UK & Ireland, Greenhouse, Nickelodeon Viacom Consumer Products, VBSi, Viacom Brand Solutions International, Be Viacom, Viacom International Media Networks and VIMN and Comedy Central are all trading names of MTV Networks Europe. MTV Networks Europe is a partnership between MTV Networks Europe Inc. and Viacom Networks Europe Inc. Address for service in Great Britain is 17-29 Hawley Crescent, London, NW1 8TT. > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From nicholls.mark at vimn.com Sat Feb 11 08:50:58 2017 From: nicholls.mark at vimn.com (Nicholls, Mark) Date: Sat, 11 Feb 2017 08:50:58 +0000 Subject: [Haskell-beginners] how do typeclasses work again? In-Reply-To: References: , Message-ID: ah that works...now the challenge is for me to understand why. I'll watch the SPJ video to get a feel for whats going on, I don't understand the difference forall a isx. (Is isx a, Show a) => isx -> String and (Is isx a, Show a) => isx -> String but I'll look it up. I think my understanding of type classes is naïve, I just thought it meant that secretly a dictionary was being passed. the compiler would identify the specific dictionary from the call site but this might be an OO minded error. I also look up TypeApplications...thanks v much ________________________________________ From: Beginners [beginners-bounces at haskell.org] on behalf of Sylvain Henry [sylvain at haskus.fr] Sent: 10 February 2017 17:17 To: beginners at haskell.org Subject: Re: [Haskell-beginners] how do typeclasses work again? Your `foo4`: 1) uses the instance `Isx isx a` to convert an `isx` into an `a` 2) then uses the instance `Show a` to convert an `a` into a String The problem is that the compiler cannot infer the actual `a` type. E.g., suppose you have the following instances: data X = X data Y = Y instance Is (x,y) x where ... instance Is (x,y) y where ... instance Show X where ... instance Show Y where ... If you write "foo4 (X,Y)", the compiler can't decide which instance to use. A solution: use AllowAmbiguousTypes as the compiler suggests and then use TypeApplications to select the "a" type: foo4 :: forall a isx. (Is isx a, Show a) => isx -> String foo4 = apply (\(i :: a) -> show a) main = print (foo4 @Y (X,Y)) -- Sylvain On 10/02/2017 17:27, Nicholls, Mark wrote: > lovely > > so if I now go.... > >> foo4 = apply (\i -> show i) > And :t foo4 is... > >> foo4 :: (Is isx a, Show a) => isx -> String > So add that as a type...and we get the same sort of awfulness...."could not deduce" bla bla > > But how do you make this disappear > >> foo4 = apply (\(i :: a) -> show i) > Doesn’t work... "could not deduce" bla bla > > I'd instinctively like to go.... > >> foo4 = apply (\(i :: ((Show a) => a)) -> show i) > "Illegal qualified type: Show a => a" > > And this is really just > >> foo4 = apply show > Where we end with "could not deduce" > > Sorry....I'm struggling. > > >> -----Original Message----- >> From: Beginners [mailto:beginners-bounces at haskell.org] On Behalf Of David >> McBride >> Sent: 09 February 2017 5:31 PM >> To: The Haskell-Beginners Mailing List - Discussion of primarily beginner-level >> topics related to Haskell >> Subject: Re: [Haskell-beginners] how do typeclasses work again? >> >> foo2 :: (Is isx Integer) => isx -> String >> >> >> isx -> String - That means that this function takes anything and returns a string. >> Is isx Integer => - That just means that whatever isx is, there should be an Is isx >> Integer instance that satisfies it. >> >> Putting those together this function takes anything and returns a string, so long >> as the anything (isx) satisfies the constraint I isx Integer. >> >> But there's nothing in the type or code that says what type x actually is. The >> Integer in the constraint just constrains what isx can be. >> >> To fix it add the ScopedTypeVariables extension and try this: >> >> foo2 :: (Is isx Integer) => isx -> String >> foo2 = apply (\(i :: Integer) -> "") >> >> Alternatively if you are using ghc 8, you can turn on TypeApplications and use >> this: >> >> foo2 :: (Is isx Integer) => isx -> String >> foo2 = apply @_ @Integer (\i -> "") >> >> On Thu, Feb 9, 2017 at 11:59 AM, Nicholls, Mark >> wrote: >>> Sorry..I do haskell about once every 6 months for 2 hours...and then get on >> with my life. >>> I always forget some nuance of typeclasses. >>> >>> Consider some simple typeclass >>> >>>> class Is isx x where >>>> apply :: (x -> y) -> isx -> y >>> >>> We can make any type a member of it...mapping to itself >>> >>>> instance Is x x where >>>> apply f = f >>> But we can also make a tuple a member of it...and pull the 1st member.. >>> >>>> instance Is (x,y) x where >>>> apply f (x,y) = f x >>> Weird and largey useless...but I'm playing. >>> >>> Then construct a function to operate on it >>> >>>> foo2 :: (Is isx Integer) => isx -> String >>>> foo2 = apply (\i -> "") >>> And... >>> >>> • Could not deduce (Is isx x0) arising from a use of ‘apply’ >>> from the context: Is isx Integer >>> bound by the type signature for: >>> foo2 :: Is isx Integer => isx -> String >>> at prop.lhs:51:3-43 >>> The type variable ‘x0’ is ambiguous >>> Relevant bindings include >>> foo2 :: isx -> String (bound at prop.lhs:52:3) >>> These potential instances exist: >>> instance Is x x -- Defined at prop.lhs:41:12 >>> instance Is (x, y) x -- Defined at prop.lhs:45:12 >>> • In the expression: apply (\ i -> "") >>> In an equation for ‘foo2’: foo2 = apply (\ i -> "") >>> >>> >>> What's it going on about? >>> (my brain is locked in F# OO type mode) >>> >>> I've told it to expect a function "Integer -> String"...surely? >>> Whats the problem. >>> >>> CONFIDENTIALITY NOTICE >>> >>> This e-mail (and any attached files) is confidential and protected by copyright >> (and other intellectual property rights). If you are not the intended recipient >> please e-mail the sender and then delete the email and any attached files >> immediately. Any further use or dissemination is prohibited. >>> While MTV Networks Europe has taken steps to ensure that this email and any >> attachments are virus free, it is your responsibility to ensure that this message >> and any attachments are virus free and do not affect your systems / data. >>> Communicating by email is not 100% secure and carries risks such as delay, >> data corruption, non-delivery, wrongful interception and unauthorised >> amendment. If you communicate with us by e-mail, you acknowledge and >> assume these risks, and you agree to take appropriate measures to minimise >> these risks when e-mailing us. >>> MTV Networks International, MTV Networks UK & Ireland, Greenhouse, >> Nickelodeon Viacom Consumer Products, VBSi, Viacom Brand Solutions >> International, Be Viacom, Viacom International Media Networks and VIMN and >> Comedy Central are all trading names of MTV Networks Europe. MTV Networks >> Europe is a partnership between MTV Networks Europe Inc. and Viacom >> Networks Europe Inc. Address for service in Great Britain is 17-29 Hawley >> Crescent, London, NW1 8TT. >>> _______________________________________________ >>> 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 > CONFIDENTIALITY NOTICE > > This e-mail (and any attached files) is confidential and protected by copyright (and other intellectual property rights). If you are not the intended recipient please e-mail the sender and then delete the email and any attached files immediately. Any further use or dissemination is prohibited. > > While MTV Networks Europe has taken steps to ensure that this email and any attachments are virus free, it is your responsibility to ensure that this message and any attachments are virus free and do not affect your systems / data. > > Communicating by email is not 100% secure and carries risks such as delay, data corruption, non-delivery, wrongful interception and unauthorised amendment. If you communicate with us by e-mail, you acknowledge and assume these risks, and you agree to take appropriate measures to minimise these risks when e-mailing us. > > MTV Networks International, MTV Networks UK & Ireland, Greenhouse, Nickelodeon Viacom Consumer Products, VBSi, Viacom Brand Solutions International, Be Viacom, Viacom International Media Networks and VIMN and Comedy Central are all trading names of MTV Networks Europe. MTV Networks Europe is a partnership between MTV Networks Europe Inc. and Viacom Networks Europe Inc. Address for service in Great Britain is 17-29 Hawley Crescent, London, NW1 8TT. > _______________________________________________ > 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 CONFIDENTIALITY NOTICE This e-mail (and any attached files) is confidential and protected by copyright (and other intellectual property rights). If you are not the intended recipient please e-mail the sender and then delete the email and any attached files immediately. Any further use or dissemination is prohibited. While MTV Networks Europe has taken steps to ensure that this email and any attachments are virus free, it is your responsibility to ensure that this message and any attachments are virus free and do not affect your systems / data. Communicating by email is not 100% secure and carries risks such as delay, data corruption, non-delivery, wrongful interception and unauthorised amendment. If you communicate with us by e-mail, you acknowledge and assume these risks, and you agree to take appropriate measures to minimise these risks when e-mailing us. MTV Networks International, MTV Networks UK & Ireland, Greenhouse, Nickelodeon Viacom Consumer Products, VBSi, Viacom Brand Solutions International, Be Viacom, Viacom International Media Networks and VIMN and Comedy Central are all trading names of MTV Networks Europe. MTV Networks Europe is a partnership between MTV Networks Europe Inc. and Viacom Networks Europe Inc. Address for service in Great Britain is 17-29 Hawley Crescent, London, NW1 8TT. From sylvain at haskus.fr Sat Feb 11 13:36:36 2017 From: sylvain at haskus.fr (Sylvain Henry) Date: Sat, 11 Feb 2017 14:36:36 +0100 Subject: [Haskell-beginners] how do typeclasses work again? In-Reply-To: References: Message-ID: On 11/02/2017 09:50, Nicholls, Mark wrote: > I don't understand the difference > > forall a isx. (Is isx a, Show a) => isx -> String > and > (Is isx a, Show a) => isx -> String I have used the `forall` explicitly only to fix the order of the type parameters (`a` and `isx`) so that we are sure to set the type of `a` when we write (using TypeApplications): foo4 @Y (X,Y) In the second declaration, the `forall` is implicit. > I think my understanding of type classes is naïve, I just thought it meant that secretly a dictionary was being passed. Yes your understanding is correct. The issue here is that the compiler doesn't know the type of `a`, hence it can't select and pass the appropriate instances. > the compiler would identify the specific dictionary from the call site Even at call site, the compiler can't infer the `a` type from the `isx` type (nor from the return type of `foo4`). Do you want the `a` type to be dependent on the `isx` type? I.e., to only be allowed to define a single `Is isx a` instance for each `isx` type. -- Sylvain From nicholls.mark at vimn.com Sun Feb 12 10:05:53 2017 From: nicholls.mark at vimn.com (Nicholls, Mark) Date: Sun, 12 Feb 2017 10:05:53 +0000 Subject: [Haskell-beginners] how do typeclasses work again? In-Reply-To: References: , Message-ID: I'm naively capable of messing around with type families...so I know how to define the types statically...that's not really what I want...that's too strong. I think I'm trying to work in the universe of typeclasses and not data types....in my OO head these two things overlap (if you see what I mean)....in Haskell they are distinct...which I'm beginning to feel makes type inference easy....but is actually quite "weak". so lets start again... > class Is isx x where > apply ::(x -> y) -> isx -> y > instance Is x x where > apply f = f i.e. lets create our tuple instance like this! > instance (Is m x) => Is (m,y) x where > apply f (m,y) = apply f m > data X = X deriving (Show) > data Y = Y deriving (Show) > foo4 :: forall a isx. (Is isx a, Show a) => isx -> String > foo4 = apply (\(i :: a) -> show i) now...this line said.... > main = print (foo4 @X (X,Y)) and that works!....which I think is what I want....in an OO world this feels like a "cast"....where Ive said (X,Y) <: X....I'm getting the compiler to extract fst for me...I'm lazy. so lets tell the compiler it could do snd for me. > instance (Is m x) => Is (y,m) x where > apply f (y,m) = apply f m gives....."Duplicate instance declarations " which is unfortunate as I wanted to then write > main = print (foo4 @Y (X,Y)) to "cast" to Y....which feels perfectly reasonable then I look this up on the interweb...and magically found some noob has been here before! "noob “Duplicate instance declarations” (again)" that noob was me!...about a year ago...and someone said I was misunderstanding how to define these sort of recursive structures....and It should be done in the class declaration...which doesn't seem to work in this case...as I want to do something recursive the answer said..... "Haskell requires that there be only one instance for each class and type. Thus is determined only from the part to the right of the =>. " ok, I buy that...IF I want to guarantee Haskell to automatically derive type class dictionaries that functional restriction is perfectly reasonable...as long as its resolved at some point. I tbink (naively)...Haskell is saying... "if I match things against (x,y) I've got 2 instance declarations....so how do I decide which one?" what I'm saying is....that's fine but I'm telling you which one at the call site....using these "@" things... so what's the problem?...the functional restriction is too restrictive. ________________________________________ From: Beginners [beginners-bounces at haskell.org] on behalf of Sylvain Henry [sylvain at haskus.fr] Sent: 11 February 2017 13:36 To: beginners at haskell.org Subject: Re: [Haskell-beginners] how do typeclasses work again? On 11/02/2017 09:50, Nicholls, Mark wrote: > I don't understand the difference > > forall a isx. (Is isx a, Show a) => isx -> String > and > (Is isx a, Show a) => isx -> String I have used the `forall` explicitly only to fix the order of the type parameters (`a` and `isx`) so that we are sure to set the type of `a` when we write (using TypeApplications): foo4 @Y (X,Y) In the second declaration, the `forall` is implicit. > I think my understanding of type classes is naïve, I just thought it meant that secretly a dictionary was being passed. Yes your understanding is correct. The issue here is that the compiler doesn't know the type of `a`, hence it can't select and pass the appropriate instances. > the compiler would identify the specific dictionary from the call site Even at call site, the compiler can't infer the `a` type from the `isx` type (nor from the return type of `foo4`). Do you want the `a` type to be dependent on the `isx` type? I.e., to only be allowed to define a single `Is isx a` instance for each `isx` type. -- Sylvain _______________________________________________ Beginners mailing list Beginners at haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners CONFIDENTIALITY NOTICE This e-mail (and any attached files) is confidential and protected by copyright (and other intellectual property rights). If you are not the intended recipient please e-mail the sender and then delete the email and any attached files immediately. Any further use or dissemination is prohibited. While MTV Networks Europe has taken steps to ensure that this email and any attachments are virus free, it is your responsibility to ensure that this message and any attachments are virus free and do not affect your systems / data. Communicating by email is not 100% secure and carries risks such as delay, data corruption, non-delivery, wrongful interception and unauthorised amendment. If you communicate with us by e-mail, you acknowledge and assume these risks, and you agree to take appropriate measures to minimise these risks when e-mailing us. MTV Networks International, MTV Networks UK & Ireland, Greenhouse, Nickelodeon Viacom Consumer Products, VBSi, Viacom Brand Solutions International, Be Viacom, Viacom International Media Networks and VIMN and Comedy Central are all trading names of MTV Networks Europe. MTV Networks Europe is a partnership between MTV Networks Europe Inc. and Viacom Networks Europe Inc. Address for service in Great Britain is 17-29 Hawley Crescent, London, NW1 8TT. From praveenvelliengiri at gmail.com Tue Feb 14 12:51:37 2017 From: praveenvelliengiri at gmail.com (Praveen Velliengiri) Date: Tue, 14 Feb 2017 18:21:37 +0530 Subject: [Haskell-beginners] OPERATOR OVERLOADING AS IN C++ Message-ID: I'm new to functional programming, Whether it is possible to do operator overloading in Haskell ? I go through the Idea of TYPECLASSES in Learn you haskell tutorial. But I can't understand the idea Can anyone suggest me some idea regarding Operator overloading and Type classes in Haskell. Thank you guys Praveen v -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Tue Feb 14 13:18:19 2017 From: fa-ml at ariis.it (Francesco Ariis) Date: Tue, 14 Feb 2017 14:18:19 +0100 Subject: [Haskell-beginners] OPERATOR OVERLOADING AS IN C++ In-Reply-To: References: Message-ID: <20170214131819.GA3107@casa.casa> On Tue, Feb 14, 2017 at 06:21:37PM +0530, Praveen Velliengiri wrote: > I'm new to functional programming, Whether it is possible to do operator > overloading in Haskell ? I go through the Idea of TYPECLASSES in Learn you > haskell tutorial. But I can't understand the idea Can anyone suggest me > some idea regarding Operator overloading and Type classes in Haskell. > Thank you guys Hello Praveen, indeed Haskell uses typeclasses to deal with ad hoc polymorphism. Are you familiar with any of them? If I write in ghci: λ> show 707 "707" λ> show True "True" λ> show 'c' "'c'" λ> show "palla" "\"palla\"" that is possible because numerous types are instances of the typeclass Show, which provides `show` λ> :t show show :: Show a => a -> String Does that help a bit? Or you aren't sure about the typeclass syntax? From praveenvelliengiri at gmail.com Wed Feb 15 12:41:06 2017 From: praveenvelliengiri at gmail.com (Praveen Velliengiri) Date: Wed, 15 Feb 2017 18:11:06 +0530 Subject: [Haskell-beginners] Beginners Digest, Vol 104, Issue 9 In-Reply-To: References: Message-ID: Thanks a lot.🙂 On 15 February 2017 at 17:30, wrote: > Send Beginners mailing list submissions to > beginners at haskell.org > > To subscribe or unsubscribe via the World Wide Web, visit > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > or, via email, send a message with subject or body 'help' to > beginners-request at haskell.org > > You can reach the person managing the list at > beginners-owner at haskell.org > > When replying, please edit your Subject line so it is more specific > than "Re: Contents of Beginners digest..." > > > Today's Topics: > > 1. OPERATOR OVERLOADING AS IN C++ (Praveen Velliengiri) > 2. Re: OPERATOR OVERLOADING AS IN C++ (Francesco Ariis) > > > ---------------------------------------------------------------------- > > Message: 1 > Date: Tue, 14 Feb 2017 18:21:37 +0530 > From: Praveen Velliengiri > To: beginners at haskell.org > Subject: [Haskell-beginners] OPERATOR OVERLOADING AS IN C++ > Message-ID: > gmail.com> > Content-Type: text/plain; charset="utf-8" > > I'm new to functional programming, Whether it is possible to do operator > overloading in Haskell ? I go through the Idea of TYPECLASSES in Learn you > haskell tutorial. But I can't understand the idea Can anyone suggest me > some idea regarding Operator overloading and Type classes in Haskell. > Thank you guys > Praveen v > -------------- next part -------------- > An HTML attachment was scrubbed... > URL: attachments/20170214/ef255a81/attachment-0001.html> > > ------------------------------ > > Message: 2 > Date: Tue, 14 Feb 2017 14:18:19 +0100 > From: Francesco Ariis > To: beginners at haskell.org > Subject: Re: [Haskell-beginners] OPERATOR OVERLOADING AS IN C++ > Message-ID: <20170214131819.GA3107 at casa.casa> > Content-Type: text/plain; charset=utf-8 > > On Tue, Feb 14, 2017 at 06:21:37PM +0530, Praveen Velliengiri wrote: > > I'm new to functional programming, Whether it is possible to do operator > > overloading in Haskell ? I go through the Idea of TYPECLASSES in Learn > you > > haskell tutorial. But I can't understand the idea Can anyone suggest me > > some idea regarding Operator overloading and Type classes in Haskell. > > Thank you guys > > Hello Praveen, > > indeed Haskell uses typeclasses to deal with ad hoc polymorphism. > Are you familiar with any of them? If I write in ghci: > > λ> show 707 > "707" > λ> show True > "True" > λ> show 'c' > "'c'" > λ> show "palla" > "\"palla\"" > > that is possible because numerous types are instances of the typeclass > Show, which provides `show` > > λ> :t show > show :: Show a => a -> String > > Does that help a bit? Or you aren't sure about the typeclass syntax? > > > ------------------------------ > > Subject: Digest Footer > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > ------------------------------ > > End of Beginners Digest, Vol 104, Issue 9 > ***************************************** > -------------- next part -------------- An HTML attachment was scrubbed... URL: From 50295 at web.de Tue Feb 21 10:15:24 2017 From: 50295 at web.de (Olumide) Date: Tue, 21 Feb 2017 10:15:24 +0000 Subject: [Haskell-beginners] Understanding the function monad ((->) r) Message-ID: <08dd31b5-01c8-ad20-5d8d-39814b7281c4@web.de> Hello List, I am having enormous difficulty understanding the definition of the bind operator of ((->) r) as show below and would appreciate help i this regard. instance Monad ((->) r) where return x = \_ -> x h >>= f = \w -> f (h w) w Thanks, - Olumide From edwards.benj at gmail.com Tue Feb 21 10:25:02 2017 From: edwards.benj at gmail.com (Benjamin Edwards) Date: Tue, 21 Feb 2017 10:25:02 +0000 Subject: [Haskell-beginners] Understanding the function monad ((->) r) In-Reply-To: <08dd31b5-01c8-ad20-5d8d-39814b7281c4@web.de> References: <08dd31b5-01c8-ad20-5d8d-39814b7281c4@web.de> Message-ID: What is it that you are having difficulty with? Is it "why" this is a good definition? Is it that you don't understand how it works? Ben On Tue, 21 Feb 2017 at 10:15 Olumide <50295 at web.de> wrote: > Hello List, > > I am having enormous difficulty understanding the definition of the bind > operator of ((->) r) as show below and would appreciate help i this > regard. > > instance Monad ((->) r) where > return x = \_ -> x > h >>= f = \w -> f (h w) w > > Thanks, > > - 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 50295 at web.de Tue Feb 21 11:34:41 2017 From: 50295 at web.de (Olumide) Date: Tue, 21 Feb 2017 11:34:41 +0000 Subject: [Haskell-beginners] Understanding the function monad ((->) r) In-Reply-To: References: <08dd31b5-01c8-ad20-5d8d-39814b7281c4@web.de> Message-ID: <366f7be1-330c-b446-d20d-fe8beee76a93@web.de> On 21/02/2017 10:25, Benjamin Edwards wrote: > What is it that you are having difficulty with? Is it "why" this is a > good definition? Is it that you don't understand how it works? I simply can't grok f (h w) w. - Olumide > On Tue, 21 Feb 2017 at 10:15 Olumide <50295 at web.de > > wrote: > > Hello List, > > I am having enormous difficulty understanding the definition of the bind > operator of ((->) r) as show below and would appreciate help i this > regard. > > instance Monad ((->) r) where > return x = \_ -> x > h >>= f = \w -> f (h w) w > > Thanks, > > - Olumide > > _______________________________________________ > 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 rahulmutt at gmail.com Tue Feb 21 14:32:55 2017 From: rahulmutt at gmail.com (Rahul Muttineni) Date: Tue, 21 Feb 2017 20:02:55 +0530 Subject: [Haskell-beginners] Understanding the function monad ((->) r) In-Reply-To: <366f7be1-330c-b446-d20d-fe8beee76a93@web.de> References: <08dd31b5-01c8-ad20-5d8d-39814b7281c4@web.de> <366f7be1-330c-b446-d20d-fe8beee76a93@web.de> Message-ID: Hi Olumide, Let the types help you out. The Monad typeclass (omitting the superclass constraints): class Monad m where return :: a -> m a (>>=) :: m a -> (a -> m b) -> m b Write out the specialised type signatures for (->) r: {-# LANGUAGE InstanceSigs #-} -- This extension allows you to specify the type signatures in instance declarations instance Monad ((->) r) where return :: a -> (r -> a) (>>=) :: (r -> a) -> (a -> (r -> b)) -> (r -> b) Now we look at how to make some definition of return that type checks. We're given an a and we want to return a function that takes an r and returns an a. Well the only way you can really do this is ignoring the r and returning the value you were given in all cases! Because 'a' can be *anything*, you really don't have much else you can do! Hence: return :: a -> (r -> a) return a = \_ -> a Now let's take a look at (>>=). Since this is a bit complicated, let's work backwards from the result type. We want a function that gives us a b given an r and given two functions with types (r -> a) and (a -> (r -> b)). To get a b, we need to use the second function. To use the second function, we must have an a, which we can get from the first function! (>>=) :: (r -> a) -> (a -> (r -> b)) -> (r -> b) (>>=) f g = \r -> (g (f r)) r Hope that helps! Rahul On Tue, Feb 21, 2017 at 5:04 PM, Olumide <50295 at web.de> wrote: > On 21/02/2017 10:25, Benjamin Edwards wrote: > >> What is it that you are having difficulty with? Is it "why" this is a >> good definition? Is it that you don't understand how it works? >> > > I simply can't grok f (h w) w. > > - Olumide > > On Tue, 21 Feb 2017 at 10:15 Olumide <50295 at web.de >> > wrote: >> >> Hello List, >> >> I am having enormous difficulty understanding the definition of the >> bind >> operator of ((->) r) as show below and would appreciate help i this >> regard. >> >> instance Monad ((->) r) where >> return x = \_ -> x >> h >>= f = \w -> f (h w) w >> >> Thanks, >> >> - Olumide >> >> _______________________________________________ >> 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 > -- Rahul Muttineni -------------- next part -------------- An HTML attachment was scrubbed... URL: From edwards.benj at gmail.com Tue Feb 21 15:08:45 2017 From: edwards.benj at gmail.com (Benjamin Edwards) Date: Tue, 21 Feb 2017 15:08:45 +0000 Subject: [Haskell-beginners] Understanding the function monad ((->) r) In-Reply-To: References: <08dd31b5-01c8-ad20-5d8d-39814b7281c4@web.de> <366f7be1-330c-b446-d20d-fe8beee76a93@web.de> Message-ID: The thing that you might also be missing is that function application binds tightest. Hopefully the parenthesis that Rahul has added help you out there. If not: \w -> f (h w) w f will be applied to the result of (h r) which yields another function, which is then applied to r that is \w -> let x = h w g = f x in g w would yield exactly the same result. I apologise for the indentation, I need a better mail client. Ben On Tue, 21 Feb 2017 at 14:34 Rahul Muttineni wrote: > Hi Olumide, > > Let the types help you out. > > The Monad typeclass (omitting the superclass constraints): > > class Monad m where > return :: a -> m a > (>>=) :: m a -> (a -> m b) -> m b > > Write out the specialised type signatures for (->) r: > > {-# LANGUAGE InstanceSigs #-} > -- This extension allows you to specify the type signatures in instance > declarations > > instance Monad ((->) r) where > return :: a -> (r -> a) > (>>=) :: (r -> a) -> (a -> (r -> b)) -> (r -> b) > > Now we look at how to make some definition of return that type checks. > We're given an a and we want to return a function that takes an r and > returns an a. Well the only way you can really do this is ignoring the r > and returning the value you were given in all cases! Because 'a' can be > *anything*, you really don't have much else you can do! Hence: > > return :: a -> (r -> a) > return a = \_ -> a > > Now let's take a look at (>>=). Since this is a bit complicated, let's > work backwards from the result type. We want a function that gives us a b > given an r and given two functions with types (r -> a) and (a -> (r -> b)). > To get a b, we need to use the second function. To use the second function, > we must have an a, which we can get from the first function! > > (>>=) :: (r -> a) -> (a -> (r -> b)) -> (r -> b) > (>>=) f g = \r -> (g (f r)) r > > Hope that helps! > Rahul > > > On Tue, Feb 21, 2017 at 5:04 PM, Olumide <50295 at web.de> wrote: > > On 21/02/2017 10:25, Benjamin Edwards wrote: > > What is it that you are having difficulty with? Is it "why" this is a > good definition? Is it that you don't understand how it works? > > > I simply can't grok f (h w) w. > > - Olumide > > On Tue, 21 Feb 2017 at 10:15 Olumide <50295 at web.de > > wrote: > > Hello List, > > I am having enormous difficulty understanding the definition of the > bind > operator of ((->) r) as show below and would appreciate help i this > regard. > > instance Monad ((->) r) where > return x = \_ -> x > h >>= f = \w -> f (h w) w > > Thanks, > > - Olumide > > _______________________________________________ > 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 > > > > > -- > Rahul Muttineni > _______________________________________________ > 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 50295 at web.de Tue Feb 21 15:52:22 2017 From: 50295 at web.de (Olumide) Date: Tue, 21 Feb 2017 15:52:22 +0000 Subject: [Haskell-beginners] Understanding the function monad ((->) r) In-Reply-To: References: <08dd31b5-01c8-ad20-5d8d-39814b7281c4@web.de> <366f7be1-330c-b446-d20d-fe8beee76a93@web.de> Message-ID: On 21/02/2017 15:08, Benjamin Edwards wrote: > The thing that you might also be missing is that function application > binds tightest. Hopefully the parenthesis that Rahul has added help you > out there. If not: > > \w -> f (h w) w > > f will be applied to the result of (h r) which yields another function, > which is then applied to r Did you mean to write (h w)? - Olumide From sudhanshuj007 at gmail.com Tue Feb 21 16:35:25 2017 From: sudhanshuj007 at gmail.com (Sudhanshu Jaiswal) Date: Tue, 21 Feb 2017 22:05:25 +0530 Subject: [Haskell-beginners] Making a Tic-Tac-Toe Game Message-ID: Also called as Noughts and crosses or Xs and Os. Hello everyone, How do I start making a *Two Player* Tic Tac Toe game in Haskell? The program basically has to show the 3*3 grid as coordinates and let each player choose his coordinates in his turn by entering the coordinates of the required cell. I also want to be able to check if a player has won and display it once the winning move has been made or the same for a Draw. What have I done? - I have read Learn You a Haskell till Modules and know basic I/O. I don't want the code instead, I am interested in learning stuff and trying problems which would lead me to get the intuition and ability to make the game by myself. I would be thankful if you folks could direct me to related problems which I could do or some advice as to how I should go about implementing such a program. -- Sudhanshu -------------- next part -------------- An HTML attachment was scrubbed... URL: From edwards.benj at gmail.com Tue Feb 21 18:06:00 2017 From: edwards.benj at gmail.com (Benjamin Edwards) Date: Tue, 21 Feb 2017 18:06:00 +0000 Subject: [Haskell-beginners] Understanding the function monad ((->) r) In-Reply-To: References: <08dd31b5-01c8-ad20-5d8d-39814b7281c4@web.de> <366f7be1-330c-b446-d20d-fe8beee76a93@web.de> Message-ID: I did, sorry! On Tue, 21 Feb 2017 at 15:53 Olumide <50295 at web.de> wrote: > On 21/02/2017 15:08, Benjamin Edwards wrote: > > The thing that you might also be missing is that function application > > binds tightest. Hopefully the parenthesis that Rahul has added help you > > out there. If not: > > > > \w -> f (h w) w > > > > f will be applied to the result of (h r) which yields another function, > > which is then applied to r > > Did you mean to write (h w)? > > - 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 tanuki at gmail.com Wed Feb 22 07:18:55 2017 From: tanuki at gmail.com (Theodore Lief Gannon) Date: Tue, 21 Feb 2017 23:18:55 -0800 Subject: [Haskell-beginners] Making a Tic-Tac-Toe Game In-Reply-To: References: Message-ID: I know you said you didn't want code, but I think this will be helpful. Here is an example of what the very top of your logic might reasonably look like. main :: IO () main = do someInitialization config <- someConfigurator result <- gameLoop $ makeInitialState config print result gameLoop :: GameState -> IO GameResult gameLoop gameState = let maybeEndState = discoverEndState gameState in case maybeEndState of Just endState -> return endState Nothing -> do playerMove <- fetchInput gameState gameLoop $ makeNextState playerMove On Tue, Feb 21, 2017 at 8:35 AM, Sudhanshu Jaiswal wrote: > Also called as Noughts and crosses or Xs and Os. > > Hello everyone, > > How do I start making a *Two Player* Tic Tac Toe game in Haskell? > > The program basically has to show the 3*3 grid as coordinates and let each > player choose his coordinates in his turn by entering the coordinates of > the required cell. I also want to be able to check if a player has won and > display it once the winning move has been made or the same for a Draw. > > What have I done? - I have read Learn You a Haskell till Modules and know > basic I/O. > > I don't want the code instead, I am interested in learning stuff and > trying problems which would lead me to get the intuition and ability to > make the game by myself. > > I would be thankful if you folks could direct me to related problems which > I could do or some advice as to how I should go about implementing such a > program. > -- > Sudhanshu > > > > _______________________________________________ > 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 shaegis at gmail.com Wed Feb 22 08:33:01 2017 From: shaegis at gmail.com (S. H. Aegis) Date: Wed, 22 Feb 2017 17:33:01 +0900 Subject: [Haskell-beginners] Type error when using splitOn function. Message-ID: Hello. I'm new to Haskell and this is the first time I use Data.Text module. And using stack on OSX 10.12.3 I'm try several times, but fail. and I don't understand what error message says. How can I fix this? Thank you a lot. Code is Main.hs : module Main where import Lib main :: IO () main = do sam <- readSam rxDxData <- readCSV print $ makeRxDxList rxDxData Lib.hs : module Lib -- ( someFunc -- ) where where import Data.Text as T import Text.Regex.TDFA import Prelude hiding (take, drop, map, lines) type RowSAM = Text type RowRxDx = Text --makeRxDxList :: Functor f => f Text -> f [Text] --makeRxDxList rowRxDx = fmap (\x -> splitOn (pack ",") x) rowRxDx -- This code pass a compile. makeRxDxList rowRxDx = map (\x -> splitOn (pack ",") pack x) $ lines rowRxDx (whole code is below...) Error Message is /Users/shaegis/Documents/Haskell/samChecker3/src/Lib.hs:25:35: error: • Couldn't match expected type ‘Char -> Char’ with actual type ‘[Text]’ • The function ‘splitOn’ is applied to three arguments, but its type ‘Text -> Text -> [Text]’ has only two In the expression: splitOn (pack ",") pack x In the first argument of ‘map’, namely ‘(\ x -> splitOn (pack ",") pack x)’ /Users/shaegis/Documents/Haskell/samChecker3/src/Lib.hs:25:54: error: • Couldn't match expected type ‘Text’ with actual type ‘String -> Text’ • Probable cause: ‘pack’ is applied to too few arguments In the second argument of ‘splitOn’, namely ‘pack’ In the expression: splitOn (pack ",") pack x In the first argument of ‘map’, namely ‘(\ x -> splitOn (pack ",") pack x)’ /Users/shaegis/Documents/Haskell/samChecker3/src/Lib.hs:25:64: error: • Couldn't match expected type ‘Text’ with actual type ‘[Text]’ • In the second argument of ‘($)’, namely ‘lines rowRxDx’ In the expression: map (\ x -> splitOn (pack ",") pack x) $ lines rowRxDx In an equation for ‘makeRxDxList’: makeRxDxList rowRxDx = map (\ x -> splitOn (pack ",") pack x) $ lines rowRxDx ------------------------------------------------------------------------------------------------------ Lib.hs module Lib -- ( someFunc -- ) where where import Data.Text as T import Text.Regex.TDFA import Prelude hiding (take, drop, map, lines) type RowSAM = Text type SAM = [Text] type Case = Text type RowRxDx = Text type RxDx = [Text] type RxDxList = [[Text]] type Rx = Text type Dx = Text type MediName = Text type Message = Text type Date = Text type PtName = Text --makeRxDxList :: Functor f => f Text -> f [Text] --makeRxDxList rowRxDx = fmap (\x -> splitOn (pack ",") x) rowRxDx makeRxDxList rowRxDx = map (\x -> splitOn (pack ",") pack x) $ lines rowRxDx pickupMediName :: RxDx -> MediName pickupMediName rxDx = rxDx !! 0 pickupDx :: RxDx -> Dx pickupDx rxDx = rxDx !! 2 pickupRx :: RxDx -> Rx pickupRx rxDx = rxDx !! 1 pickupPtName :: Case -> PtName pickupPtName ptCase = take 3 $ drop 45 ptCase pickupCaseDate :: Case -> Date pickupCaseDate ptCase = take 8 $ drop (348 + 2) ptCase isErrorRxDx :: Rx -> Dx -> Case -> Bool isErrorRxDx rxCode dxCode ptCase = case isExistRx rxCode ptCase of True -> if (isExistDx dxCode ptCase) then False else True False -> False isExistDx :: Dx -> Case -> Bool isExistDx dxCode ptCase = (unpack ptCase) =~ (unpack dxCode) isExistRx :: Rx -> Case -> Bool isExistRx rxCode ptCase = rxCode `isInfixOf` ptCase splitIntoCase :: RowSAM -> SAM splitIntoCase = splitOn $ pack "AH021" readCSV :: IO Text readCSV = pack <$> readFile "/Users/shaegis/Documents/Haskell/samChecker3/RxDxData.csv" readSam :: IO Text readSam = pack <$> readFile "/Users/shaegis/Documents/Haskell/samChecker3/BoHomUTF8.dat" -------------- next part -------------- An HTML attachment was scrubbed... URL: From zhiwudazhanjiangshi at gmail.com Wed Feb 22 09:31:55 2017 From: zhiwudazhanjiangshi at gmail.com (yi lu) Date: Wed, 22 Feb 2017 17:31:55 +0800 Subject: [Haskell-beginners] Type error when using splitOn function. In-Reply-To: References: Message-ID: -- map (\x -> splitOn (pack ",") pack x) $ lines rowRxDx map (\x -> splitOn (pack ",") (pack x)) $ lines rowRxDx Like this? On Wed, Feb 22, 2017 at 4:33 PM, S. H. Aegis wrote: > Hello. > I'm new to Haskell and this is the first time I use Data.Text module. > And using stack on OSX 10.12.3 > I'm try several times, but fail. and I don't understand what error message > says. > How can I fix this? > Thank you a lot. > > Code is > > Main.hs : > module Main where > import Lib > > main :: IO () > main = do > sam <- readSam > rxDxData <- readCSV > print $ makeRxDxList rxDxData > > Lib.hs : > module Lib > -- ( someFunc > -- ) where > where > > import Data.Text as T > import Text.Regex.TDFA > import Prelude hiding (take, drop, map, lines) > > type RowSAM = Text > type RowRxDx = Text > > --makeRxDxList :: Functor f => f Text -> f [Text] > --makeRxDxList rowRxDx = fmap (\x -> splitOn (pack ",") x) rowRxDx -- > This code pass a compile. > makeRxDxList rowRxDx = map (\x -> splitOn (pack ",") pack x) $ lines > rowRxDx > (whole code is below...) > > Error Message is > /Users/shaegis/Documents/Haskell/samChecker3/src/Lib.hs:25:35: error: > • Couldn't match expected type ‘Char -> Char’ > with actual type ‘[Text]’ > • The function ‘splitOn’ is applied to three arguments, > but its type ‘Text -> Text -> [Text]’ has only two > In the expression: splitOn (pack ",") pack x > In the first argument of ‘map’, namely > ‘(\ x -> splitOn (pack ",") pack x)’ > > /Users/shaegis/Documents/Haskell/samChecker3/src/Lib.hs:25:54: error: > • Couldn't match expected type ‘Text’ > with actual type ‘String -> Text’ > • Probable cause: ‘pack’ is applied to too few arguments > In the second argument of ‘splitOn’, namely ‘pack’ > In the expression: splitOn (pack ",") pack x > In the first argument of ‘map’, namely > ‘(\ x -> splitOn (pack ",") pack x)’ > > /Users/shaegis/Documents/Haskell/samChecker3/src/Lib.hs:25:64: error: > • Couldn't match expected type ‘Text’ with actual type ‘[Text]’ > • In the second argument of ‘($)’, namely ‘lines rowRxDx’ > In the expression: > map (\ x -> splitOn (pack ",") pack x) $ lines rowRxDx > In an equation for ‘makeRxDxList’: > makeRxDxList rowRxDx > = map (\ x -> splitOn (pack ",") pack x) $ lines rowRxDx > ------------------------------------------------------------ > ------------------------------------------ > Lib.hs > module Lib > -- ( someFunc > -- ) where > where > > import Data.Text as T > import Text.Regex.TDFA > import Prelude hiding (take, drop, map, lines) > > type RowSAM = Text > type SAM = [Text] > type Case = Text > type RowRxDx = Text > type RxDx = [Text] > type RxDxList = [[Text]] > type Rx = Text > type Dx = Text > type MediName = Text > type Message = Text > type Date = Text > type PtName = Text > > --makeRxDxList :: Functor f => f Text -> f [Text] > --makeRxDxList rowRxDx = fmap (\x -> splitOn (pack ",") x) rowRxDx > makeRxDxList rowRxDx = map (\x -> splitOn (pack ",") pack x) $ lines > rowRxDx > > pickupMediName :: RxDx -> MediName > pickupMediName rxDx = rxDx !! 0 > > pickupDx :: RxDx -> Dx > pickupDx rxDx = rxDx !! 2 > > pickupRx :: RxDx -> Rx > pickupRx rxDx = rxDx !! 1 > > pickupPtName :: Case -> PtName > pickupPtName ptCase = take 3 $ drop 45 ptCase > > pickupCaseDate :: Case -> Date > pickupCaseDate ptCase = take 8 $ drop (348 + 2) ptCase > > isErrorRxDx :: Rx -> Dx -> Case -> Bool > isErrorRxDx rxCode dxCode ptCase = > case isExistRx rxCode ptCase of > True -> if (isExistDx dxCode ptCase) then False else True > False -> False > > isExistDx :: Dx -> Case -> Bool > isExistDx dxCode ptCase = (unpack ptCase) =~ (unpack dxCode) > > isExistRx :: Rx -> Case -> Bool > isExistRx rxCode ptCase = rxCode `isInfixOf` ptCase > > splitIntoCase :: RowSAM -> SAM > splitIntoCase = splitOn $ pack "AH021" > > readCSV :: IO Text > readCSV = pack <$> readFile "/Users/shaegis/Documents/ > Haskell/samChecker3/RxDxData.csv" > > readSam :: IO Text > readSam = pack <$> readFile "/Users/shaegis/Documents/ > Haskell/samChecker3/BoHomUTF8.dat" > > > > _______________________________________________ > 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 fa-ml at ariis.it Wed Feb 22 09:35:57 2017 From: fa-ml at ariis.it (Francesco Ariis) Date: Wed, 22 Feb 2017 10:35:57 +0100 Subject: [Haskell-beginners] Type error when using splitOn function. In-Reply-To: References: Message-ID: <20170222093557.GA9429@casa.casa> On Wed, Feb 22, 2017 at 05:33:01PM +0900, S. H. Aegis wrote: > Hello. > I'm new to Haskell and this is the first time I use Data.Text module. > And using stack on OSX 10.12.3 > I'm try several times, but fail. and I don't understand what error message > says. > How can I fix this? > Thank you a lot. Hello SH, Text.map has signature `(Char -> Char) -> Text -> Text`, so I expect you to need fmap too if the return value of makeRxDxList has type f [Text] makeRxDxList rowRxDx = fmap _ rowRxDx -- or base map _ is a hole and if the compiler will tell you which function needs to go there, in this case one with signature `Text -> [Text]`. Does that help? If not, provide makeRxDxList signature and a brief description so it's easier to diagnose the problem -F From shaegis at gmail.com Wed Feb 22 11:53:58 2017 From: shaegis at gmail.com (S. H. Aegis) Date: Wed, 22 Feb 2017 20:53:58 +0900 Subject: [Haskell-beginners] Type error when using splitOn function. In-Reply-To: References: Message-ID: Thank you to your answer. I try to like these, but still got error map (\x -> splitOn (pack ",") (pack x)) $ lines rowRxDx map (\x -> splitOn (pack ",") x) $ lines rowRxDx map (\x -> splitOn "," x) $ lines rowRxDx etc... 2017-02-22 18:31 GMT+09:00 yi lu : > -- map (\x -> splitOn (pack ",") pack x) $ lines rowRxDx > map (\x -> splitOn (pack ",") (pack x)) $ lines rowRxDx > > Like this? > > On Wed, Feb 22, 2017 at 4:33 PM, S. H. Aegis wrote: > >> Hello. >> I'm new to Haskell and this is the first time I use Data.Text module. >> And using stack on OSX 10.12.3 >> I'm try several times, but fail. and I don't understand what error >> message says. >> How can I fix this? >> Thank you a lot. >> >> Code is >> >> Main.hs : >> module Main where >> import Lib >> >> main :: IO () >> main = do >> sam <- readSam >> rxDxData <- readCSV >> print $ makeRxDxList rxDxData >> >> Lib.hs : >> module Lib >> -- ( someFunc >> -- ) where >> where >> >> import Data.Text as T >> import Text.Regex.TDFA >> import Prelude hiding (take, drop, map, lines) >> >> type RowSAM = Text >> type RowRxDx = Text >> >> --makeRxDxList :: Functor f => f Text -> f [Text] >> --makeRxDxList rowRxDx = fmap (\x -> splitOn (pack ",") x) rowRxDx -- >> This code pass a compile. >> makeRxDxList rowRxDx = map (\x -> splitOn (pack ",") pack x) $ lines >> rowRxDx >> (whole code is below...) >> >> Error Message is >> /Users/shaegis/Documents/Haskell/samChecker3/src/Lib.hs:25:35: error: >> • Couldn't match expected type ‘Char -> Char’ >> with actual type ‘[Text]’ >> • The function ‘splitOn’ is applied to three arguments, >> but its type ‘Text -> Text -> [Text]’ has only two >> In the expression: splitOn (pack ",") pack x >> In the first argument of ‘map’, namely >> ‘(\ x -> splitOn (pack ",") pack x)’ >> >> /Users/shaegis/Documents/Haskell/samChecker3/src/Lib.hs:25:54: error: >> • Couldn't match expected type ‘Text’ >> with actual type ‘String -> Text’ >> • Probable cause: ‘pack’ is applied to too few arguments >> In the second argument of ‘splitOn’, namely ‘pack’ >> In the expression: splitOn (pack ",") pack x >> In the first argument of ‘map’, namely >> ‘(\ x -> splitOn (pack ",") pack x)’ >> >> /Users/shaegis/Documents/Haskell/samChecker3/src/Lib.hs:25:64: error: >> • Couldn't match expected type ‘Text’ with actual type ‘[Text]’ >> • In the second argument of ‘($)’, namely ‘lines rowRxDx’ >> In the expression: >> map (\ x -> splitOn (pack ",") pack x) $ lines rowRxDx >> In an equation for ‘makeRxDxList’: >> makeRxDxList rowRxDx >> = map (\ x -> splitOn (pack ",") pack x) $ lines rowRxDx >> ------------------------------------------------------------ >> ------------------------------------------ >> Lib.hs >> module Lib >> -- ( someFunc >> -- ) where >> where >> >> import Data.Text as T >> import Text.Regex.TDFA >> import Prelude hiding (take, drop, map, lines) >> >> type RowSAM = Text >> type SAM = [Text] >> type Case = Text >> type RowRxDx = Text >> type RxDx = [Text] >> type RxDxList = [[Text]] >> type Rx = Text >> type Dx = Text >> type MediName = Text >> type Message = Text >> type Date = Text >> type PtName = Text >> >> --makeRxDxList :: Functor f => f Text -> f [Text] >> --makeRxDxList rowRxDx = fmap (\x -> splitOn (pack ",") x) rowRxDx >> makeRxDxList rowRxDx = map (\x -> splitOn (pack ",") pack x) $ lines >> rowRxDx >> >> pickupMediName :: RxDx -> MediName >> pickupMediName rxDx = rxDx !! 0 >> >> pickupDx :: RxDx -> Dx >> pickupDx rxDx = rxDx !! 2 >> >> pickupRx :: RxDx -> Rx >> pickupRx rxDx = rxDx !! 1 >> >> pickupPtName :: Case -> PtName >> pickupPtName ptCase = take 3 $ drop 45 ptCase >> >> pickupCaseDate :: Case -> Date >> pickupCaseDate ptCase = take 8 $ drop (348 + 2) ptCase >> >> isErrorRxDx :: Rx -> Dx -> Case -> Bool >> isErrorRxDx rxCode dxCode ptCase = >> case isExistRx rxCode ptCase of >> True -> if (isExistDx dxCode ptCase) then False else True >> False -> False >> >> isExistDx :: Dx -> Case -> Bool >> isExistDx dxCode ptCase = (unpack ptCase) =~ (unpack dxCode) >> >> isExistRx :: Rx -> Case -> Bool >> isExistRx rxCode ptCase = rxCode `isInfixOf` ptCase >> >> splitIntoCase :: RowSAM -> SAM >> splitIntoCase = splitOn $ pack "AH021" >> >> readCSV :: IO Text >> readCSV = pack <$> readFile "/Users/shaegis/Documents/Hask >> ell/samChecker3/RxDxData.csv" >> >> readSam :: IO Text >> readSam = pack <$> readFile "/Users/shaegis/Documents/Hask >> ell/samChecker3/BoHomUTF8.dat" >> >> >> >> _______________________________________________ >> 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 > > -- Sok Ha, CHANG Dr. Chang's Clinic. #203. 503-23. AmSa-Dong, GangDong-Gu, Seoul. Tel: +82-2-442-7585 -------------- next part -------------- An HTML attachment was scrubbed... URL: From shaegis at gmail.com Wed Feb 22 12:02:22 2017 From: shaegis at gmail.com (S. H. Aegis) Date: Wed, 22 Feb 2017 21:02:22 +0900 Subject: [Haskell-beginners] Type error when using splitOn function. In-Reply-To: <20170222093557.GA9429@casa.casa> References: <20170222093557.GA9429@casa.casa> Message-ID: Thank you so much. --makeRxDxList :: Functor f => f Text -> f [Text] Above signature comes from ghci using command :t My intention is makeRxDxList :: Text -> [[Text]] but, I got error, and try several times and below codes pass a complier. makeRxDxList rowRxDx = fmap (\x -> splitOn (pack ",") x) rowRxDx -- This code pass a compile. and then, I run ghci, type :t, and got below signature. makeRxDxList :: Functor f => f Text -> f [Text] Your kind answer says, I cannot help using fmap. right? ^^; Thanks again. 2017-02-22 18:35 GMT+09:00 Francesco Ariis : > On Wed, Feb 22, 2017 at 05:33:01PM +0900, S. H. Aegis wrote: > > Hello. > > I'm new to Haskell and this is the first time I use Data.Text module. > > And using stack on OSX 10.12.3 > > I'm try several times, but fail. and I don't understand what error > message > > says. > > How can I fix this? > > Thank you a lot. > > Hello SH, Text.map has signature `(Char -> Char) -> Text -> Text`, so > I expect you to need fmap too if the return value of makeRxDxList has > type f [Text] > > makeRxDxList rowRxDx = fmap _ rowRxDx > -- or base map > > _ is a hole and if the compiler will tell you which function needs to > go there, in this case one with signature `Text -> [Text]`. > > Does that help? If not, provide makeRxDxList signature and a brief > description so it's easier to diagnose the problem > -F > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Sok Ha, CHANG Dr. Chang's Clinic. #203. 503-23. AmSa-Dong, GangDong-Gu, Seoul. Tel: +82-2-442-7585 -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Wed Feb 22 13:31:16 2017 From: fa-ml at ariis.it (Francesco Ariis) Date: Wed, 22 Feb 2017 14:31:16 +0100 Subject: [Haskell-beginners] Type error when using splitOn function. In-Reply-To: References: <20170222093557.GA9429@casa.casa> Message-ID: <20170222133116.GA14860@casa.casa> On Wed, Feb 22, 2017 at 09:02:22PM +0900, S. H. Aegis wrote: > Thank you so much. > > --makeRxDxList :: Functor f => f Text -> f [Text] > Above signature comes from ghci using command :t > My intention is > makeRxDxList :: Text -> [[Text]] > but, I got error, and try several times and below codes pass a complier. > makeRxDxList rowRxDx = fmap (\x -> splitOn (pack ",") x) rowRxDx -- This > code pass a compile. > and then, I run ghci, type :t, and got below signature. > makeRxDxList :: Functor f => f Text -> f [Text] > > Your kind answer says, I cannot help using fmap. right? ^^; > Thanks again. Then this: makeRxDxList :: Text -> [[Text]] makeRxDxList rowRxDx = fmap f (lines rowRxDx) -- you imported Prelude hiding map, so we will use fmap where f :: Text -> [Text] f x = splitOn (pack ",") x should do (at least it typechecks). GHC errors may not have the prettiest formatting ever, but they are very useful, the most important bits being line & column of the offending expression plus the "expected this but got that" part; get acquainted with them! From shaegis at gmail.com Wed Feb 22 13:41:10 2017 From: shaegis at gmail.com (S. H. Aegis) Date: Wed, 22 Feb 2017 22:41:10 +0900 Subject: [Haskell-beginners] Type error when using splitOn function. In-Reply-To: <20170222133116.GA14860@casa.casa> References: <20170222093557.GA9429@casa.casa> <20170222133116.GA14860@casa.casa> Message-ID: It works !!! (^O^) Thank you so much. Have a nice day~! 2017-02-22 22:31 GMT+09:00 Francesco Ariis : > On Wed, Feb 22, 2017 at 09:02:22PM +0900, S. H. Aegis wrote: > > Thank you so much. > > > > --makeRxDxList :: Functor f => f Text -> f [Text] > > Above signature comes from ghci using command :t > > My intention is > > makeRxDxList :: Text -> [[Text]] > > but, I got error, and try several times and below codes pass a complier. > > makeRxDxList rowRxDx = fmap (\x -> splitOn (pack ",") x) rowRxDx -- This > > code pass a compile. > > and then, I run ghci, type :t, and got below signature. > > makeRxDxList :: Functor f => f Text -> f [Text] > > > > Your kind answer says, I cannot help using fmap. right? ^^; > > Thanks again. > > Then this: > > makeRxDxList :: Text -> [[Text]] > makeRxDxList rowRxDx = fmap f (lines rowRxDx) > -- you imported Prelude hiding map, so we will use fmap > where > f :: Text -> [Text] > f x = splitOn (pack ",") x > > should do (at least it typechecks). > > GHC errors may not have the prettiest formatting ever, but they are > very useful, the most important bits being line & column of the offending > expression plus the "expected this but got that" part; get acquainted > with them! > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Sok Ha, CHANG Dr. Chang's Clinic. #203. 503-23. AmSa-Dong, GangDong-Gu, Seoul. Tel: +82-2-442-7585 -------------- next part -------------- An HTML attachment was scrubbed... URL: From frederic-emmanuel.picca at synchrotron-soleil.fr Wed Feb 22 15:27:39 2017 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Wed, 22 Feb 2017 15:27:39 +0000 Subject: [Haskell-beginners] How to link two Types Message-ID: Hello, I wrote this code data DataFrameH5 a = DataFrameH5 (Nxs a) -- Nexus file (DataSource H5) -- gamma (DataSource H5) -- delta (DataSource H5) -- wavelength PoniGenerator -- ponie generator class Frame t a where len :: t -> IO (Maybe Int) row :: t -> Int -> MaybeT IO (DifTomoFrame a DIM1) instance Frame (DataFrameH5 DataFrameH5Path) DataFrameH5Path where len (DataFrameH5 _ _ (DataSourceH5 _ d) _ _) = lenH5Dataspace d row d@(DataFrameH5 nxs' g d' w ponigen) idx = do n <- lift $ len d let eof = fromJust n - 1 == idx let mu = 0.0 let komega = 0.0 let kappa = 0.0 let kphi = 0.0 gamma <- g `atIndex'` (ix1 0) delta <- d' `atIndex'` (ix1 idx) wavelength <- w `atIndex'` (ix1 0) let source = Source (head wavelength *~ nano meter) let positions = concat [mu, komega, kappa, kphi, gamma, delta] -- print positions let geometry = Geometry K6c source positions Nothing let detector = ZeroD m <- lift $ geometryDetectorRotationGet geometry detector poniext <- lift $ ponigen (MyMatrix HklB m) idx return $ DifTomoFrame { difTomoFrameNxs = nxs' , difTomoFrameIdx = idx , difTomoFrameEOF = eof , difTomoFrameGeometry = geometry , difTomoFramePoniExt = poniext } has you can see my t type contains also the a reference to the a one So when I create the instance, I need to write two times the DataFrameH5Path I would like to know how to write the same class with only class Frame t where len :: t -> IO (Maybe Int) row :: t -> Int -> MaybeT IO (DifTomoFrame DIM1) thanks for your help Frederic From toad3k at gmail.com Wed Feb 22 15:59:38 2017 From: toad3k at gmail.com (David McBride) Date: Wed, 22 Feb 2017 10:59:38 -0500 Subject: [Haskell-beginners] How to link two Types In-Reply-To: References: Message-ID: Maybe TypeFamilies would work for you? I can only give you a barebones outline of what it might look like. {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-} import Control.Monad.Trans.Maybe data DataFrameH5 a = DataFrameH5 data DataFrameH5Path = DataFrameH5Path class Frame t where type Key t len :: t -> IO (Maybe Int) row :: t -> Int -> MaybeT IO (Key t) instance Frame (DataFrameH5 a) where type Key (DataFrameH5 a) = a len DataFrameH5 = return . Just $ undefined row DataFrameH5 idx = MaybeT $ do return undefined On Wed, Feb 22, 2017 at 10:27 AM, PICCA Frederic-Emmanuel wrote: > Hello, I wrote this code > > data DataFrameH5 a > = DataFrameH5 > (Nxs a) -- Nexus file > (DataSource H5) -- gamma > (DataSource H5) -- delta > (DataSource H5) -- wavelength > PoniGenerator -- ponie generator > > class Frame t a where > len :: t -> IO (Maybe Int) > row :: t -> Int -> MaybeT IO (DifTomoFrame a DIM1) > > instance Frame (DataFrameH5 DataFrameH5Path) DataFrameH5Path where > len (DataFrameH5 _ _ (DataSourceH5 _ d) _ _) = lenH5Dataspace d > > row d@(DataFrameH5 nxs' g d' w ponigen) idx = do > n <- lift $ len d > let eof = fromJust n - 1 == idx > let mu = 0.0 > let komega = 0.0 > let kappa = 0.0 > let kphi = 0.0 > gamma <- g `atIndex'` (ix1 0) > delta <- d' `atIndex'` (ix1 idx) > wavelength <- w `atIndex'` (ix1 0) > let source = Source (head wavelength *~ nano meter) > let positions = concat [mu, komega, kappa, kphi, gamma, delta] > -- print positions > let geometry = Geometry K6c source positions Nothing > let detector = ZeroD > m <- lift $ geometryDetectorRotationGet geometry detector > poniext <- lift $ ponigen (MyMatrix HklB m) idx > return $ DifTomoFrame { difTomoFrameNxs = nxs' > , difTomoFrameIdx = idx > , difTomoFrameEOF = eof > , difTomoFrameGeometry = geometry > , difTomoFramePoniExt = poniext > } > > has you can see my t type contains also the a reference to the a one > So when I create the instance, I need to write two times the DataFrameH5Path > > I would like to know how to write the same class with only > > class Frame t where > len :: t -> IO (Maybe Int) > row :: t -> Int -> MaybeT IO (DifTomoFrame DIM1) > > thanks for your help > > Frederic > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From frederic-emmanuel.picca at synchrotron-soleil.fr Wed Feb 22 16:19:41 2017 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Wed, 22 Feb 2017 16:19:41 +0000 Subject: [Haskell-beginners] How to link two Types In-Reply-To: References: , Message-ID: Hello thanks, I will investigate, but I like this solution. I can ad more type to a type family right ? Is it possible with this type family to be able to link in the other way ? a -> t Cheers Fred From toad3k at gmail.com Wed Feb 22 16:29:16 2017 From: toad3k at gmail.com (David McBride) Date: Wed, 22 Feb 2017 11:29:16 -0500 Subject: [Haskell-beginners] How to link two Types In-Reply-To: References: Message-ID: It is hard to tell from your code what you intend, but it works however you want it to, so long as it type checks. class Frame a where type Whatever a len :: Whatever a -> IO (Maybe Int) row :: Whatever a -> MaybeT IO (DifTomoFrame a DIM1) instance Frame DataFrameH5Path where type Whatever DataFrameH5Path = DataFrameH5 len = undefined -- :: DataFrameH5 -> IO (Maybe Int) row = undefined -- :: DataFrameH5 -> Int -> MaybeT (DifTomoFrame DataFrameH5Path DIM1) On Wed, Feb 22, 2017 at 11:19 AM, PICCA Frederic-Emmanuel wrote: > Hello thanks, I will investigate, but I like this solution. > I can ad more type to a type family right ? > > > Is it possible with this type family to be able to link in the other way ? > > a -> t > > Cheers > > Fred > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From toad3k at gmail.com Wed Feb 22 16:34:43 2017 From: toad3k at gmail.com (David McBride) Date: Wed, 22 Feb 2017 11:34:43 -0500 Subject: [Haskell-beginners] How to link two Types In-Reply-To: References: Message-ID: I should mention I just wrote that code off the cuff. It's probably not even close to right. I recommend you mess with type families a little to see if they get you where you want to go in your existing code. On Wed, Feb 22, 2017 at 11:29 AM, David McBride wrote: > It is hard to tell from your code what you intend, but it works > however you want it to, so long as it type checks. > > class Frame a where > type Whatever a > len :: Whatever a -> IO (Maybe Int) > row :: Whatever a -> MaybeT IO (DifTomoFrame a DIM1) > > instance Frame DataFrameH5Path where > type Whatever DataFrameH5Path = DataFrameH5 > len = undefined -- :: DataFrameH5 -> IO (Maybe Int) > row = undefined -- :: DataFrameH5 -> Int -> MaybeT (DifTomoFrame > DataFrameH5Path DIM1) > > > > On Wed, Feb 22, 2017 at 11:19 AM, PICCA Frederic-Emmanuel > wrote: >> Hello thanks, I will investigate, but I like this solution. >> I can ad more type to a type family right ? >> >> >> Is it possible with this type family to be able to link in the other way ? >> >> a -> t >> >> Cheers >> >> Fred >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From frederic-emmanuel.picca at synchrotron-soleil.fr Wed Feb 22 16:40:47 2017 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Wed, 22 Feb 2017 16:40:47 +0000 Subject: [Haskell-beginners] How to link two Types In-Reply-To: References: , Message-ID: > It is hard to tell from your code what you intend, but it works > however you want it to, so long as it type checks. > class Frame a where > type Whatever a > len :: Whatever a -> IO (Maybe Int) > row :: Whatever a -> MaybeT IO (DifTomoFrame a DIM1) > instance Frame DataFrameH5Path where > type Whatever DataFrameH5Path = DataFrameH5 > len = undefined -- :: DataFrameH5 -> IO (Maybe Int) > row = undefined -- :: DataFrameH5 -> Int -> MaybeT (DifTomoFrame > DataFrameH5Path DIM1) In fact what I try realy to do is this. data DataFrameH5Path = DataFrameH5Path (DataItem H5) -- image (DataItem H5) -- gamma (DataItem H5) -- delta (DataItem H5) -- wavelength deriving (Show) data DataFrameH5 a = DataFrameH5 (Nxs a) -- Nexus file (DataSource H5) -- gamma (DataSource H5) -- delta (DataSource H5) -- wavelength PoniGenerator -- ponie generator withDataFrameH5 :: (Frame a, MonadSafe m) => File -> Nxs (Key a) -> PoniGenerator -> (a -> m r) -> m r withDataFrameH5 h nxs'@(Nxs _ _ (DataFrameH5Path _ g d w)) gen = bracket (liftIO before) (liftIO . after) where -- before :: File -> DataFrameH5Path -> m DataFrameH5 before :: IO a before = DataFrameH5 <$> return nxs' <*> openDataSource h g <*> openDataSource h d <*> openDataSource h w <*> return gen after :: a -> IO () after (DataFrameH5 _ g' d' w' _) = do closeDataSource g' closeDataSource d' closeDataSource w' I open and hdf5 file and I need to read a bunch of data from this file. the DataFrameH5 is a sort of resource like a File handler. I need a location in the file in order to acce the data, then I need to close the file So I store in the H5 type these resource, that I can release at the end. Ideally I would like to have only The H5Path type and hide the H5 one but I do not know how to do this. I have in fact different H5Path types which necessitate each time there corresponding H5 type. So I want a one for one relation between the H5 <-> H5Path type. Cheers Frederic From frederic-emmanuel.picca at synchrotron-soleil.fr Wed Feb 22 16:41:19 2017 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Wed, 22 Feb 2017 16:41:19 +0000 Subject: [Haskell-beginners] How to link two Types In-Reply-To: References: , Message-ID: > I should mention I just wrote that code off the cuff. It's probably > not even close to right. I recommend you mess with type families a > little to see if they get you where you want to go in your existing > code. I am playing with it thanks :)) From frederic-emmanuel.picca at synchrotron-soleil.fr Wed Feb 22 17:19:10 2017 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Wed, 22 Feb 2017 17:19:10 +0000 Subject: [Haskell-beginners] How to link two Types In-Reply-To: References: , Message-ID: Hello, I am affected by this error src/Hkl/Xrd/OneD.hs:238:49-52: Could not deduce (Key a ~ Key b0) from the context (Frame a) bound by the type signature for getPoniExtRef :: Frame a => XRDRef (Key a) -> IO PoniExt at src/Hkl/Xrd/OneD.hs:235:18-56 NB: `Key' is a type function, and may not be injective The type variable `b0' is ambiguous Possible fix: add a type signature that fixes these type variable(s) Expected type: Nxs (Key b0) Actual type: Nxs (Key a) In the second argument of `withDataFrameH5', namely nxs' In the first argument of `(>->)', namely `withDataFrameH5 h5file nxs' (gen output f) yield' In the first argument of `toListM', namely `(withDataFrameH5 h5file nxs' (gen output f) yield >-> hoist lift (frames' [idx]))' I looked at this http://stackoverflow.com/questions/20870432/type-family-vs-data-family-in-brief-haskell#20908500 So in your opinion it would be better to use a data family instead of a type familly ? Cheers From kc1956 at gmail.com Wed Feb 22 18:14:50 2017 From: kc1956 at gmail.com (KC) Date: Wed, 22 Feb 2017 10:14:50 -0800 Subject: [Haskell-beginners] Making a Tic-Tac-Toe Game In-Reply-To: References: Message-ID: If you want graphics there is Making your first Haskell game Which uses hGamer3D and aio -- -- Sent from an expensive device which will be obsolete in a few months! :D Casey On Feb 21, 2017 8:36 AM, "Sudhanshu Jaiswal" wrote: > Also called as Noughts and crosses or Xs and Os. > > Hello everyone, > > How do I start making a *Two Player* Tic Tac Toe game in Haskell? > > The program basically has to show the 3*3 grid as coordinates and let each > player choose his coordinates in his turn by entering the coordinates of > the required cell. I also want to be able to check if a player has won and > display it once the winning move has been made or the same for a Draw. > > What have I done? - I have read Learn You a Haskell till Modules and know > basic I/O. > > I don't want the code instead, I am interested in learning stuff and > trying problems which would lead me to get the intuition and ability to > make the game by myself. > > I would be thankful if you folks could direct me to related problems which > I could do or some advice as to how I should go about implementing such a > program. > -- > Sudhanshu > > > > _______________________________________________ > 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 Thu Feb 23 01:50:05 2017 From: michael at schmong.org (Michael Litchard) Date: Wed, 22 Feb 2017 17:50:05 -0800 Subject: [Haskell-beginners] Understanding the function monad ((->) r) In-Reply-To: References: <08dd31b5-01c8-ad20-5d8d-39814b7281c4@web.de> <366f7be1-330c-b446-d20d-fe8beee76a93@web.de> Message-ID: Thanks for this response. the Monad instance for ((->) r) has been bugging me as well. On Tue, Feb 21, 2017 at 6:32 AM, Rahul Muttineni wrote: > Hi Olumide, > > Let the types help you out. > > The Monad typeclass (omitting the superclass constraints): > > class Monad m where > return :: a -> m a > (>>=) :: m a -> (a -> m b) -> m b > > Write out the specialised type signatures for (->) r: > > {-# LANGUAGE InstanceSigs #-} > -- This extension allows you to specify the type signatures in instance > declarations > > instance Monad ((->) r) where > return :: a -> (r -> a) > (>>=) :: (r -> a) -> (a -> (r -> b)) -> (r -> b) > > Now we look at how to make some definition of return that type checks. > We're given an a and we want to return a function that takes an r and > returns an a. Well the only way you can really do this is ignoring the r > and returning the value you were given in all cases! Because 'a' can be > *anything*, you really don't have much else you can do! Hence: > > return :: a -> (r -> a) > return a = \_ -> a > > Now let's take a look at (>>=). Since this is a bit complicated, let's > work backwards from the result type. We want a function that gives us a b > given an r and given two functions with types (r -> a) and (a -> (r -> b)). > To get a b, we need to use the second function. To use the second function, > we must have an a, which we can get from the first function! > > (>>=) :: (r -> a) -> (a -> (r -> b)) -> (r -> b) > (>>=) f g = \r -> (g (f r)) r > > Hope that helps! > Rahul > > > On Tue, Feb 21, 2017 at 5:04 PM, Olumide <50295 at web.de> wrote: > >> On 21/02/2017 10:25, Benjamin Edwards wrote: >> >>> What is it that you are having difficulty with? Is it "why" this is a >>> good definition? Is it that you don't understand how it works? >>> >> >> I simply can't grok f (h w) w. >> >> - Olumide >> >> On Tue, 21 Feb 2017 at 10:15 Olumide <50295 at web.de >>> > wrote: >>> >>> Hello List, >>> >>> I am having enormous difficulty understanding the definition of the >>> bind >>> operator of ((->) r) as show below and would appreciate help i this >>> regard. >>> >>> instance Monad ((->) r) where >>> return x = \_ -> x >>> h >>= f = \w -> f (h w) w >>> >>> Thanks, >>> >>> - Olumide >>> >>> _______________________________________________ >>> 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 >> > > > > -- > Rahul Muttineni > > _______________________________________________ > 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 50295 at web.de Sat Feb 25 20:19:15 2017 From: 50295 at web.de (Olumide) Date: Sat, 25 Feb 2017 20:19:15 +0000 Subject: [Haskell-beginners] Understanding the function monad ((->) r) In-Reply-To: References: <08dd31b5-01c8-ad20-5d8d-39814b7281c4@web.de> <366f7be1-330c-b446-d20d-fe8beee76a93@web.de> Message-ID: <298e16cd-1436-b976-bba0-1fae42ad7b25@web.de> Thanks a bunch. Simply gorgeous answer. - Olumide On 21/02/17 14:32, Rahul Muttineni wrote: > Hi Olumide, > > Let the types help you out. > > The Monad typeclass (omitting the superclass constraints): > > class Monad m where > return :: a -> m a > (>>=) :: m a -> (a -> m b) -> m b > > Write out the specialised type signatures for (->) r: > > {-# LANGUAGE InstanceSigs #-} > -- This extension allows you to specify the type signatures in instance > declarations > > instance Monad ((->) r) where > return :: a -> (r -> a) > (>>=) :: (r -> a) -> (a -> (r -> b)) -> (r -> b) > > Now we look at how to make some definition of return that type checks. > We're given an a and we want to return a function that takes an r and > returns an a. Well the only way you can really do this is ignoring the r > and returning the value you were given in all cases! Because 'a' can be > *anything*, you really don't have much else you can do! Hence: > > return :: a -> (r -> a) > return a = \_ -> a > > Now let's take a look at (>>=). Since this is a bit complicated, let's > work backwards from the result type. We want a function that gives us a > b given an r and given two functions with types (r -> a) and (a -> (r -> > b)). To get a b, we need to use the second function. To use the second > function, we must have an a, which we can get from the first function! > > (>>=) :: (r -> a) -> (a -> (r -> b)) -> (r -> b) > (>>=) f g = \r -> (g (f r)) r > > Hope that helps! > Rahul > > > On Tue, Feb 21, 2017 at 5:04 PM, Olumide <50295 at web.de > > wrote: > > On 21/02/2017 10:25, Benjamin Edwards wrote: > > What is it that you are having difficulty with? Is it "why" this > is a > good definition? Is it that you don't understand how it works? > > > I simply can't grok f (h w) w. > > - Olumide > > On Tue, 21 Feb 2017 at 10:15 Olumide <50295 at web.de > > >> wrote: > > Hello List, > > I am having enormous difficulty understanding the definition > of the bind > operator of ((->) r) as show below and would appreciate help > i this > regard. > > instance Monad ((->) r) where > return x = \_ -> x > h >>= f = \w -> f (h w) w > > Thanks, > > - Olumide > > _______________________________________________ > 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 > > > > > > -- > Rahul Muttineni > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From brosius.jan at gmail.com Tue Feb 28 11:43:54 2017 From: brosius.jan at gmail.com (Jan) Date: Tue, 28 Feb 2017 12:43:54 +0100 Subject: [Haskell-beginners] =?utf-8?q?Saul_Alinsky=E2=80=99s_Most_Famous_?= =?utf-8?b?RGlzY2lwbGUuLi4=?= Message-ID: <331C3F3A-E52C-4E5D-B07D-4335BB59836D@gmail.com> http://www.tldm.org/news33/saul-alinskys-most-famous-disciple.htm Verstuurd vanaf mijn iPhone