network-attoparsec 0.9.2 → 0.10.0

raw patch · 3 files changed

+116/−79 lines, 3 filesdep +enclosed-exceptionsdep +lifted-basedep +monad-controlPVP ok

version bump matches the API change (PVP)

Dependencies added: enclosed-exceptions, lifted-base, monad-control, transformers

API changes (from Hackage documentation)

Files

• network-attoparsec.cabal +8/−1
• src/Network/Attoparsec.hs +33/−11
• test/Network/AttoparsecSpec.hs +75/−67

@@ -1,6 +1,6 @@ name: network-attoparsec
 category: Network, Parsing
-version: 0.9.2
+version: 0.10.0
 license: MIT
 license-file: LICENSE
 copyright: (c) 2015 Leon Mergen
@@ -24,6 +24,11 @@   exposed-modules:     Network.Attoparsec
 
   build-depends:       base                     >= 4.3          && < 5
+                     , lifted-base
+                     , monad-control
+                     , transformers
+                     , enclosed-exceptions
+                     , exceptions
 
                      , mtl
                      , network
@@ -45,6 +50,8 @@                      , hspec
 
                      , exceptions
+                     , enclosed-exceptions
+                     , transformers
                      , bytestring
                      , mtl
                      , network

@@ -15,7 +15,9 @@ 
 module Network.Attoparsec (ParseC, parseMany, parseOne) where
 
-import           Control.Monad.Error
+import           Control.Monad.IO.Class
+import           Control.Monad.Catch
+import           Control.Exception.Enclosed (tryAny)
 
 import qualified Data.ByteString            as BS
 import qualified Network.Socket             as NS
@@ -45,13 +47,13 @@ --
 --   For more usage examples, see the test directory.
 parseMany :: ( MonadIO m
-             , MonadError String m)
+             , MonadMask m)
           => NS.Socket         -- ^ Socket to read data from
           -> ParseC a          -- ^ Initial parser state
           -> ParseC a          -- ^ Continuation parser state
           -> m (ParseC a, [a]) -- ^ Next parser state with parsed values
 parseMany s p0 pCur = do
-  buf <- liftIO $ NSB.recv s 4096
+  buf <- readAvailable s
   (p1, xs) <- parseBuffer p0 Many buf pCur
   return (p1, xs)
 
@@ -68,17 +70,21 @@ --
 --  > doParse sock = parseOne sock (AttoParsec.parse myParser)
 parseOne :: ( MonadIO m
-            , MonadError String m)
+            , MonadMask m)
          => NS.Socket -- ^ Socket to read data from
          -> ParseC a  -- ^ Initial parser state
          -> m a       -- ^ Parsed value
 parseOne s p0 = do
-  buf <- liftIO $ NSB.recv s 4096
+  liftIO $ putStrLn ("attemtpgin to read buffer in parseOne...")
+  buf <- readAvailable s
+  liftIO $ putStrLn ("read buffer: " ++ show buf)
   (p1, value) <- parseBuffer p0 Single buf p0
 
   case value of
    -- We do not yet have enough data for a single item, let's request more
-   []  -> parseOne s p1
+   []  -> do
+     liftIO $ putStrLn "entering recursion, parsing next"
+     parseOne s p1
    [x] -> return x
 
    -- This is an internal error, since it means our single-object parser
@@ -86,7 +92,7 @@    _   -> error "More than one element parsed"
 
 parseBuffer :: ( MonadIO m
-               , MonadError String m)
+               , MonadMask m)
             => ParseC a          -- ^ Initial parser state
             -> ParseMode         -- ^ Whether to perform greedy or non-greedy parsing
             -> BS.ByteString     -- ^ Unconsumed buffer from previous run
@@ -97,9 +103,11 @@   let next bCur pCur =
         case pCur bCur of
          -- On error, throw error through MonadError
-         Atto.Fail    err _ _  -> throwError ("An error occured while parsing input: " ++ show err)
-         Atto.Partial p1       -> return (p1, [])
-         Atto.Done    b1 v     ->
+         Atto.Fail    err _ _  -> do
+           fail ("An error occurred while parsing: " ++ show err)
+         Atto.Partial p1       -> do
+           return (p1, [])
+         Atto.Done    b1 v     -> do
            if BS.null b1
              -- This means a "perfect parse" occured: exactly enough data was on
              -- the socket to complete one parse round.
@@ -111,7 +119,7 @@                    --
                    -- We throw an error, since within "single-object parsing mode"
                    -- we assume only perfect parses happen.
-                   Single -> throwError ("Unconsumed data left on socket: " ++ show b1)
+                   Single -> fail ("Unconsumed data left on socket: " ++ show b1)
 
                    -- Multi-object parsing mode, in which case we will enter
                    -- recursion.
@@ -120,3 +128,17 @@                      return (p1, v : xs)
 
   in next
