Send Beginners mailing list submissions to
        beginners@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-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.  How to use GHC.Event module,     main thread not exit directly
      (baltern...@foxmail.com)
   2. Re:  Haskell Question (Seph Shewell Brockway)
   3. Re:  Haskell Question (Ut Primum)
   4. Re:  Haskell Question (Seph Shewell Brockway)


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

Message: 1
Date: Fri, 18 Oct 2019 23:53:42 +0800
From: "baltern...@foxmail.com" <baltern...@foxmail.com>
To: beginners <beginners@haskell.org>
Subject: [Haskell-beginners] How to use GHC.Event module,       main thread
        not exit directly
Message-ID: <201910182353417471...@foxmail.com>+8C573A28B77CA83E
Content-Type: text/plain; charset="utf-8"

Hello everyone:
I write a server use GHC.Event module, 
Refer to this article https://wiki.haskell.org/Simple_Servers

{-# LANGUAGE OverloadedStrings #-}
-- A simple example of an epoll based http server in Haskell.
--
-- Uses two libraries:
--   * network-bytestring, bytestring-based socket IO.
--      - cabal install network-bytestring: 
--
--   * haskell-event, epoll-based scalable IO events
--      - git clone git://github.com/tibbe/event.git
--      - autoreconf ; then cabal install
import Network hiding (accept)
import Network.Socket (fdSocket, accept)
import Network.Socket.ByteString
import Data.ByteString.Char8
import System.Event
import System.Posix
import System.Posix.IO
main = withSocketsDo $ do
    sock <- listenOn $ PortNumber 5002
    let fd = fromIntegral (fdSocket sock)
    mgr <- new
    registerFd mgr (client sock) fd evtRead
    loop mgr
client sock _ _ = do
    (c,_) <- accept sock
    sendAll c msg
    sClose c
msg = "HTTP/1.0 200 OK\r\nContent-Length: 5\r\n\r\nPong!\r\n"

but I not find the definition of 'loop' function: loop mgr

the after is my program:
btnz@vmubuntuserver:~/work/code/echo-server-event-model$ cat Main.hs
module Main where

import Network.Socket
import Network.Socket.ByteString (recv, sendAll)
import GHC.Event as Event
import qualified Control.Exception as E (bracket)
import Data.ByteString.Internal (packChars)

hints = defaultHints {addrFlags = [AI_PASSIVE], addrSocketType = Stream}
msg = "HTTP/1.0 200 OK\r\nContent-Length: 5\r\n\r\nPong!\r\n"

main :: IO ()
main = do
    putStrLn "Hello, Haskell!"
    addr <- head <$> getAddrInfo (Just hints) Nothing (Just "3000")
    E.bracket (sock addr) close eventServer
    return ()
    where
        sock addr = do
            s <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol 
addr)
            setSocketOption s ReuseAddr 1
            withFdSocket s setCloseOnExecIfNeeded
            bind s $ addrAddress addr
            listen s 1024
            return s
        eventServer s = do
            fd <- withFdSocket s (\ci -> return (fromIntegral ci))
            mgr <- Event.new
            Event.registerFd mgr (service s) fd Event.evtRead Event.OneShot
--            loop mgr

service :: Socket -> FdKey -> Event -> IO ()
service s _ _ = do
    (c, _) <- accept s
    sendAll c $ packChars msg
    close c

btnz@vmubuntuserver:~/work/code/echo-server-event-model$ cabal run
Up to date
Hello, Haskell!

when I run cabal run the program exit directly.



baltern...@foxmail.com
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 
<http://mail.haskell.org/pipermail/beginners/attachments/20191018/df94d1fc/attachment-0001.html>

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

Message: 2
Date: Fri, 18 Oct 2019 17:16:41 +0100
From: Seph Shewell Brockway <s...@codex.scot>
To: The Haskell-Beginners Mailing List - Discussion of primarily
        beginner-level topics related to Haskell <beginners@haskell.org>
Subject: Re: [Haskell-beginners] Haskell Question
Message-ID: <20191018161641.pl5zbgzd2z45bxzm@leviathan>
Content-Type: text/plain; charset=utf-8

