Browse Source

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

Marcos Dumay de Medeiros 8 years ago
parent
commit
ce219d884e

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

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

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

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

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

@@ -11,6 +11,10 @@ import System.IO (Handle, hClose)
 import System.IO.Uniform
 import System.IO.Uniform
 import qualified Data.ByteString as BS
 import qualified Data.ByteString as BS
 
 
+{- |
+A pair of handles, the first for input,
+and the second for output.
+-}
 data HandlePair = HandlePair Handle Handle
 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 (
 module System.IO.Uniform.Network (
   SocketIO,
   SocketIO,
   BoundedPort,
   BoundedPort,
@@ -26,7 +27,7 @@ import System.IO.Error
 
 
 import System.Posix.Types (Fd(..))
 import System.Posix.Types (Fd(..))
 
 
--- | UniformIO IP connections.
+-- | UniformIO TCP connections.
 instance UniformIO SocketIO where
 instance UniformIO SocketIO where
   uRead (SocketIO s) n = allocaArray n (
   uRead (SocketIO s) n = allocaArray n (
     \b -> do
     \b -> do

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

@@ -1,3 +1,4 @@
+-- | UniformIO over stdin and stdout
 module System.IO.Uniform.Std (
 module System.IO.Uniform.Std (
   StdIO(StdIO)
   StdIO(StdIO)
   ) where
   ) 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
 Streamline exports a monad that, given an uniform IO target, emulates
@@ -12,12 +12,10 @@ module System.IO.Uniform.Streamline (
   withClient,
   withClient,
   withServer,
   withServer,
   withTarget,
   withTarget,
-  -- ** Several pass runner
-  StreamlineState,
-  streamline,
-  resume,
-  close,
-  remaining,
+  -- ** Interruptible support
+  inStreamlineCtx,
+  peelStreamlineCtx,
+  closeTarget,
   -- * Sending and recieving data
   -- * Sending and recieving data
   send,
   send,
   send',
   send',
@@ -52,7 +50,9 @@ import System.IO.Uniform.Streamline.Scanner
 import Data.Default.Class
 import Data.Default.Class
 
 
 import Control.Monad.Trans.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 Control.Monad.IO.Class
 import System.IO.Error
 import System.IO.Error
 import Data.ByteString (ByteString)
 import Data.ByteString (ByteString)
@@ -94,7 +94,7 @@ writeF cl l = case echo cl of
     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
 
 
--- | withServer f serverIP port
+-- | > withServer f serverIP port
 --
 --
 --  Connects to the given server port, runs f, and closes the connection.
 --  Connects to the given server port, runs f, and closes the connection.
 withServer :: MonadIO m => IP -> Int -> Streamline m a -> m a
 withServer :: MonadIO m => IP -> Int -> Streamline m a -> m a
@@ -104,7 +104,7 @@ withServer host port f = do
   liftIO $ S.uClose ds
   liftIO $ S.uClose ds
   return ret
   return ret
 
 
--- | withClient f boundPort
+-- | > withClient f boundPort
 --
 --
 --  Accepts a connection at the bound port, runs f and closes the connection.
 --  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
 withClient :: MonadIO m => N.BoundedPort -> (IP -> Int -> Streamline m a) -> m a
@@ -116,7 +116,7 @@ withClient port f = do
   return ret
   return ret
 
 
 {- |
 {- |
-withTarget f someIO
+> withTarget f someIO
 
 
 Runs f wrapped on a Streamline monad that does IO on 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}
   (r, _) <- withTarget' f def{str=SomeIO s}
   return r
   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
 instance Monad m => Monad (Streamline m) where
   --return :: (Monad m) => a -> Streamline m a
   --return :: (Monad m) => a -> Streamline m a
   return x = Streamline  $ \cl -> return (x, cl)
   return x = Streamline  $ \cl -> return (x, cl)
@@ -186,7 +168,7 @@ send' r = Streamline $ \cl -> do
 {- |
 {- |
 Very much like Attoparsec's runScanner:
 Very much like Attoparsec's runScanner:
 
 
-runScanner scanner initial_state
+> runScanner scanner initial_state
 
 
 Recieves data, running the scanner on each byte,
 Recieves data, running the scanner on each byte,
 using the scanner result as initial state for the
 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 :: MonadIO m => String -> m a
 eofError msg = liftIO . ioError $ mkIOError eofErrorType msg Nothing Nothing
 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 (
 module System.IO.Uniform.Streamline.Scanner (
   IOScanner,
   IOScanner,
   IOScannerState(..),
   IOScannerState(..),
@@ -45,6 +48,7 @@ instance Monad IOScannerState where
     Running y -> LastPass y
     Running y -> LastPass y
   (Running x) >>= f = f x
   (Running x) >>= f = f x
 
 
+-- | IOScanner type, as required by the scan functions of Streamline
 type IOScanner a = a -> Word8 -> IOScannerState a
 type IOScanner a = a -> Word8 -> IOScannerState a
 
 
 -- | Creates a scanner that'll finish when any of the given scanners finish.
 -- | 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
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
 --                   | | | +--- 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.
 -- A short (one-line) description of the package.
 synopsis:   Uniform IO over files, network, anything.
 synopsis:   Uniform IO over files, network, anything.
@@ -70,7 +70,7 @@ source-repository head
 source-repository this
 source-repository this
   type:     git
   type:     git
   location: https://sealgram.com/git/haskell/uniform-io
   location: https://sealgram.com/git/haskell/uniform-io
-  tag:   1.1.1.0
+  tag:   1.2.2.1
 
 
 library
 library
   -- Modules exported by the library.
   -- Modules exported by the library.
@@ -107,7 +107,9 @@ library
       transformers >=0.3,
       transformers >=0.3,
       word8 >=0.1,
       word8 >=0.1,
       attoparsec >=0.13.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.
   -- Directories containing source files.
   hs-source-dirs: src
   hs-source-dirs: src