{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

-- | Here we implement a null guard channel that provides no guards,
-- but is hopefully useful as an example.
module Events.NullGuard (
   NullGuardedChannel,
   newNullGuardedChannel
   ) where

import Events.GuardedEvents
import Events.GuardedChannels
import Events.DeleteQueue



type NullGuardedChannel value = GuardedChannel () value

newNullGuardedChannel :: IO (NullGuardedChannel value)
newNullGuardedChannel :: IO (NullGuardedChannel value)
newNullGuardedChannel = value -> IO (NullGuardedChannel value)
forall value. value -> IO (NullGuardedChannel value)
newNullGuardedChannelPrim ([Char] -> value
forall a. HasCallStack => [Char] -> a
error [Char]
"newNull")

-- The argument to newNullGuardedChannelPrim is not looked at,
-- but helps us to avoid overloading woes.
newNullGuardedChannelPrim :: value -> IO (NullGuardedChannel value)
newNullGuardedChannelPrim :: value -> IO (NullGuardedChannel value)
newNullGuardedChannelPrim (value
_ :: value) =
   GQ NullGuardQueue value
-> VQ (NullValueQueue value) -> IO (NullGuardedChannel value)
forall (guardQueue :: * -> *) (valueQueue :: * -> *) guard value.
HasGuardedChannel guardQueue valueQueue guard value =>
GQ guardQueue value
-> VQ valueQueue -> IO (GuardedChannel guard value)
newGuardedChannel ([Char] -> GQ NullGuardQueue value
forall a. HasCallStack => [Char] -> a
error [Char]
"newNull1" :: (GQ NullGuardQueue value))
      ([Char] -> VQ (NullValueQueue value)
forall a. HasCallStack => [Char] -> a
error [Char]
"newNull2" :: (VQ (NullValueQueue value)))


-- --------------------------------------------------------------------
-- The Guard type
-- --------------------------------------------------------------------

instance Guard () where
   nullGuard :: ()
nullGuard = ()
   andGuard :: () -> () -> ()
andGuard ()
_ ()
_ = ()

-- --------------------------------------------------------------------
-- The Value Queue.
-- --------------------------------------------------------------------

data NullValueQueue value valueCont =
   NullValueQueue (DeleteQueue (value,valueCont))

emptyNullValueQueue :: NullValueQueue value a
emptyNullValueQueue :: NullValueQueue value a
emptyNullValueQueue = DeleteQueue (value, a) -> NullValueQueue value a
forall value valueCont.
DeleteQueue (value, valueCont) -> NullValueQueue value valueCont
NullValueQueue DeleteQueue (value, a)
forall v. DeleteQueue v
emptyQueue

instance HasEmpty (NullValueQueue value) where
   newEmpty :: IO (NullValueQueue value xData)
newEmpty = NullValueQueue value xData -> IO (NullValueQueue value xData)
forall (m :: * -> *) a. Monad m => a -> m a
return NullValueQueue value xData
forall value a. NullValueQueue value a
emptyNullValueQueue

instance HasAdd (NullValueQueue value) value where
   add :: NullValueQueue value xData
-> value -> xData -> IO (NullValueQueue value xData, IO ())
add (NullValueQueue DeleteQueue (value, xData)
deleteQueue) value
value xData
valueCont =
      do
         (DeleteQueue (value, xData)
deleteQueue2,IO ()
invalidate) <- DeleteQueue (value, xData)
-> (value, xData) -> IO (DeleteQueue (value, xData), IO ())
forall v. DeleteQueue v -> v -> IO (DeleteQueue v, IO ())
addQueue DeleteQueue (value, xData)
deleteQueue (value
value,xData
valueCont)
         (NullValueQueue value xData, IO ())
-> IO (NullValueQueue value xData, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (DeleteQueue (value, xData) -> NullValueQueue value xData
forall value valueCont.
DeleteQueue (value, valueCont) -> NullValueQueue value valueCont
NullValueQueue DeleteQueue (value, xData)
deleteQueue2,IO ()
invalidate)

instance HasRemove (NullValueQueue value) () value where
   remove :: NullValueQueue value yData
-> ()
-> IO
     (Maybe (value, yData, IO (NullValueQueue value yData)),
      NullValueQueue value yData)
remove (NullValueQueue DeleteQueue (value, yData)
deleteQueue) () =
       do
          Maybe
  ((value, yData), DeleteQueue (value, yData),
   DeleteQueue (value, yData))
removed <- DeleteQueue (value, yData)
-> IO
     (Maybe
        ((value, yData), DeleteQueue (value, yData),
         DeleteQueue (value, yData)))
forall v.
DeleteQueue v -> IO (Maybe (v, DeleteQueue v, DeleteQueue v))
removeQueue DeleteQueue (value, yData)
deleteQueue
          case Maybe
  ((value, yData), DeleteQueue (value, yData),
   DeleteQueue (value, yData))
removed of
             Maybe
  ((value, yData), DeleteQueue (value, yData),
   DeleteQueue (value, yData))
Nothing -> (Maybe (value, yData, IO (NullValueQueue value yData)),
 NullValueQueue value yData)
-> IO
     (Maybe (value, yData, IO (NullValueQueue value yData)),
      NullValueQueue value yData)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (value, yData, IO (NullValueQueue value yData))
forall a. Maybe a
Nothing,NullValueQueue value yData
forall value a. NullValueQueue value a
emptyNullValueQueue)
             Just ((value
value,yData
valueCont),DeleteQueue (value, yData)
deleteQueue2,DeleteQueue (value, yData)
deleteQueue0) ->
                (Maybe (value, yData, IO (NullValueQueue value yData)),
 NullValueQueue value yData)
-> IO
     (Maybe (value, yData, IO (NullValueQueue value yData)),
      NullValueQueue value yData)
forall (m :: * -> *) a. Monad m => a -> m a
return ((value, yData, IO (NullValueQueue value yData))
-> Maybe (value, yData, IO (NullValueQueue value yData))
forall a. a -> Maybe a
Just(value
value,yData
valueCont,
                      NullValueQueue value yData -> IO (NullValueQueue value yData)
forall (m :: * -> *) a. Monad m => a -> m a
return (DeleteQueue (value, yData) -> NullValueQueue value yData
forall value valueCont.
DeleteQueue (value, valueCont) -> NullValueQueue value valueCont
NullValueQueue DeleteQueue (value, yData)
deleteQueue0)),
                   DeleteQueue (value, yData) -> NullValueQueue value yData
forall value valueCont.
DeleteQueue (value, valueCont) -> NullValueQueue value valueCont
NullValueQueue DeleteQueue (value, yData)
deleteQueue2)
-- --------------------------------------------------------------------
-- The Guard Queue
-- --------------------------------------------------------------------

data NullGuardQueue guardCont = NullGuardQueue (DeleteQueue guardCont)

emptyNullGuardQueue :: NullGuardQueue a
emptyNullGuardQueue :: NullGuardQueue a
emptyNullGuardQueue = DeleteQueue a -> NullGuardQueue a
forall guardCont. DeleteQueue guardCont -> NullGuardQueue guardCont
NullGuardQueue DeleteQueue a
forall v. DeleteQueue v
emptyQueue

instance HasEmpty NullGuardQueue where
   newEmpty :: IO (NullGuardQueue xData)
newEmpty = NullGuardQueue xData -> IO (NullGuardQueue xData)
forall (m :: * -> *) a. Monad m => a -> m a
return NullGuardQueue xData
forall a. NullGuardQueue a
emptyNullGuardQueue

instance HasAdd NullGuardQueue () where
   add :: NullGuardQueue xData
-> () -> xData -> IO (NullGuardQueue xData, IO ())
add (NullGuardQueue DeleteQueue xData
deleteQueue) () xData
guardCont =
      do
         (DeleteQueue xData
deleteQueue2,IO ()
invalidate) <- DeleteQueue xData -> xData -> IO (DeleteQueue xData, IO ())
forall v. DeleteQueue v -> v -> IO (DeleteQueue v, IO ())
addQueue DeleteQueue xData
deleteQueue xData
guardCont
         DeleteQueue xData
deleteQueue3 <- DeleteQueue xData -> IO (DeleteQueue xData)
forall v. DeleteQueue v -> IO (DeleteQueue v)
cleanQueue DeleteQueue xData
deleteQueue2
         (NullGuardQueue xData, IO ()) -> IO (NullGuardQueue xData, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (DeleteQueue xData -> NullGuardQueue xData
forall guardCont. DeleteQueue guardCont -> NullGuardQueue guardCont
NullGuardQueue DeleteQueue xData
deleteQueue3,IO ()
invalidate)

instance HasRemove NullGuardQueue value () where
   remove :: NullGuardQueue yData
-> value
-> IO
     (Maybe ((), yData, IO (NullGuardQueue yData)),
      NullGuardQueue yData)
remove (NullGuardQueue DeleteQueue yData
deleteQueue) value
value =
       do
          Maybe (yData, DeleteQueue yData, DeleteQueue yData)
removed <- DeleteQueue yData
-> IO (Maybe (yData, DeleteQueue yData, DeleteQueue yData))
forall v.
DeleteQueue v -> IO (Maybe (v, DeleteQueue v, DeleteQueue v))
removeQueue DeleteQueue yData
deleteQueue
          case Maybe (yData, DeleteQueue yData, DeleteQueue yData)
removed of
             Maybe (yData, DeleteQueue yData, DeleteQueue yData)
Nothing -> (Maybe ((), yData, IO (NullGuardQueue yData)),
 NullGuardQueue yData)
-> IO
     (Maybe ((), yData, IO (NullGuardQueue yData)),
      NullGuardQueue yData)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ((), yData, IO (NullGuardQueue yData))
forall a. Maybe a
Nothing,NullGuardQueue yData
forall a. NullGuardQueue a
emptyNullGuardQueue)
             Just (yData
guardCont,DeleteQueue yData
deleteQueue2,DeleteQueue yData
deleteQueue0) ->
                (Maybe ((), yData, IO (NullGuardQueue yData)),
 NullGuardQueue yData)
-> IO
     (Maybe ((), yData, IO (NullGuardQueue yData)),
      NullGuardQueue yData)
forall (m :: * -> *) a. Monad m => a -> m a
return (((), yData, IO (NullGuardQueue yData))
-> Maybe ((), yData, IO (NullGuardQueue yData))
forall a. a -> Maybe a
Just((),yData
guardCont,
                      NullGuardQueue yData -> IO (NullGuardQueue yData)
forall (m :: * -> *) a. Monad m => a -> m a
return (DeleteQueue yData -> NullGuardQueue yData
forall guardCont. DeleteQueue guardCont -> NullGuardQueue guardCont
NullGuardQueue DeleteQueue yData
deleteQueue0)),
                   DeleteQueue yData -> NullGuardQueue yData
forall guardCont. DeleteQueue guardCont -> NullGuardQueue guardCont
NullGuardQueue DeleteQueue yData
deleteQueue2)