On Wed, Oct 16, 2019 at 09:09:40PM +0000, instanc...@aol.com wrote:
> I need help with this haskell functionWrite a function productLastPart which, 
> only using library functions, returns the product of thelast n numbers in the 
> list, where n is the first argument to the function. productLastPart :: Int 
> -> [Int] -> Int

It would probably help you learn if you made an attempt to solve it
yourself first. If you post what you have so far, I’d be happy to take
a look.

         Regards,

         Seph

-- 
Seph Shewell Brockway, BSc MSc (Glas.)
Pronouns: she/her


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

Message: 3
Date: Fri, 18 Oct 2019 18:59:05 +0200
From: Ut Primum <utpri...@gmail.com>
To: The Haskell-Beginners Mailing List - Discussion of primarily
        beginner-level topics related to Haskell <beginners@haskell.org>
Subject: Re: [Haskell-beginners] Haskell Question
Message-ID:
        <CANjDmKL2=hXqiovgTmRjMeqGtJYBYZmaLvH=jiopb9whkbg...@mail.gmail.com>
Content-Type: text/plain; charset="utf-8"

Hi,
this is my solution:

productLastPart :: Int -> [Int] -> Int
productLastPart n xs = product (take n (reverse xs))

It only uses functions product, take and reverse
Regards,
Ut

<http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_campaign=sig-email&utm_content=webmail>
Mail
priva di virus. www.avg.com
<http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_campaign=sig-email&utm_content=webmail>
<#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2>

Il giorno ven 18 ott 2019 alle ore 18:16 Seph Shewell Brockway
<s...@codex.scot> ha scritto:

> On Wed, Oct 16, 2019 at 09:09:40PM +0000, instanc...@aol.com wrote:
> > I need help with this haskell functionWrite a function productLastPart
> which, only using library functions, returns the product of thelast n
> numbers in the list, where n is the first argument to the
> function. productLastPart :: Int -> [Int] -> Int
>
> It would probably help you learn if you made an attempt to solve it
> yourself first. If you post what you have so far, I’d be happy to take
> a look.
>
>          Regards,
>
>          Seph
>
> --
> Seph Shewell Brockway, BSc MSc (Glas.)
> Pronouns: she/her
> _______________________________________________
> Beginners mailing list
> Beginners@haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: 
<http://mail.haskell.org/pipermail/beginners/attachments/20191018/67029331/attachment-0001.html>

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

Message: 4
Date: Fri, 18 Oct 2019 20:44:22 +0100
From: Seph Shewell Brockway <s...@codex.scot>
To: The Haskell-Beginners Mailing List - Discussion of primarily
        beginner-level topics related to Haskell <beginners@haskell.org>
Subject: Re: [Haskell-beginners] Haskell Question
Message-ID: <20191018194422.z2kuwm7tcvyxor6i@leviathan>
Content-Type: text/plain; charset=utf-8

On Fri, Oct 18, 2019 at 06:59:05PM +0200, Ut Primum wrote:
> Hi,
> this is my solution:
> 
> productLastPart :: Int -> [Int] -> Int
> productLastPart n xs = product (take n (reverse xs))
> 
> It only uses functions product, take and reverse
> Regards,
> Ut

That should work. I’d probably use point-free style, though, and avoid
all of those brackets.

   productLastPart n = product . take n . reverse

The version you’ve written runs in linear time, as would a version that
worked like this:

   productLastPart n xs = product (drop (length xs - n) xs)

because reverse, length and product (actually a partial application of
foldr) are all linear in the length of the list—they access each element
once. You can see the GHC implementation of reverse at
https://hackage.haskell.org/package/base-4.12.0.0/docs/src/GHC.List.html#reverse.
This turns out to be the best we can do with a regular Haskell list,
because accessing the last element of a list is a linear-time operation:

   last :: [a] -> a
   last [] = error "Oh no!"
   last [x] = x
   last (x : xs) = last xs

There do, however, exist list types like Sequence and Vector that allow
constant-time access to both ends of the list.

Hope this is helpful.

                                                Seph

-- 
Seph Shewell Brockway, BSc MSc (Glas.)
Pronouns: she/her


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

Subject: Digest Footer

_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners


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

End of Beginners Digest, Vol 136, Issue 3
*****************************************

Reply via email to