Fix for conduit 1.3.0

conduit-resumablesink.cabal

@@ -1,5 +1,5 @@
 Name:          conduit-resumablesink
-Version:       0.2
+Version:       0.3
 Synopsis:      Allows conduit to resume sinks to feed multiple sources into it.
 Description:
     @conduit-resumablesink@ is a solution to the problem where you have a @conduit@
@@ -20,9 +20,10 @@ Library
   Exposed-modules: Data.Conduit.ResumableSink
   Build-depends: 
                  base >= 4 && < 5,
-                 conduit >= 1.2 && <1.3,
+                 conduit >= 1.2 && < 1.4,
                  void >= 0.6 && < 0.8
   ghc-options:     -Wall
+  extensions: CPP, PatternSynonyms, Rank2Types
 
 test-suite test
     hs-source-dirs: test

hssrc/Data/Conduit/ResumableSink.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE CPP, PatternSynonyms, Rank2Types #-}
+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
+
 module Data.Conduit.ResumableSink (
   ResumableSink(..), connectResumeSink, newResumableSink, closeResumableSink,
   (+$$), (++$$), (-++$$)
@@ -7,12 +10,39 @@ where
 import Data.Conduit.Internal
 import Data.Void
 
--- | 
-data ResumableSink i m r = ResumableSink (Sink i m r)
+#if MIN_VERSION_conduit(1,3,0)
+pattern ConduitM :: forall i o m r. (forall b. (r -> Pipe i i o () m b) -> Pipe i i o () m b) -> ConduitT i o m r
+pattern ConduitM act = ConduitT act
+#else
+(.|) :: Monad m => ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
+(.|) = (=$=)
+#endif
 
+newtype ResumableSink i m r = ResumableSink (ConduitM i Void m r)
+
+#if MIN_VERSION_conduit(1,3,0)
 -- | Connects a new source to a resumable sink. The result will be Right an updated
 --   ResumableSink or Left result if the Sink completes.
-connectResumeSink :: Monad m => Source m i -> ResumableSink i m r -> m (Either r (ResumableSink i m r))
+connectResumeSink :: Monad m => ConduitM () i m () -> ResumableSink i m r -> m (Either r (ResumableSink i m r))
+connectResumeSink (ConduitM left') (ResumableSink (ConduitM right')) = go (left' Done) (right' Done)
+  where
+    go :: Monad m
+       => Pipe () () i    () m ()
+       -> Pipe i  i  Void () m r
+       -> m (Either r (ResumableSink i m r))
+    go (NeedInput cont0 _ ) right               = go (cont0 ()) right
+    go (Done ())            right               = return . Right . ResumableSink $ ConduitM (\finalize -> right >>= finalize)
+    go (PipeM pm)           right               = pm >>= \left -> go left right
+    go (Leftover left ())   right               = go left right
+    go (HaveOutput left1 o) (NeedInput cont0 _) = go left1 (cont0 o)
+    go _                    (HaveOutput _ o)    = absurd o
+    go _                    (Done r)            = return $ Left r
+    go left                 (PipeM pm)          = pm >>= go left
+    go left                 (Leftover right i)  = go (HaveOutput left i) right
+#else
+-- | Connects a new source to a resumable sink. The result will be Right an updated
+--   ResumableSink or Left result if the Sink completes.
+connectResumeSink :: Monad m => ConduitM () i m () -> ResumableSink i m r -> m (Either r (ResumableSink i m r))
 connectResumeSink (ConduitM left') (ResumableSink (ConduitM right')) = go (return ()) (left' Done) (right' Done)
   where
     go :: Monad m
@@ -21,7 +51,7 @@ connectResumeSink (ConduitM left') (ResumableSink (ConduitM right')) = go (retur
        -> Pipe i  i  Void () m r
        -> m (Either r (ResumableSink i m r))
     go final  (NeedInput cont0 _ )        right               = go final (cont0 ()) right
-    go final  (Done ())                   right               = return . Right . ResumableSink $ ConduitM (\finalize -> right >>= finalize)
+    go final  (Done ())                   right               = (Right . ResumableSink $ ConduitM (\finalize -> right >>= finalize)) <$ final
     go final  (PipeM pm)                  right               = pm >>= \left -> go final left right
     go final  (Leftover left ())          right               = go final left right
     go final0 (HaveOutput left1 final1 o) (NeedInput cont0 _) = go (final0 >> final1) left1 (cont0 o)
@@ -29,25 +59,26 @@ connectResumeSink (ConduitM left') (ResumableSink (ConduitM right')) = go (retur
     go final  _                           (Done r)            = Left r <$ final
     go final  left                        (PipeM pm)          = pm >>= go final left
     go final  left                        (Leftover right i)  = go final (HaveOutput left (return ()) i) right
+#endif
 
 -- | Converts a sink into a ResumableSink that can be used with ++$$
-newResumableSink :: Monad m => Sink i m r -> ResumableSink i m r
+newResumableSink :: Monad m => ConduitM i Void m r -> ResumableSink i m r
 newResumableSink = ResumableSink
 
 -- | Closes a ResumableSink and gets the final result.
 closeResumableSink :: Monad m => ResumableSink i m r -> m r
-closeResumableSink (ResumableSink sink) = runConduit $ return () =$= sink
+closeResumableSink (ResumableSink sink) = runConduit $ return () .| sink
 
 -- | Connects a source and a sink. The result will be Right a
 --   ResumableSink or Left result if the Sink completes.
-(+$$) :: Monad m => Source m i -> Sink i m r -> m (Either r (ResumableSink i m r))
+(+$$) :: Monad m => ConduitM () i m () -> ConduitM i Void m r -> m (Either r (ResumableSink i m r))
 source +$$ sink = source `connectResumeSink` newResumableSink sink
 
 -- | Connects a new source to a resumable sink. The result will be Right an updated
 --   ResumableSink or Left result if the Sink completes.
-(++$$) :: Monad m => Source m i -> ResumableSink i m r -> m (Either r (ResumableSink i m r))
+(++$$) :: Monad m => ConduitM () i m () -> ResumableSink i m r -> m (Either r (ResumableSink i m r))
 (++$$) = connectResumeSink
 
 -- | Attaches a source to a resumable sink, finishing the sink and returning a result.
-(-++$$) :: Monad m => Source m i -> ResumableSink i m r -> m r
-source -++$$ ResumableSink sink = source $$ sink
+(-++$$) :: Monad m => ConduitM () i m () -> ResumableSink i m r -> m r
+source -++$$ ResumableSink sink = runConduit $ source .| sink

stack.yaml

@@ -0,0 +1,66 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+# resolver:
+#  name: custom-snapshot
+#  location: "./custom-snapshot.yaml"
+resolver: lts-12.05
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+#    git: https://github.com/commercialhaskell/stack.git
+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#   extra-dep: true
+#  subdirs:
+#  - auto-update
+#  - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (e.g., acme-missiles-0.3)
+extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+flags: {}
+
+# Extra package databases containing global packages
+extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.5"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor