Timeout.hs

{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, GADTs, FlexibleInstances, ScopedTypeVariables, DeriveDataTypeable, TypeSynonymInstances, StandaloneDeriving, NamedFieldPuns #-}

{-|
This module defines a simple 'Neuron' which initiates 'dissolving' after a given delay. It can be used to limit execution time of
the network. You 'grow' it in 'Incubation' by using something like:

> _ <- growNeuron defaultOptions :: NerveNone TimeoutNeuron

somewhere among (best at the end) 'growNeuron' calls for other 'Neuron's in 'Incubation'.
-}

module Control.Etage.Timeout (
  TimeoutNeuron,
  TimeoutFromImpulse,
  TimeoutForImpulse,
  TimeoutOptions,
  NeuronFromImpulse,
  NeuronForImpulse,
  NeuronOptions(..)
) where

import Control.Concurrent
import Control.Monad
import Data.Typeable

import Control.Etage

defaultTimeout :: Int
defaultTimeout = 60000000 -- microseconds, 60 seconds

data TimeoutNeuron = TimeoutNeuron TimeoutOptions deriving (Typeable)

instance Show TimeoutNeuron where
  show = show . typeOf

-- | 'Impulse's from 'TimeoutNeuron'. This 'Neuron' does not define any 'Impulse's it would send.
type TimeoutFromImpulse = NeuronFromImpulse TimeoutNeuron
-- | 'Impulse's for 'TimeoutNeuron'. This 'Neuron' does not define any 'Impulse's it would receive.
type TimeoutForImpulse = NeuronForImpulse TimeoutNeuron
{-|
Options for 'TimeoutNeuron'. This option is defined:

[@timeout :: 'Int'@] The length of the delay in microseconds before initiating 'dissolving'. Default is 60 seconds.
-}
type TimeoutOptions = NeuronOptions TimeoutNeuron

-- | Impulse instance for 'TimeoutNeuron'.
instance Impulse TimeoutFromImpulse where
  impulseTime _ = undefined
  impulseValue _ = undefined

-- | Impulse instance for 'TimeoutNeuron'.
instance Impulse TimeoutForImpulse where
  impulseTime _ = undefined
  impulseValue _ = undefined

deriving instance Show TimeoutFromImpulse
deriving instance Show TimeoutForImpulse

-- | A simple 'Neuron' which initiates 'dissolving' after a given delay.
instance Neuron TimeoutNeuron where
  data NeuronFromImpulse TimeoutNeuron
  data NeuronForImpulse TimeoutNeuron
  data NeuronOptions TimeoutNeuron = TimeoutOptions {
      timeout :: Int -- microseconds
    } deriving (Eq, Ord, Read, Show)
  
  mkDefaultOptions = return TimeoutOptions {
      timeout = defaultTimeout
    }
  
  grow options = return $ TimeoutNeuron options
  
  live _ n@(TimeoutNeuron TimeoutOptions { timeout }) = do
    threadDelay timeout
    dissolving n