cached outgoing presence messages until socket becomes available.

1 files changed, 5 insertions, 54 deletions

diff --git a/Presence/AdaptServer.hs b/Presence/AdaptServer.hs
index da3ab523..2ef07038 100644
--- a/Presence/AdaptServer.hs
+++ b/Presence/AdaptServer.hs
@@ -3,9 +3,9 @@
 module AdaptServer where
 
 import Data.IORef
-import Debug.Trace
+-- import Debug.Trace
 import Data.HList
-import Network.Socket (Socket)
+-- import Network.Socket (Socket)
 import qualified Data.ByteString.Lazy.Char8 as L
 import ByteStringOperators
 
@@ -18,46 +18,6 @@ adaptDoCon (dropTill,lex,parse) g st bs cont = do
     putStrLn $ "packet: " ++ show bs
     let (HCons rsRef st') = st
     rs <- readIORef rsRef
-    {- parse error 
-     - ( "Expected <? but found <\n  in file remote-inbound  at line 1 col 1"
-     - , Chunk "<presence from='" Empty ,
-     -
-     - [(file remote-inbound  at line 1 col 1 ,<)
-     - ,(file remote-inbound  at line 1 col 2 ,presence)
-     - ,(file remote-inbound  at line 1 col 11 ,from)
-     - ,(file remote-inbound  at line 1 col 15 ,=)
-     - ,(file remote-inbound  at line 1 col 16 ,' or ")
-     - ,(file remote-inbound  at line 1 col 17 ,Lexical error:
-     -   unexpected EOF while looking for closing token '
-     -     to match the opening token in file remote-inbound  at line 1 col 17)
-     - ]
-     -
-     - )
-     -}
-    -- rs' =
-    -- ,[(file remote-inbound  at line 1 col 2 ,presence)
-    -- ,(file remote-inbound  at line 1 col 11 ,from)
-    -- ,(file remote-inbound  at line 1 col 15 ,=)
-    -- ,(file remote-inbound  at line 1 col 16 ,' or ")
-    -- ,(file remote-inbound  at line 1 col 17 ,Lexical error:
-    --   unexpected EOF while looking for closing token '
-    --   to match the opening token in file remote-inbound  at line 1 col 17)
-    -- ]
-    -- )
-    -- let parse' ls = let (e,rs') = parse ls
-
-    {- parse error ("Expected <? but found <\n  in file remote-inbound  at line 1 col 1"
-     - ,Chunk "<presence from='" Empty
-     - ,[(file remote-inbound  at line 1 col 1 ,<)
-     - ,(file remote-inbound  at line 1 col 2 ,presence)
-     - ,(file remote-inbound  at line 1 col 11 ,from)
-     - ,(file remote-inbound  at line 1 col 15 ,=)
-     - ,(file remote-inbound  at line 1 col 16 ,' or ")]
-     - ,[(file remote-inbound  at line 1 col 2 ,presence)
-     - ,(file remote-inbound  at line 1 col 11 ,from)
-     - ,(file remote-inbound  at line 1 col 15 ,=)
-     - ,(file remote-inbound  at line 1 col 16 ,' or ")])
-     -}
 
     let contR rem v = do
             writeIORef rsRef rem
@@ -67,24 +27,15 @@ adaptDoCon (dropTill,lex,parse) g st bs cont = do
           case e of
               Left err -> if null rs'
                             then contR "" ()
-                            else trace ("parse error "++show (err,bs,lexemes,rs')) $ do
+                            else -- trace ("parse error "++show (err,bs,lexemes,rs')) $ do
                                     contR rem ()
               Right e -> do
                 -- writeIORef rsRef rs'
                 g st' e (\() -> loop (dropTill rem rs') rs')
         loop rem [] = contR "" ()
     let buf = rs <++> bs
-    when (L.length buf < 4096)
+    when (L.length buf < 8192)
          (loop buf (lex buf))
 
-{-
-adaptServer ::
-  (Show err, Show raw,Show lexemes)
-    =>
-      (raw -> [lexemes], [lexemes] -> (Either err msg, [lexemes]))
-      -> (Socket -> st -> IO st', 
-          st' -> msg -> (()->IO ()) -> IO ())
-      -> (Socket -> st -> IO (HCons (IORef [lexemes]) st'),
-          HCons (IORef [lexemes]) st' -> raw -> (()->IO ()) -> IO ())
--}
+
 adaptServer (dropTill,lex,parse) (startCon,doCon) = (adaptStartCon startCon, adaptDoCon (dropTill,lex,parse) doCon)