Quellcode durchsuchen

Makes Streamline an instance of Interruptible and MonadControlTrans. Also, complete doccumentation.

Marcos Dumay de Medeiros vor 8 Jahren
Ursprung
Commit
ce219d884e

+ 1 - 0
src/System/IO/Uniform/ByteString.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
+-- | UniformIO on memory
 module System.IO.Uniform.ByteString (
   ByteStringIO,
   withByteStringIO, withByteStringIO'

+ 1 - 0
src/System/IO/Uniform/File.hs

@@ -1,3 +1,4 @@
+-- | UniformIO functions for file access
 module System.IO.Uniform.File (
   FileIO,
   openFile

+ 4 - 0
src/System/IO/Uniform/HandlePair.hs

@@ -11,6 +11,10 @@ import System.IO (Handle, hClose)
 import System.IO.Uniform
 import qualified Data.ByteString as BS
 
+{- |
+A pair of handles, the first for input,
+and the second for output.
+-}
 data HandlePair = HandlePair Handle Handle
 
 {- |

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

@@ -1,3 +1,4 @@
+-- | UniformIO functions for TCP connections
 module System.IO.Uniform.Network (
   SocketIO,
   BoundedPort,
@@ -26,7 +27,7 @@ import System.IO.Error
 
 import System.Posix.Types (Fd(..))
 
--- | UniformIO IP connections.
+-- | UniformIO TCP connections.
 instance UniformIO SocketIO where
   uRead (SocketIO s) n = allocaArray n (
     \b -> do

+ 1 - 0
src/System/IO/Uniform/Std.hs

@@ -1,3 +1,4 @@
+-- | UniformIO over stdin and stdout
 module System.IO.Uniform.Std (
   StdIO(StdIO)
   ) where

+ 36 - 48
src/System/IO/Uniform/Streamline.hs

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

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

@@ -1,3 +1,6 @@
+{- |
+IO scanners for use with the Streamline monad transformer.
+-}
 module System.IO.Uniform.Streamline.Scanner (
   IOScanner,
   IOScannerState(..),
@@ -45,6 +48,7 @@ instance Monad IOScannerState where
     Running y -> LastPass y
   (Running x) >>= f = f x
 
+-- | IOScanner type, as required by the scan functions of Streamline
 type IOScanner a = a -> Word8 -> IOScannerState a
 
 -- | Creates a scanner that'll finish when any of the given scanners finish.

+ 5 - 3
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.2.0
+version:    1.2.2.0.0
 
 -- A short (one-line) description of the package.
 synopsis:   Uniform IO over files, network, anything.
@@ -70,7 +70,7 @@ source-repository head
 source-repository this
   type:     git
   location: https://sealgram.com/git/haskell/uniform-io
-  tag:   1.1.1.0
+  tag:   1.2.2.1
 
 library
   -- Modules exported by the library.
@@ -107,7 +107,9 @@ library
       transformers >=0.3,
       word8 >=0.1,
       attoparsec >=0.13.0.1,
-      data-default-class >= 0.0.1
+      data-default-class >= 0.0.1,
+      monad-control,
+      interruptible
   
   -- Directories containing source files.
   hs-source-dirs: src