diff options
Diffstat (limited to 'KikiD/Message.hs')
-rw-r--r-- | KikiD/Message.hs | 35 |
1 files changed, 25 insertions, 10 deletions
diff --git a/KikiD/Message.hs b/KikiD/Message.hs index 5b642f3..cd3ee71 100644 --- a/KikiD/Message.hs +++ b/KikiD/Message.hs | |||
@@ -1,22 +1,37 @@ | |||
1 | {-# LANGUAGE DoAndIfThenElse #-} | ||
1 | module KikiD.Message where | 2 | module KikiD.Message where |
2 | 3 | ||
3 | import Data.Serialize | 4 | import Data.Serialize as Cereal |
4 | import qualified KikiD.GetLine | ||
5 | import qualified Data.ByteString.Char8 as B | 5 | import qualified Data.ByteString.Char8 as B |
6 | import Data.Monoid | 6 | import Data.Monoid |
7 | import Text.Read | 7 | import Text.Read |
8 | import Data.Char (ord) | 8 | import Data.Char (ord,chr) |
9 | import Control.Monad | 9 | import Control.Monad |
10 | import Data.Bytes.Serial as R | ||
11 | import Data.Bytes.Put as Put | ||
12 | import Data.Bytes.Get as Get | ||
13 | import Codec.LineReady | ||
14 | import Control.Monad.Loops | ||
10 | 15 | ||
11 | data KikiDMessage = TODO deriving (Show,Read) | 16 | data KikiDMessage = TODO deriving (Show,Read) |
12 | 17 | ||
13 | instance Serialize KikiDMessage where | 18 | instance Serialize KikiDMessage where |
14 | put m = mapM_ (putWord8 . fromIntegral . ord) "TODO" | 19 | put m = mapM_ (Cereal.putWord8 . fromIntegral . ord) "TO\nO" |
15 | -- putByteString . B.pack $ show m ++ "\n" | 20 | -- putByteString . B.pack $ show m ++ "\n" |
16 | get = do | 21 | get = do |
17 | t <- getWord8 | 22 | t <- Cereal.getWord8 |
18 | o <- getWord8 | 23 | o <- Cereal.getWord8 |
19 | d <- getWord8 | 24 | d <- Cereal.getWord8 |
20 | o <- getWord8 | 25 | o <- Cereal.getWord8 |
21 | return TODO | 26 | let s = map (chr . fromIntegral) [t,o,d,o] |
22 | 27 | if "TO\nO" == s | |
28 | then return TODO | ||
29 | else fail ("Could not decode message: " ++ show s) | ||
30 | |||
31 | instance Serial KikiDMessage where | ||
32 | serialize m = Put.putByteString . toLineReady . Cereal.encode $ m | ||
33 | deserialize = do | ||
34 | xs <- unfoldWhileM (/= '\n') (fmap (chr . fromIntegral) Get.getWord8) | ||
35 | case (Cereal.decode . fromLineReady $ B.pack xs) of | ||
36 | Left str -> fail str | ||
37 | Right x -> return x | ||