Merge.hs

{-# LANGUAGE DeriveGeneric #-}

module Pipes.Fluid.Merge where

import qualified GHC.Generics as G

-- | Differentiates whether a value from either or both producers.
-- In the case of one producer, additional identify if the other producer is live or dead.
data Source = FromBoth | FromLeft OtherStatus | FromRight OtherStatus
    deriving (Eq, Show, Ord, G.Generic)

-- | The other producer can be live (still yielding values), or dead
data OtherStatus = OtherLive | OtherDead
    deriving (Eq, Show, Ord, G.Generic)

-- | Differentiates when only one side is available (due to initial merge values of Nothing)
-- or if two values (one of which may be a previous values) are availabe.
data Merged a b =
    Coupled Source a b
    | LeftOnly OtherStatus a
    | RightOnly OtherStatus b
    deriving (Eq, Show, Ord, G.Generic)

-- | This can be used with 'Pipes.Prelude.takeWhile'
isBothLive :: Merged x y -> Bool
isBothLive (Coupled FromBoth _ _) = True
isBothLive (Coupled (FromLeft OtherLive) _ _) = True
isBothLive (Coupled (FromRight OtherLive) _ _) = True
isBothLive (LeftOnly OtherLive _) = True
isBothLive (RightOnly OtherLive _) = True
isBothLive _ = False
{-# INLINABLE isBothLive #-}

-- | This can be used with 'Pipes.Prelude.takeWhile'
isLeftLive :: Merged x y -> Bool
isLeftLive (Coupled FromBoth _ _) = True
isLeftLive (Coupled (FromLeft _) _ _) = True
isLeftLive (Coupled (FromRight OtherLive) _ _) = True
isLeftLive (LeftOnly _ _) = True
isLeftLive (RightOnly OtherLive _) = True
isLeftLive _ = False
{-# INLINABLE isLeftLive #-}

-- | This can be used with 'Pipes.Prelude.takeWhile'
isRightLive :: Merged x y -> Bool
isRightLive (Coupled FromBoth _ _) = True
isRightLive (Coupled (FromRight _) _ _) = True
isRightLive (Coupled (FromLeft OtherLive) _ _) = True
isRightLive (RightOnly _ _) = True
isRightLive (LeftOnly OtherLive _) = True
isRightLive _ = False
{-# INLINABLE isRightLive #-}

-- | This can be used with 'Pipes.Prelude.takeWhile'
isRightDead :: Merged x y -> Bool
isRightDead (Coupled (FromLeft OtherDead) _ _) = True
isRightDead (LeftOnly OtherDead _) = True
isRightDead _ = False
{-# INLINABLE isRightDead #-}

-- | This can be used with 'Pipes.Prelude.takeWhile'
isLeftDead :: Merged x y -> Bool
isLeftDead (Coupled (FromRight OtherDead) _ _) = True
isLeftDead (RightOnly OtherDead _) = True
isLeftDead _ = False
{-# INLINABLE isLeftDead #-}

class Merge f where
    merge' :: Maybe x -> Maybe y -> f x -> f y -> f (Merged x y)

merge :: Merge f => f x -> f y -> f (Merged x y)
merge = merge' Nothing Nothing
{-# INLINABLE merge #-}

-- | Keep only the values originated from the left, replacing other yields with Nothing.
-- This is useful when React is based on STM, since filtering with Producer STM results in
-- larger STM transactions which may result in blocking.
discreteLeft :: Merged x y -> Maybe x
discreteLeft (LeftOnly _ x) = Just x
discreteLeft (Coupled FromBoth  x _) = Just x
discreteLeft (Coupled (FromLeft _)  x _) = Just x
discreteLeft _ = Nothing

-- | Keep only the values originated from the right, replacing other yields with Nothing.
-- This is useful when React is based on STM, since filtering with Producer STM results in
-- larger STM transactions which may result in blocking.
discreteRight :: Merged x y -> Maybe y
discreteRight (RightOnly _ y) = Just y
discreteRight (Coupled FromBoth  _ y) = Just y
discreteRight (Coupled (FromRight _)  _ y) = Just y
discreteRight _ = Nothing

-- | Keep only the values originated from both, replacing other yields with Nothing.
-- This is useful when React is based on STM, since filtering with Producer STM results in
-- larger STM transactions which may result in blocking.
discreteBoth :: Merged x y -> Maybe (x, y)
discreteBoth (Coupled FromBoth  x y) = Just (x, y)
discreteBoth _ = Nothing