Hub.hs

{-|
Module:             STM.Hub
Description:        Hub's are bounded single-reader-multiple-writer queues.
Copyright:          © 2017 All rights reserved.
License:            GPL-3
Maintainer:         Evan Cofsky <evan@theunixman.com>
Stability:          experimental
Portability:        POSIX
-}

module STM.Hub (
    HubLength,
    Hub,
    hub,

    hubMsg,
    hubEmpty,

    Source,
    source,
    sourceMsg
    )where

import Lawless
import STM.Base

-- * The 'Hub'

-- | The length of a 'Hub', guaranteed to be positive.
newtype HubLength = HubLength Word64
    deriving (Eq, Ord, Show, Bounded, Enum, Num, Integral, Real)

-- | The 'Hub' receives the messages from various 'Source's.
newtype Hub a = Hub {unHub ∷ TBChan a}

hub ∷ MonadBase IO m ⇒ HubLength → m (Hub a)
hub l = liftBase $ Hub <$> (newTBChanIO $ fromIntegral l)

hubMsg ∷ MonadBase IO m ⇒ (Hub a) → (m a)
hubMsg = atomically ∘ readTBChan ∘ unHub

hubEmpty ∷ MonadBase IO m ⇒ (Hub a) → (m Bool)
hubEmpty = atomically ∘  isEmptyTBChan ∘ unHub

-- * The 'Source'

-- | A 'Source' attached to a 'Hub' that can send messages to it.
newtype Source a = Source {unSource ∷ TBChan a}

-- | Create a 'Source' attached to a 'Hub'.
source ∷ Getter (Hub a) (Source a)
source = to $ Source ∘ unHub

-- | Send a message to a 'Hub' through a 'Source'.
sourceMsg ∷ MonadBase IO m ⇒ Source a → a → m ()
sourceMsg s = atomically ∘ writeTBChan (unSource s)