equal
deleted
inserted
replaced
1 {-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} |
1 {-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} |
2 module ClientIO where |
2 module ClientIO where |
3 |
3 |
4 import qualified Control.Exception as Exception |
4 import qualified Control.Exception as Exception |
|
5 import Control.Monad.State |
5 import Control.Concurrent.Chan |
6 import Control.Concurrent.Chan |
6 import Control.Concurrent |
7 import Control.Concurrent |
7 import Control.Monad |
8 import Control.Monad |
8 import Network |
9 import Network |
9 import Network.Socket.ByteString |
10 import Network.Socket.ByteString |
15 |
16 |
16 |
17 |
17 pDelim :: B.ByteString |
18 pDelim :: B.ByteString |
18 pDelim = "\n\n" |
19 pDelim = "\n\n" |
19 |
20 |
20 bs2Packets :: B.ByteString -> ([[B.ByteString]], B.ByteString) |
21 bs2Packets = runState takePacks |
21 bs2Packets = unfoldrE extractPackets |
|
22 where |
|
23 extractPackets :: B.ByteString -> Either B.ByteString ([B.ByteString], B.ByteString) |
|
24 extractPackets buf = |
|
25 let buf' = until (not . B.isPrefixOf pDelim) (B.drop 2) buf in |
|
26 let (bsPacket, bufTail) = B.breakSubstring pDelim buf' in |
|
27 if B.null bufTail then |
|
28 Left bsPacket |
|
29 else |
|
30 if B.null bsPacket then |
|
31 Left bufTail |
|
32 else |
|
33 Right (B.splitWith (== '\n') bsPacket, bufTail) |
|
34 |
22 |
|
23 takePacks :: State B.ByteString [[B.ByteString]] |
|
24 takePacks |
|
25 = do modify (until (not . B.isPrefixOf pDelim) (B.drop 2)) |
|
26 packet <- state $ B.breakSubstring pDelim |
|
27 buf <- get |
|
28 if B.null buf then put packet >> return [] else |
|
29 if B.null packet then return [] else |
|
30 do packets <- takePacks |
|
31 return (B.splitWith (== '\n') packet : packets) |
35 |
32 |
36 listenLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO () |
33 listenLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO () |
37 listenLoop sock chan ci = recieveWithBufferLoop B.empty |
34 listenLoop sock chan ci = recieveWithBufferLoop B.empty |
38 where |
35 where |
39 recieveWithBufferLoop recvBuf = do |
36 recieveWithBufferLoop recvBuf = do |