|
@@ -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'
|