|
@@ -36,7 +36,7 @@ module System.IO.Uniform.Streamline (
|
|
-- * Behavior settings
|
|
-- * Behavior settings
|
|
startTls,
|
|
startTls,
|
|
isSecure,
|
|
isSecure,
|
|
- setTimeout,
|
|
|
|
|
|
+ transformTarget,
|
|
echoTo,
|
|
echoTo,
|
|
setEcho
|
|
setEcho
|
|
) where
|
|
) where
|
|
@@ -65,24 +65,22 @@ import Data.IP (IP)
|
|
import qualified Data.Attoparsec.ByteString as A
|
|
import qualified Data.Attoparsec.ByteString as A
|
|
|
|
|
|
-- | Internal state for a Streamline monad
|
|
-- | Internal state for a Streamline monad
|
|
-data StreamlineState = StreamlineState {str :: SomeIO, timeout :: Int, buff :: ByteString, isEOF :: Bool, echo :: Maybe Handle}
|
|
|
|
|
|
+data StreamlineState = StreamlineState {str :: SomeIO, buff :: ByteString, isEOF :: Bool, echo :: Maybe Handle}
|
|
instance Default StreamlineState where
|
|
instance Default StreamlineState where
|
|
-- | Will open StdIO
|
|
-- | Will open StdIO
|
|
- def = StreamlineState (SomeIO Std.StdIO) defaultTimeout BS.empty False Nothing
|
|
|
|
|
|
+ def = StreamlineState (SomeIO Std.StdIO) BS.empty False Nothing
|
|
|
|
|
|
-- | Monad that emulates character stream IO over block IO.
|
|
-- | Monad that emulates character stream IO over block IO.
|
|
newtype Streamline m a = Streamline {withTarget' :: StreamlineState -> m (a, StreamlineState)}
|
|
newtype Streamline m a = Streamline {withTarget' :: StreamlineState -> m (a, StreamlineState)}
|
|
|
|
|
|
blockSize :: Int
|
|
blockSize :: Int
|
|
blockSize = 4096
|
|
blockSize = 4096
|
|
-defaultTimeout :: Int
|
|
|
|
-defaultTimeout = 1000000 * 600
|
|
|
|
|
|
|
|
readF :: MonadIO m => StreamlineState -> m ByteString
|
|
readF :: MonadIO m => StreamlineState -> m ByteString
|
|
readF cl = case echo cl of
|
|
readF cl = case echo cl of
|
|
Just h -> do
|
|
Just h -> do
|
|
l <- liftIO $ S.uRead (str cl) blockSize
|
|
l <- liftIO $ S.uRead (str cl) blockSize
|
|
- liftIO $ BS.hPutStr h "<"
|
|
|
|
|
|
+ liftIO $ BS.hPutStr h "< "
|
|
liftIO $ BS.hPutStr h l
|
|
liftIO $ BS.hPutStr h l
|
|
return l
|
|
return l
|
|
Nothing -> liftIO $ S.uRead (str cl) blockSize
|
|
Nothing -> liftIO $ S.uRead (str cl) blockSize
|
|
@@ -90,7 +88,7 @@ readF cl = case echo cl of
|
|
writeF :: MonadIO m => StreamlineState -> ByteString -> m ()
|
|
writeF :: MonadIO m => StreamlineState -> ByteString -> m ()
|
|
writeF cl l = case echo cl of
|
|
writeF cl l = case echo cl of
|
|
Just h -> do
|
|
Just h -> do
|
|
- liftIO $ BS.hPutStr h ">"
|
|
|
|
|
|
+ liftIO $ BS.hPutStr h "> "
|
|
liftIO $ BS.hPutStr h l
|
|
liftIO $ BS.hPutStr h l
|
|
liftIO $ S.uPut (str cl) l
|
|
liftIO $ S.uPut (str cl) l
|
|
Nothing -> liftIO $ S.uPut (str cl) l
|
|
Nothing -> liftIO $ S.uPut (str cl) l
|
|
@@ -321,10 +319,6 @@ runAttoparsec p = Streamline $ \cl ->
|
|
isSecure :: Monad m => Streamline m Bool
|
|
isSecure :: Monad m => Streamline m Bool
|
|
isSecure = Streamline $ \cl -> return (S.isSecure $ str cl, cl)
|
|
isSecure = Streamline $ \cl -> return (S.isSecure $ str cl, cl)
|
|
|
|
|
|
--- | Sets the timeout for the streamlined IO target.
|
|
|
|
-setTimeout :: Monad m => Int -> Streamline m ()
|
|
|
|
-setTimeout t = Streamline $ \cl -> return ((), cl{timeout=t})
|
|
|
|
-
|
|
|
|
-- | Sets echo of the streamlines IO target.
|
|
-- | Sets echo of the streamlines IO target.
|
|
-- If echo is set, all the data read an written to the target
|
|
-- If echo is set, all the data read an written to the target
|
|
-- will be echoed in stdout, with ">" and "<" markers indicating
|
|
-- will be echoed in stdout, with ">" and "<" markers indicating
|
|
@@ -333,6 +327,14 @@ setEcho :: Monad m => Bool -> Streamline m ()
|
|
setEcho e = Streamline $ \cl ->
|
|
setEcho e = Streamline $ \cl ->
|
|
if e then return ((), cl{echo=Just stdout}) else return ((), cl{echo=Nothing})
|
|
if e then return ((), cl{echo=Just stdout}) else return ((), cl{echo=Nothing})
|
|
|
|
|
|
|
|
+{- |
|
|
|
|
+Replaces the enclosed target with the result of the given transformation.
|
|
|
|
+
|
|
|
|
+Discards all buffered data in the process.
|
|
|
|
+-}
|
|
|
|
+transformTarget :: (UniformIO a, Monad m) => (SomeIO -> a) -> Streamline m ()
|
|
|
|
+transformTarget w = Streamline $ \cl -> return ((), cl{str = SomeIO . w . str $ cl})
|
|
|
|
+
|
|
{- |
|
|
{- |
|
|
Sets echo of the streamlined IO target.
|
|
Sets echo of the streamlined IO target.
|
|
|
|
|