{-# LANGUAGE DeriveDataTypeable #-}

-- | Holds some types that the modules requires in common.
module Network.Zyre2.Types where

import Control.Exception (Exception, throw)
import Data.IORef (IORef, newIORef, readIORef)
import qualified Data.Map.Strict as Map
import Data.Text
import Data.Typeable (Typeable)
import Data.Word (Word32)
import Foreign (Ptr)

-- | Runtime exceptions that can be thrown.
data ZyreException
  = StaleZyreContextException
  | ZyreMsgDontSupportFramesException
  deriving (Int -> ZyreException -> ShowS
[ZyreException] -> ShowS
ZyreException -> String
(Int -> ZyreException -> ShowS)
-> (ZyreException -> String)
-> ([ZyreException] -> ShowS)
-> Show ZyreException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZyreException] -> ShowS
$cshowList :: [ZyreException] -> ShowS
show :: ZyreException -> String
$cshow :: ZyreException -> String
showsPrec :: Int -> ZyreException -> ShowS
$cshowsPrec :: Int -> ZyreException -> ShowS
Show, Typeable)

instance Exception ZyreException

-- Context to apply to zyre functions.

-- | A context handle for zyre contexts. Holds relevant state for
-- the context, and is tagged with the state of the context.
-- E.g. 'ZCreated', 'ZRunning', 'ZStopped', 'ZDestroyed'.
data ZyreContext state = ZyreContext
  { ZyreContext state -> Ptr ()
_zyreContextPtr :: Ptr (),
    ZyreContext state -> IORef Bool
_zyreContextStale :: IORef Bool,
    -- | Mapping of node-ids to node names.
    ZyreContext state -> IORef (Map Text Text)
_zyreContextNodeNames :: IORef (Map.Map Text Text)
  }

-- Phantom tags for the zyre context.

-- | Phantom tag for a created context.
data ZCreated = ZCreated

-- | Phantom tag for a running context.
data ZRunning = ZRunning

-- | Phantom tag for a stopped context.
data ZStopped = ZStopped

-- | Phantom tag for a destroyed context.
data ZDestroyed = ZDestroyed

-- | Perform an IO a action unless the context is stale, then throw
-- a 'StaleZyreContextException' instead.
unlessStale :: ZyreContext s -> IO a -> IO a
unlessStale :: ZyreContext s -> IO a -> IO a
unlessStale (ZyreContext Ptr ()
_ IORef Bool
stale IORef (Map Text Text)
_) IO a
fn = do
  Bool
isStale <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
stale
  if Bool
isStale
    then ZyreException -> IO a
forall a e. Exception e => e -> a
throw ZyreException
StaleZyreContextException
    else IO a
fn