Interruptible streamline, and better docs overall

src/System/IO/Uniform.hs

@@ -9,10 +9,12 @@ module System.IO.Uniform (
   UniformIO(..),
   TlsSettings(..),
   SomeIO(..),
-  mapOverInput
+  mapOverInput,
+  uGetContents
   ) where
 
 import Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as LBS
 import Control.Exception
 import Control.Applicative ((<$>))
 import System.IO.Error
@@ -81,3 +83,13 @@ mapOverInput io block f initial = do
     Right dt -> do
       i <- f initial dt
       mapOverInput io block f i
+
+{- |
+Returns the entire contents recieved from this target.
+-}
+uGetContents :: UniformIO io => io -> Int -> IO LBS.ByteString
+uGetContents io block = LBS.fromChunks <$> mapOverInput io block atEnd []
+  where
+    atEnd :: [ByteString] -> ByteString -> IO [ByteString]
+    atEnd bb b = return $ bb ++ [b]
+

src/System/IO/Uniform/Streamline.hs

@@ -1,41 +1,58 @@
 {-# LANGUAGE OverloadedStrings #-}
 
--- |
--- Streamline exports a monad that, given an uniform IO target, emulates
--- character tream IO using high performance block IO.
+{- |
+Streamline exports a monad that, given an uniform IO target, emulates
+character stream IO using high performance block IO.
+-}
 module System.IO.Uniform.Streamline (
+  -- * Basic Type
   Streamline,
-  IOScannerState(..),
+  -- * Running streamline targets
+  -- ** Single pass runners
   withClient,
   withServer,
   withTarget,
+  -- ** Several pass runner
+  StreamlineState,
+  streamline,
+  resume,
+  close,
+  remaining,
+  -- * Sending and recieving data
   send,
   send',
   recieveLine,
   recieveLine',
-  lazyRecieveLine,
   recieveN,
   recieveN',
-  lazyRecieveN,
-  recieveTill,
-  recieveTill',
-  startTls,
+  -- ** Running a parser
   runAttoparsec,
   runAttoparsecAndReturn,
-  isSecure,
-  setTimeout,
-  setEcho,
+  -- ** Scanning the input
   runScanner,
   runScanner',
   scan,
   scan',
-  textScanner
+  recieveTill,
+  recieveTill',
+  -- ** Deprecated functions
+  lazyRecieveLine,
+  lazyRecieveN,
+  -- * Behavior settings
+  startTls,
+  isSecure,
+  setTimeout,
+  echoTo,
+  setEcho
   ) where
 
+import System.IO (stdout, Handle)
 import qualified System.IO.Uniform as S
 import qualified System.IO.Uniform.Network as N
+import qualified System.IO.Uniform.Std as Std
 import System.IO.Uniform (UniformIO, SomeIO(..), TlsSettings)
 import System.IO.Uniform.Streamline.Scanner
+import Data.Default.Class
 
 import Control.Monad.Trans.Class
 import Control.Applicative
@@ -51,31 +68,36 @@ import qualified Data.Char as C
 
 import qualified Data.Attoparsec.ByteString as A
 
-data Data = Data {str :: SomeIO, timeout :: Int, buff :: ByteString, isEOF :: Bool, echo :: Bool}
+-- | Internal state for a Streamline monad
+data StreamlineState = StreamlineState {str :: SomeIO, timeout :: Int, buff :: ByteString, isEOF :: Bool, echo :: Maybe Handle}
+instance Default StreamlineState where
+  -- | Will open StdIO
+  def = StreamlineState (SomeIO Std.StdIO) defaultTimeout BS.empty False Nothing
+
 -- | Monad that emulates character stream IO over block IO.
-newtype Streamline m a = Streamline {withTarget' :: Data -> m (a, Data)}
+newtype Streamline m a = Streamline {withTarget' :: StreamlineState -> m (a, StreamlineState)}
 
 blockSize :: Int
 blockSize = 4096
 defaultTimeout :: Int
 defaultTimeout = 1000000 * 600
 
-readF :: MonadIO m => Data -> m ByteString
-readF cl = if echo cl
-          then do
-            l <- liftIO $ S.uRead (str cl) blockSize
-            liftIO $ BS.putStr "<"
-            liftIO $ BS.putStr l
-            return l
-          else liftIO $ S.uRead (str cl) blockSize
-
-writeF :: MonadIO m => Data -> ByteString -> m ()
-writeF cl l = if echo cl
-             then do
-               liftIO $ BS.putStr ">"
-               liftIO $ BS.putStr l
-               liftIO $ S.uPut (str cl) l
-             else liftIO $ S.uPut (str cl) l
+readF :: MonadIO m => StreamlineState -> m ByteString
+readF cl = case echo cl of
+  Just h -> do
+    l <- liftIO $ S.uRead (str cl) blockSize
+    liftIO $ BS.hPutStr h "<"
+    liftIO $ BS.hPutStr h l
+    return l
+  Nothing -> liftIO $ S.uRead (str cl) blockSize
+
+writeF :: MonadIO m => StreamlineState -> ByteString -> m ()
+writeF cl l = case echo cl of
+  Just h -> do
+    liftIO $ BS.hPutStr h ">"
+    liftIO $ BS.hPutStr h l
+    liftIO $ S.uPut (str cl) l
+  Nothing -> liftIO $ S.uPut (str cl) l
 
 -- | withServer f serverIP port
 --
@@ -83,7 +105,7 @@ writeF cl l = if echo cl
 withServer :: MonadIO m => IP -> Int -> Streamline m a -> m a
 withServer host port f = do
   ds <- liftIO $ N.connectTo host port
-  (ret, _) <- withTarget' f $ Data (SomeIO ds) defaultTimeout "" False False
+  (ret, _) <- withTarget' f def{str=SomeIO ds}
   liftIO $ S.uClose ds
   return ret
 
@@ -94,17 +116,37 @@ withClient :: MonadIO m => N.BoundedPort -> (IP -> Int -> Streamline m a) -> m a
 withClient port f = do
   ds <- liftIO $ N.accept port
   (peerIp, peerPort) <- liftIO $ N.getPeer ds
-  (ret, _) <- withTarget' (f peerIp peerPort) $ Data (SomeIO ds) defaultTimeout "" False False
+  (ret, _) <- withTarget' (f peerIp peerPort) def{str=SomeIO ds}
   liftIO $ S.uClose ds
   return ret
 
--- | withTarget f someIO
---
---  Runs f wrapped on a Streamline monad that does IO on nomeIO.
-withTarget :: (MonadIO m, UniformIO a) => a -> Streamline m b -> m b
-withTarget s f = do  
-  (ret, _) <- withTarget' f $ Data (SomeIO s) defaultTimeout "" False False
-  return ret
+{- |
+withTarget f someIO
+
+Runs f wrapped on a Streamline monad that does IO on someIO.
+-}
+withTarget :: (Monad m, UniformIO a) => a -> Streamline m b -> m b
+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
@@ -133,7 +175,7 @@ instance MonadTrans Streamline where
 instance MonadIO m => MonadIO (Streamline m) where
   liftIO = lift . liftIO
 
--- | Sends data over the streamlines an IO target.
+-- | Sends data over the IO target.
 send :: MonadIO m => ByteString -> Streamline m ()
 send r = Streamline $ \cl -> do
   writeF cl r
@@ -146,17 +188,10 @@ send' r = Streamline $ \cl -> do
   mapM (writeF cl) dd
   return ((), cl)
 
--- | Equivalent to runScanner', but returns a strict, completely
---   evaluated ByteString.
-runScanner :: MonadIO m => s -> IOScanner s -> Streamline m (ByteString, s)
-runScanner state scanner = do
-  (rt, st) <- runScanner' state scanner
-  return (LBS.toStrict rt, st)
-
 {- |
 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
@@ -165,13 +200,20 @@ Nothing.
 
 Returns the scanned ByteString.
  -} 
+runScanner :: MonadIO m => s -> IOScanner s -> Streamline m (ByteString, s)
+runScanner state scanner = do
+  (rt, st) <- runScanner' state scanner
+  return (LBS.toStrict rt, st)
+
+-- | Equivalent to runScanner, but returns a strict, completely
+--   evaluated ByteString.
 runScanner' :: MonadIO m => s -> IOScanner s -> Streamline m (LBS.ByteString, s)
 runScanner' state scanner = Streamline $ \d ->
   do
     (tx, st, d') <- in_scan d state
     return ((LBS.fromChunks tx, st), d')
   where
-    --in_scan :: Data -> s -> m ([ByteString], s, Data)
+    --in_scan :: StreamlineState -> s -> m ([ByteString], s, StreamlineState)
     in_scan d st
       | isEOF d = eofError "System.IO.Uniform.Streamline.scan'"
       | BS.null (buff d) = do
@@ -197,11 +239,11 @@ runScanner' state scanner = Streamline $ \d ->
 data ScanResult s = SplitAt Int s | AllInput s
 
 
--- | Equivalent to runScanner, but dischards the final state
+-- | Equivalent to runScanner, but discards the final state
 scan :: MonadIO m => s -> IOScanner s -> Streamline m ByteString
 scan state scanner = fst <$> runScanner state scanner
 
--- | Equivalent to runScanner', but dischards the final state
+-- | Equivalent to runScanner', but discards the final state
 scan' :: MonadIO m => s -> IOScanner s -> Streamline m LBS.ByteString
 scan' state scanner = fst <$> runScanner' state scanner
 
@@ -218,7 +260,7 @@ lazyRecieveLine :: MonadIO m => Streamline m [ByteString]
 {-# DEPRECATED #-}
 lazyRecieveLine = Streamline $ \cl -> lazyRecieveLine' cl
   where
-    lazyRecieveLine' :: MonadIO m => Data -> m ([ByteString], Data)
+    lazyRecieveLine' :: MonadIO m => StreamlineState -> m ([ByteString], StreamlineState)
     lazyRecieveLine' cl' = 
       if isEOF cl'
       then eofError "System.IO.Uniform.Streamline.lazyRecieveLine"
@@ -264,7 +306,7 @@ lazyRecieveN :: (Functor m, MonadIO m) => Int -> Streamline m [ByteString]
 {-# DEPRECATED #-}
 lazyRecieveN n' = Streamline $ \cl' -> lazyRecieveN' cl' n'
   where
-    lazyRecieveN' :: (Functor m, MonadIO m) => Data -> Int -> m ([ByteString], Data)
+    lazyRecieveN' :: (Functor m, MonadIO m) => StreamlineState -> Int -> m ([ByteString], StreamlineState)
     lazyRecieveN' cl n =
       if isEOF cl
       then eofError "System.IO.Uniform.Streamline.lazyRecieveN"
@@ -318,7 +360,7 @@ runAttoparsecAndReturn p = Streamline $ \cl ->
     (cl', i, a) <- liftIO $ continueResult cl c
     return ((i, a), cl')
   where
-    continueResult :: Data -> A.Result a -> IO (Data, ByteString, (Either String a))
+    continueResult :: StreamlineState -> A.Result a -> IO (StreamlineState, ByteString, (Either String a))
     -- tx eof ds 
     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)
@@ -339,7 +381,7 @@ runAttoparsec p = Streamline $ \cl ->
     (cl', a) <- liftIO $ continueResult cl c
     return (a, cl')
   where
-    continueResult :: Data -> A.Result a -> IO (Data, (Either String a))
+    continueResult :: StreamlineState -> A.Result a -> IO (StreamlineState, (Either String a))
     continueResult cl c = case c of
         A.Fail i _ msg -> return (cl{buff=i}, Left msg)
         A.Done i r -> return (cl{buff=i}, Right r)
@@ -347,7 +389,7 @@ runAttoparsec p = Streamline $ \cl ->
           d <- readF cl
           let eof' = BS.null d
           continueResult cl{buff=d}{isEOF=eof'} (c' d)
-  
+
 -- | Indicates whether transport layer security is being used.
 isSecure :: Monad m => Streamline m Bool
 isSecure = Streamline $ \cl -> return (S.isSecure $ str cl, cl)
@@ -361,7 +403,20 @@ setTimeout t = Streamline $ \cl -> return ((), cl{timeout=t})
 --   will be echoed in stdout, with ">" and "<" markers indicating
 --   what is read and written.
 setEcho :: Monad m => Bool -> Streamline m ()
-setEcho e = Streamline $ \cl -> return ((), cl{echo=e})
+setEcho e = Streamline $ \cl ->
+  if e then return ((), cl{echo=Just stdout}) else return ((), cl{echo=Nothing})
+
+{- |
+Sets echo of the streamlined IO target.
+
+If echo is set, all the data read an written to the target
+will be echoed to the handle, with ">" and "<" markers indicating
+what is read and written.
+
+Setting to Nothing will disable echo.
+-}
+echoTo :: Monad m => Maybe Handle -> Streamline m ()
+echoTo h = Streamline $ \cl -> return ((), cl{echo=h})
 
 lineWithEol :: A.Parser (ByteString, ByteString)
 lineWithEol = do
@@ -377,3 +432,24 @@ 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.
+-}
+close :: MonadIO m => StreamlineState -> m ()
+close st = liftIO . S.uClose . str $ st
+
+{- |
+Retrieves the remaining contents of a streamline state, closing it afterwards.
+-}
+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'

src/System/IO/Uniform/Streamline/Scanner.hs

@@ -1,4 +1,9 @@
-module System.IO.Uniform.Streamline.Scanner where
+module System.IO.Uniform.Streamline.Scanner (
+  IOScanner,
+  IOScannerState(..),
+  textScanner,
+  anyScanner
+  )where
 
 import Control.Applicative
 import Data.Default.Class
@@ -43,6 +48,7 @@ instance Monad IOScannerState where
 
 type IOScanner a = a -> Word8 -> IOScannerState a
 
+-- | Creates a scanner that'll finish when any of the given scanners finish.
 anyScanner :: Default a => [IOScanner a] -> IOScanner [a]
 anyScanner scanners = scan
   where
@@ -54,6 +60,10 @@ anyScanner scanners = scan
     apScanner (s:ss) (t:tt) h = s t h : apScanner ss tt h
 
 
+{- |
+Given a sequence of bytes, creates a scanner that will scan
+its input untill that sequence is found.
+-}
 textScanner :: [Word8] -> (IOScanner [[Word8]])
 textScanner [] = \_ _ -> Finished
 textScanner t@(c:_) = scanner

uniform-io.cabal

@@ -10,7 +10,7 @@ name:                uniform-io
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:    1.1.1.0
+version:    1.1.2.0
 
 -- A short (one-line) description of the package.
 synopsis:   Uniform IO over files, network, anything.