|
@@ -1,4 +1,4 @@
|
|
|
-{-# LANGUAGE OverloadedStrings #-}
|
|
|
+{-# LANGUAGE OverloadedStrings, TypeFamilies #-}
|
|
|
|
|
|
{- |
|
|
|
Streamline exports a monad that, given an uniform IO target, emulates
|
|
@@ -12,12 +12,10 @@ module System.IO.Uniform.Streamline (
|
|
|
withClient,
|
|
|
withServer,
|
|
|
withTarget,
|
|
|
- -- ** Several pass runner
|
|
|
- StreamlineState,
|
|
|
- streamline,
|
|
|
- resume,
|
|
|
- close,
|
|
|
- remaining,
|
|
|
+ -- ** Interruptible support
|
|
|
+ inStreamlineCtx,
|
|
|
+ peelStreamlineCtx,
|
|
|
+ closeTarget,
|
|
|
-- * Sending and recieving data
|
|
|
send,
|
|
|
send',
|
|
@@ -52,7 +50,9 @@ import System.IO.Uniform.Streamline.Scanner
|
|
|
import Data.Default.Class
|
|
|
|
|
|
import Control.Monad.Trans.Class
|
|
|
-import Control.Monad (ap)
|
|
|
+import Control.Monad.Trans.Interruptible
|
|
|
+import Control.Monad.Trans.Control
|
|
|
+import Control.Monad (ap, liftM)
|
|
|
import Control.Monad.IO.Class
|
|
|
import System.IO.Error
|
|
|
import Data.ByteString (ByteString)
|
|
@@ -94,7 +94,7 @@ writeF cl l = case echo cl of
|
|
|
liftIO $ S.uPut (str cl) l
|
|
|
Nothing -> liftIO $ S.uPut (str cl) l
|
|
|
|
|
|
--- | withServer f serverIP port
|
|
|
+-- | > withServer f serverIP port
|
|
|
--
|
|
|
-- Connects to the given server port, runs f, and closes the connection.
|
|
|
withServer :: MonadIO m => IP -> Int -> Streamline m a -> m a
|
|
@@ -104,7 +104,7 @@ withServer host port f = do
|
|
|
liftIO $ S.uClose ds
|
|
|
return ret
|
|
|
|
|
|
--- | withClient f boundPort
|
|
|
+-- | > withClient f boundPort
|
|
|
--
|
|
|
-- Accepts a connection at the bound port, runs f and closes the connection.
|
|
|
withClient :: MonadIO m => N.BoundedPort -> (IP -> Int -> Streamline m a) -> m a
|
|
@@ -116,7 +116,7 @@ withClient port f = do
|
|
|
return ret
|
|
|
|
|
|
{- |
|
|
|
-withTarget f someIO
|
|
|
+> withTarget f someIO
|
|
|
|
|
|
Runs f wrapped on a Streamline monad that does IO on someIO.
|
|
|
-}
|
|
@@ -125,24 +125,6 @@ withTarget s f = do
|
|
|
(r, _) <- withTarget' f def{str=SomeIO s}
|
|
|
return r
|
|
|
|
|
|
-{- |
|
|
|
-Run f wrapped on a Streamline monad, returning the final state in a way that
|
|
|
-can be continued with "resume".
|
|
|
-
|
|
|
-If run with this function, the state must be closed, explicitly with "close" or
|
|
|
-implicitly with "remaining".
|
|
|
--}
|
|
|
-streamline :: (Monad m, UniformIO a) => a -> Streamline m b -> m (b, StreamlineState)
|
|
|
-streamline s f = withTarget' f def{str=SomeIO s}
|
|
|
-
|
|
|
-{- |
|
|
|
-Continues the execution of functions on a Streamline monad comming from
|
|
|
-"start" or another "resume" call.
|
|
|
--}
|
|
|
-resume :: Monad m => StreamlineState -> Streamline m b -> m (b, StreamlineState)
|
|
|
-resume dt f = withTarget' f dt
|
|
|
-
|
|
|
-
|
|
|
instance Monad m => Monad (Streamline m) where
|
|
|
--return :: (Monad m) => a -> Streamline m a
|
|
|
return x = Streamline $ \cl -> return (x, cl)
|
|
@@ -186,7 +168,7 @@ send' r = Streamline $ \cl -> do
|
|
|
{- |
|
|
|
Very much like Attoparsec's runScanner:
|
|
|
|
|
|
-runScanner scanner initial_state
|
|
|
+> runScanner scanner initial_state
|
|
|
|
|
|
Recieves data, running the scanner on each byte,
|
|
|
using the scanner result as initial state for the
|
|
@@ -365,21 +347,27 @@ echoTo h = Streamline $ \cl -> return ((), cl{echo=h})
|
|
|
eofError :: MonadIO m => String -> m a
|
|
|
eofError msg = liftIO . ioError $ mkIOError eofErrorType msg Nothing Nothing
|
|
|
|
|
|
-{- |
|
|
|
-Closes the target of a streamline state, releasing any used resource.
|
|
|
--}
|
|
|
-close :: MonadIO m => StreamlineState -> m ()
|
|
|
-close = liftIO . S.uClose . str
|
|
|
-
|
|
|
-{- |
|
|
|
-Retrieves the remaining contents of a streamline state, closing it afterwards.
|
|
|
--}
|
|
|
-remaining :: MonadIO m => StreamlineState -> m LBS.ByteString
|
|
|
-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'
|
|
|
+instance Interruptible Streamline where
|
|
|
+ type RSt Streamline a = (a, StreamlineState)
|
|
|
+ resume f (a, st) = withTarget' (f a) st
|
|
|
+
|
|
|
+-- | Creates a Streamline interrutible context
|
|
|
+inStreamlineCtx :: UniformIO io => io -> a -> RSt Streamline a
|
|
|
+inStreamlineCtx io a = (a, def{str = SomeIO io})
|
|
|
+
|
|
|
+-- | Closes the target of a streamline state, releasing any resource.
|
|
|
+closeTarget :: MonadIO m => Streamline m ()
|
|
|
+closeTarget = Streamline $ \st -> do
|
|
|
+ liftIO . S.uClose . str $ st
|
|
|
+ return ((), st)
|
|
|
+
|
|
|
+-- | Removes a Streamline interruptible context
|
|
|
+peelStreamlineCtx :: RSt Streamline a -> (a, SomeIO)
|
|
|
+peelStreamlineCtx (a, dt) = (a, str dt)
|
|
|
+
|
|
|
+instance MonadTransControl Streamline where
|
|
|
+ type StT Streamline a = (a, StreamlineState)
|
|
|
+ liftWith f = Streamline $ \s ->
|
|
|
+ liftM (\x -> (x, s))
|
|
|
+ (f $ \t -> withTarget' t s)
|
|
|
+ restoreT = Streamline . const
|