repace Parsec with Attoparsec

Author: banacorn

Web/SocketIO/Protocol.hs

@@ -10,24 +10,21 @@ import              Web.SocketIO.Types
 --------------------------------------------------------------------------------
 import              Control.Applicative                     ((<$>), (<*>))
 import              Data.Aeson
-import qualified    Data.ByteString.Lazy                    as B
 import qualified    Data.ByteString.Lazy                    as BL
 --import              Text.Parsec
 --import              Text.Parsec.ByteString.Lazy
 import              Data.Attoparsec.ByteString.Lazy
+import              Data.Attoparsec.ByteString.Char8        (digit, decimal)
 import              Prelude                                 hiding (take)
 
-
-parseMessage = undefined
---parsePath = undefined
 --------------------------------------------------------------------------------
 -- | Parse raw ByteString to Messages
 parseFramedMessage :: BL.ByteString -> Framed Message
 parseFramedMessage input = if isSingleton
     then Framed $ [parseMessage' input]
     else Framed $ map parseMessage' splitted
     where   splitted = split input
-            parseMessage' x = case (eitherResult . parse parseMessage) x of
+            parseMessage' x = case (eitherResult . parse messageParser) x of
                 Left _  -> MsgNoop
                 Right a -> a
             isSingleton = not (BL.null input) && BL.head input /= 239
@@ -44,114 +41,74 @@ split str = map (BL.drop 2) . skipOddIndexed True . filter isDelimiter . BL.spli
 
 ----------------------------------------------------------------------------------
 ---- | Message, not framed
---parseMessage :: Parser Message
---parseMessage = do
---    n <- digit
---    case n of
---        '0' ->  (parseID >> parseEndpoint >>= return . MsgDisconnect)
---            <|> (                  return $ MsgDisconnect NoEndpoint)
---        '1' ->  (parseID >> parseEndpoint >>= return . MsgConnect)
---            <|> (                  return $ MsgConnect NoEndpoint)
---        '2' ->  return MsgHeartbeat
---        '3' ->  parseRegularMessage Msg
---        '4' ->  parseRegularMessage MsgJSON
---        '5' ->  MsgEvent    <$> parseID 
---                            <*> parseEndpoint 
---                            <*> parseEvent
---        '6' ->  try (do 
---                string ":::"
---                n' <- read <$> number
---                char '+'
---                d <- fromString <$> text
---                return $ MsgACK (ID n') (Data d)
---            ) <|> (do
---                string ":::"
---                n' <- read <$> number
---                return $ MsgACK (ID n') NoData
---            )
---        '7' -> colon >> MsgError <$> parseEndpoint <*> parseData
---        '8' ->  return $ MsgNoop
---        _   ->  return $ MsgNoop
---    where   parseRegularMessage ctr = ctr <$> parseID 
---                                          <*> parseEndpoint 
---                                          <*> parseData
-
-----------------------------------------------------------------------------------
---endpoint :: Parser String
---endpoint = many1 $ satisfy (/= ':')
-
-----------------------------------------------------------------------------------
---number :: Parser String
---number = many1 digit
-
-----------------------------------------------------------------------------------
---colon :: Parser Char
---colon = char ':'
-
-----------------------------------------------------------------------------------
---parseID :: Parser ID
---parseID  =  try (colon >> number >>= plus >>= return . IDPlus . read)
---        <|> try (colon >> number          >>= return . ID . read)
---        <|>     (colon >>                     return   NoID)
---        where   plus n = char '+' >> return n 
-
-----------------------------------------------------------------------------------
---parseEndpoint :: Parser Endpoint
---parseEndpoint    =  try (colon >> fromString <$> endpoint >>= return . Endpoint)
---                <|>     (colon >>                             return   NoEndpoint)
-
-----------------------------------------------------------------------------------
---parseData :: Parser Data
---parseData    =  try (colon >> text >>= return . Data . fromString)
---            <|>     (colon >>      return   NoData)
-
-----------------------------------------------------------------------------------
---parseEvent :: Parser Event
---parseEvent = try (do
---                colon
---                t <- text
---                case decode (fromString t) of
---                    Just e -> return e
---                    Nothing -> return NoEvent
---            )
---            <|>     (colon >>          return   NoEvent)
-
-
-----------------------------------------------------------------------------------
----- | Slashes as delimiters
---textWithoutSlash :: Parser String
---textWithoutSlash = many1 $ satisfy (/= '/')
+messageParser :: Parser Message
+messageParser = do
+    n <- digit
+    case n of
+        '0' -> choice
+            [   idParser >> endpointParser >>= return . MsgDisconnect
+            ,                                  return $ MsgDisconnect NoEndpoint
+            ]
+        '1' -> choice
+            [   idParser >> endpointParser >>= return . MsgConnect
+            ,                                  return $ MsgConnect NoEndpoint 
+            ]
+        '2' -> return MsgHeartbeat
+        '3' -> Msg          <$> idParser 
+                            <*> endpointParser 
+                            <*> dataParser
+        '4' -> MsgJSON      <$> idParser 
+                            <*> endpointParser 
+                            <*> dataParser
+        '5' -> MsgEvent     <$> idParser 
+                            <*> endpointParser 
+                            <*> eventParser
+        '6' -> choice
+            [   do  string ":::"
+                    d <- decimal
+                    x <- takeTillEnd
+                    return $ MsgACK (ID d) (Data x)
+            ,   do  string ":::"
+                    d <- decimal
+                    return $ MsgACK (ID d) NoData
+            ]
+        '7' -> string ":" >> MsgError <$> endpointParser <*> dataParser
+        '8' -> return MsgNoop
+        _   -> return MsgNoop
+
+idParser :: Parser ID
+idParser = choice
+    [   string ":" >> decimal >>= plus >>= return . IDPlus
+    ,   string ":" >> decimal          >>= return . ID
+    ,   string ":" >>                      return   NoID
+    ]
+    where   plus n = string "+" >> return n
 
---slash :: Parser Char
---slash = char '/'
+endpointParser :: Parser Endpoint
+endpointParser = do
+    string ":"
+    option NoEndpoint (takeWhile1 (/= 58) >>= return . Endpoint)
 
-----------------------------------------------------------------------------------
----- | Non-empty text
---text :: Parser String
---text = many1 anyChar
+dataParser :: Parser Data
+dataParser = do
+    string ":"
+    option NoData (takeWhile1 (/= 58) >>= return . Data)
 
-a :: ByteString
-a = ":{\"name\":\"hey\",\"args\":[\"haha\"]}"
 eventParser :: Parser Event
 eventParser = do
     string ":"
-    t <- takeTill (== 32)
+    t <- takeTillEnd
     case decode (serialize t) of
         Just e  -> return e
         Nothing -> return NoEvent
 
-
-test p = parseOnly p
-
 ------------------------------------------------------------------------------               
 -- | Parse given HTTP request
 parsePath :: ByteString -> Path
 parsePath p = case parseOnly pathParser p of
     Left _  -> WithoutSession "" ""
     Right x -> x 
 
-------------------------------------------------------------------------------
--- | "/:namespace/:protocol/[:transport/:sessionID]" -> Path
 pathParser :: Parser Path
 pathParser = do
     string "/"