New function for running a backend handler

src/Walrus/Backend.hs

@@ -2,9 +2,11 @@
 
 module Walrus.Backend (
   Backend(..),
+  BackendHandler,
   module Walrus.Backend.Metadata,
   parseBackend,
-  runBackend
+  callBackend,
+  runBackendOnce
   ) where
 
 import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -13,12 +15,15 @@ import Data.Attoparsec.ByteString.Char8.Extras
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Char as C
 import Data.Textual.Class
+import Control.Monad.IO.Class
+import Control.Lens
 
 import Walrus.Backend.Metadata
 
 import Network
 import System.IO
---import System.IO.Uniform
+import System.IO.Uniform
+import System.IO.Uniform.Streamline
 --import System.IO.Uniform.HandlePair as HP
 --import System.IO.Uniform.Network as Net
 import qualified System.Process as P
@@ -26,6 +31,8 @@ import qualified System.Process as P
 data Backend = TCPBackend String Int |
                ExecBackend String [String] deriving (Show, Read, Ord, Eq)
 
+type BackendHandler = Metadata -> LBS.ByteString -> IO (Either String (Metadata, LBS.ByteString))
+
 parseBackend :: A.Parser Backend
 parseBackend = do
   A.choice [
@@ -58,8 +65,8 @@ parseBackend = do
     qStr :: A.Parser String
     qStr = fromTextual <$> quotedString '\\' " " ""
 
-runBackend :: Backend -> (Metadata, LBS.ByteString) -> IO (Either String (Metadata, LBS.ByteString))
-runBackend b (m, qdt) = do
+callBackend :: Backend -> (Metadata, LBS.ByteString) -> IO (Either String (Metadata, LBS.ByteString))
+callBackend b (m, qdt) = do
   let rm = renderMetadata m
   edt' <- intBk b $ LBS.concat [
     fromTextual rm,
@@ -75,6 +82,21 @@ runBackend b (m, qdt) = do
       m' <- parseMetadata
       return m'
 
+runBackendOnce :: UniformIO u => u -> BackendHandler -> IO (Either String ())
+runBackendOnce u f =  withTarget u $ do
+  m' <- runAttoparsec parseMetadata
+  case m' of
+    Left e -> return . Left . show $ e
+    Right m -> do
+      dt <- 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
+          return . Right $ ()
+
 runTcp :: String -> Int -> LBS.ByteString -> IO LBS.ByteString
 runTcp host port dt = do
   h <- connectTo host (PortNumber . fromIntegral $ port)