[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit 1f99575ad1a19f727d3dc3856583708237786041
Author: John Goerzen <jgoerzen at complete.org>
Date:   Sat Dec 18 05:59:42 2004 +0100

    added tests
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-85)

diff --git a/ChangeLog b/ChangeLog
index 567ab2f..5369d48 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,21 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-17 22:59:42 GMT	John Goerzen <jgoerzen at complete.org>	patch-85
+
+    Summary:
+      added tests
+    Revision:
+      missingh--head--0.7--patch-85
+
+
+    new files:
+     .arch-ids/test2.hs.id .arch-ids/test3.hs.id test2.hs test3.hs
+
+    modified files:
+     ChangeLog
+
+
 2004-12-17 22:48:30 GMT	John Goerzen <jgoerzen at complete.org>	patch-84
 
     Summary:
diff --git a/test2.hs b/test2.hs
new file mode 100644
index 0000000..f10dc1b
--- /dev/null
+++ b/test2.hs
@@ -0,0 +1,26 @@
+-- example code 2 for socketserver
+import MissingH.Network.SocketServer
+import MissingH.IO
+import MissingH.Logging.Logger
+import Data.Char
+import System.IO
+import MissingH.Str
+
+lineInteraction :: [String] -> [String]
+lineInteraction inp =
+   let realInteract :: [String] -> [String]
+       realInteract [] = []
+       realInteract ("QUIT":_) = ["Goodbye!"]
+       realInteract ("easeregg":_) = ["Yow!"]
+       realInteract (x:xs) = map toUpper x : realInteract xs
+       in
+       ("Welcome to the uppercase server.  I'll echo everything back to\n" ++
+         "you in uppercase.  When done, just type \"QUIT\" to exit.\n") :
+         realInteract (map rstrip inp)
+
+realhandler h = do hLineInteract h h lineInteraction
+                   hClose h
+handler = threadedHandler $ loggingHandler "main" INFO $ handleHandler $
+            realhandler
+main = do updateGlobalLogger "main" (setLevel DEBUG)
+          serveTCPforever ((simpleInetOptions 12345) {reuse = True}) handler
diff --git a/test3.hs b/test3.hs
new file mode 100644
index 0000000..9fee0d7
--- /dev/null
+++ b/test3.hs
@@ -0,0 +1,35 @@
+-- example code 3 for socketserver
+import MissingH.Network.SocketServer
+import MissingH.IO
+import MissingH.Logging.Logger
+import Data.Char
+import System.IO
+import MissingH.Str
+import System.Time
+
+realhandler h = 
+    let loop = do e <- hIsEOF h
+                  if e then return ()
+                     else do c <- hGetLine h
+                             case (rstrip c) of 
+                                 "QUIT" -> hPutStr h "Goodbye!\n"
+                                 "COMMANDS" -> do hPutStrLn h "You can type TIME for the current time"
+                                                  loop
+                                 "TIME" -> do ct <- getClockTime
+                                              calt <- toCalendarTime ct
+                                              hPutStrLn h $ calendarTimeToString calt
+                                              loop
+                                 x -> do hPutStrLn h (map toUpper x)
+                                         loop
+        in do hPutStrLn h "Welcome to the uppercase server.  I'll echo"
+              hPutStrLn h "everything back to you in uppercase.  When done,"
+              hPutStrLn h "just type \"QUIT\" to exit."
+              hPutStrLn h "You can also type \"COMMANDS\" for some fun stuff."
+              hPutStrLn h ""
+              loop
+              hClose h
+
+handler = threadedHandler $ loggingHandler "main" INFO $ handleHandler $
+            realhandler
+main = do updateGlobalLogger "main" (setLevel DEBUG)
+          serveTCPforever ((simpleInetOptions 12345) {reuse = True}) handler

-- 
haskell-testpack