Clean up warnings

snoyberg · Aug 15, 2014 · 164f01f · 164f01f
1 parent dfff204
commit 164f01f
Show file tree

Hide file tree

Showing 3 changed files with 33 additions and 39 deletions.
diff --git a/conduit/Data/Conduit/Internal/Conduit.hs b/conduit/Data/Conduit/Internal/Conduit.hs
@@ -82,8 +82,8 @@ module Data.Conduit.Internal.Conduit
     ) where
 
 import Control.Applicative (Applicative (..))
-import Control.Exception.Lifted as E (Exception, catch)
-import Control.Monad ((>=>), liftM, ap, when, liftM2)
+import Control.Exception.Lifted as E (Exception)
+import Control.Monad (liftM, when, liftM2)
 import Control.Monad.Error.Class(MonadError(..))
 import Control.Monad.Reader.Class(MonadReader(..))
 import Control.Monad.RWS.Class(MonadRWS())
@@ -95,20 +95,15 @@ import Control.Monad.Base (MonadBase (liftBase))
 import Data.Void (Void, absurd)
 import Data.Monoid (Monoid (mappend, mempty))
 import Control.Monad.Trans.Resource
-import qualified GHC.Exts
 import qualified Data.IORef as I
 import Control.Monad.Morph (MFunctor (..))
-#if MIN_VERSION_exceptions(0, 6, 0)
-import qualified Control.Monad.Catch as Catch
-#endif
 import Data.Conduit.Internal.Pipe hiding (yield, mapOutput, leftover, yieldM, yieldOr, await, awaitForever)
-import Control.Monad.Trans.Class (lift)
 import qualified Data.Conduit.Internal.Pipe as CI
-import Control.Monad.Morph (hoist)
-import Control.Monad (liftM, forever, when, unless)
-import Control.Applicative (Applicative (..))
+import Control.Monad (forever, unless)
 import Data.Traversable (Traversable (..))
-import Control.Monad.Trans.Resource (MonadResource)
+#if MIN_VERSION_exceptions(0, 6, 0)
+import qualified Control.Monad.Catch as Catch
+#endif
 
 -- | Core datatype of the conduit package. This type represents a general
 -- component which can consume a stream of input values @i@, produce a stream
@@ -616,9 +611,6 @@ passthroughSink (ConduitM sink0) final =
                 CI.yield x
                 go [] (next x)
 