+
+readAvailable :: ( MonadIO m
+                 , MonadMask m)
+              => NS.Socket
+              -> m BS.ByteString
+readAvailable s =
+  let doRead  = NSB.recv s 4096
+      tryRead = tryAny doRead
+
+  in do
+    conn <- liftIO $ NS.isConnected s
+    liftIO $ putStrLn ("now reading from socket, connected = " ++ show conn)
+    res <- liftIO tryRead
+    either throwM return res

@@ -2,10 +2,11 @@ 
 module Network.AttoparsecSpec where
 
-import           Control.Concurrent               (forkIO, killThread,
-                                                   threadDelay)
+import           Control.Concurrent               (ThreadId, forkIO, killThread,
+                                                   threadDelay, myThreadId)
+
+import           Control.Monad.IO.Class
 import           Control.Monad.Catch
-import           Control.Monad.Error
 
 import qualified Data.Attoparsec.ByteString       as Atto
 
@@ -20,32 +21,52 @@ 
 pairSockets :: ( MonadIO m
                , MonadMask m)
-            => (NS.Socket -> IO a)
-            -> (NS.Socket -> IO b)
-            -> m b
-pairSockets writeCallback readCallback = do
-  serverThread <- liftIO $ forkIO $ NS.listen "*" "1234" (\(lsock, _) ->
-                                                           NS.accept lsock (\pair -> do
-                                                                                     _ <- writeCallback (fst pair)
-                                                                                     return ()))
+            => (NS.Socket -> IO r0)
+            -> (NS.Socket -> m r1)
+            -> m r1
+pairSockets writeCallback readCallback =
+  let
+    handleWrite :: NS.Socket -> IO ()
+    handleWrite s = do
+      putStrLn "handling writing"
+      _ <- writeCallback s
+      myTid <- myThreadId
+      putStrLn ("handled write, my thread id = " ++ show myTid)
+      return ()
 
-  liftIO $ threadDelay 100000
+    handleRead s = do
+      result <- readCallback s
+      return result
 
-  result <- NS.connect "127.0.0.1" "1234" (\pair -> liftIO $ readCallback  (fst pair))
+    handleServer :: IO ThreadId
+    handleServer =
+      return =<< forkIO $ NS.listen "*" "1234" $ \(lsock, _) ->
+                                                  NS.accept lsock (handleWrite . fst)
 
-  liftIO $ killThread serverThread
+  in do
+    liftIO $ putStrLn "starting server"
+    serverThread <- liftIO $ handleServer
 
-  return result
+    liftIO $ putStrLn ("started server, thread id = " ++ show serverThread)
+    liftIO $ threadDelay 100000
 
+    result <- NS.connect "127.0.0.1" "1234" (handleRead . fst)
+
+    liftIO $ putStrLn "killing server"
+    liftIO $ killThread serverThread
+    liftIO $ putStrLn "killed server"
+
+    return result
+
 spec :: Spec
 spec = do
   describe "when parsing a single object" $ do
     it "it should work with correct data" $
       let writeSocket s = NS.send s "1234"
-          readSocket s  = runErrorT $ Atto.parseOne s (Atto.parse numberParser)
+          readSocket s  = Atto.parseOne s (Atto.parse numberParser)
           numberParser  = decimal
 
-      in (pairSockets writeSocket readSocket) `shouldReturn` Right 1234
+      in (pairSockets writeSocket readSocket) `shouldReturn` 1234
 
     it "it should work with partial data" $
       let writeSocket s = do
@@ -53,105 +74,92 @@             threadDelay 100000
             NS.send s "34"
 
-          readSocket s  = runErrorT $ Atto.parseOne s (Atto.parse numberParser)
+          readSocket s  = Atto.parseOne s (Atto.parse numberParser)
           numberParser  = decimal
 
-      in (pairSockets writeSocket readSocket) `shouldReturn` Right 1234
+      in (pairSockets writeSocket readSocket) `shouldReturn` 1234
 
-    it "it should leave unconsumed data in tact" $
-      let writeSocket s = do
-            NS.send s "1234ab"
+    it "it should expect no unconsumed data" $
+      let writeSocket s = NS.send s "1234ab"
 
-          readSocket s  = runErrorT $ Atto.parseOne s (Atto.parse numberParser)
+          readSocket s  = Atto.parseOne s (Atto.parse numberParser)
           numberParser  = decimal
 
-      in (pairSockets writeSocket readSocket) `shouldReturn` Left "Unconsumed data left on socket: \"ab\""
+      in (pairSockets writeSocket readSocket) `shouldThrow` anyIOException
 
     it "it should throw an error when the provided data is incorrect" $
