New target: HandlePair

src/System/IO/Uniform/HandlePair.hs

@@ -0,0 +1,32 @@
+{- |
+IO into a pair of Haskell handles, like the ones
+created with stdin and stdout of a forked process.
+-}
+module System.IO.Uniform.HandlePair (
+  HandlePair,
+  fromHandles
+  ) where
+
+import System.IO (Handle, hClose)
+import System.IO.Uniform
+import qualified Data.ByteString as BS
+
+data HandlePair = HandlePair Handle Handle
+
+{- |
+> fromHandles inputHandler outputHandler
+
+Creates a uniform io target from a pair of handlers.
+-}
+fromHandles :: Handle -> Handle -> HandlePair
+fromHandles = HandlePair
+
+-- | UniformIO that reads from stdin and writes to stdout.
+instance UniformIO HandlePair where
+  uRead (HandlePair i _) n = BS.hGetSome i n
+  uPut (HandlePair _ o) t = BS.hPut o t
+  uClose (HandlePair i o) = do
+    hClose i
+    hClose o
+  startTls _ a = return a
+  isSecure _ = True

test/Base.hs

@@ -3,14 +3,20 @@
 module Base (simpleTest) where
 
 import Distribution.TestSuite
+import System.IO.Error
 
 simpleTest :: String -> IO Progress -> Test
 simpleTest n t = 
   let test = TestInstance
-        {run = t,
+        {run = t',
          name = n,
          tags = [],
          options = [],
          setOption = \_ _ -> Right test
         }
   in Test test
+  where
+    t' :: IO Progress
+    t' = catchIOError t (
+      \e -> return . Finished . Fail $ "Raised exception: " ++ show e
+      )

test/Targets.hs

@@ -4,12 +4,14 @@ module Targets (tests) where
 
 import Distribution.TestSuite
 import Base (simpleTest)
-import Control.Concurrent(forkIO) 
+import Control.Concurrent(forkIO)
+import qualified System.IO as I
 import System.IO.Uniform
 import System.IO.Uniform.Network
 import System.IO.Uniform.File
 --import System.IO.Uniform.Std
 import System.IO.Uniform.ByteString
+import System.IO.Uniform.HandlePair
 import System.Timeout (timeout)
 import qualified Data.ByteString.Char8 as C8
 import Data.ByteString (ByteString)
@@ -20,7 +22,8 @@ tests = return [
   simpleTest "network" testNetwork,
   simpleTest "file" testFile,
   simpleTest "network TLS" testTls,
-  simpleTest "byte string" testBS
+  simpleTest "byte string" testBS,
+  simpleTest "handle pair" testHandlePair
   ]
 
 testNetwork :: IO Progress
@@ -102,3 +105,18 @@ testBS = do
     countAndEcho io initial dt = do
       uPut io dt
       return $ initial + BS.length dt
+
+testHandlePair :: IO Progress
+testHandlePair = do
+  let l = "abcde\n"
+  h <- I.openFile "test/testHandles" I.WriteMode
+  let s = fromHandles h h
+  uPut s l
+  uClose s
+  h' <- I.openFile "test/testHandles" I.ReadMode
+  let s' = fromHandles h' h'
+  l' <- uRead s' 100
+  uClose s'
+  if l == l'
+    then return . Finished $ Pass
+    else return . Finished . Fail . C8.unpack $ l'

test/testHandles

@@ -0,0 +1 @@
+abcde

uniform-io.cabal

@@ -80,6 +80,7 @@ library
       System.IO.Uniform.File,
       System.IO.Uniform.Std,
       System.IO.Uniform.ByteString,
+      System.IO.Uniform.HandlePair,
       System.IO.Uniform.Streamline,
       System.IO.Uniform.Streamline.Scanner