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