Marcos Dumay de Medeiros 8 years ago
parent
commit
ce82e0cbad

+ 2 - 2
src/System/IO/Uniform.hs

@@ -54,8 +54,8 @@ class UniformIO a where
 data SomeIO = forall a. (UniformIO a) => SomeIO a
 data SomeIO = forall a. (UniformIO a) => SomeIO a
 
 
 instance UniformIO SomeIO where
 instance UniformIO SomeIO where
-  uRead (SomeIO s) n = uRead s n
-  uPut (SomeIO s) t  = uPut s t
+  uRead (SomeIO s) = uRead s
+  uPut (SomeIO s)  = uPut s
   uClose (SomeIO s) = uClose s
   uClose (SomeIO s) = uClose s
   startTls set (SomeIO s) = SomeIO <$> startTls set s
   startTls set (SomeIO s) = SomeIO <$> startTls set s
   isSecure (SomeIO s) = isSecure s
   isSecure (SomeIO s) = isSecure s

+ 2 - 2
src/System/IO/Uniform/ByteString.hs

@@ -29,7 +29,7 @@ instance UniformIO ByteStringIO where
       ioError $ mkIOError eofErrorType "read past end of input" Nothing Nothing
       ioError $ mkIOError eofErrorType "read past end of input" Nothing Nothing
     else do
     else do
       let (r, i') = BS.splitAt n i
       let (r, i') = BS.splitAt n i
-      let eof' = (BS.null r && n > 0)
+      let eof' = BS.null r && n > 0
       putMVar (bsioinput s) (i', eof')
       putMVar (bsioinput s) (i', eof')
       return r
       return r
   uPut s t = do
   uPut s t = do
@@ -37,7 +37,7 @@ instance UniformIO ByteStringIO where
     let o' = mappend o $ BSBuild.byteString t
     let o' = mappend o $ BSBuild.byteString t
     putMVar (bsiooutput s) o'
     putMVar (bsiooutput s) o'
   uClose _ = return ()
   uClose _ = return ()
-  startTls _ a = return a
+  startTls _ = return
   isSecure _ = True
   isSecure _ = True
 
 
 -- | withByteStringIO' input f
 -- | withByteStringIO' input f

+ 4 - 4
src/System/IO/Uniform/External.hs

@@ -11,13 +11,13 @@ import System.Posix.Types (Fd(..))
 
 
 data Nethandler
 data Nethandler
 -- | A bounded IP port from where to accept SocketIO connections.
 -- | A bounded IP port from where to accept SocketIO connections.
-newtype BoundedPort = BoundedPort {lis :: (Ptr Nethandler)}
+newtype BoundedPort = BoundedPort {lis :: Ptr Nethandler}
 data Ds
 data Ds
 data TlsDs
 data TlsDs
 -- | UniformIO IP connections.
 -- | UniformIO IP connections.
-data SocketIO = SocketIO {sock :: (Ptr Ds)} | TlsSocketIO {bio :: (Ptr TlsDs)}
+data SocketIO = SocketIO {sock :: Ptr Ds} | TlsSocketIO {bio :: Ptr TlsDs}
 -- | UniformIO type for file IO.
 -- | UniformIO type for file IO.
-newtype FileIO = FileIO {fd :: (Ptr Ds)}
+newtype FileIO = FileIO {fd :: Ptr Ds}
 -- | UniformIO that reads from stdin and writes to stdout.
 -- | UniformIO that reads from stdin and writes to stdout.
 data StdIO = StdIO
 data StdIO = StdIO
 
 
@@ -36,7 +36,7 @@ foreign import ccall interruptible "createToIPv4Host" c_connect4 :: CUInt -> CIn
 foreign import ccall interruptible "createToIPv6Host" c_connect6 :: Ptr CUChar -> CInt -> IO (Ptr Ds)
 foreign import ccall interruptible "createToIPv6Host" c_connect6 :: Ptr CUChar -> CInt -> IO (Ptr Ds)
 
 
 foreign import ccall interruptible "startSockTls" c_startSockTls :: Ptr Ds -> CString -> CString -> CString -> IO (Ptr TlsDs)
 foreign import ccall interruptible "startSockTls" c_startSockTls :: Ptr Ds -> CString -> CString -> CString -> IO (Ptr TlsDs)
-foreign import ccall safe "getPeer" c_getPeer :: Ptr Ds -> Ptr CUInt -> Ptr CUChar -> Ptr CInt -> IO (CInt)
+foreign import ccall safe "getPeer" c_getPeer :: Ptr Ds -> Ptr CUInt -> Ptr CUChar -> Ptr CInt -> IO CInt
 
 
 --foreign import ccall safe "getFd" c_getFd :: Ptr Ds -> IO CInt
 --foreign import ccall safe "getFd" c_getFd :: Ptr Ds -> IO CInt
 --foreign import ccall safe "getTlsFd" c_getTlsFd :: Ptr TlsDs -> IO CInt
 --foreign import ccall safe "getTlsFd" c_getTlsFd :: Ptr TlsDs -> IO CInt

+ 15 - 18
src/System/IO/Uniform/File.hs

@@ -10,32 +10,29 @@ import Foreign
 import Foreign.C.String
 import Foreign.C.String
 import Foreign.C.Error
 import Foreign.C.Error
 import qualified Data.ByteString as BS
 import qualified Data.ByteString as BS
+import Control.Monad
 
 
 import System.Posix.Types (Fd(..))
 import System.Posix.Types (Fd(..))
 
 
 
 
 -- | UniformIO type for file IO.
 -- | UniformIO type for file IO.
 instance UniformIO FileIO where
 instance UniformIO FileIO where
-  uRead s n = do
-    allocaArray n (
-      \b -> do
-        count <- c_recv (fd s) b $ fromIntegral n
-        if count < 0
-          then throwErrno "could not read"
-          else  BS.packCStringLen (b, fromIntegral count)
-      )
-  uPut s t = do
-    BS.useAsCStringLen t (
-      \(str, n) -> do
-        count <- c_send (fd s) str $ fromIntegral n
-        if count < 0
-          then throwErrno "could not write"
-          else return ()
-      )
+  uRead s n = allocaArray n (
+    \b -> do
+      count <- c_recv (fd s) b $ fromIntegral n
+      if count < 0
+        then throwErrno "could not read"
+        else  BS.packCStringLen (b, fromIntegral count)
+    )
+  uPut s t = BS.useAsCStringLen t (
+    \(str, n) -> do
+      count <- c_send (fd s) str $ fromIntegral n
+      when (count < 0) $ throwErrno "could not write"
+    )
   uClose s = do
   uClose s = do
     f <- Fd <$> c_prepareToClose (fd s)
     f <- Fd <$> c_prepareToClose (fd s)
     closeFd f
     closeFd f
-  startTls _ f = return f
+  startTls _ = return
   isSecure _ = True
   isSecure _ = True
   
   
   
   
@@ -43,7 +40,7 @@ instance UniformIO FileIO where
 openFile :: String -> IO FileIO
 openFile :: String -> IO FileIO
 openFile fileName = do
 openFile fileName = do
   r <- withCString fileName (
   r <- withCString fileName (
-    \f -> fmap FileIO $ c_createFile f
+    fmap FileIO . c_createFile
     )
     )
   if fd r == nullPtr
   if fd r == nullPtr
     then throwErrno "could not open file"
     then throwErrno "could not open file"

+ 3 - 3
src/System/IO/Uniform/HandlePair.hs

@@ -23,10 +23,10 @@ fromHandles = HandlePair
 
 
 -- | UniformIO that reads from stdin and writes to stdout.
 -- | UniformIO that reads from stdin and writes to stdout.
 instance UniformIO HandlePair where
 instance UniformIO HandlePair where
-  uRead (HandlePair i _) n = BS.hGetSome i n
-  uPut (HandlePair _ o) t = BS.hPut o t
+  uRead (HandlePair i _) = BS.hGetSome i
+  uPut (HandlePair _ o) = BS.hPut o
   uClose (HandlePair i o) = do
   uClose (HandlePair i o) = do
     hClose i
     hClose i
     hClose o
     hClose o
-  startTls _ a = return a
+  startTls _ = return
   isSecure _ = True
   isSecure _ = True

+ 28 - 35
src/System/IO/Uniform/Network.hs

@@ -20,6 +20,7 @@ import qualified Data.IP as IP
 import qualified Data.ByteString as BS
 import qualified Data.ByteString as BS
 import qualified Data.List as L
 import qualified Data.List as L
 import Control.Exception
 import Control.Exception
+import Control.Monad
 import qualified Network.Socket as Soc
 import qualified Network.Socket as Soc
 import System.IO.Error
 import System.IO.Error
 
 
@@ -27,38 +28,30 @@ import System.Posix.Types (Fd(..))
 
 
 -- | UniformIO IP connections.
 -- | UniformIO IP connections.
 instance UniformIO SocketIO where
 instance UniformIO SocketIO where
-  uRead (SocketIO s) n = do
-    allocaArray n (
-      \b -> do
-        count <- c_recv s b (fromIntegral n)
-        if count < 0
-          then throwErrno "could not read"
-          else BS.packCStringLen (b, fromIntegral count)
-      )
-  uRead (TlsSocketIO s) n = do
-    allocaArray n (
-      \b -> do
-        count <- c_recvTls s b $ fromIntegral n
-        if count < 0
-          then throwErrno "could not read"
-          else BS.packCStringLen (b, fromIntegral count)
-      )
-  uPut (SocketIO s) t = do
-    BS.useAsCStringLen t (
-      \(str, n) -> do
-        count <- c_send s str $ fromIntegral n
-        if count < 0
-          then throwErrno "could not write"
-          else return ()
-      )
-  uPut (TlsSocketIO s) t = do
-    BS.useAsCStringLen t (
-      \(str, n) -> do
-        count <- c_sendTls s str $ fromIntegral n
-        if count < 0
-          then throwErrno "could not write"
-          else return ()
-      )
+  uRead (SocketIO s) n = allocaArray n (
+    \b -> do
+      count <- c_recv s b (fromIntegral n)
+      if count < 0
+        then throwErrno "could not read"
+        else BS.packCStringLen (b, fromIntegral count)
+    )
+  uRead (TlsSocketIO s) n = allocaArray n (
+    \b -> do
+      count <- c_recvTls s b $ fromIntegral n
+      if count < 0
+        then throwErrno "could not read"
+        else BS.packCStringLen (b, fromIntegral count)
+    )
+  uPut (SocketIO s) t = BS.useAsCStringLen t (
+    \(str, n) -> do
+      count <- c_send s str $ fromIntegral n
+      when (count < 0) $ throwErrno "could not write"
+    )
+  uPut (TlsSocketIO s) t = BS.useAsCStringLen t (
+    \(str, n) -> do
+      count <- c_sendTls s str $ fromIntegral n
+      when (count < 0) $ throwErrno "could not write"
+    )
   uClose (SocketIO s) = do
   uClose (SocketIO s) = do
     f <- Fd <$> c_prepareToClose s
     f <- Fd <$> c_prepareToClose s
     closeFd f
     closeFd f
@@ -107,8 +100,8 @@ connectToHost host port = do
 connectTo :: IP.IP -> Int -> IO SocketIO
 connectTo :: IP.IP -> Int -> IO SocketIO
 connectTo host port = do
 connectTo host port = do
   r <- case host of
   r <- case host of
-    IP.IPv4 host' -> fmap SocketIO $ c_connect4 (fromIntegral . IP.toHostAddress $ host') (fromIntegral port)
-    IP.IPv6 host' -> fmap SocketIO $ withArray (ipToArray host') (
+    IP.IPv4 host' -> SocketIO <$> c_connect4 (fromIntegral . IP.toHostAddress $ host') (fromIntegral port)
+    IP.IPv6 host' -> SocketIO <$> withArray (ipToArray host') (
       \add -> c_connect6 add (fromIntegral port)
       \add -> c_connect6 add (fromIntegral port)
       )
       )
   if sock r == nullPtr
   if sock r == nullPtr
