Browse Source

Conduit compatibility

Marcos Dumay de Medeiros 5 years ago
parent
commit
70e9046d6d
4 changed files with 116 additions and 13 deletions
  1. 36 0
      src/System/IO/Uniform/Conduit.hs
  2. 23 0
      src/System/IO/Uniform/Null.hs
  3. 26 0
      test/TestConduit.hs
  4. 31 13
      uniform-io.cabal

+ 36 - 0
src/System/IO/Uniform/Conduit.hs

@@ -0,0 +1,36 @@
+{- |
+Conduit interfaces for uniform IO targets.
+-}
+module System.IO.Uniform.Conduit (
+  runConduit,
+  source,
+  sink
+  ) where
+
+import System.IO.Uniform
+import Control.Monad.Extra
+import qualified Data.Conduit as C
+import Control.Monad.IO.Class
+import Data.ByteString (ByteString)
+
+chunkSize :: Int
+chunkSize = 4000
+
+{- |
+Places a target at both ends of a conduit pipe.
+-}
+runConduit :: (MonadIO m, UniformIO u) => u -> C.ConduitM ByteString ByteString m a -> m a
+runConduit trg f = C.runConduit $ source trg `C.fuse` f `C.fuseUpstream` sink trg
+
+source :: (MonadIO m, UniformIO u) => u -> C.Source m ByteString
+source u =  unlessM (liftIO $ isEOF u) $ do
+  dt <- liftIO $ uRead u chunkSize
+  C.yield dt
+  source u
+
+sink :: (UniformIO u, MonadIO m) => u -> C.Sink ByteString m ()
+sink u = do
+  dt <- C.await
+  case dt of
+    Just dt' -> liftIO $ uPut u dt'
+    Nothing -> liftIO $ uClose u

+ 23 - 0
src/System/IO/Uniform/Null.hs

@@ -0,0 +1,23 @@
+{- |
+NullIO:
+
+Always reads empty string, writes are null routed,
+always at EOF.
+-}
+module System.IO.Uniform.Null (
+  NullIO(..)
+  ) where
+
+import System.IO.Uniform
+
+import qualified Data.ByteString as BS
+
+-- | Wrapper that does UniformIO that reads and writes on the memory.
+data NullIO = NullIO
+instance UniformIO NullIO where
+  uRead _ _ = return BS.empty
+  uPut _ _ = return ()
+  uClose _ = return ()
+  startTls _ = return
+  isSecure _ = True
+  isEOF _ = return True

+ 26 - 0
test/TestConduit.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module TestConduit (tests) where
+
+import Distribution.TestSuite
+import Base
+import qualified Data.Conduit.List as C
+import System.IO.Uniform.ByteString
+import System.IO.Uniform.Conduit
+import Data.Monoid (Sum(..))
+import qualified Data.ByteString as BS
+
+tests :: IO [Test]
+tests = do
+  return [
+    simpleTest "runConduit" testRunConduit
+    ]
+
+testRunConduit :: IO Progress
+testRunConduit = do
+  let dt = "Some data to test ByteString"
+  (Sum len, _) <- withByteStringIO dt $ \io ->
+    runConduit io (C.foldMap (Sum . BS.length))
+  if BS.length dt /= len
+    then return . Finished . Fail $ "Failure on ByteStringIO test. Length is: " ++ show len
+    else return . Finished $ Pass

+ 31 - 13
uniform-io.cabal

@@ -46,7 +46,8 @@ library
       System.IO.Uniform.HandlePair,
       System.IO.Uniform.Timeout,
       System.IO.Uniform.Streamline,
-      System.IO.Uniform.Streamline.Scanner
+      System.IO.Uniform.Streamline.Scanner,
+      System.IO.Uniform.Conduit            
 
   ghc-options: -Wall -fno-warn-unused-do-bind -fwarn-incomplete-patterns -fno-warn-orphans
 
@@ -67,18 +68,19 @@ library
   
   -- Other library packages from which modules are imported.
   build-depends:
-      base >=4.8,
-      iproute >=1.4,
-      bytestring >=0.10,
-      network >=2.4,
-      transformers >=0.3,
-      word8 >=0.1,
-      attoparsec >=0.13.0.1,
-      data-default-class >= 0.0.1,
-      monad-control,
-      transformers-base,
-      conduit,          
-      interruptible
+                base >=4.8,
+                iproute >=1.4,
+                bytestring >=0.10,
+                network >=2.4,
+                transformers >=0.3,
+                word8 >=0.1,
+                attoparsec >=0.13.0.1,
+                data-default-class >= 0.0.1,
+                monad-control,
+                transformers-base,
+                conduit,
+                extra,
+                interruptible
   
   -- Directories containing source files.
   hs-source-dirs: src
@@ -138,3 +140,19 @@ Test-suite limited_input
     Base
   ghc-options: -Wall -fno-warn-unused-do-bind -fwarn-incomplete-patterns -threaded
   default-language: Haskell2010
+
+Test-suite conduit
+  type: detailed-0.9
+  test-module: TestConduit
+  hs-source-dirs:
+    test
+  build-depends:
+                base >=4.7,
+                Cabal >= 1.9.2,
+                bytestring >=0.10 && <1.0,
+                conduit,
+                uniform-io
+  other-modules:
+    Base
+  ghc-options: -Wall -fno-warn-unused-do-bind -fwarn-incomplete-patterns -threaded
+  default-language: Haskell2010