{-# LANGUAGE GADTs #-}{-# LANGUAGE Rank2Types #-}------------------------------------------------------------------------------- |-- Module : Data.Machine.Tee-- Copyright : (C) 2012 Edward Kmett, Rúnar Bjarnason, Paul Chiusano-- License : BSD-style (see the file LICENSE)---- Maintainer : Edward Kmett <ekmett@gmail.com>-- Stability : provisional-- Portability : Rank-2 Types, GADTs------------------------------------------------------------------------------moduleData.Machine.Tee(-- * TeesTee ,TeeT ,T (..),tee ,teeT ,addL ,addR ,capL ,capR ,capT ,zipWithT ,zipWith ,zipping )whereimportData.Machine.Is importData.Machine.Plan importData.Machine.Process importData.Machine.Type importData.Machine.Source importPreludehiding((.),id,zipWith)--------------------------------------------------------------------------------- Tees--------------------------------------------------------------------------------- | The input descriptor for a 'Tee' or 'TeeT'dataT a b c whereL ::T a b a R ::T a b b -- | A 'Machine' that can read from two input stream in a deterministic manner.typeTee a b c =Machine (T a b )c -- | A 'Machine' that can read from two input stream in a deterministic manner with monadic side-effects.typeTeeT m a b c =MachineT m (T a b )c -- | Compose a pair of pipes onto the front of a Tee.---- Examples:---- >>> import Data.Machine.Source-- >>> run $ tee (source [1..]) (source ['a'..'c']) zipping-- [(1,'a'),(2,'b'),(3,'c')]--tee::Monadm =>ProcessT m a a' ->ProcessT m b b' ->TeeT m a' b' c ->TeeT m a b c tee ma mb m =MachineT $runMachineTm >>=\v ->casev ofStop ->returnStop Yield o k ->return$Yield o $tee ma mb k Await f L ff ->runMachineTma >>=\u ->caseu ofStop ->runMachineT$tee stopped mb ff Yield a k ->runMachineT$tee k mb $f a Await g Refl fg ->return$Await (\a ->tee (g a )mb $encased v )L $tee fg mb $encased v Await f R ff ->runMachineTmb >>=\u ->caseu ofStop ->runMachineT$tee ma stopped ff Yield b k ->runMachineT$tee ma k $f b Await g Refl fg ->return$Await (\b ->tee ma (g b )$encased v )R $tee ma fg $encased v -- | `teeT mt ma mb` Use a `Tee` to interleave or combine the outputs of `ma`-- and `mb`.---- The resulting machine will draw from a single source.---- Examples:---- >>> import Data.Machine.Source-- >>> run $ teeT zipping echo echo <~ source [1..5]-- [(1,2),(3,4)]--teeT::Monadm =>TeeT m a b c ->MachineT m k a ->MachineT m k b ->MachineT m k c teeT mt ma mb =MachineT $runMachineTmt >>=\v ->casev ofStop ->returnStop Yield o k ->return$Yield o $teeT k ma mb Await f L ff ->runMachineTma >>=\u ->caseu ofStop ->runMachineT$teeT ff stopped mb Yield a k ->runMachineT$teeT (f a )k mb Await g rq fg ->return$Await (\r ->teeT (encased v )(g r )mb )rq $teeT (encased v )fg mb Await f R ff ->runMachineTmb >>=\u ->caseu ofStop ->runMachineT$teeT ff ma stopped Yield a k ->runMachineT$teeT (f a )ma k Await g rq fg ->return$Await (\r ->teeT (encased v )ma (g r ))rq $teeT (encased v )ma fg -- | Precompose a pipe onto the left input of a tee.addL::Monadm =>ProcessT m a b ->TeeT m b c d ->TeeT m a c d addL p =tee p echo {-# INLINEaddL#-}-- | Precompose a pipe onto the right input of a tee.addR::Monadm =>ProcessT m b c ->TeeT m a c d ->TeeT m a b d addR =tee echo {-# INLINEaddR#-}-- | Tie off one input of a tee by connecting it to a known source.capL::Monadm =>SourceT m a ->TeeT m a b c ->ProcessT m b c capL s t =fit cappedT $addL s t {-# INLINEcapL#-}-- | Tie off one input of a tee by connecting it to a known source.capR::Monadm =>SourceT m b ->TeeT m a b c ->ProcessT m a c capR s t =fit cappedT $addR s t {-# INLINEcapR#-}-- | Tie off both inputs to a tee by connecting them to known sources.-- This is recommended over capping each side separately, as it is-- far more efficient.capT::Monadm =>SourceT m a ->SourceT m b ->TeeT m a b c ->SourceT m c capT l r t =plug $tee l r t {-# INLINEcapT#-}-- | Natural transformation used by 'capL' and 'capR'.cappedT::T a a b ->Is a b cappedT R =Refl cappedTL =Refl {-# INLINEcappedT#-}-- | wait for both the left and the right sides of a T and then merge them with f.zipWithT::(a ->b ->c )->PlanT (T a b )c m ()zipWithT f =do{a <-awaits L ;b <-awaits R ;yield $f a b }{-# INLINEzipWithT#-}-- | Zip together two inputs, then apply the given function,-- halting as soon as either input is exhausted.-- This implementation reads from the left, then the rightzipWith::(a ->b ->c )->Tee a b c zipWith f =repeatedly $doa <-awaits L b <-awaits R yield (f a b ){-# INLINEzipWith#-}-- | Zip together two inputs, halting as soon as either input is exhausted.zipping::Tee a b (a ,b )zipping =zipWith (,){-# INLINEzipping#-}