diff options
Diffstat (limited to 'KikiD')
-rw-r--r-- | KikiD/ClientState.hs | 14 | ||||
-rw-r--r-- | KikiD/Message.hs | 7 |
2 files changed, 20 insertions, 1 deletions
diff --git a/KikiD/ClientState.hs b/KikiD/ClientState.hs new file mode 100644 index 0000000..a80a392 --- /dev/null +++ b/KikiD/ClientState.hs | |||
@@ -0,0 +1,14 @@ | |||
1 | module KikiD.ClientState where | ||
2 | |||
3 | import KikiD.Message | ||
4 | import Control.Concurrent.STM.TBMQueue | ||
5 | import Control.Concurrent | ||
6 | |||
7 | data ClientState = CState {cliQueue :: TBMQueue KikiDMessage} | ||
8 | |||
9 | mkClient = CState | ||
10 | { cliQueue = error "ERROR CState: cliQueue parameter is required" | ||
11 | } | ||
12 | |||
13 | type ClientID = ThreadId | ||
14 | threadIdToClient = id | ||
diff --git a/KikiD/Message.hs b/KikiD/Message.hs index cd3ee71..efefdc6 100644 --- a/KikiD/Message.hs +++ b/KikiD/Message.hs | |||
@@ -12,6 +12,7 @@ import Data.Bytes.Put as Put | |||
12 | import Data.Bytes.Get as Get | 12 | import Data.Bytes.Get as Get |
13 | import Codec.LineReady | 13 | import Codec.LineReady |
14 | import Control.Monad.Loops | 14 | import Control.Monad.Loops |
15 | import Data.Word | ||
15 | 16 | ||
16 | data KikiDMessage = TODO deriving (Show,Read) | 17 | data KikiDMessage = TODO deriving (Show,Read) |
17 | 18 | ||
@@ -31,7 +32,11 @@ instance Serialize KikiDMessage where | |||
31 | instance Serial KikiDMessage where | 32 | instance Serial KikiDMessage where |
32 | serialize m = Put.putByteString . toLineReady . Cereal.encode $ m | 33 | serialize m = Put.putByteString . toLineReady . Cereal.encode $ m |
33 | deserialize = do | 34 | deserialize = do |
34 | xs <- unfoldWhileM (/= '\n') (fmap (chr . fromIntegral) Get.getWord8) | 35 | xs <- unfoldM $ do |
36 | flag <- Get.isEmpty | ||
37 | if flag then return Nothing else do | ||
38 | c <- fmap (chr . fromIntegral) Get.getWord8 | ||
39 | if (c == '\n') then return Nothing else return (Just c) | ||
35 | case (Cereal.decode . fromLineReady $ B.pack xs) of | 40 | case (Cereal.decode . fromLineReady $ B.pack xs) of |
36 | Left str -> fail str | 41 | Left str -> fail str |
37 | Right x -> return x | 42 | Right x -> return x |