{- Module : Tubes.Sink Description : Defines the Sink type. Copyright : (c) 2014-2016 Gatlin Johnson <gatlin@niltag.net> License : GPL-3 Maintainer : gatlin@niltag.net Stability : experimental -} {-# LANGUAGE RankNTypes #-} module Tubes.Sink ( Sink(..) ) where import Prelude hiding (map) import qualified Prelude as P import Control.Monad.IO.Class import Data.Functor.Contravariant (Contravariant(..)) import Data.Functor.Contravariant.Divisible (Divisible(..), Decidable(..)) import Data.Semigroup import Tubes.Core import Tubes.Util {- | A potentially full sink of values parameterized over a base monad. It never 'yield's. A 'Sink' is a contravariant functor. Intuitively this means that it is a consumer of some base type, and you may map transformations over its input before it is consumed. Example: @ import Data.Functor.Contravariant add5 :: Sink IO Int add5 = Sink $ loop 0 5 where loop acc 0 = do liftIO $ putStrLn $ "Sum of five numbers: " ++ (show acc) halt loop acc count = do n <- await loop (acc + n) (count - 1) times2Add5:: Sink IO Int times2Add5 = (*2) >$< add5 main :: IO () main = do runTube $ each [1..10] >< pour add5 -- "Sum of five numbers: 15" runTube $ each [1..10] >< pour times2Add5 -- "Sum of five numbers: 30" @ 'Sink's may also be merged together, as they form a semigroup: @ import Data.Semigroup writeToFile :: Sink IO String writeToFile = Sink $ do line <- await liftIO . putStrLn $ "Totally writing this to a file: " ++ line writeToConsole :: Sink IO String writeToConsole = Sink $ do line <- await liftIO . putStrLn $ "Console out: " ++ line writeOut :: Sink IO String writeOut = writeToFile <> writeToConsole main :: IO () main = do runTube $ each [1..3] \>\< map show \>\< forever (pour writeOut) -- Totally writing this to a file: 1 -- Console out: 1 -- Totally writing this to a file: 2 -- Console out: 2 -- Totally writing this to a file: 3 -- Console out: 3 @ -} newtype Sink m a = Sink { pour :: Tube a () m () } instance Monad m => Contravariant (Sink m) where contramap f snk = Sink $ map f >< (pour snk) instance Monad m => Divisible (Sink m) where divide f (Sink sa) (Sink sb) = Sink $ do (a,b) <- await >>= return . f yield a >< sa yield b >< sb conquer = Sink $ cat >< (pour conquer) instance Monad m => Decidable (Sink m) where lose f = Sink $ await >>= return . f >> return () choose f sa sb = Sink $ do x <- await >>= return . f case x of Left a -> yield a >< pour sa Right b -> yield b >< pour sb instance Monad m => Semigroup (Sink m a) where s1 <> s2 = divide (\x -> (x,x)) s1 s2