-      let writeSocket s = do
-            NS.send s "ab"
-
-          readSocket s  = runErrorT $ Atto.parseOne s (Atto.parse numberParser)
+      let writeSocket s = NS.send s "ab"
+          readSocket s  = Atto.parseOne s (Atto.parse numberParser)
           numberParser  = decimal
 
-      in (pairSockets writeSocket readSocket) `shouldReturn` Left "An error occured while parsing input: \"ab\""
+      in (pairSockets writeSocket readSocket) `shouldThrow` anyIOException
 
+    it "it should throw an error when the socket is closed before parsing could be completed" $
+      let writeSocket s = NS.send s "12"
+          readSocket s  = Atto.parseOne s (Atto.parse numberParser)
+          numberParser  = do
+            _ <- "1234"
+            _ <- endOfLine
+            return ()
 
-  describe "when providing multiple matching objects" $ do
+      in (pairSockets writeSocket readSocket) `shouldThrow` anyIOException
+
+  describe "when parsing multiple matching objects" $ do
+    let numberParser :: Atto.Parser Integer
+        numberParser = do
+          num <- decimal
+          endOfLine
+          return num
+
     it "should return error when using single object parser" $
       let writeSocket s = NS.send s "1234\n5678\n"
-          readSocket s  = runErrorT $ Atto.parseOne s (Atto.parse numberParser)
-          numberParser  = do
-            num <- decimal
-            endOfLine
-            return num
+          readSocket s  = Atto.parseOne s (Atto.parse numberParser)
 
-      in (pairSockets writeSocket readSocket) `shouldReturn` Left "Unconsumed data left on socket: \"5678\\n\""
+      in (pairSockets writeSocket readSocket) `shouldThrow` anyIOException
 
     it "should return multiple objects when using multi object parser" $
       let writeSocket s = NS.send s "1234\n5678\n"
-          readSocket s  = runErrorT $ do
+          readSocket s  = do
             (_, xs) <- Atto.parseMany s (Atto.parse numberParser) (Atto.parse numberParser)
             return xs
-          numberParser  = do
-            num <- decimal
-            endOfLine
-            return num
-
-      in (pairSockets writeSocket readSocket) `shouldReturn` Right [1234, 5678]
+      in (pairSockets writeSocket readSocket) `shouldReturn` [1234, 5678]
 
     it "should return single object when using multi object parser and providing partial data" $
       let writeSocket s = NS.send s "1234\n56"
-          readSocket s  = runErrorT $ do
+          readSocket s  = do
             (_, xs) <- Atto.parseMany s (Atto.parse numberParser) (Atto.parse numberParser)
             return xs
-          numberParser  = do
-            num <- decimal
-            endOfLine
-            return num
 
-      in (pairSockets writeSocket readSocket) `shouldReturn` Right [1234]
+      in (pairSockets writeSocket readSocket) `shouldReturn` [1234]
 
     it "should return multiple objects when using multi object parser and providing incremental data" $
       let writeSocket s = do
             _ <- NS.send s "1234\n56"
             threadDelay 100000
             NS.send s "78\n9012\n"
-          readSocket s  = runErrorT $ do
+          readSocket s  = do
             (p, xs1) <- Atto.parseMany s (Atto.parse numberParser) (Atto.parse numberParser)
             (_, xs2) <- Atto.parseMany s (Atto.parse numberParser) p
             return (xs1 ++ xs2)
-          numberParser  = do
-            num <- decimal
-            endOfLine
-            return num
 
-      in (pairSockets writeSocket readSocket) `shouldReturn` Right [1234, 5678, 9012]
+      in (pairSockets writeSocket readSocket) `shouldReturn` [1234, 5678, 9012]
 
     it "should return nothing objects when using multi object parser and providing not enough data" $
       let writeSocket s = NS.send s "12"
-          readSocket s  = runErrorT $ do
+          readSocket s  = do
             (_, xs) <- Atto.parseMany s (Atto.parse numberParser) (Atto.parse numberParser)
             return xs
-          numberParser  = do
-            num <- decimal
-            endOfLine
-            return num
 
-      in (pairSockets writeSocket readSocket) `shouldReturn` Right []
+      in (pairSockets writeSocket readSocket) `shouldReturn` []
 
     it "should return one object when using multi object parser and providing incremental data" $
       let writeSocket s = do
             _ <- NS.send s "12"
             threadDelay 100000
             NS.send s "34\n"
-          readSocket s  = runErrorT $ do
+          readSocket s  = do
             (p, xs1) <- Atto.parseMany s (Atto.parse numberParser) (Atto.parse numberParser)
             (_, xs2) <- Atto.parseMany s (Atto.parse numberParser) p
             return (xs1 ++ xs2)
-          numberParser  = do
-            num <- decimal
-            endOfLine
-            return num
 
-      in (pairSockets writeSocket readSocket) `shouldReturn` Right [1234]
+      in (pairSockets writeSocket readSocket) `shouldReturn` [1234]