{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- | Defines the types for a sink, which is a consumer of data. module Data.Conduit.Types.Sink ( SinkResult (..) , Sink (..) , SinkPush , SinkClose ) where import Control.Monad.Trans.Resource import Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad (liftM, ap) import Control.Applicative (Applicative (..)) import Control.Monad.Base (MonadBase (liftBase)) -- | The value of the @sinkPush@ record. type SinkPush input m output = input -> ResourceT m (SinkResult input m output) -- | The value of the @sinkClose@ record. type SinkClose m output = ResourceT m output -- | A @Sink@ ultimately returns a single output value. Each time data is -- pushed to it, a @Sink@ may indicate that it is still processing data, or -- that it is done, in which case it returns some optional leftover input and -- an output value. -- -- The @Processing@ constructors provides updated push and close functions to -- be used in place of the original @Sink@. -- -- Since 0.2.0 data SinkResult input m output = Processing (SinkPush input m output) (SinkClose m output) | Done (Maybe input) output instance Monad m => Functor (SinkResult input m) where fmap f (Processing push close) = Processing ((fmap . fmap . fmap) f push) (fmap f close) fmap f (Done input output) = Done input (f output) {- Note to my future self, and anyone else who reads my code: It's tempting to change `Sink` to look like: newtype Sink input m output = Sink { runSink :: ResourceT m (SinkResult input m output) } If you start implementing this, eventually you'll realize that you will have to enforce an invariant to make it all work: a `SinkResult` can't return leftovers unless data was pushed to it. The idea is that, with the actual definition of `Sink`, it's impossible to get a `SinkResult` without first pushing in some input. Therefore, it's always valid at the type level to return leftovers. In this simplified `Sink`, it would be possible to have code that looks like: sink1 = Sink $ return $ Done (Just "foo") () fsink2 () = Sink $ return $ Done (Just "bar") () sink1 >>= fsink2 Now we'd have to coalesce "foo" and "bar" together (e.g., require `Monoid`), throw away data, or throw an exception. So the current three-constructor approach to `Sink` may not be as pretty, but it enforce the invariants much better. -} -- | In general, a sink will consume data and eventually produce an output when -- it has consumed \"enough\" data. There are two caveats to that statement: -- -- * Some sinks do not actually require any data to produce an output. This is -- included with a sink in order to allow for a 'Monad' instance. -- -- * Some sinks will consume all available data and only produce a result at -- the \"end\" of a data stream (e.g., @sum@). -- -- To allow for the first caveat, we have the 'SinkNoData' constructor. For the -- second, the 'SinkData' constructor has two records: one for receiving more -- input, and the other to indicate the end of a stream. Note that, at the end -- of a stream, some output is required. If a specific 'Sink' implementation -- cannot always produce output, this should be indicated in its return value, -- using something like a 'Maybe' or 'Either'. -- -- A @Sink@ should clean up any resources it has allocated when it returns a -- value, whether that be via @sinkPush@ or @sinkClose@. -- -- Since 0.2.0 data Sink input m output = SinkNoData output | SinkData { sinkPush :: SinkPush input m output , sinkClose :: SinkClose m output } -- | This constructor is provided to allow us to create an efficient -- @MonadTrans@ instance. | SinkLift (ResourceT m (Sink input m output)) instance Monad m => Functor (Sink input m) where fmap f (SinkNoData x) = SinkNoData (f x) fmap f (SinkData p c) = SinkData { sinkPush = liftM (fmap f) . p , sinkClose = liftM f c } fmap f (SinkLift msink) = SinkLift (liftM (fmap f) msink) instance Resource m => Applicative (Sink input m) where pure = return (<*>) = ap instance Resource m => Monad (Sink input m) where return = SinkNoData SinkNoData x >>= f = f x SinkLift mx >>= f = SinkLift $ do x <- mx return $ x >>= f SinkData push0 close0 >>= f = SinkData (push push0) (close close0) where push push' input = do res <- push' input case res of Done lo output -> pushHelper lo (f output) Processing push'' close'' -> return $ Processing (push push'') (close close'') pushHelper lo (SinkNoData y) = return $ Done lo y pushHelper (Just l) (SinkData pushF _) = pushF l pushHelper Nothing (SinkData pushF closeF) = return (Processing pushF closeF) pushHelper lo (SinkLift msink) = msink >>= pushHelper lo close close' = do output <- close' closeHelper (f output) closeHelper (SinkNoData y) = return y closeHelper (SinkData _ closeF) = closeF closeHelper (SinkLift msink) = msink >>= closeHelper instance (Resource m, Base m ~ base, Applicative base) => MonadBase base (Sink input m) where liftBase = lift . resourceLiftBase instance MonadTrans (Sink input) where lift = SinkLift . liftM SinkNoData . lift instance (Resource m, MonadIO m) => MonadIO (Sink input m) where liftIO = lift . liftIO