@@ -145,7 +138,7 @@ bindPort port = do
 --  Accept clients on a port previously bound with bindPort.
 --  Accept clients on a port previously bound with bindPort.
 accept :: BoundedPort -> IO SocketIO
 accept :: BoundedPort -> IO SocketIO
 accept port = do
 accept port = do
-  r <- fmap SocketIO $ c_accept (lis port)
+  r <- SocketIO <$> c_accept (lis port)
   if sock r == nullPtr
   if sock r == nullPtr
     then throwErrno "could not accept connection"
     then throwErrno "could not accept connection"
     else return r
     else return r

+ 14 - 17
src/System/IO/Uniform/Std.hs

@@ -8,25 +8,22 @@ import System.IO.Uniform.External
 import Foreign
 import Foreign
 import Foreign.C.Error
 import Foreign.C.Error
 import qualified Data.ByteString as BS
 import qualified Data.ByteString as BS
+import Control.Monad
 
 
 -- | UniformIO that reads from stdin and writes to stdout.
 -- | UniformIO that reads from stdin and writes to stdout.
 instance UniformIO StdIO where
 instance UniformIO StdIO where
-  uRead _ n = do
-    allocaArray n (
-      \b -> do
-        count <- c_recvStd b (fromIntegral n)
-        if count < 0
-          then throwErrno "could not read"
-          else BS.packCStringLen (b, fromIntegral count)
-      )
-  uPut _ t = do
-    BS.useAsCStringLen t (
-      \(str, n) -> do
-        count <- c_sendStd str $ fromIntegral n
-        if count < 0
-          then throwErrno "could not write"
-          else return ()
-      )
+  uRead _ n = allocaArray n (
+    \b -> do
+      count <- c_recvStd b (fromIntegral n)
+      if count < 0
+        then throwErrno "could not read"
+        else BS.packCStringLen (b, fromIntegral count)
+    )
+  uPut _ t = BS.useAsCStringLen t (
+    \(str, n) -> do
+      count <- c_sendStd str $ fromIntegral n
+      when (count < 0) $ throwErrno "could not write"
+    )
   uClose _ = return ()
   uClose _ = return ()