-{-# RULES "ConduitM: lift x >>= f" forall m f. lift m >>= f = ConduitM (PipeM (liftM (unConduitM . f) m)) #-}
-{-# RULES "ConduitM: lift x >> f" forall m f. lift m >> f = ConduitM (PipeM (liftM (\_ -> unConduitM f) m)) #-}
-
 -- Define fixity of all our operators
 infixr 0 $$
 infixl 1 $=
@@ -639,7 +631,7 @@ src $$ sink = do
     (rsrc, res) <- src $$+ sink
     rsrc $$+- return ()
     return res
-{-# INLINE ($$) #-}
+{-# INLINE [1] ($$) #-}
 
 -- | Left fuse, combining a source and a conduit together into a new source.
 --
@@ -653,7 +645,7 @@ src $$ sink = do
 --
 -- Since 0.4.0
 ($=) :: Monad m => Conduit a m b -> ConduitM b c m r -> ConduitM a c m r
-ConduitM src $= ConduitM con = ConduitM $ pipeL src con
+($=) = (=$=)
 {-# INLINE ($=) #-}
 
 -- | Right fuse, combining a conduit and a sink together into a new sink.
@@ -668,7 +660,7 @@ ConduitM src $= ConduitM con = ConduitM $ pipeL src con
 --
 -- Since 0.4.0
 (=$) :: Monad m => Conduit a m b -> ConduitM b c m r -> ConduitM a c m r
-ConduitM con =$ ConduitM sink = ConduitM $ pipeL con sink
+(=$) = (=$=)
 {-# INLINE (=$) #-}
 
 -- | Fusion operator, combining two @Conduit@s together into a new @Conduit@.
@@ -680,15 +672,14 @@ ConduitM con =$ ConduitM sink = ConduitM $ pipeL con sink
 -- Since 0.4.0
 (=$=) :: Monad m => Conduit a m b -> ConduitM b c m r -> ConduitM a c m r
 ConduitM left =$= ConduitM right = ConduitM $ pipeL left right
-{-# INLINE (=$=) #-}
+{-# INLINE [1] (=$=) #-}
 
 -- | Wait for a single input value from upstream. If no data is available,
 -- returns @Nothing@.
 --
 -- Since 0.5.0
 await :: Monad m => Consumer i m (Maybe i)
 await = ConduitM CI.await
-{-# RULES "await >>= maybe" forall x y. await >>= maybe x y = ConduitM (NeedInput (unConduitM . y) (unConduitM . const x)) #-}
 {-# INLINE [1] await #-}
 
 -- | Send a value downstream to the next component to consume. If the
@@ -706,17 +697,7 @@ yieldM :: Monad m => m o -> ConduitM i o m ()
 yieldM = ConduitM . CI.yieldM
 {-# INLINE [1] yieldM #-}
 
-{-# RULES
-    "yield o >> p" forall o (p :: ConduitM i o m r). yield o >> p = ConduitM (HaveOutput (unConduitM p) (return ()) o)
-  ; "mapM_ yield" mapM_ yield = ConduitM . sourceList
-  ; "yieldOr o c >> p" forall o c (p :: ConduitM i o m r). yieldOr o c >> p =
-        ConduitM (HaveOutput (unConduitM p) c o)
-  ; "when yield next" forall b o p. when b (yield o) >> p =
-        if b then ConduitM (HaveOutput (unConduitM p) (return ()) o) else p
-  ; "unless yield next" forall b o p. unless b (yield o) >> p =
-        if b then p else ConduitM (HaveOutput (unConduitM p) (return ()) o)
-  ; "lift m >>= yield" forall m. lift m >>= yield = yieldM m
-   #-}
+  -- FIXME rule won't fire, see FIXME in .Pipe; "mapM_ yield" mapM_ yield = ConduitM . sourceList
 
 -- | Provide a single piece of leftover input to be consumed by the next
 -- component in the current monadic binding.
@@ -728,8 +709,6 @@ yieldM = ConduitM . CI.yieldM
 leftover :: i -> ConduitM i o m ()
 leftover = ConduitM . CI.leftover
 {-# INLINE [1] leftover #-}
-{-# RULES "leftover l >> p" forall l (p :: ConduitM i o m r). leftover l >> p =
-    ConduitM (Leftover (unConduitM p) l) #-}
 
 -- | Perform some allocation and run an inner component. Two guarantees are
 -- given about resource finalization:
@@ -1033,3 +1012,21 @@ fuseBoth (ConduitM up) (ConduitM down) =
 fuseUpstream :: Monad m => ConduitM a b m r -> Conduit b m c -> ConduitM a c m r
 fuseUpstream up down = fmap fst (fuseBoth up down)
 {-# INLINE fuseUpstream #-}
+
+-- Rewrite rules
+
+{-# RULES "ConduitM: lift x >>= f" forall m f. lift m >>= f = ConduitM (PipeM (liftM (unConduitM . f) m)) #-}
+{-# RULES "ConduitM: lift x >> f" forall m f. lift m >> f = ConduitM (PipeM (liftM (\_ -> unConduitM f) m)) #-}
+{-# RULES "await >>= maybe" forall x y. await >>= maybe x y = ConduitM (NeedInput (unConduitM . y) (unConduitM . const x)) #-}
+{-# RULES
+    "yield o >> p" forall o (p :: ConduitM i o m r). yield o >> p = ConduitM (HaveOutput (unConduitM p) (return ()) o)
+  ; "yieldOr o c >> p" forall o c (p :: ConduitM i o m r). yieldOr o c >> p =
+        ConduitM (HaveOutput (unConduitM p) c o)
+  ; "when yield next" forall b o p. when b (yield o) >> p =
+        if b then ConduitM (HaveOutput (unConduitM p) (return ()) o) else p
+  ; "unless yield next" forall b o p. unless b (yield o) >> p =
+        if b then p else ConduitM (HaveOutput (unConduitM p) (return ()) o)
+  ; "lift m >>= yield" forall m. lift m >>= yield = yieldM m
+   #-}
+{-# RULES "leftover l >> p" forall l (p :: ConduitM i o m r). leftover l >> p =
+    ConduitM (Leftover (unConduitM p) l) #-}
diff --git a/conduit/Data/Conduit/Internal/Pipe.hs b/conduit/Data/Conduit/Internal/Pipe.hs
@@ -47,7 +47,7 @@ module Data.Conduit.Internal.Pipe
 
 import Control.Applicative (Applicative (..))
 import Control.Exception.Lifted as E (Exception, catch)
-import Control.Monad ((>=>), liftM, ap, when, liftM2)
+import Control.Monad ((>=>), liftM, ap)
 import Control.Monad.Error.Class(MonadError(..))
 import Control.Monad.Reader.Class(MonadReader(..))
 import Control.Monad.RWS.Class(MonadRWS())
@@ -60,7 +60,6 @@ import Data.Void (Void, absurd)
 import Data.Monoid (Monoid (mappend, mempty))
 import Control.Monad.Trans.Resource
 import qualified GHC.Exts
-import qualified Data.IORef as I
 import Control.Monad.Morph (MFunctor (..))
 #if MIN_VERSION_exceptions(0, 6, 0)
 import qualified Control.Monad.Catch as Catch
@@ -275,10 +274,11 @@ yieldOr o f = HaveOutput (Done ()) f o
 
 {-# RULES
     "CI.yield o >> p" forall o (p :: Pipe l i o u m r). yield o >> p = HaveOutput p (return ()) o
-  ; "mapM_ CI.yield" mapM_ yield = sourceList
   ; "CI.yieldOr o c >> p" forall o c (p :: Pipe l i o u m r). yieldOr o c >> p = HaveOutput p c o
   ; "lift m >>= CI.yield" forall m. lift m >>= yield = yieldM m
   #-}
+  -- FIXME: Too much inlining on mapM_, can't enforce; "mapM_ CI.yield" mapM_ yield = sourceList
+  -- Maybe we can get a rewrite rule on foldr instead? Need a benchmark to back this up.
 
 -- | Provide a single piece of leftover input to be consumed by the next pipe
 -- in the current monadic binding.

diff --git a/conduit/Data/Conduit/List.hs b/conduit/Data/Conduit/List.hs
@@ -69,9 +69,8 @@ import Prelude
     , (>>=)
     , seq
     , otherwise
-    , Enum (succ), Eq
+    , Enum, Eq
     , maybe
-    , either
     , (<=)
     )
 import Data.Monoid (Monoid, mempty, mappend)
@@ -271,7 +270,6 @@ map f = awaitForever $ yield . f
 {-# INLINE [1] map #-}
 
 -- Since a Source never has any leftovers, fusion rules on it are safe.
-{-# RULES "source/map fusion $=" forall f src. src $= map f = mapFuseRight src f #-}
 {-# RULES "source/map fusion =$=" forall f src. src =$= map f = mapFuseRight src f #-}
 
 mapFuseRight :: Monad m => Source m a -> (a -> b) -> Source m b
@@ -539,7 +537,6 @@ filterFuseRight (CI.ConduitM src) f =
 -- Intermediate finalizers are dropped, but this is acceptable: the next
 -- yielded value would be demanded by downstream in any event, and that new
 -- finalizer will always override the existing finalizer.
-{-# RULES "source/filter fusion $=" forall f src. src $= filter f = filterFuseRight src f #-}
 {-# RULES "source/filter fusion =$=" forall f src. src =$= filter f = filterFuseRight src f #-}
 {-# INLINE filterFuseRight #-}