[Haskell-beginners] Developing Web Applications with Haskell and Yesod

KMandPJLynch kmandpjlynch at verizon.net
Tue Mar 12 15:47:30 CET 2013


Good morning,

I sent a previous email to you in regard to this - if my request is rejected, will I be notified?

I'm reading the book "Developing Web Applications with Haskell and Yesod".
It is a very interesting read and I'm hoping to be able to be able to put up a simple web app using it as a result.
I was wondering if anyone has had experience with it.

Thank you

On Mar 12, 2013, at 9:21 AM, beginners-request at haskell.org wrote:

> Send Beginners mailing list submissions to
> 	beginners at 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-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. Re:  Writing a custom pop function for a stack	data type (doaltan)
>   2. Re:  Writing a custom pop function for a stack data type
>      (Brent Yorgey)
>   3. Re:  Suspend/resume computation using Cont monad	and callCC
>      (Ertugrul S?ylemez)
>   4. Re:  Writing a custom pop function for a stack data type
>      (Emanuel Koczwara)
>   5. Re:  Performance problem with Haskell/OpenGL/GLFW
>      (Jesper S?rnesj?)
> 
> 
> ----------------------------------------------------------------------
> 
> Message: 1
> Date: Tue, 12 Mar 2013 11:06:35 +0000 (GMT)
> From: doaltan <doaltan at yahoo.co.uk>
> Subject: Re: [Haskell-beginners] Writing a custom pop function for a
> 	stack	data type
> To: divyanshu ranjan <idivyanshu.ranjan at gmail.com>
> Cc: "beginners at haskell.org" <beginners at haskell.org>
> Message-ID:
> 	<1363086395.38137.YahooMailNeo at web171402.mail.ir2.yahoo.com>
> Content-Type: text/plain; charset="iso-8859-1"
> 
> Actually I'm getting the error with this :
> 
> data Stack = Empty | Elem Char Stack deriving Show
> 
> 
> pophead :: Stack -> Char
> pophead Empty = Empty 
> pophead (Elem x stack) = x
> 
> 
> 
> ________________________________
> From: divyanshu ranjan <idivyanshu.ranjan at gmail.com>
> To: doaltan <doaltan at yahoo.co.uk>; The Haskell-Beginners Mailing List - Discussion of primarily beginner-level topics related to Haskell <beginners at haskell.org> 
> Sent: Tuesday, 12 March 2013, 12:53
> Subject: Re: [Haskell-beginners] Writing a custom pop function for a stack data type
> 
> 
> You have declared new data type mystack not Stack, so haskell compiler could not find Stack data type and its constructors. Secondly data type in Haskell need to be start with?capital?letters like
> 
> data Mystack = Empty | Elem Char Mystack deriving Show
> then correct Function?definition is?
> pophead :: Mystack -> Char
> 
> Regards
> Divyanshu?
> 
> 
> 
> On Tue, Mar 12, 2013 at 4:12 PM, doaltan <doaltan at yahoo.co.uk> wrote:
> 
> Hi I have such a stack data structure:?
>> datamystack =Empty |Elem Char mystack derivingShow
>> 
>> I'm trying to get the head of the stack using this:
>> pophead :: Stack -> Char
>> pophead Empty = Empty 
>> pophead (Element x stack) = x
>> And I'm getting this error for the last sentence of the function :
>> Not in
> scope: data constructor `Stack'
>> Can you tell me how to fix it? 
>> Thanks.
>> 
>> _______________________________________________
>> Beginners mailing list
>> Beginners at haskell.org
>> http://www.haskell.org/mailman/listinfo/beginners
>> 
>> 
> -------------- next part --------------
> An HTML attachment was scrubbed...
> URL: <http://www.haskell.org/pipermail/beginners/attachments/20130312/90aa5548/attachment-0001.htm>
> 
> ------------------------------
> 
> Message: 2
> Date: Tue, 12 Mar 2013 07:13:01 -0400
> From: Brent Yorgey <byorgey at seas.upenn.edu>
> Subject: Re: [Haskell-beginners] Writing a custom pop function for a
> 	stack data type
> To: beginners at haskell.org
> Message-ID: <20130312111301.GA17557 at seas.upenn.edu>
> Content-Type: text/plain; charset=iso-8859-1
> 
> On Tue, Mar 12, 2013 at 11:06:35AM +0000, doaltan wrote:
>> Actually I'm getting the error with this :
>> 
>> data Stack = Empty | Elem Char Stack deriving Show
>> 
>> 
>> pophead :: Stack -> Char
>> pophead Empty = Empty 
>> pophead (Elem x stack) = x
> 
> This code will result in a type error, but not the one you said.  Try
> compiling this exact code and see what error you get.
> 
> -Brent
> 
>> 
>> 
>> 
>> ________________________________
>> From: divyanshu ranjan <idivyanshu.ranjan at gmail.com>
>> To: doaltan <doaltan at yahoo.co.uk>; The Haskell-Beginners Mailing List - Discussion of primarily beginner-level topics related to Haskell <beginners at haskell.org> 
>> Sent: Tuesday, 12 March 2013, 12:53
>> Subject: Re: [Haskell-beginners] Writing a custom pop function for a stack data type
>> 
>> 
>> You have declared new data type mystack not Stack, so haskell compiler could not find Stack data type and its constructors. Secondly data type in Haskell need to be start with?capital?letters like
>> 
>> data Mystack = Empty | Elem Char Mystack deriving Show
>> then correct Function?definition is?
>> pophead :: Mystack -> Char
>> 
>> Regards
>> Divyanshu?
>> 
>> 
>> 
>> On Tue, Mar 12, 2013 at 4:12 PM, doaltan <doaltan at yahoo.co.uk> wrote:
>> 
>> Hi I have such a stack data structure:?
>>> datamystack =Empty |Elem Char mystack derivingShow
>>> 
>>> I'm trying to get the head of the stack using this:
>>> pophead :: Stack -> Char
>>> pophead Empty = Empty 
>>> pophead (Element x stack) = x
>>> And I'm getting this error for the last sentence of the function :
>>> Not in
>> scope: data constructor `Stack'
>>> Can you tell me how to fix it? 
>>> Thanks.
>>> 
>>> _______________________________________________
>>> Beginners mailing list
>>> Beginners at haskell.org
>>> http://www.haskell.org/mailman/listinfo/beginners
>>> 
>>> 
> 
>> _______________________________________________
>> Beginners mailing list
>> Beginners at haskell.org
>> http://www.haskell.org/mailman/listinfo/beginners
> 
> 
> 
> 
> ------------------------------
> 
> Message: 3
> Date: Tue, 12 Mar 2013 12:53:37 +0100
> From: Ertugrul S?ylemez <es at ertes.de>
> Subject: Re: [Haskell-beginners] Suspend/resume computation using Cont
> 	monad	and callCC
> To: beginners at haskell.org
> Message-ID: <20130312125337.42531e7f at tritium.ertes.de>
> Content-Type: text/plain; charset="us-ascii"
> 
> Dmitriy Matrosov <sgf.dma at gmail.com> wrote:
> 
>> I have two functions f and g, and i want them to execute in following
>> order: first function f runs, then suspends and passes control to
>> function g. Function g runs, then suspends and "unpauses" function f.
>> Function f finishes and passes control to function g, which also
>> finishes. Here is illustration ('o' means start of function, dot means
>> suspend and pass control to other function, 'x' means end of
>> function):
>> 
>> [...]
>> 
>> I want to implement this using Cont monad and callCC.
> 
> Not directly answering your question, but what you need is called
> coroutines, and there are better monads for that purpose.  This is how
> the Cont monads are defined:
> 
>    newtype Cont r a = Cont ((a -> r) -> r)
> 
> But what you really need here is called a Coroutine monad:
> 
>    newtype Coroutine f a = Coroutine (Either (f (Coroutine f a)) a)
> 
> Don't worry about that scary type, because if you look closely you will
> find that this is just Free as defined in the 'free' package:
> 
>    data Free f a
>        = Free (f (Free f a))
>        | Pure a
> 
> This is how it works:  The computation either results in a value (Pure)
> or it returns a way to continue the computation wrapped in `f` (Free):
> 
>    Free (Identity (Pure 15))
> 
> This computation suspends with the continuation "Pure 15".  If you
> continue it, it will result in 15.  Of course there are some helper
> functions to ease defining continuations:
> 
>    liftF (Identity 15)
> 
> So first you need a functor.  The monad-coroutine package has coined the
> term "suspension functor" for this particular purpose.  It captures the
> nature of the suspension.  As you saw the Identity functor allows you to
> suspend and resume:
> 
>    type Suspend = Identity
> 
>    suspend :: Free Suspend ()
>    suspend = liftF (Suspend ())
> 
> or even more generally:
> 
>    suspend :: (Applicative f) => Free f ()
>    suspend = liftF (pure ())
> 
> You can use this in a computation:
> 
>    doStuff
>    suspend
>    doOtherStuff
>    suspend
>    return 15
> 
> This returns to the controller and allows it to resume the computation
> if it wishes to:
> 
>    loop :: Free Suspend Integer -> IO Integer
>    loop (Pure x) = return x
>    loop (Free (Identity k)) = do
>        putStrLn "Suspended."
>        loop k
> 
> You can also define an abortion functor (predefined in
> Data.Functor.Constant from the "transformers" package):
> 
>    newtype Constant r a = Constant r
>        deriving (Functor)
> 
>    abort :: r -> Free (Constant r) a
>    abort = Free . Constant
> 
> You will find that in a loop you don't receive a continuation, but
> instead an abortion value, much like in a Cont computation that ignores
> its continuation:
> 
>    loop :: Free (Constant Integer) Integer -> IO Integer
>    loop (Pure x) = putStrLn "Completed" >> return x
>    loop (Free (Constant x)) = do
>        putStrLn ("Aborted with: " ++ show x)
>        return x
> 
> Another possibility is a functor to request values of a certain type:
> 
>    type Request = (->)
> 
>    request :: Free (Request e) a
>    request = Free Pure
> 
> Now the controlling loop has to supply values when requested to do so:
> 
>    comp :: Free (Request String) Integer
>    comp = do
>        x <- fmap read request
>        y <- if x /= 15
>               then fmap read request
>               else return 5
>        return (x + y)
> 
>    loop :: Free (Request String) Integer -> IO Integer
>    loop (Pure x) = return x
>    loop (Free k) = do
>        putStrLn "Gimme something:"
>        getLine >>= loop . k
> 
> Optionally add a prompt:
> 
>    data Prompt e a = Prompt String (e -> a)
>        deriving (Functor)
> 
>    prompt :: String -> Free (Prompt e) e
>    prompt p = Free (Prompt p Pure)
> 
>    loop :: Free (Prompt String) Integer -> IO Integer
>    loop (Pure x) = return x
>    loop (Free (Prompt p k)) = do
>        putStrLn p
>        getLine >>= loop . k
> 
> With a type system extension you can even request arbitrary IO actions:
> 
>    data Run a = forall b. Run (IO b) (b -> a)
> 
>    requestIO :: IO a -> Free Run a
>    requestIO c = Free (Run c Pure)
> 
>    loop :: Free Run Integer -> IO Integer
>    loop (Pure x) = return x
>    loop (Free (Run c k)) = do
>        putStrLn "IO action requested."
>        c >>= loop . k
> 
> And you can yield values:
> 
>    type Yield = (,)
> 
>    yield :: v -> Free (Yield v) ()
>    yield x = Free (x, Pure ())
> 
>    loop :: Free (Yield String) Integer -> IO Integer
>    loop (Pure x) = return x
>    loop (Free (str, k)) = do
>        putStrLn ("Yielded: " ++ str)
>        loop k
> 
> Or both request and yield (comonad-transformers package):
> 
>    type MySusp v e = Coproduct (Yield v) (Request e)
> 
>    yield :: v -> Free (MySusp v e) ()
>    yield x = Free . Coproduct . Left $ (x, Pure ())
> 
>    request :: Free (MySusp v e) e
>    request = Free . Coproduct . Right $ Pure
> 
>    loop :: Free (MySusp String String) Integer -> IO Integer
>    loop (Pure x) = return x
>    loop (Free (Coproduct f)) =
>        case f of
>          Left (x, k) -> do
>              putStrLn ("Yielded " ++ x)
>              loop k
>          Right k -> do
>              putStrLn "Requested."
>              getLine >>= loop . k
> 
> There are many more ways to use Free, but this should give you the basic
> building blocks.
> 
> I hope it helps.
> 
> 
> Greets,
> Ertugrul
> 
> -- 
> Not to be or to be and (not to be or to be and (not to be or to be and
> (not to be or to be and ... that is the list monad.
> -------------- next part --------------
> A non-text attachment was scrubbed...
> Name: signature.asc
> Type: application/pgp-signature
> Size: 836 bytes
> Desc: not available
> URL: <http://www.haskell.org/pipermail/beginners/attachments/20130312/ac0c98a9/attachment-0001.pgp>
> 
> ------------------------------
> 
> Message: 4
> Date: Tue, 12 Mar 2013 13:46:08 +0100
> From: Emanuel Koczwara <poczta at emanuelkoczwara.pl>
> Subject: Re: [Haskell-beginners] Writing a custom pop function for a
> 	stack data type
> To: doaltan <doaltan at yahoo.co.uk>, The Haskell-Beginners Mailing List
> 	-	Discussion of primarily beginner-level topics related to Haskell
> 	<beginners at haskell.org>
> Message-ID: <1363092368.2892.7.camel at emanuel-Dell-System-Vostro-3750>
> Content-Type: text/plain; charset="UTF-8"
> 
> Hi,
> 
> Dnia 2013-03-12, wto o godzinie 11:06 +0000, doaltan pisze:
>> Actually I'm getting the error with this :
>> 
>> 
>> data Stack = Empty | Elem Char Stack deriving Show
>> 
>> 
>> pophead :: Stack -> Char
>> pophead Empty = Empty 
>> pophead (Elem x stack) = x
>> 
>> 
> 
>  pophead should return Char. You can't return Stack if you defined the
> type of pophead as Stack -> Char. You can try to use Maybe here and
> return Maybe Char (Just x or Nothing) or you can use error function to
> raise an error.
> 
>  You can use _ instead of stack like this:
> 
> pophead (Elem x _) = x
> 
> Emanuel
> 
> 
> 
> 
> 
> 
> ------------------------------
> 
> Message: 5
> Date: Wed, 13 Mar 2013 00:21:30 +1100
> From: Jesper S?rnesj? <sarnesjo at gmail.com>
> Subject: Re: [Haskell-beginners] Performance problem with
> 	Haskell/OpenGL/GLFW
> To: The Haskell-Beginners Mailing List - Discussion of primarily
> 	beginner-level topics related to Haskell <beginners at haskell.org>
> Message-ID:
> 	<CALex+Wg_Q_azi3cqE_nRYDsdoutUoKS6=Zm=vB6H4NrC1-jUfQ at mail.gmail.com>
> Content-Type: text/plain; charset=ISO-8859-1
> 
> On Mon, Mar 11, 2013 at 8:23 AM, Jesper S?rnesj? <sarnesjo at gmail.com> wrote:
>> I used gfxCardStatus to show which card was in use. When I ran
>> test2.c, the system briefly switched to the discrete card. However,
>> when I ran Test2.hs, the system kept using the integrated chip the
>> whole time. Presumably, the Intel chip lacks a hardware implementation
>> of OpenGL 3.2, which causes the system to fall back to a software
>> renderer. I then used gfxCardStatus to force the system to *always*
>> use the discrete card and - boom! - this time Test2.hs received a
>> hardware renderer!
>> 
>> So it seems that the problem is a) Mac OS X-specific, or possibly
>> specific to systems with multiple graphics cards, b) related to
>> triggering the *switch* to the better graphics card. I don't yet
>> understand why the C program triggers a switch, while the Haskell
>> program does not, but I'll keep investigating.
> 
> I haven't had much time to look at this, unfortunately, but I did
> notice one interesting thing: the Haskell program *does* in fact
> trigger a switch of graphics cards, just... not as quickly.
> 
> To see this, you can check the system console (using Console.app).
> Here is what a switch from the integrated card to the discrete one
> looks like on my machine:
> 
>    3/13/13 12:02:22.486 AM WindowServer[77]: Received display connect
> changed for display 0x4272dc0
>    3/13/13 12:02:22.548 AM WindowServer[77]: Received display connect
> changed for display 0x3f003d
>    3/13/13 12:02:22.549 AM WindowServer[77]: CGXMuxAcknowledge:
> Posting glitchless acknowledge
>    3/13/13 12:02:22.593 AM WindowServer[77]: Received display connect
> changed for display 0x4272dc0
> 
> When I run the C program, this get logged immediately following the
> execution of glfwOpenWindow (I stepped through the program using GDB).
> 
> For the Haskell program, well... If I run the program normally, the
> above gets logged with roughly a second's delay, and the program
> receives a software renderer. However, if I step through it using
> GHCi, it gets logged immediately following the execution of
> glfwOpenWindow - and the program receives a hardware renderer!
> 
> Shot in the dark here, but could this be due to lazy I/O? I seem to
> recall reading something about GHCi forcing stricter I/O.
> 
> -- 
> Jesper S?rnesj?
> http://jesper.sarnesjo.org/
> 
> 
> 
> ------------------------------
> 
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
> 
> 
> End of Beginners Digest, Vol 57, Issue 18
> *****************************************




More information about the Beginners mailing list