Browse Source

UniformIO based handles

Marcos Dumay de Medeiros 8 years ago
parent
commit
a6a44ddcbd
1 changed files with 24 additions and 7 deletions
  1. 24 7
      src/Walrus/Backend.hs

+ 24 - 7
src/Walrus/Backend.hs

@@ -3,10 +3,12 @@
 module Walrus.Backend (
   Backend(..),
   LazyHandler,
+  UIOHandler,
   module Walrus.Backend.Metadata,
   parseBackend,
   callBackend,
-  runLazyOnce
+  runLazyOnce,
+  runUIOOnce
   ) where
 
 import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -23,7 +25,7 @@ import Walrus.Backend.Metadata
 import Network
 import System.IO
 import System.IO.Uniform
-import System.IO.Uniform.Streamline
+import qualified System.IO.Uniform.Streamline as S
 --import System.IO.Uniform.HandlePair as HP
 --import System.IO.Uniform.Network as Net
 import qualified System.Process as P
@@ -32,6 +34,7 @@ data Backend = TCPBackend String Int |
                ExecBackend String [String] deriving (Show, Read, Ord, Eq)
 
 type LazyHandler = Metadata -> LBS.ByteString -> IO (Either String (Metadata, LBS.ByteString))
+type UIOHandler = Metadata -> S.Streamline IO (Either String (Metadata, LBS.ByteString))
 
 parseBackend :: A.Parser Backend
 parseBackend = A.choice [
@@ -80,18 +83,32 @@ callBackend b (m, qdt) = do
     repParse = parseMetadata
 
 runLazyOnce :: UniformIO u => u -> LazyHandler -> IO (Either String ())
-runLazyOnce u f =  withTarget u $ do
-  m' <- runAttoparsec parseMetadata
+runLazyOnce u f =  S.withTarget u $ do
+  m' <- S.runAttoparsec parseMetadata
   case m' of
     Left e -> return . Left . show $ e
     Right m -> do
-      dt <- recieveN' $ m^.dataSize
+      dt <- S.recieveN' $ m^.dataSize
       r <- liftIO $ f m dt
       case r of
         Left e -> return . Left $ e
         Right (mo, dto) -> do
-          send $ renderMetadata mo
-          send' dto
+          S.send $ renderMetadata mo
+          S.send' dto
+          return . Right $ ()
+
+runUIOOnce :: UniformIO u => u -> UIOHandler -> IO (Either String ())
+runUIOOnce u f =  S.withTarget u $ do
+  m' <- S.runAttoparsec parseMetadata
+  case m' of
+    Left e -> return . Left . show $ e
+    Right m -> do
+      r <- f m
+      case r of
+        Left e -> return . Left $ e
+        Right (mo, dto) -> do
+          S.send $ renderMetadata mo
+          S.send' dto
           return . Right $ ()
 
 runTcp :: String -> Int -> LBS.ByteString -> IO LBS.ByteString