kikid: Serialization...

1 files changed, 6 insertions, 37 deletions

diff --git a/KikiD/PortServer.hs b/KikiD/PortServer.hs
index 31101a7..b42e340 100644
--- a/KikiD/PortServer.hs
+++ b/KikiD/PortServer.hs
@@ -22,28 +22,13 @@ import Control.Monad.Loops
 import KikiD.Multiplex (pipeTransHookMicroseconds)
 import Control.Exception
 import Control.Concurrent.Async
-import Data.Serialize
+import Data.Bytes.Serial as R
+import Data.Bytes.Put as Put
 
 import Control.Arrow (second)
---import qualified Merv.GetLine as MG
 
-{-instance Serialize IRC.Message where
-    put = putByteString . IRC.encode
-    get = do
-        x <- MG.getLine
-        case IRC.decode x of
-            Just x -> return x
-            Nothing -> fail ("IRC PARSE ERROR:'" <> B.unpack x <> "'")
 
-
-createIRCPortListener :: PortNumber -> B.ByteString -> Int -> Int -> Int
-                   -> TBMQueue (ThreadId,TBMQueue IRC.Message) -> TBMQueue IRC.Message -> IO ()
-createIRCPortListener port name delay qsize maxconns postNewTChans outq = 
-  createTCPPortListener port name delay qsize maxconns postNewTChans outq ircReact
-
--}
-
-createTCPPortListener :: Serialize a => PortNumber -> B.ByteString -> Int -> Int -> Int
+createTCPPortListener :: Serial a => PortNumber -> B.ByteString -> Int -> Int -> Int
                    -> TBMQueue (ThreadId,TBMQueue a) -> TBMQueue a 
                    -> (Handle -> TBMQueue a -> IO ()) -> IO ()
 createTCPPortListener port name delay qsize maxconns postNewTChans outq react = 
@@ -65,7 +50,7 @@ createTCPPortListener port name delay qsize maxconns postNewTChans outq react =
         sockAcceptLoop sock name delay qsize postNewTChans outq react
         )
  
-sockAcceptLoop :: Serialize a => Socket -> B.ByteString -> Int -> Int -> TBMQueue (ThreadId,TBMQueue a) -> TBMQueue a 
+sockAcceptLoop :: Serial a => Socket -> B.ByteString -> Int -> Int -> TBMQueue (ThreadId,TBMQueue a) -> TBMQueue a 
                        -> (Handle -> TBMQueue a -> IO ()) -> IO ()
 sockAcceptLoop listenSock name delay qsize postNewTChans outq react = 
     whileM_ (atomically $ fmap not (isClosedTBMQueue postNewTChans)) $ do
@@ -98,7 +83,7 @@ sockAcceptLoop listenSock name delay qsize postNewTChans outq react =
                 waitBoth async1 async2
             )
  
-runConn :: Serialize a => Handle -> B.ByteString -> TBMQueue a -> TBMQueue a -> Int 
+runConn :: Serial a => Handle -> B.ByteString -> TBMQueue a -> TBMQueue a -> Int 
                        -> (Handle -> TBMQueue a -> IO ()) -> IO ()
 runConn hdl name q outq delay react = do
     --send sock (encode (Message Nothing "NOTICE" ["*", ("Hi " <> name <> "!\n")]))
@@ -115,7 +100,7 @@ runConn hdl name q outq delay react = do
             whileM_ pending  $ do
                 m <- atomically (readTBMQueue q)
                 case m of
-                    Just m -> B.hPutStrLn hdl (encode m) 
+                    Just m -> B.hPutStrLn hdl (runPutS $ R.serialize m) 
                     -- Nothing means the Queue is closed and empty, so dont loop
                     Nothing -> return () 
             threadDelay delay
@@ -127,19 +112,3 @@ runConn hdl name q outq delay react = do
         (whileM_ (atomically . fmap not $ isClosedTBMQueue outq) $ react hdl outq )
 
 
-{-
-ircReact hdl outq = do
-        line <- B.hGetLine hdl
-        -- debugging
-        dir <- getAppUserDataDirectory "merv"
-        tid <- myThreadId
-        let bQuit = (B.isPrefixOf "/quit") line
-        appendFile (dir </> "xdebug") 
-                   (printf "%s:%s\n(bQuit=%s) %s\n" (show tid) (show line) (show bQuit) (show $ IRC.parseMessage line))
-        -- end debugging
-        case IRC.decode line of
-            Just (IRC.msg_command -> "QUIT") -> atomically $ closeTBMQueue outq
-            Just m -> atomically $ writeTBMQueue outq m
-            Nothing | "/q" `B.isPrefixOf` line -> atomically $ closeTBMQueue outq
-            _ -> return undefined
--}