Send Beginners mailing list submissions to
        beginners@haskell.org

To subscribe or unsubscribe via the World Wide Web, visit
        http://www.haskell.org/mailman/listinfo/beginners
or, via email, send a message with subject or body 'help' to
        beginners-requ...@haskell.org

You can reach the person managing the list at
        beginners-ow...@haskell.org

When replying, please edit your Subject line so it is more specific
than "Re: Contents of Beginners digest..."


Today's Topics:

   1. Re:  missing ghci, need to install cca (Erik de Castro Lopo)
   2. Re:  missing ghci, need to install cca (Franco)
   3.  Idiomatic way of working with Either and lists (Emmanuel Surleau)
   4.  Laziness problem, some code never being executed,        when using
      Control.Monad.State.Strict (Olivier Boudry)
   5. Re:  Idiomatic way of working with Either and     lists
      (Daniel Fischer)
   6. Re:  Idiomatic way of working with Either and     lists
      (Daniel Fischer)
   7. Re:  Idiomatic way of working with Either and lists
      (Emmanuel Surleau)
   8. Re:  Laziness problem,    some code never being executed, when
      using Control.Monad.State.Strict (Olivier Boudry)


----------------------------------------------------------------------

Message: 1
Date: Sat, 26 Jan 2013 22:11:56 +1100
From: Erik de Castro Lopo <mle...@mega-nerd.com>
Subject: Re: [Haskell-beginners] missing ghci, need to install cca
To: beginners@haskell.org
Message-ID: <20130126221156.edc8266051f68bbe4259b...@mega-nerd.com>
Content-Type: text/plain; charset=US-ASCII

Franco wrote:

> I have been warned by the #haskell irc channel on freenode that those errors
> essentially mean "you don't have ghci installed, so no template haskell for 
> you".
> 
> Indeed my platform (ARM, running Debian ARMHF) does not have ghci.

What version of ghc do you have? I thought the 7.6.1 version
of ghci for armhf did support a working ghci.

Erik
-- 
----------------------------------------------------------------------
Erik de Castro Lopo
http://www.mega-nerd.com/



------------------------------

Message: 2
Date: Sat, 26 Jan 2013 12:00:22 +0000
From: Franco <franc...@gmx.com>
Subject: Re: [Haskell-beginners] missing ghci, need to install cca
To: beginners@haskell.org
Message-ID: <20130126120022.GA5527@efikamx>
Content-Type: text/plain; charset=us-ascii

> What version of ghc do you have? I thought the 7.6.1 version
> of ghci for armhf did support a working ghci.

7.4.1 (I am running wheezy/sid).

7.6.1 is being tested in experimental [1], but debian experimental is quite a
nightmare for me, I plan to stay on stable as soon as wheezy is released.

[1] http://packages.debian.org/experimental/ghc





------------------------------

Message: 3
Date: Sat, 26 Jan 2013 17:26:26 +0100
From: Emmanuel Surleau <emmanuel.surl...@gmail.com>
Subject: [Haskell-beginners] Idiomatic way of working with Either and
        lists
To: Haskell Beginners <beginners@haskell.org>
Message-ID: <20130126162626.GA8793@mercurialalchemist>
Content-Type: text/plain; charset=us-ascii

Hi,

I'm trying to figure out the best way to work with Either and lists.

I have a function f which goes:

f :: a -> Either SomeError b

Now, I'd like to do:

applyF :: [a] -> (a -> Either SomeError b) -> Either SomeError [b]

That is, map f over a list and return either a list or the first error found.
The function should stop at the first error. I have implemented applyF with a
fold, but I'm sure there must be something like this already, being a fairly
generic pattern.

Thanks,

Emm



------------------------------

Message: 4
Date: Sat, 26 Jan 2013 17:29:20 +0100
From: Olivier Boudry <olivier.bou...@gmail.com>
Subject: [Haskell-beginners] Laziness problem, some code never being
        executed,       when using Control.Monad.State.Strict
To: beginners@haskell.org
Message-ID:
        <CAC-kiLCnESVbcFoji1iL9=r7wFYGC0+pV52Q_n1z=92fzbd...@mail.gmail.com>
Content-Type: text/plain; charset="utf-8"

Hi folks,