-  startTls _ a = return a
+  startTls _ = return
   isSecure _ = True
   isSecure _ = True

+ 14 - 84
src/System/IO/Uniform/Streamline.hs

@@ -35,9 +35,6 @@ module System.IO.Uniform.Streamline (
   scan',
   scan',
   recieveTill,
   recieveTill,
   recieveTill',
   recieveTill',
-  -- ** Deprecated functions
-  lazyRecieveLine,
-  lazyRecieveN,
   -- * Behavior settings
   -- * Behavior settings
   startTls,
   startTls,
   isSecure,
   isSecure,
@@ -63,7 +60,6 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString.Lazy as LBS
 import Data.Word8 (Word8)
 import Data.Word8 (Word8)
 import Data.IP (IP)
 import Data.IP (IP)
-import qualified Data.Char as C
 
 
 import qualified Data.Attoparsec.ByteString as A
 import qualified Data.Attoparsec.ByteString as A
 
 
@@ -184,7 +180,7 @@ send r = Streamline $ \cl -> do
 send' :: MonadIO m => LBS.ByteString -> Streamline m ()
 send' :: MonadIO m => LBS.ByteString -> Streamline m ()
 send' r = Streamline $ \cl -> do
 send' r = Streamline $ \cl -> do
   let dd = LBS.toChunks r
   let dd = LBS.toChunks r
-  mapM (writeF cl) dd
+  mapM_ (writeF cl) dd
   return ((), cl)
   return ((), cl)
 
 
 {- |
 {- |
@@ -254,29 +250,6 @@ recieveLine = recieveTill "\n"
 recieveLine' :: MonadIO m => Streamline m LBS.ByteString
 recieveLine' :: MonadIO m => Streamline m LBS.ByteString
 recieveLine' = recieveTill' "\n"
 recieveLine' = recieveTill' "\n"
 
 
--- | Use recieveLine'.
-lazyRecieveLine :: MonadIO m => Streamline m [ByteString]
-{-# DEPRECATED #-}
-lazyRecieveLine = Streamline $ \cl -> lazyRecieveLine' cl
-  where
-    lazyRecieveLine' :: MonadIO m => StreamlineState -> m ([ByteString], StreamlineState)
-    lazyRecieveLine' cl' = 
-      if isEOF cl'
-      then eofError "System.IO.Uniform.Streamline.lazyRecieveLine"
-      else
-        if BS.null $ buff cl'
-        then do
-          dt <- readF cl'
-          lazyRecieveLine' cl'{buff=dt}{isEOF=BS.null dt}
-        else do
-          let l = A.parseOnly lineWithEol $ buff cl'
-          case l of
-            Left _ -> do
-              l' <- readF cl'
-              (ret, cl'') <- lazyRecieveLine' cl'{buff=l'}{isEOF=BS.null l'}
-              return ((buff cl') : ret, cl'')
-            Right (ret, dt) -> return ([ret], cl'{buff=dt})
-
 -- | Recieves the given number of bytes.
 -- | Recieves the given number of bytes.
 recieveN :: MonadIO m => Int -> Streamline m ByteString
 recieveN :: MonadIO m => Int -> Streamline m ByteString
 recieveN n = LBS.toStrict <$> recieveN' n
 recieveN n = LBS.toStrict <$> recieveN' n
@@ -290,7 +263,7 @@ recieveN' n | n <= 0 = return ""
               return (LBS.fromChunks tt, cl')
               return (LBS.fromChunks tt, cl')
   where
   where
     recieve d b
     recieve d b
-      | isEOF d = eofError "System.IO.Uniform.Streamline.lazyRecieveN"
+      | isEOF d = eofError "System.IO.Uniform.Streamline.recieveN"
       | BS.null . buff $ d = do
       | BS.null . buff $ d = do
         dt <- readF d
         dt <- readF d
         recieve d{buff=dt}{isEOF=BS.null dt} b
         recieve d{buff=dt}{isEOF=BS.null dt} b
@@ -301,35 +274,6 @@ recieveN' n | n <= 0 = return ""
         (r, d') <- recieve d{buff=""} $ b - (BS.length . buff $ d)
         (r, d') <- recieve d{buff=""} $ b - (BS.length . buff $ d)
         return (buff d : r, d')
         return (buff d : r, d')
 
 
--- | Use recieveN'.
-lazyRecieveN :: (Functor m, MonadIO m) => Int -> Streamline m [ByteString]
-{-# DEPRECATED #-}
-lazyRecieveN n' = Streamline $ \cl' -> lazyRecieveN' cl' n'
-  where
-    lazyRecieveN' :: (Functor m, MonadIO m) => StreamlineState -> Int -> m ([ByteString], StreamlineState)
-    lazyRecieveN' cl n =
-      if isEOF cl
-      then eofError "System.IO.Uniform.Streamline.lazyRecieveN"
-      else
-        if BS.null (buff cl)
-        then do
-          b <- readF cl
-          let eof = BS.null b
-          let cl' = cl{buff=b}{isEOF=eof}
-          lazyRecieveN' cl' n
-        else
-          if n <= BS.length (buff cl)
-          then let
-            ret = [BS.take n (buff cl)]
-            buff' = BS.drop n (buff cl)
-            in return (ret, cl{buff=buff'})
-          else let
-            cl' = cl{buff=""}
-            b = buff cl
-            in fmap (appFst b) $ lazyRecieveN' cl' (n - BS.length b)
-    appFst :: a -> ([a], b) -> ([a], b)
-    appFst a (l, b) = (a:l, b)
-
 -- | Recieves data until it matches the argument.
 -- | Recieves data until it matches the argument.
 --   Returns all of it, including the matching data.
 --   Returns all of it, including the matching data.
 recieveTill :: MonadIO m => ByteString -> Streamline m ByteString
 recieveTill :: MonadIO m => ByteString -> Streamline m ByteString
@@ -337,7 +281,7 @@ recieveTill t = LBS.toStrict <$> recieveTill' t
 
 
 -- | Lazy version of recieveTill
 -- | Lazy version of recieveTill
 recieveTill' :: MonadIO m => ByteString -> Streamline m LBS.ByteString
 recieveTill' :: MonadIO m => ByteString -> Streamline m LBS.ByteString
-recieveTill' t = recieve . BS.unpack $ t
+recieveTill' = recieve . BS.unpack
   where
   where
     recieve t' = scan' [] (textScanner t')
     recieve t' = scan' [] (textScanner t')
 
 
@@ -360,7 +304,7 @@ runAttoparsecAndReturn p = Streamline $ \cl ->
     (cl', i, a) <- liftIO $ continueResult cl c
     (cl', i, a) <- liftIO $ continueResult cl c
     return ((i, a), cl')
     return ((i, a), cl')
   where
   where
-    continueResult :: StreamlineState -> A.Result a -> IO (StreamlineState, ByteString, (Either String a))
+    continueResult :: StreamlineState -> A.Result a -> IO (StreamlineState, ByteString, Either String a)
     -- tx eof ds 
     -- tx eof ds 
     continueResult cl c = case c of
     continueResult cl c = case c of
       A.Fail i _ msg -> return (cl{buff=i}, BS.take (BS.length (buff cl) - BS.length i) (buff cl), Left msg)
       A.Fail i _ msg -> return (cl{buff=i}, BS.take (BS.length (buff cl) - BS.length i) (buff cl), Left msg)
@@ -381,7 +325,7 @@ runAttoparsec p = Streamline $ \cl ->
     (cl', a) <- liftIO $ continueResult cl c
     (cl', a) <- liftIO $ continueResult cl c
     return (a, cl')
     return (a, cl')
   where
   where
-    continueResult :: StreamlineState -> A.Result a -> IO (StreamlineState, (Either String a))
+    continueResult :: StreamlineState -> A.Result a -> IO (StreamlineState, Either String a)
     continueResult cl c = case c of
     continueResult cl c = case c of
         A.Fail i _ msg -> return (cl{buff=i}, Left msg)
         A.Fail i _ msg -> return (cl{buff=i}, Left msg)
         A.Done i r -> return (cl{buff=i}, Right r)
         A.Done i r -> return (cl{buff=i}, Right r)
@@ -418,38 +362,24 @@ Setting to Nothing will disable echo.
 echoTo :: Monad m => Maybe Handle -> Streamline m ()
 echoTo :: Monad m => Maybe Handle -> Streamline m ()
 echoTo h = Streamline $ \cl -> return ((), cl{echo=h})
 echoTo h = Streamline $ \cl -> return ((), cl{echo=h})
 
 
-lineWithEol :: A.Parser (ByteString, ByteString)
-lineWithEol = do
-  l <- A.scan False lineScanner
-  r <- A.takeByteString
-  return (l, r)
-  
 eofError :: MonadIO m => String -> m a
 eofError :: MonadIO m => String -> m a
 eofError msg = liftIO . ioError $ mkIOError eofErrorType msg Nothing Nothing
 eofError msg = liftIO . ioError $ mkIOError eofErrorType msg Nothing Nothing
 
 
-lineScanner :: Bool -> Word8 -> Maybe Bool
-lineScanner False c 
-  | c == (fromIntegral . C.ord $ '\n') = Just True
-  | otherwise = Just False
-lineScanner True _ = Nothing
-
 {- |
 {- |
 Closes the target of a streamline state, releasing any used resource.
 Closes the target of a streamline state, releasing any used resource.
 -}
 -}
 close :: MonadIO m => StreamlineState -> m ()
 close :: MonadIO m => StreamlineState -> m ()
-close st = liftIO . S.uClose . str $ st
+close = liftIO . S.uClose . str
 
 
 {- |
 {- |
 Retrieves the remaining contents of a streamline state, closing it afterwards.
 Retrieves the remaining contents of a streamline state, closing it afterwards.
 -}
 -}
 remaining :: MonadIO m => StreamlineState -> m LBS.ByteString
 remaining :: MonadIO m => StreamlineState -> m LBS.ByteString
-remaining st =
-  if isEOF st then close st >> return LBS.empty
-  else
-    if BS.null . buff $ st
-    then do
-      dt <- readF st
-      remaining st{buff=dt}{isEOF=BS.null dt}
-    else do
-      dt' <- remaining st{buff=BS.empty}
-      return $ LBS.append (LBS.fromStrict . buff $ st) dt'
+remaining st
+  | isEOF st = close st >> return LBS.empty
+  | BS.null . buff $ st = do
+    dt <- readF st
+    remaining st{buff=dt}{isEOF=BS.null dt}
+  | otherwise = do
+    dt' <- remaining st{buff=BS.empty}
+    return $ LBS.append (LBS.fromStrict . buff $ st) dt'

+ 4 - 4
src/System/IO/Uniform/Streamline/Scanner.hs

@@ -29,7 +29,7 @@ instance Functor IOScannerState where
   fmap f (LastPass x) = LastPass $ f x
   fmap f (LastPass x) = LastPass $ f x
   fmap f (Running x) = Running $ f x
   fmap f (Running x) = Running $ f x
 instance Applicative IOScannerState where
 instance Applicative IOScannerState where
-  pure a = Running a
+  pure = Running
   Finished <*> _ = Finished
   Finished <*> _ = Finished
   _ <*> Finished = Finished
   _ <*> Finished = Finished
   (LastPass f) <*> (LastPass x) = LastPass $ f x
   (LastPass f) <*> (LastPass x) = LastPass $ f x
@@ -63,7 +63,7 @@ anyScanner scanners = scan
 Given a sequence of bytes, creates a scanner that will scan
 Given a sequence of bytes, creates a scanner that will scan
 its input untill that sequence is found.
 its input untill that sequence is found.
 -}
 -}
-textScanner :: [Word8] -> (IOScanner [[Word8]])
+textScanner :: [Word8] -> IOScanner [[Word8]]
 textScanner [] = \_ _ -> Finished
 textScanner [] = \_ _ -> Finished
 textScanner t@(c:_) = scanner
 textScanner t@(c:_) = scanner
   where
   where
@@ -76,8 +76,8 @@ textScanner t@(c:_) = scanner
     popStacks ((h':hh):ss) h
     popStacks ((h':hh):ss) h
       | h == h' && null hh = case popStacks ss h of
       | h == h' && null hh = case popStacks ss h of
         Finished -> Finished
         Finished -> Finished
-        LastPass ss' -> LastPass $ ss'
-        Running ss' -> LastPass $ ss'
+        LastPass ss' -> LastPass ss'
+        Running ss' -> LastPass ss'
       | h == h' = case popStacks ss h of
       | h == h' = case popStacks ss h of
         Finished -> Finished
         Finished -> Finished
         LastPass ss' -> LastPass $ hh:ss'
         LastPass ss' -> LastPass $ hh:ss'

+ 1 - 5
test/Blocking.hs

@@ -18,15 +18,11 @@ import qualified Data.Attoparsec.ByteString as A
 tests :: IO [Test]
 tests :: IO [Test]
 tests = return [
 tests = return [
   simpleTest "recieveLine"
   simpleTest "recieveLine"
-  (successTimeout "A test\n" (S.recieveLine)),
+  (successTimeout "A test\n" S.recieveLine),
   simpleTest "runAttoparsec with successful parser"
   simpleTest "runAttoparsec with successful parser"
   (successTimeout "abcde" (parseBS (A.string "abcde"))),
   (successTimeout "abcde" (parseBS (A.string "abcde"))),
   simpleTest "runAttoparsec with failed parser"
   simpleTest "runAttoparsec with failed parser"
   (failTimeout "abcde" (parseBS (A.string "c"))),
   (failTimeout "abcde" (parseBS (A.string "c"))),
-  simpleTest "lazyRecieveLine"
-  (successTimeout "Another test\n" (concatLine S.lazyRecieveLine)),
-  simpleTest "lazyReceiveN"
-  (failTimeout "abcde" (concatLine (S.lazyRecieveN 5))),
   simpleTest "recieveTill"
   simpleTest "recieveTill"
   (failTimeout "abcde" (restoreLine $ S.recieveTill "de"))
   (failTimeout "abcde" (restoreLine $ S.recieveTill "de"))
   ]
   ]