I'm using the state monad (Control.Monad.State.Strict) to keep track of the
state of a monopoly game (Project Euler problem #84). I'm really close to
get something that works, but I just have some code with side effects only
that does not execute and I struggle force it to execute. I used hpc to
discover which part of the code was never run and found lines 93 to 95. In
those lines I'm trying to update a visits Map that holds the number of
times I've been on a particular cell of the board. What I don't understand
is that the code in lines 66 to 68 is almost identical and this one gets
executed. The visit Map is used at the very end to retrieve results.

   57 execAction :: State Monopoly ()   58 execAction = do   59     m
<- get   60     let b = board m   61     let s = CL.value b   62
case s of   63         (CC _) -> execCommunityChest   64         (CH
_) -> execChance   65         G2J    -> execMove gotoJail   66
_      -> do   67             let v = insertWith (+) s 1 (visit m)
68             put m {visit = v}...

   80     let c = cc m   81     c' <- execCard c   82     put m {cc =
c'}   83    84 execCard :: CardsDeck -> State Monopoly CardsDeck   85
execCard cd = do   86     let cd' = CL.next cd   87     case CL.value
cd of   88         Just mv -> do   89             execMove mv   90
        return cd'   91         Nothing -> do   92             m <-
get   93             let s = CL.value $ board m   94             let v
= insertWith (+) s 1 (visit m)   95             put m {visit = v}   96
            return cd'

I tried to play with some $! to force execution but it never goes deep
enough and I don't really know where to place these. I did not copy the
whole solution as requested on the Project Euler site.

Any help on this would be greatly appreciated,

Thanks,

Olivier.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 
<http://www.haskell.org/pipermail/beginners/attachments/20130126/c0655f90/attachment-0001.htm>

------------------------------

Message: 5
Date: Sat, 26 Jan 2013 17:41:39 +0100
From: Daniel Fischer <daniel.is.fisc...@googlemail.com>
Subject: Re: [Haskell-beginners] Idiomatic way of working with Either
        and     lists
To: beginners@haskell.org
Message-ID: <13200450.dstgkgb...@linux-v7dw.site>
Content-Type: text/plain; charset="us-ascii"

On Saturday 26 January 2013, 17:26:26, Emmanuel Surleau wrote:
> Hi,
> 
> I'm trying to figure out the best way to work with Either and lists.
> 
> I have a function f which goes:
> 
> f :: a -> Either SomeError b
> 
> Now, I'd like to do:
> 
> applyF :: [a] -> (a -> Either SomeError b) -> Either SomeError [b]
> 
> That is, map f over a list and return either a list or the first error
> found. The function should stop at the first error. I have implemented
> applyF with a fold, but I'm sure there must be something like this already,
> being a fairly generic pattern.

Since (Either e) is a Monad,

mapM :: Monad m => (a -> m b) -> [a] -> m [b]

does what you want. If your GHC is <= 7.4.2 (and >= 7.0.1), you will need to

import Control.Monad.Instances

The version with the argument order you gave is

forM :: Monad m => [a] -> (a -> m b) -> m [b]
forM = flip mapM



------------------------------

Message: 6
Date: Sat, 26 Jan 2013 17:40:49 +0100
From: Daniel Fischer <daniel.is.fisc...@googlemail.com>
Subject: Re: [Haskell-beginners] Idiomatic way of working with Either
        and     lists
To: beginners@haskell.org
Message-ID: <2593141.g1x6urg...@linux-v7dw.site>
Content-Type: text/plain; charset="us-ascii"

On Saturday 26 January 2013, 17:26:26, Emmanuel Surleau wrote:
> Hi,
> 
> I'm trying to figure out the best way to work with Either and lists.
> 
> I have a function f which goes:
> 
> f :: a -> Either SomeError b
> 
> Now, I'd like to do:
> 
> applyF :: [a] -> (a -> Either SomeError b) -> Either SomeError [b]
> 
> That is, map f over a list and return either a list or the first error
> found. The function should stop at the first error. I have implemented
> applyF with a fold, but I'm sure there must be something like this already,
> being a fairly generic pattern.

Since (Either e) is a Monad,

mapM :: Monad m => (a -> m b) -> [a] -> m [b]

does what you want. If your GHC is <= 7.4.2 (and >= 7.0.1), you will need to

import Control.Monad.Instances

The version with the argument order you gave is

forM :: Monad m => [a] -> (a -> m b) -> m [b]
forM = flip mapM



------------------------------

Message: 7
Date: Sat, 26 Jan 2013 20:31:44 +0100
From: Emmanuel Surleau <emmanuel.surl...@gmail.com>
Subject: Re: [Haskell-beginners] Idiomatic way of working with Either
        and lists
To: Daniel Fischer <daniel.is.fisc...@googlemail.com>
Cc: beginners@haskell.org
Message-ID: <20130126193144.GB8793@mercurialalchemist>
Content-Type: text/plain; charset=us-ascii

On Sat, Jan 26, 2013 at 05:41:39PM +0100, Daniel Fischer wrote:
> On Saturday 26 January 2013, 17:26:26, Emmanuel Surleau wrote:
> > Hi,
> > 
> > I'm trying to figure out the best way to work with Either and lists.
> > 
> > I have a function f which goes:
> > 
> > f :: a -> Either SomeError b
> > 
> > Now, I'd like to do:
> > 
> > applyF :: [a] -> (a -> Either SomeError b) -> Either SomeError [b]
> > 
> > That is, map f over a list and return either a list or the first error
> > found. The function should stop at the first error. I have implemented
> > applyF with a fold, but I'm sure there must be something like this already,
> > being a fairly generic pattern.
> 
> Since (Either e) is a Monad,
> 
> mapM :: Monad m => (a -> m b) -> [a] -> m [b]
> 
> does what you want. If your GHC is <= 7.4.2 (and >= 7.0.1), you will need to
> 
> import Control.Monad.Instances
> 
> The version with the argument order you gave is
> 
> forM :: Monad m => [a] -> (a -> m b) -> m [b]
> forM = flip mapM

Brilliant. Thank you very much, that's much better than my fold.

Cheers,

Emm



------------------------------

Message: 8
Date: Sun, 27 Jan 2013 06:02:20 +0100
From: Olivier Boudry <olivier.bou...@gmail.com>
Subject: Re: [Haskell-beginners] Laziness problem,      some code never
        being executed, when using Control.Monad.State.Strict
To: beginners@haskell.org
Message-ID:
        <cac-kilcjkpcseseogdfot1+xeg_v6nx0cbayb9h0uwmmbrp...@mail.gmail.com>
Content-Type: text/plain; charset="utf-8"

Hi,

I found the solution to the problem. It was in the function calling
execCard where I was overwriting a state value with an older result.

execChance = do
    m <- get
    let c = ch m
    c' <- execCard c
    put m {ch = c'}      <-- overwriting the m value put in the execCard
function

I fixed it by adding one more get before the last put.

Thanks,

Olivier.


On Sat, Jan 26, 2013 at 5:29 PM, Olivier Boudry <olivier.bou...@gmail.com>wrote:

> Hi folks,
>
> I'm using the state monad (Control.Monad.State.Strict) to keep track of
> the state of a monopoly game (Project Euler problem #84). I'm really close
> to get something that works, but I just have some code with side effects
> only that does not execute and I struggle force it to execute. I used hpc
> to discover which part of the code was never run and found lines 93 to 95.
> In those lines I'm trying to update a visits Map that holds the number of
> times I've been on a particular cell of the board. What I don't understand
> is that the code in lines 66 to 68 is almost identical and this one gets
> executed. The visit Map is used at the very end to retrieve results.
>
>    57 execAction :: State Monopoly ()   58 execAction = do   59     m <- get  
>  60     let b = board m   61     let s = CL.value b   62     case s of   63   
>       (CC _) -> execCommunityChest   64         (CH _) -> execChance   65     
>     G2J    -> execMove gotoJail   66         _      -> do   67             
> let v = insertWith (+) s 1 (visit m)   68             put m {visit = v}...
>
>    80     let c = cc m   81     c' <- execCard c   82     put m {cc = c'}   
> 83    84 execCard :: CardsDeck -> State Monopoly CardsDeck   85 execCard cd = 
> do   86     let cd' = CL.next cd   87     case CL.value cd of   88         
> Just mv -> do   89             execMove mv   90             return cd'   91   
>       Nothing -> do   92             m <- get   93             let s = 
> CL.value $ board m   94             let v = insertWith (+) s 1 (visit m)   95 
>             put m {visit = v}   96             return cd'
>
> I tried to play with some $! to force execution but it never goes deep
> enough and I don't really know where to place these. I did not copy the
> whole solution as requested on the Project Euler site.
>
> Any help on this would be greatly appreciated,
>
> Thanks,
>
> Olivier.
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 
<http://www.haskell.org/pipermail/beginners/attachments/20130127/15f9beec/attachment.htm>

------------------------------

_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://www.haskell.org/mailman/listinfo/beginners


End of Beginners Digest, Vol 55, Issue 28
*****************************************

Reply via email to