packages feed

Etage 0.1.4 → 0.1.5

raw patch · 13 files changed

+643/−343 lines, 13 filesdep ~ghc

Dependency ranges changed: ghc

Files

Etage.cabal view
@@ -1,5 +1,5 @@ Name:                Etage-Version:             0.1.4+Version:             0.1.5 Synopsis:            A general data-flow framework Description:         A general data-flow framework featuring nondeterminism, laziness and neurological pseudo-terminology. It can be                      used for example for data-flow computations or event propagation networks. It tries hard to aide type checking and to@@ -34,17 +34,19 @@                        Control.Etage.Worker,                        Control.Etage.Timeout,                        Control.Etage.Function,-                       Control.Etage.Fail+                       Control.Etage.Fail,+                       Control.Etage.Delay   Build-depends:       base >= 4.3 && < 5,                        mtl >= 1.1 && < 3,                        random > 1.0 && < 2,                        unix >= 2.4 && < 3,                        time >= 1.1 && < 2,                        operational >= 0.2 && < 1,-                       ghc >= 7.0.1+                       ghc >= 7   Other-modules:       Control.Etage.Internals,                        Control.Etage.Externals,                        Control.Etage.Propagate,+                       Control.Etage.Fuse,                        Control.Etage.Incubator,                        Control.Etage.Chan   HS-source-dirs:      lib
+ lib/Control/Etage/Delay.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, GADTs, FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances, DeriveDataTypeable, NamedFieldPuns, DisambiguateRecordFields #-}++{-|+This module defines a 'Neuron' which delays received 'Impulse's before sending them further. In this way network can have a simple+kind of memory (state) without a need of special 'Neuron's. You 'grow' it in 'Incubation' by using something like:++> nerveDelay <- (growNeuron :: NerveBoth (DelayNeuron IInteger)) (\o -> o { delay = 2 })++Sometimes the same effect can be achieved by using a 'Nerve' as a queue and using 'fuseWith' (or 'fuse') to synchronize (and thus+delay) 'Impulse's. For example, the following two programs both output Fibonacci sequence:++> incubate $ do+>   nerveDump <- (growNeuron :: NerveOnlyFor DumpNeuron) (\o -> o { showInsteadOfDump = True })+>   nerveDelay <- (growNeuron :: NerveBoth (DelayNeuron IInteger)) defaultOptions+>   nerveSum <- (growNeuron :: NerveBoth (FunctionNeuron IIntegerList IInteger)) (\o -> o { function = \t -> (: []) . IValue t . sum . list })+>   nerveFused <- [TranslatableFrom nerveDelay, TranslatableFrom nerveSum] `fuseWith` (listFuser :: ImpulseTime -> [IInteger] -> [IIntegerList])+>   +>   nerveSum `attachTo` [TranslatableFor nerveDelay, TranslatableFor nerveDump]+>   nerveFused `attachTo` [TranslatableFor nerveSum]+>   +>   liftIO $ do+>     t <- getCurrentImpulseTime+>     sendFromNeuron nerveSum $ IValue t 1+>     sendFromNeuron nerveDelay $ IValue t 0++> incubate $ do+>   nerveDump <- (growNeuron :: NerveOnlyFor DumpNeuron) (\o -> o { showInsteadOfDump = True })+>   nerveSum <- (growNeuron :: NerveBoth (FunctionNeuron IIntegerList IInteger)) (\o -> o { function = \t -> (: []) . IValue t . sum . list })+>   +>   liftIO $ do+>     t <- getCurrentImpulseTime+>     sendFromNeuron nerveSum $ IValue t 0+>   +>   nerveSum' <- liftIO $ branchNerveFrom nerveSum+>   nerveFused <- [TranslatableFrom nerveSum, TranslatableFrom nerveSum'] `fuseWith` (listFuser :: ImpulseTime -> [IInteger] -> [IIntegerList])+>   +>   nerveSum `attachTo` [TranslatableFor nerveDump]+>   nerveFused `attachTo` [TranslatableFor nerveSum]+>   +>   liftIO $ do+>     t <- getCurrentImpulseTime+>     sendFromNeuron nerveSum $ IValue t 1++This 'Neuron' processes all 'Impulse's it receives.+-}++module Control.Etage.Delay (+  DelayNeuron,+  DelayFromImpulse,+  DelayForImpulse,+  DelayOptions,+  NeuronOptions(..)+) where++import Data.Data++import Control.Etage++defaultDelay :: Int+defaultDelay = 1++data DelayNeuron i = DelayNeuron (DelayOptions i) deriving (Typeable, Data)++-- | 'Impulse's from 'DelayNeuron', of type @i@.+type DelayFromImpulse i = NeuronFromImpulse (DelayNeuron i)+-- | 'Impulse's for 'DelayNeuron', of type @i@.+type DelayForImpulse i = NeuronForImpulse (DelayNeuron i)+{-|+Options for 'DelayNeuron'. This option is defined:++[@delay :: 'Int'@] For how many 'Impulse's should received 'Impulse's be delayed before sending them. Default value is 1.+-}+type DelayOptions i = NeuronOptions (DelayNeuron i)++-- | A 'Neuron' which delays received 'Impulse's before sending them further.+instance Impulse i => Neuron (DelayNeuron i) where+  type NeuronFromImpulse (DelayNeuron i) = i+  type NeuronForImpulse (DelayNeuron i) = i+  data NeuronOptions (DelayNeuron i) = DelayOptions {+      delay :: Int+    } deriving (Eq, Ord, Read, Show, Data)+  +  mkDefaultOptions = return DelayOptions {+      delay = defaultDelay+    }+  +  grow options = return $ DelayNeuron options+  +  live nerve (DelayNeuron DelayOptions { delay }) = live' []+    where live' pastImpulses = do+            is <- waitAndSlurpForNeuron nerve -- we want all not just newest+            let allImpulses = is ++ pastImpulses+                (delayedImpulses, readyImpulses) = splitAt delay allImpulses+            sendListFromNeuron nerve $ reverse readyImpulses+            live' delayedImpulses
lib/Control/Etage/Dump.hs view
@@ -1,11 +1,11 @@-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, GADTs, FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances, StandaloneDeriving, DeriveDataTypeable, NamedFieldPuns #-}+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, GADTs, FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances, DeriveDataTypeable, NamedFieldPuns #-}  {-| This module defines a 'Neuron' which dumps all 'Impulse's it receives. You 'grow' it in 'Incubation' by using something like: -> nerveDump <- growNeuron (\o -> o { showInsteadOfDump = True }) :: NerveOnlyFor DumpNeuron+> nerveDump <- (growNeuron :: NerveOnlyFor DumpNeuron) (\o -> o { showInsteadOfDump = True }) -It is an example of a 'Neuron' which can recieve any 'Impulse' type.+It is an example of a 'Neuron' which can recieve any 'Impulse' type. It processes all 'Impulse's it receives. -}  module Control.Etage.Dump (@@ -13,22 +13,23 @@   DumpFromImpulse,   DumpForImpulse,   DumpOptions,-  NeuronFromImpulse,-  NeuronForImpulse(..),   NeuronOptions(..) ) where  import Control.Monad-import Data.Typeable+import Data.Data import System.IO  import Control.Etage +defaultPrefix :: String+defaultPrefix = ""+ data DumpNeuron = DumpNeuron DumpOptions deriving (Typeable) --- | 'Impulse's from 'DumpNeuron'. This 'Neuron' does not define any 'Impulse's it would send.+-- | 'Impulse's from 'DumpNeuron'. This 'Neuron' does not define any 'Impulse's it would send, 'NoImpulse'. type DumpFromImpulse = NeuronFromImpulse DumpNeuron--- | 'Impulse's for 'DumpNeuron'. This 'Neuron' can recieve any 'Impulse' type.+-- | 'Impulse's for 'DumpNeuron'. This 'Neuron' can recieve any 'Impulse' type, 'AnyImpulse'. type DumpForImpulse = NeuronForImpulse DumpNeuron {-| Options for 'DumpNeuron'. Those options are defined:@@ -37,52 +38,31 @@  [@showInsteadOfDump :: 'Bool'@] Should it use 'show' when dumping 'Impulse's? By default it dumps 'impulseTime' and 'impulseValue' values.++[@prefix :: 'String'@] Prefix to use when dumping. Default is no prefix. -} type DumpOptions = NeuronOptions DumpNeuron --- | Impulse instance for 'DumpNeuron'.-instance Impulse DumpFromImpulse where-  impulseTime _ = undefined-  impulseValue _ = undefined---- | Impulse instance for 'DumpNeuron'.-instance Impulse DumpForImpulse where-  impulseTime (DumpForImpulse i) = impulseTime i-  impulseValue (DumpForImpulse i) = impulseValue i--deriving instance Show DumpFromImpulse--instance Show DumpForImpulse where-  show (DumpForImpulse i) = show i--instance Eq DumpForImpulse where-  (==) = impulseEq--instance Ord DumpForImpulse where-  compare = impulseCompare- -- | A 'Neuron' which dumps all 'Impulse's it receives. instance Neuron DumpNeuron where-  data NeuronFromImpulse DumpNeuron-  data NeuronForImpulse DumpNeuron where-    DumpForImpulse :: Impulse i => i -> DumpForImpulse+  type NeuronFromImpulse DumpNeuron = NoImpulse+  type NeuronForImpulse DumpNeuron = AnyImpulse   data NeuronOptions DumpNeuron = DumpOptions {       handle :: Handle,-      showInsteadOfDump :: Bool+      showInsteadOfDump :: Bool,+      prefix :: String     } deriving (Eq, Show)      mkDefaultOptions = return DumpOptions {       handle = stdout,-      showInsteadOfDump = False+      showInsteadOfDump = False,+      prefix = defaultPrefix     }      grow options = return $ DumpNeuron options   -  live nerve (DumpNeuron DumpOptions { handle, showInsteadOfDump }) = forever $ do+  live nerve (DumpNeuron DumpOptions { handle, showInsteadOfDump, prefix }) = forever $ do     i <- getForNeuron nerve -- we want all not just newest     if showInsteadOfDump-      then hPutStrLn handle $ show i-      else hPutStrLn handle $ show (impulseTime i) ++ ": " ++ show (impulseValue i)--instance Impulse i => ImpulseTranslator i DumpForImpulse where-  translate i = [DumpForImpulse i]+      then hPutStrLn handle $ prefix ++ show i+      else hPutStrLn handle $ prefix ++ show (impulseTime i) ++ ": " ++ show (impulseValue i)
lib/Control/Etage/Externals.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, GADTs, FlexibleInstances, FlexibleContexts, ScopedTypeVariables, TypeSynonymInstances, StandaloneDeriving, DeriveDataTypeable, NamedFieldPuns #-}+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, GADTs, OverlappingInstances, FlexibleInstances, FlexibleContexts, ScopedTypeVariables, TypeSynonymInstances, StandaloneDeriving, DeriveDataTypeable, NamedFieldPuns #-}  module Control.Etage.Externals (   -- * 'Neuron's and 'Impulse's@@ -23,13 +23,26 @@   Impulse(..),   ImpulseTime,   ImpulseValue,-  ImpulseTranslator(..),+  AnyImpulse(..),+  NoImpulse,+  IValue(..),+  IInteger,+  IRational,+  IList(..),+  IIntegerList,+  IRationalList, +  ImpulseTranslator(..),   translateAndSend,    Nerve,   AxonConductive,   AxonNonConductive,+  FromNerve(..),+  ForNerve(..),+  BothNerve(..),+  TranslatableFrom(..),+  TranslatableFor(..),    -- * Sending and receiving outside the 'Neuron'   -- | Those functions are used outside the 'Neuron' when interacting with it.@@ -54,6 +67,8 @@    -- * Helper functions   prepareEnvironment,+  fuserFun,+  listFuser,   getCurrentImpulseTime,   impulseEq,   impulseCompare@@ -209,7 +224,7 @@ data NeuronMapCapability =     NeuronMapOnCapability Int -- ^ Map a 'Neuron' to fixed capability.   | NeuronFreelyMapOnCapability -- ^ Let Haskell decide on which capability is best to map a 'Neuron' at a given time.-  deriving (Eq, Ord, Read, Show)+  deriving (Eq, Ord, Read, Show, Typeable, Data)  {-| Creates a 'NeuronMapOnCapability' value with a chosen capability picked by random. Useful when you have to map few 'Neuron's to the@@ -230,16 +245,99 @@                  NeuronFreelyMapOnCapability -> forkIO                  NeuronMapOnCapability c     -> forkOnIO c -deriving instance Typeable1 NeuronFromImpulse-deriving instance Typeable1 NeuronForImpulse-deriving instance Typeable1 NeuronOptions+-- TODO: Use "deriving instance Typeable1 NeuronOptions" once support for that is in stable GHC version+instance Typeable1 NeuronOptions where+  typeOf1 _ = mkTyConApp (mkTyCon "Control.Etage.Externals.NeuronOptions") [] +{-|+An existentially quantified type encompassing all 'Impulse's. Useful when 'Neuron' should send or receive any 'Impulse' type.+-}+data AnyImpulse where+  AnyImpulse :: Impulse i => i -> AnyImpulse++instance Impulse AnyImpulse where+  impulseTime (AnyImpulse i) = impulseTime i+  impulseValue (AnyImpulse i) = impulseValue i++deriving instance Typeable AnyImpulse++instance Show AnyImpulse where+  show (AnyImpulse i) = show i++instance Eq AnyImpulse where+  (==) = impulseEq++instance Ord AnyImpulse where+  compare = impulseCompare++instance Impulse i => ImpulseTranslator i AnyImpulse where+  translate i = [AnyImpulse i]++instance ImpulseTranslator AnyImpulse AnyImpulse where+  translate i = [i]++{-|+Empty 'Impulse' data type. Useful when 'Neuron' does not send or receive 'Impulse's.+-}+data NoImpulse++instance Impulse NoImpulse where+  impulseTime _ = undefined+  impulseValue _ = undefined++deriving instance Typeable NoImpulse+deriving instance Show NoImpulse+deriving instance Data NoImpulse++{-|+Basic 'Impulse' data type holding a 'value'.++Ordered first by 'impulseValueTimestamp' and then by 'value'. Equal only if both 'impulseValueTimestamp' and 'value' are equal.+-}+data (Real r, Show r, Typeable r) => IValue r = IValue {+    -- time is first so that ordering is first by time+    impulseValueTimestamp :: ImpulseTime, -- ^ Time when the 'Impulse' was created/finalized.+    value :: r -- ^ 'value' of the 'Impulse'.+  } deriving (Eq, Ord, Read, Show, Typeable, Data)++instance (Real r, Show r, Typeable r) => Impulse (IValue r) where+  impulseTime IValue { impulseValueTimestamp } = impulseValueTimestamp+  impulseValue IValue { value } = [toRational value]++-- | 'IValue' type with 'value' as 'Integer' type.+type IInteger = IValue Integer+-- | 'IValue' type with 'value' as 'Rational' type.+type IRational = IValue Rational++{-|+Basic 'Impulse' data type holding a 'list' of values.++Ordered first by 'impulseListTimestamp' and then by 'list'. Equal only if both 'impulseListTimestamp' and 'list' are equal.+-}+data (Real r, Show r, Typeable r) => IList r = IList {+    -- time is first so that ordering is first by time+    impulseListTimestamp :: ImpulseTime, -- ^ Time when the 'Impulse' was created/finalized.+    list :: [r] -- ^ 'list' of values of the 'Impulse'.+  } deriving (Eq, Ord, Read, Show, Typeable, Data)++instance (Real r, Show r, Typeable r) => Impulse (IList r) where+  impulseTime IList { impulseListTimestamp } = impulseListTimestamp+  impulseValue IList { list } = map toRational list++-- | 'IList' type with 'list' having 'Integer' type values.+type IIntegerList = IList Integer+-- | 'IList' type with 'list' having 'Rational' type values.+type IRationalList = IList Rational++-- TODO: Should be call of dissolving automatic at the end of the live?+-- TODO: Use NoImpulse as default for NeuronFromImpulse and NeuronForImpulse once support for defaults are implemented in GHC+ -- | A type class which defines common methods and data types of 'Neuron's.-class (Typeable n, Impulse (NeuronFromImpulse n), Impulse (NeuronForImpulse n)) => Neuron n where-  -- | A data type for 'Impulses' send from a 'Neuron'. 'Neuron' does not really need to use them.-  data NeuronFromImpulse n-  -- | A data type for 'Impulses' send for a 'Neuron'. 'Neuron' does not really need to use them.-  data NeuronForImpulse n+class (Typeable n, Impulse (NeuronFromImpulse n), Impulse (NeuronForImpulse n), Typeable (NeuronFromImpulse n), Typeable (NeuronForImpulse n)) => Neuron n where+  -- | A type for 'Impulses' send from a 'Neuron'. If not used, define it simply as 'NoImpulse'.+  type NeuronFromImpulse n+  -- | A type for 'Impulses' send for a 'Neuron'. If not used, define it simply as 'NoImpulse'.+  type NeuronForImpulse n   -- | A data type for options. 'Neuron' does not really need to use them.   data NeuronOptions n   @@ -312,7 +410,7 @@ An exception which initiates 'dissolve'-ing of a 'Neuron'. Should be thrown inside the 'Neuron' with passing its 'Neuron' value as argument (as passed to 'live' method). For throwing outside the 'Neuron' use 'DissolveException' (or simply 'detach' and others). -}-data DissolvingException = DissolvingException String deriving (Show, Typeable)+data DissolvingException = DissolvingException String deriving (Show, Typeable, Data)  instance Exception DissolvingException @@ -328,7 +426,7 @@ An exception which initiates 'dissolve'-ing of a 'Neuron'. Should be thrown outside the 'Neuron' to the 'Neuron'. For throwing inside the 'Neuron' use 'DissolvingException' (or simply 'dissolving'). -}-data DissolveException = DissolveException deriving (Show, Typeable)+data DissolveException = DissolveException deriving (Show, Typeable, Data)  instance Exception DissolveException @@ -378,7 +476,25 @@   -- important as first 'Impulse's in the list are send first along a 'Nerve'.   translate :: i -> [j] +instance Impulse i => ImpulseTranslator i i where+  translate i = [i]+ {-|+An existentially quantified type encompassing all 'Nerve's which can be 'translate'd to the same 'Impulse' type. Used in+'fuseWith' (and 'fuse') to list all 'Nerve's from which you want to 'fuse' 'Impulse's.+-}+data TranslatableFrom i where+  TranslatableFrom :: (Impulse for, ImpulseTranslator from i) => Nerve from AxonConductive for forConductivity -> TranslatableFrom i++{-|+An existentially quantified type encompassing all 'Nerve's which can be 'translate'd from the same 'Impulse' type. Used in+'attachTo' (and 'propagate') to list all 'Nerve's to which you want a given 'Nerve' to 'attach' to (and 'Impulse's to+'propagate').+-}+data TranslatableFor i where+  TranslatableFor :: (Impulse from, ImpulseTranslator i for) => Nerve from fromConductivity for AxonConductive -> TranslatableFor i++{-| Function which can be used as an argument to 'growNeuron' or 'attach' which leaves default options as they are.  In fact it is just an 'id'entity function.@@ -404,6 +520,24 @@   return ()  {-|+Helper function for use with 'fuseWith' (and 'fuse') which wraps given function with 'impulseValue' before it and 'IValue' after.++For example, you can define a fusing function which makes a 'product' of fusing 'Impulse's (more precisely their data payload):++> impulseFuser ((: []) . product . concat)+-}+fuserFun :: (Real r, Show r, Typeable r) => ([ImpulseValue] -> [r]) -> ImpulseTime -> [AnyImpulse] -> [IValue r]+fuserFun f t = map (IValue t) . f . map impulseValue++{-|+Helper function for use with 'fuseWith' (and 'fuse') which converts a list of 'IValue' 'Impulse's to a 'IList' 'Impulse'. If given list is empty no+resulting 'Impulse' is made.+-}+listFuser :: (Real r, Show r, Typeable r) => ImpulseTime -> [IValue r] -> [IList r]+listFuser _ [] = []+listFuser t vs = [IList t . map value $ vs]++{-| Translates (if necessary 'ImpulseTranslator' exists) an 'Impulse' and sends translation to 'Neuron'. -} translateAndSend :: ImpulseTranslator i for => Nerve from fromConductivity for AxonConductive -> i -> IO ()@@ -416,17 +550,13 @@ getCurrentImpulseTime = getPOSIXTime  {-|-This function defines equality between 'Impulse's as equality of 'impulseTime' and 'impulseValue' values. Useful for 'Neuron's which-operate on all types of 'Impulse's and want 'Eq' defined on their 'Impulse's. Examples of such 'Neuron's are "Control.Etage.Dump"-and "Control.Etage.Function".+This function defines equality between 'Impulse's as equality of 'impulseTime' and 'impulseValue' values. -} impulseEq :: (Impulse i, Impulse j) => i -> j -> Bool impulseEq a b = impulseTime a == impulseTime b && impulseValue a == impulseValue b  {-| This function defines ordering between 'Impulse's as ordering first by 'impulseTime' values and then by 'impulseValue' values.-Useful for 'Neuron's which operate on all types of 'Impulse's and want 'Ord' defined on their 'Impulse's. Examples of such-'Neuron's are "Control.Etage.Dump" and "Control.Etage.Function". -} impulseCompare :: (Impulse i, Impulse j) => i -> j -> Ordering impulseCompare a b = (impulseTime a, impulseValue a) `compare` (impulseTime b, impulseValue b)
lib/Control/Etage/Fail.hs view
@@ -4,9 +4,11 @@ This module defines a simple 'Neuron' which just fails (throws a 'DissolvingException') in 'grow'ing phase. It can be used to test error recovery and cleanup in 'grow'ing phase or early stages of 'live'ing phase in other 'Neuron's by using something like: -> _ <- growNeuron defaultOptions :: NerveNone FailNeuron+> _ <- (growNeuron :: NerveNone FailNeuron) (\o -> o { delay = 10000000 })  somewhere among (or after) 'growNeuron' calls for other 'Neuron's in 'Incubation'.++This 'Neuron' does not process any 'Impulse's. -}  module Control.Etage.Fail (@@ -14,44 +16,46 @@   FailFromImpulse,   FailForImpulse,   FailOptions,-  NeuronFromImpulse,-  NeuronForImpulse,-  NeuronOptions+  NeuronOptions(..) ) where -import Data.Typeable+import Control.Concurrent+import Data.Data  import Control.Etage +defaultDelay :: Int+defaultDelay = 0 -- microseconds+ data FailNeuron deriving (Typeable) +deriving instance Data FailNeuron+ instance Show FailNeuron where   show = show . typeOf --- | 'Impulse's from 'FailNeuron'. This 'Neuron' does not define any 'Impulse's it would send.+-- | 'Impulse's from 'FailNeuron'. This 'Neuron' does not define any 'Impulse's it would send, 'NoImpulse'. type FailFromImpulse = NeuronFromImpulse FailNeuron--- | 'Impulse's for 'FailNeuron'. This 'Neuron' does not define any 'Impulse's it would receive.+-- | 'Impulse's for 'FailNeuron'. This 'Neuron' does not define any 'Impulse's it would receive, 'NoImpulse'. type FailForImpulse = NeuronForImpulse FailNeuron--- | Options for 'FailNeuron'. This 'Neuron' does not define any options.-type FailOptions = NeuronOptions FailNeuron---- | Impulse instance for 'FailNeuron'.-instance Impulse FailFromImpulse where-  impulseTime _ = undefined-  impulseValue _ = undefined---- | Impulse instance for 'FailNeuron'.-instance Impulse FailForImpulse where-  impulseTime _ = undefined-  impulseValue _ = undefined+{-| Options for 'FailNeuron'. This option is defined: -deriving instance Show FailFromImpulse-deriving instance Show FailForImpulse+[@delay :: 'Int'@] The delay in microseconds before 'Neuron' fails. Default is no delay.+-}+type FailOptions = NeuronOptions FailNeuron  -- | A simple 'Neuron' which just fails in 'grow'ing phase. instance Neuron FailNeuron where-  data NeuronFromImpulse FailNeuron-  data NeuronForImpulse FailNeuron-  data NeuronOptions FailNeuron+  type NeuronFromImpulse FailNeuron = NoImpulse+  type NeuronForImpulse FailNeuron = NoImpulse+  data NeuronOptions FailNeuron = FailOptions {+      delay :: Int+    } deriving (Eq, Ord, Read, Show, Data)   -  grow _ = dissolving (undefined :: FailNeuron)+  mkDefaultOptions = return FailOptions {+      delay = defaultDelay+    }+  +  grow FailOptions { delay } = do+    threadDelay delay+    dissolving (undefined :: FailNeuron)
lib/Control/Etage/Function.hs view
@@ -1,13 +1,32 @@-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, GADTs, FlexibleInstances, ScopedTypeVariables, DeriveDataTypeable, TypeSynonymInstances, NamedFieldPuns #-}+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, GADTs, FlexibleInstances, ScopedTypeVariables, DeriveDataTypeable, TypeSynonymInstances, NamedFieldPuns, DisambiguateRecordFields #-}  {-| This module defines a 'Neuron' which applies a given function to received 'Impulse's. As Haskell is a lazy language this does-not mean that the result will be immediately evaluated but that it will be evaluated when (and if) the result will be needed-(probably in some other 'Neuron'). You 'grow' it in 'Incubation' by using something like:+not mean that the result will be immediately (fully) evaluated but that it will be evaluated when (and if) the result will be+needed (probably in some other 'Neuron'). You 'grow' it in 'Incubation' by using something like: -> nerveFunction <- growNeuron (\o -> o { function = negate . sum }) :: NerveBoth FunctionNeuron+> nerveFunction <- (growNeuron :: NerveBoth (FunctionNeuron AnyImpulse IRational)) (\o -> o { function = \t -> (: []) . IValue t . sum . impulseValue }) -It is an example of a 'Neuron' which can operate on any 'Impulse' type by using 'impulseValue' type class method.+This example can receive any 'Impulse' type ('AnyImpulse') and returns 'sum' of its data payload (as given by 'impulseValue')+as 'IRational' type.++The following example calculates the greatest common divisor ('gcd'):++> incubate $ do+>   let gcd t IList { list = (a:b:is) } = let r = a `mod` b in if r == 0 then [IList t (b:is)] else [IList t (b:r:is)]+>       gcd _ _ = []+>   +>   nerveDump <- (growNeuron :: NerveOnlyFor DumpNeuron) (\o -> o { showInsteadOfDump = True })+>   nerveSum <- (growNeuron :: NerveBoth (FunctionNeuron IIntegerList IIntegerList)) (\o -> o { function = gcd })+>   +>   nerveSum `attachTo` [TranslatableFor nerveSum, TranslatableFor nerveDump]+>   +>   liftIO $ do+>     t <- getCurrentImpulseTime+>     sendForNeuron nerveSum $ IList t [110, 80, 5]++This 'Neuron' is an example of a 'Neuron' with both receiving and sending 'Impulse's types parametrized. It processes only the newest 'Impulse's it receives, when+they get queued, so 'Impulse's are dropped if load is too high. -}  module Control.Etage.Function (@@ -15,70 +34,43 @@   FunctionFromImpulse,   FunctionForImpulse,   FunctionOptions,-  NeuronFromImpulse,-  NeuronForImpulse,   NeuronOptions(..) ) where  import Control.Applicative import Control.Monad-import Data.Typeable+import Data.Data  import Control.Etage -defaultFunction :: [Rational] -> Rational-defaultFunction = sum+defaultFunction :: (Impulse i, Impulse j) => ImpulseTime -> i -> [j]+defaultFunction _ _ = [] -data FunctionNeuron = FunctionNeuron FunctionOptions deriving (Typeable)+data FunctionNeuron i j = FunctionNeuron (FunctionOptions i j) deriving (Typeable) -instance Show FunctionNeuron where+instance (Impulse i, Impulse j) => Show (FunctionNeuron i j) where   show = show . typeOf  {-|-'Impulse's from 'FunctionNeuron'. This 'Impulse' constructor is defined:--[@Value { impulseTimestamp :: 'ImpulseTime', value :: 'Rational' }@]-@impulseTimestamp@ is time when the function was applied (but not when the result was evaluated), @value@ contains the (lazy) result.+'Impulse's from 'FunctionNeuron', of type @j@. -}-type FunctionFromImpulse = NeuronFromImpulse FunctionNeuron--- | 'Impulse's for 'FunctionNeuron'. This 'Neuron' can recieve any 'Impulse' type.-type FunctionForImpulse = NeuronForImpulse FunctionNeuron+type FunctionFromImpulse i j = NeuronFromImpulse (FunctionNeuron i j)+-- | 'Impulse's for 'FunctionNeuron', of type @i@.+type FunctionForImpulse i j = NeuronForImpulse (FunctionNeuron i j) {-| Options for 'FunctionNeuron'. This option is defined: -[@function :: \['Rational'\] -> 'Rational'@] The function to apply to recieved 'Impulse's. Default is 'sum'.+[@function :: 'ImpulseTime' -> i -> \[j\]@] The function to apply to recieved 'Impulse's. Resulting 'Impulse's are send+in the list order. Default is to always return an empty list. -}-type FunctionOptions = NeuronOptions FunctionNeuron---- | Impulse instance for 'FunctionNeuron'.-instance Impulse FunctionFromImpulse where-  impulseTime Value { impulseTimestamp } = impulseTimestamp-  impulseValue Value { value } = [value]---- | Impulse instance for 'FunctionNeuron'.-instance Impulse FunctionForImpulse where-  impulseTime (FunctionForImpulse i) = impulseTime i-  impulseValue (FunctionForImpulse i) = impulseValue i--instance Show FunctionForImpulse where-  show (FunctionForImpulse i) = show i--instance Eq FunctionForImpulse where-  (==) = impulseEq--instance Ord FunctionForImpulse where-  compare = impulseCompare+type FunctionOptions i j = NeuronOptions (FunctionNeuron i j)  -- | A 'Neuron' which applies a given function to received 'Impulse's.-instance Neuron FunctionNeuron where-  data NeuronFromImpulse FunctionNeuron = Value {-      impulseTimestamp :: ImpulseTime, -- time is first so that ordering is first by time-      value :: Rational-    } deriving (Eq, Ord, Read, Show)-  data NeuronForImpulse FunctionNeuron where-    FunctionForImpulse :: Impulse i => i -> FunctionForImpulse-  data NeuronOptions FunctionNeuron = FunctionOptions {-      function :: [Rational] -> Rational+instance (Impulse i, Impulse j) => Neuron (FunctionNeuron i j) where+  type NeuronFromImpulse (FunctionNeuron i j) = j+  type NeuronForImpulse (FunctionNeuron i j) = i+  data NeuronOptions (FunctionNeuron i j) = FunctionOptions {+      function :: ImpulseTime -> i -> [j]     }      mkDefaultOptions = return FunctionOptions {@@ -89,9 +81,5 @@      live nerve (FunctionNeuron FunctionOptions { function }) = forever $ do     i <- head <$> waitAndSlurpForNeuron nerve -- just newest-    let r = function . impulseValue $ i     time <- getCurrentImpulseTime-    sendFromNeuron nerve Value { impulseTimestamp = time, value = r }--instance Impulse i => ImpulseTranslator i FunctionForImpulse where-  translate i = [FunctionForImpulse i]+    sendListFromNeuron nerve $ function time i
+ lib/Control/Etage/Fuse.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, GADTs, FlexibleInstances, ScopedTypeVariables, DeriveDataTypeable, TypeSynonymInstances, NamedFieldPuns #-}++module Control.Etage.Fuse (+  fuse,+  FuseFromImpulse,+  FuseForImpulse+) where++import Control.Applicative+import Control.Monad+import Data.Typeable++import Control.Etage.Internals+import Control.Etage.Externals++data FuseNeuron i j = FuseNeuron (FuseOptions i j) deriving (Typeable)++type FuseFromImpulse i j = NeuronFromImpulse (FuseNeuron i j)+type FuseForImpulse i j = NeuronForImpulse (FuseNeuron i j)+type FuseOptions i j = NeuronOptions (FuseNeuron i j)++{-|+An internal 'Neuron' which implements 'fuse'.+-}+instance (Impulse i, Impulse j) => Neuron (FuseNeuron i j) where+  type NeuronFromImpulse (FuseNeuron i j) = j+  type NeuronForImpulse (FuseNeuron i j) = NoImpulse+  data NeuronOptions (FuseNeuron i j) = FuseOptions {+      fuser :: ImpulseTime -> [i] -> [j],+      nerves :: [TranslatableFrom i]+    }+  +  mkDefaultOptions = return FuseOptions {+      fuser = undefined,+      nerves = undefined+    }+  +  grow options = return $ FuseNeuron options+  +  live nerve (FuseNeuron FuseOptions { fuser, nerves }) = forever $ do+    is <- concat <$> mapM (\(TranslatableFrom n) -> translate <$> getFromNeuron n) nerves+    time <- getCurrentImpulseTime+    sendListFromNeuron nerve $ fuser time is++{-|+It 'grow's an internal 'Neuron' which 'fuse's 'Impulse's received from given 'Nerve's using the given function, sending them over+the resulting 'grow'n 'Nerve', 'translate'-ing received 'Impulse's as necessary.++The important aspect of 'fuse'-ing is its synchronization behavior, as it requires exactly one 'Impulse' from each given 'Nerve' at+a time to 'fuse' them together. So it is important that all given 'Nerve's have more or less the equal density of 'Impulse's, otherwise+queues of some 'Nerve's will grow unproportionally because of the stalled 'Impulse's, causing at least a memory leak.++'impulseFuser' helper function can maybe help you with defining fusing function. 'fuseWith' uses type of the given function to construct+type of the resulting 'Nerve' so probably too polymorphic type will give you problems.++Check 'fuseWith' for a more high-level function (of 'Incubation') taking care of all the details (like branching 'Nerve's as necessary).+Use this function only if you are dealing with 'grow'ing and 'attach'ing of 'Nerve's directly.+-}+fuse :: forall i j. (Impulse i, Impulse j) => [TranslatableFrom i] -> (ImpulseTime -> [i] -> [j]) -> IO (Nerve (FuseFromImpulse i j) AxonConductive (FuseForImpulse i j) AxonNonConductive)+fuse nerves fuser = do+  -- we do not manage this neuron, it will be cleaned by RTS at program exit+  -- TODO: What if this is not the only thing the program is doing? Should we cleanup this threads at the end of Incubation, too?+  nerve <- growNerve+  _ <- attach (\o -> o { fuser, nerves } :: NeuronOptions (FuseNeuron i j)) nerve+  return nerve
lib/Control/Etage/Incubator.hs view
@@ -12,36 +12,41 @@   -- >   prepareEnvironment   -- >      -- >   incubate $ do-  -- >     nerveRandom <- growNeuron defaultOptions :: NerveOnlyFrom (SequenceNeuron Int)-  -- >     nerveDump <- growNeuron defaultOptions :: NerveOnlyFor DumpNeuron+  -- >     nerveRandom <- (growNeuron :: NerveOnlyFrom (SequenceNeuron Int)) defaultOptions+  -- >     nerveDump <- (growNeuron :: NerveOnlyFor DumpNeuron) defaultOptions   -- >     -  -- >     nerveRandom `attachTo` [Translatable nerveDump]+  -- >     nerveRandom `attachTo` [TranslatableFor nerveDump]   incubate,   growNeuron,   attachTo,+  fuseWith,   NerveBoth,   NerveNone,   NerveOnlyFrom,   NerveOnlyFor,   Incubation,-  Translatable(..),   -- * Internals   -- | Be careful when using those functions as you have to assure your network is well-behaved:   --   -- * You should assure that for all 'Nerve's you defined as conductive from 'Neuron's and 'attach'ed them to 'Neuron's you-  -- really receive sent impulses, otherwise there will be a memory leak. You should probably just define those nerves-  -- as 'NerveOnlyFor' or 'NerveNone'.+  -- really receive sent impulses, otherwise there will be a memory leak. You should probably just define those 'Nerve's you+  -- are not interested in 'Impulse's from as 'NerveOnlyFor' or 'NerveNone'.   --   -- * If you 'attach' multiple 'Neuron's to the same 'Nerve' you should probably take care of branching 'Nerve's correctly. For   -- example, if multiple 'Neuron's are receiving from the same 'Nerve' you should first branch 'Nerve' with 'branchNerveFor',   -- otherwise 'Neuron's will not receive all 'Impulse's as some other 'Neuron' will receive it first (but this can be also   -- intentional).   -- On the other hand, if you are receiving from the same 'Neuron' at multiple parts of the network you should branch-  -- 'Nerve' with 'branchNerveFrom' for each such part (or not, if intentional). This also holds for 'propagate': if you are using+  -- 'Nerve' with 'branchNerveFrom' for each such part (or not, if intentional).+  --+  -- * This also holds for 'propagate': if you are using   -- it multiple times with the same 'Nerve' as @from@ argument you should first branch it with 'branchNerveFrom'. (But it is   -- probably easier to just use it once and list all @for@ 'Nerve's together.)   ---  -- * And of course in a case of an exception or in general when your are doing cleanup you should assure that 'detach'+  -- * And for 'fuse': all 'Nerve's you are 'fuse'-ing from should probably be first branched with 'branchNerveFrom' if you are+  -- also receiving from them somewhere else.+  --+  -- * Of course in a case of an exception or in general when your are doing cleanup you should assure that 'detach'   -- (or 'detachAndWait') is called for each 'LiveNeuron' (or 'detachMany' or 'detachManyAndWait').   --   -- They are exposed so that you can decouple 'grow'ing and 'dissolve'-ing handling and that you can attach 'Nerve's@@ -67,9 +72,11 @@   -- Which 'Neuron' you want is in this case inferred from the type of the 'Nerve' you defined.   growNerve,   propagate,+  fuse,   branchNerveFor,   branchNerveFrom,-  branchNerveBoth+  branchNerveBoth,+  cross ) where  import Control.Applicative@@ -83,12 +90,14 @@  import Control.Etage.Chan import Control.Etage.Propagate+import Control.Etage.Fuse import Control.Etage.Internals import Control.Etage.Externals  data IncubationOperation a where   NeuronOperation :: (Neuron n, GrowAxon (Axon (NeuronFromImpulse n) fromConductivity), GrowAxon (Axon (NeuronForImpulse n) forConductivity)) => (NeuronOptions n -> NeuronOptions n) -> IncubationOperation (Nerve (NeuronFromImpulse n) fromConductivity (NeuronForImpulse n) forConductivity)-  AttachOperation :: forall from for forConductivity. (Typeable from, Typeable for, Typeable forConductivity) => Nerve from AxonConductive for forConductivity -> [Translatable from] -> IncubationOperation ()+  AttachOperation :: forall from for forConductivity. (Impulse from, Impulse for) => Nerve from AxonConductive for forConductivity -> [TranslatableFor from] -> IncubationOperation ()+  FuseOperation :: forall i j. (Impulse i, Impulse j) => [TranslatableFrom i] -> (ImpulseTime -> [i] -> [j]) -> IncubationOperation (Nerve (FuseFromImpulse i j) AxonConductive (FuseForImpulse i j) AxonNonConductive)  type Incubation' a = ProgramT IncubationOperation IO a {-|@@ -106,28 +115,44 @@   (neurons, chans, attached) <- restore $ interpret [] [] [] program   flip finally (detachManyAndWait neurons) $ do     let na = nub chans \\ nub attached-        typ = unlines . map (\(ChanBox c) -> ' ' : show (neuronTypeOf c)) $ na-    unless (null na) $ hPutStrLn stderr $ "Warning: It seems not all created nerves were attached. This causes a memory leak as send impulses are not received. You should probably just define those nerves as NerveOnlyFor or NerveNone. Dangling nerves for neurons:\n" ++ typ+        typ = unlines . map (\(ChanBox c) -> ' ' : show (impulseTypeOf c)) $ na+    unless (null na) $ hPutStrLn stderr $ "Warning: It seems not all created (conductive) nerves were attached. This causes a memory leak as send impulses are not received. You should probably just define those nerves as NerveOnlyFor or NerveNone. Dangling nerves have following impulse types in direction from a neuron:\n" ++ typ     restore waitForException  interpret :: [LiveNeuron] -> [ChanBox] -> [ChanBox] -> Incubation' () -> IO ([LiveNeuron], [ChanBox], [ChanBox]) interpret neurons chans attached = viewT >=> eval neurons chans attached     where eval :: [LiveNeuron] -> [ChanBox] -> [ChanBox] -> ProgramViewT IncubationOperation IO () -> IO ([LiveNeuron], [ChanBox], [ChanBox])-          eval ns cs ats (Return _) = return (ns, cs, ats)+          eval ns cs ats (Return ()) = return (ns, cs, ats)           eval ns cs ats (NeuronOperation optionsSetter :>>= is) = do             nerve <- liftIO growNerve             let c = getFromChan nerve             bracketOnError (attach optionsSetter nerve) detachAndWait $ \n -> interpret (n:ns) (c ++ cs) ats . is $ nerve           eval ns cs ats (AttachOperation from for :>>= is) = do-            let c = head . getFromChan $ from -- we know there exists from chan as type checking assures that (from is conductive)-            (from', ats') <- if c `notElem` ats-                               then return (from, c:ats)-                               else do-                                 branchFrom <- branchNerveFrom from -- we have to branch from chan as it is attached multiple times-                                 return (branchFrom, ats) -- we store only original nerves in attached list+            (from', ats') <- maybeBranch from ats             propagate from' for             interpret ns cs ats' . is $ ()+          eval ns cs ats (FuseOperation nerves fuser :>>= is) = do+            (nerves', ats') <- maybeBranchMany nerves ats+            n <- fuse nerves' fuser+            let c = getFromChan n+            interpret ns (c ++ cs) ats' . is $ n +maybeBranch :: forall from for forConductivity. (Impulse from, Impulse for) => Nerve from AxonConductive for forConductivity -> [ChanBox] -> IO (Nerve from AxonConductive for forConductivity, [ChanBox])+maybeBranch from ats = do+  let c = head . getFromChan $ from -- we know there exists from chan as type checking assures that (from is conductive)+  if c `notElem` ats+    then return (from, c:ats)+    else do+      branchFrom <- branchNerveFrom from -- we have to branch from chan as it is attached multiple times+      return (branchFrom, ats) -- we store only original nerves in attached list++maybeBranchMany :: forall i. (Impulse i) => [TranslatableFrom i] -> [ChanBox] -> IO ([TranslatableFrom i], [ChanBox])+maybeBranchMany [] ats = return ([], ats)+maybeBranchMany (TranslatableFrom n:ns) ats = do+  (n', ats') <- maybeBranch n ats+  (ns', ats'') <- maybeBranchMany ns ats'+  return (TranslatableFrom n':ns', ats'')+ {-| Grows a 'Neuron', taking a function which changes default options and returning a 'Nerve' 'attach'ed to the 'Neuron'. @@ -139,72 +164,67 @@ {-| Attaches a 'Nerve' to other 'Nerve's so that 'Impulse's send from the 'Neuron' over the first 'Nerve' are received by 'Neuron's of other 'Nerve's. 'Impulse's are 'propagate'd only in this direction, not in the other. If you want also the other direction use-'attachTo' again for that direction.+'attachTo' again for that direction. 'attachTo' takes care of all the details (like branching 'Nerve's as necessary).  Internally it uses 'propagate'. -}-attachTo :: forall from for forConductivity. (Typeable from, Typeable for, Typeable forConductivity) => Nerve from AxonConductive for forConductivity -> [Translatable from] -> Incubation ()+attachTo :: forall from for forConductivity. (Impulse from, Impulse for) => Nerve from AxonConductive for forConductivity -> [TranslatableFor from] -> Incubation ()+attachTo _ [] = return () attachTo n ts = Incubation $ singleton (AttachOperation n ts) -class GrowAxon a where-  growAxon :: IO a--instance Impulse i => GrowAxon (Axon i AxonConductive) where-  growAxon = Axon <$> newChan--instance GrowAxon (Axon i AxonNonConductive) where-  growAxon = return NoAxon- {-|-Grows an unattached 'Nerve'. By specifying type of the 'Nerve' you can specify conductivity of both directions (which is then-type checked for consistency around the program) and thus specify which 'Impulse's you are interested in (and thus limit possible-memory leak). With type of 'Impulse's this 'Nerve' is capable of conducting you can also specify which 'Neuron' you are interested-in 'grow'ing on the one end of the 'Nerve'.+Fuses 'Impulse's received from given 'Nerve's using the given function, sending them over the resulting 'grow'n 'Nerve'. +'fuseWith' takes care of all the details (like branching 'Nerve's as necessary). -For example, you could grow a 'Nerve' for "Control.Etage.Sequence" 'Neuron' and 'Neuron' itself like this:+The important aspect of 'fuse'-ing is its synchronization behavior, as it requires exactly one 'Impulse' from each given 'Nerve' at+a time to 'fuse' them together. So it is important that all given 'Nerve's have more or less the equal density of 'Impulse's, otherwise+queues of some 'Nerve's will grow unproportionally because of the stalled 'Impulse's, causing at least a memory leak. -> nerve <- growNerve :: IO (Nerve (SequenceFromImpulse Int) AxonConductive (SequenceForImpulse Int) AxonNonConductive)-> neuron <- attach defaultOptions nerve+'impulseFuser' helper function can maybe help you with defining fusing function. 'fuseWith' uses type of the given function to construct+type of the resulting 'Nerve' so probably too polymorphic type will give you problems. -and for example print all 'Impulse's as they are coming in:+For example, 'fuse'-ing by 'sum'ing two 'Impulse's together can be achived like this: -> print =<< getContentsFromNeuron nerve+> incubate $ do+>   nerveRandom1 <- (growNeuron :: NerveOnlyFrom (SequenceNeuron Int)) defaultOptions+>   nerveRandom2 <- (growNeuron :: NerveOnlyFrom (SequenceNeuron Int)) defaultOptions+>   nerveDump <- (growNeuron :: NerveOnlyFor DumpNeuron) defaultOptions+>   +>   nerveFused <- [TranslatableFrom nerveRandom1, TranslatableFrom nerveRandom2] `fuseWith` (impulseFuser ((: []) . sum . concat))+>   +>   nerveFused `attachTo` [TranslatableFor nerveDump] -Check 'growNeuron' for a more high-level function (of 'Incubation') which both 'grow's a 'Neuron' and corresponding 'Nerve' taking-care of all the details. Use this function only if you need decoupled 'grow'ing.+Internally it uses 'fuse'. -}-growNerve :: (Impulse from, Impulse for, GrowAxon (Axon from fromConductivity), GrowAxon (Axon for forConductivity)) => IO (Nerve from fromConductivity for forConductivity)-growNerve = do-  from <- growAxon-  for <- growAxon-  return $ Nerve from for+fuseWith :: forall i j. (Impulse i, Impulse j) => [TranslatableFrom i] -> (ImpulseTime -> [i] -> [j]) -> Incubation (Nerve (FuseFromImpulse i j) AxonConductive (FuseForImpulse i j) AxonNonConductive)+fuseWith ts f = Incubation $ singleton (FuseOperation ts f)  {-|-Type which helps you define a type of the result of 'growNeuron'. It takes type of the 'Neuron' you want to 'grow' as an argument-and specifies a 'Nerve' which is conductive in both directions.+Type which helps you define (fix) a type of the 'growNeuron' function so that compiler knows whith 'Neuron' instance to choose.+It takes type of the 'Neuron' you want to 'grow' as an argument and specifies a 'Nerve' which is conductive in both directions. -}-type NerveBoth n = Incubation (Nerve (NeuronFromImpulse n) AxonConductive (NeuronForImpulse n) AxonConductive)+type NerveBoth n = (NeuronOptions n -> NeuronOptions n) -> Incubation (Nerve (NeuronFromImpulse n) AxonConductive (NeuronForImpulse n) AxonConductive) {-|-Type which helps you define a type of the result of 'growNeuron'. It takes type of the 'Neuron' you want to 'grow' as an argument-and specifies a 'Nerve' which is not conductive in any directions.+Type which helps you define (fix) a type of the 'growNeuron' function so that compiler knows whith 'Neuron' instance to choose.+It takes type of the 'Neuron' you want to 'grow' as an argument and specifies a 'Nerve' which is not conductive in any directions. -}-type NerveNone n = Incubation (Nerve (NeuronFromImpulse n) AxonNonConductive (NeuronForImpulse n) AxonNonConductive)+type NerveNone n = (NeuronOptions n -> NeuronOptions n) -> Incubation (Nerve (NeuronFromImpulse n) AxonNonConductive (NeuronForImpulse n) AxonNonConductive) {-|-Type which helps you define a type of the result of 'growNeuron'. It takes type of the 'Neuron' you want to 'grow' as an argument-and specifies a 'Nerve' which is conductive only in the direction from the 'Neuron'.+Type which helps you define (fix) a type of the 'growNeuron' function so that compiler knows whith 'Neuron' instance to choose.+It takes type of the 'Neuron' you want to 'grow' as an argument and specifies a 'Nerve' which is conductive only in the direction from the 'Neuron'. -}-type NerveOnlyFrom n = Incubation (Nerve (NeuronFromImpulse n) AxonConductive (NeuronForImpulse n) AxonNonConductive)+type NerveOnlyFrom n = (NeuronOptions n -> NeuronOptions n) -> Incubation (Nerve (NeuronFromImpulse n) AxonConductive (NeuronForImpulse n) AxonNonConductive) {-|-Type which helps you define a type of the result of 'growNeuron'. It takes type of the 'Neuron' you want to 'grow' as an argument-and specifies a 'Nerve' which is conductive only in the direction to the 'Neuron'.+Type which helps you define (fix) a type of the 'growNeuron' function so that compiler knows whith 'Neuron' instance to choose.+It takes type of the 'Neuron' you want to 'grow' as an argument and specifies a 'Nerve' which is conductive only in the direction to the 'Neuron'. -}-type NerveOnlyFor n = Incubation (Nerve (NeuronFromImpulse n) AxonNonConductive (NeuronForImpulse n) AxonConductive)+type NerveOnlyFor n = (NeuronOptions n -> NeuronOptions n) -> Incubation (Nerve (NeuronFromImpulse n) AxonNonConductive (NeuronForImpulse n) AxonConductive)  class (Typeable a, Eq a) => ChanClass a where-  neuronTypeOf :: a -> TypeRep+  impulseTypeOf :: a -> TypeRep  instance Impulse i => ChanClass (Chan i) where-  neuronTypeOf = head . typeRepArgs . head . typeRepArgs . typeOf -- we assume here that impulses are just NeuronFromImpulse or NeuronForImpulse+  impulseTypeOf = head . typeRepArgs . typeOf -- we remove Chan and leave just type of elements  data ChanBox where   ChanBox :: ChanClass a => a -> ChanBox
lib/Control/Etage/Internals.hs view
@@ -10,14 +10,21 @@   ImpulseTime,   AxonConductive,   AxonNonConductive,+  FromNerve(..),+  ForNerve(..),+  BothNerve(..),   NeuronDissolved,   NeuronId,-  waitForException+  waitForException,+  GrowAxon(..),+  growNerve,+  cross ) where -import Control.Concurrent hiding (Chan)+import Control.Applicative+import Control.Concurrent hiding (Chan, newChan)+import Data.Data import Data.Time.Clock.POSIX-import Data.Typeable import Numeric import Text.ParserCombinators.ReadP @@ -38,7 +45,8 @@  {-| Type class with common methods for impulses send over 'Nerve's and processed in 'Neuron's so that it is possible to define-'Neuron's which operate on any 'Impulse' type. An example of such 'Neuron' is "Control.Etage.Function".+'Neuron's which operate on any 'Impulse' type by using 'AnyImpulse' type as their receiving 'Impulse's type. An example of+such 'Neuron' is "Control.Etage.Dump". -} class (Show i, Typeable i) => Impulse i where   -- | This method should return a timestamp when the 'Impulse' was created/finalized what should be the moment just before it is send@@ -67,6 +75,9 @@ really read somewhere, otherwise a memory leak will occur. -} data AxonConductive deriving (Typeable)++deriving instance Data AxonConductive+ {-| Is axon (one direction of a 'Nerve') conductive? No, it is not. @@ -75,6 +86,8 @@ -} data AxonNonConductive deriving (Typeable) +deriving instance Data AxonNonConductive+ data Axon impulse conductivity where   Axon :: Impulse i => Chan i -> Axon i AxonConductive   NoAxon :: Axon i AxonNonConductive@@ -95,6 +108,24 @@ instance (Typeable forConductivity, Typeable fromConductivity, Typeable from, Typeable for) => Show (Nerve from fromConductivity for forConductivity) where   show = show . typeOf +{-|+An existentially quantified type encompassing all 'Nerve's which are conductive from a 'Neuron'.+-}+data FromNerve where+  FromNerve :: Impulse from => Nerve from AxonConductive for forConductivity -> FromNerve++{-|+An existentially quantified type encompassing all 'Nerve's which are conductive to a 'Neuron'.+-}+data ForNerve where+  ForNerve :: Impulse for => Nerve from fromConductivity for AxonConductive -> ForNerve++{-|+An existentially quantified type encompassing all 'Nerve's which are conductive in both directions.+-}+data BothNerve where+  BothNerve :: (Impulse from, Impulse for) => Nerve from AxonConductive for AxonConductive -> BothNerve+ type NeuronDissolved = SampleVar () type NeuronId = ThreadId @@ -113,3 +144,58 @@  waitForException :: IO a waitForException = newEmptyMVar >>= takeMVar++class GrowAxon a where+  growAxon :: IO a++instance Impulse i => GrowAxon (Axon i AxonConductive) where+  growAxon = Axon <$> newChan++instance GrowAxon (Axon i AxonNonConductive) where+  growAxon = return NoAxon++-- TODO: Make an incubation version of growNerve which would follow if it was correctly attached (but how to follow if it is used as an option to a neuron and is consumed there?)+{-|+Grows an unattached 'Nerve'. By specifying type of the 'Nerve' you can specify conductivity of both directions (which is then+type checked for consistency around the program) and thus specify which 'Impulse's you are interested in (and thus limit possible+memory leak). With type of 'Impulse's this 'Nerve' is capable of conducting you can also specify which 'Neuron' you are interested+in 'grow'ing on the one end of the 'Nerve'.++For example, you could grow a 'Nerve' for "Control.Etage.Sequence" 'Neuron' and 'Neuron' itself like this:++> nerve <- growNerve :: IO (Nerve (SequenceFromImpulse Int) AxonConductive (SequenceForImpulse Int) AxonNonConductive)+> neuron <- attach defaultOptions nerve++and for example print all 'Impulse's as they are coming in:++> print =<< getContentsFromNeuron nerve++Check 'growNeuron' for a more high-level function (of 'Incubation') which both 'grow's a 'Neuron' and corresponding 'Nerve' taking+care of all the details. Use this function only if you need decoupled 'grow'ing.+-}+growNerve :: (Impulse from, Impulse for, GrowAxon (Axon from fromConductivity), GrowAxon (Axon for forConductivity)) => IO (Nerve from fromConductivity for forConductivity)+growNerve = do+  from <- growAxon+  for <- growAxon+  return $ Nerve from for++{-|+Crosses axons around in a 'Nerve'. Useful probably only when you want to 'attachTo' 'Nerve' so that it looks as 'Impulse's are comming+from a 'Neuron' and are not send to a 'Neuron'. So in this case you are 'attach'ing 'Nerve' in a direction away from a 'Neuron' and not+towards it, what is a default.++For example, you can do something like this:++> nerveDump <- (growNeuron :: NerveOnlyFor DumpNeuron) defaultOptions+> nerveOnes <- (growNeuron :: NerveOnlyFrom (SequenceNeuron Int)) (\o -> o { valueSource = repeat 1 })+> nerveTwos <- (growNeuron :: NerveOnlyFrom (SequenceNeuron Int)) (\o -> o { valueSource = repeat 2 })+> +> nerveOnes `attachTo` [TranslatableFor (cross nerveTwos)]+> nerveTwos `attachTo` [TranslatableFor nerveDump]++Of course in this example you could simply 'attachTo' both 'Nerve's to "Control.Etage.Dump" 'Neuron'. So 'cross' is probably useful+only when using 'Nerve's unattached to its 'Neuron' (made by 'growNerve', for example) and/or when using such 'Nerve's with+'Neuron's which operate on how 'Impulse's are 'propagate'd (or 'fuse'd).+-}+cross :: Nerve from fromConductivity for forConductivity -> Nerve for forConductivity from fromConductivity+cross (Nerve from for) = Nerve for from
lib/Control/Etage/Propagate.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE TypeFamilies, GADTs, ScopedTypeVariables, TypeSynonymInstances, StandaloneDeriving, DeriveDataTypeable, NamedFieldPuns #-}+{-# LANGUAGE TypeFamilies, GADTs, ScopedTypeVariables, TypeSynonymInstances, DeriveDataTypeable, NamedFieldPuns #-}  module Control.Etage.Propagate (-  propagate,-  Translatable(..)+  propagate ) where  import Control.Monad@@ -13,67 +12,40 @@  -- TODO: Implement delay in propagation (constant delay, random from some distribution) -data (Typeable from, Typeable for, Typeable forConductivity) => PropagateNeuron from for forConductivity = PropagateNeuron (PropagateOptions from for forConductivity) deriving (Typeable)--type PropagateFromImpulse from for forConductivity = NeuronFromImpulse (PropagateNeuron from for forConductivity)-type PropagateForImpulse from for forConductivity = NeuronForImpulse (PropagateNeuron from for forConductivity)-type PropagateOptions from for forConductivity = NeuronOptions (PropagateNeuron from for forConductivity)--{-|-Impulse instance for internal 'Neuron' which implements 'propagate'.--}-instance (Typeable from, Typeable for, Typeable forConductivity) => Impulse (PropagateFromImpulse from for forConductivity) where-  impulseTime _ = undefined-  impulseValue _ = undefined--{-|-Impulse instance for internal 'Neuron' which implements 'propagate'.--}-instance (Typeable from, Typeable for, Typeable forConductivity) => Impulse (PropagateForImpulse from for forConductivity) where-  impulseTime _ = undefined-  impulseValue _ = undefined+data PropagateNeuron from for = PropagateNeuron (PropagateOptions from for) deriving (Typeable) -deriving instance Show (PropagateFromImpulse from for forConductivity)-deriving instance Show (PropagateForImpulse from for forConductivity)+type PropagateOptions from for = NeuronOptions (PropagateNeuron from for)  {-| An internal 'Neuron' which implements 'propagate'. -}-instance (Typeable from, Typeable for, Typeable forConductivity) => Neuron (PropagateNeuron from for forConductivity) where-  data NeuronFromImpulse (PropagateNeuron from for forConductivity)-  data NeuronForImpulse (PropagateNeuron from for forConductivity)-  data NeuronOptions (PropagateNeuron from for forConductivity) = PropagateOptions {-      from :: Nerve from AxonConductive for forConductivity,-      for ::[Translatable from]+instance (Impulse from, Impulse for) => Neuron (PropagateNeuron from for) where+  type NeuronFromImpulse (PropagateNeuron from for) = from+  type NeuronForImpulse (PropagateNeuron from for) = for+  data NeuronOptions (PropagateNeuron from for) = PropagateOptions {+      for ::[TranslatableFor for]     }      mkDefaultOptions = return PropagateOptions {-      from = undefined,       for = undefined     }      grow options = return $ PropagateNeuron options   -  live _ (PropagateNeuron PropagateOptions { from, for }) = forever $ do-    i <- getFromNeuron from-    mapM_ (\(Translatable n) -> translateAndSend n i) for+  live nerve (PropagateNeuron PropagateOptions { for }) = forever $ do+    i <- getForNeuron nerve+    mapM_ (\(TranslatableFor n) -> translateAndSend n i) for  {-|-It 'grow's an internal 'Neuron' which propagates 'Impulse's from a given 'Nerve' to other 'Nerve's, 'translate'-ing as necessary.+It 'grow's an internal 'Neuron' which 'propagate's 'Impulse's from a given 'Nerve' to other 'Nerve's, 'translate'-ing as necessary.  Check 'attachTo' for a more high-level function (of 'Incubation') taking care of all the details (like branching 'Nerve's as necessary). Use this function only if you are dealing with 'grow'ing and 'attach'ing of 'Nerve's directly. -}-propagate :: forall from for forConductivity. (Typeable from, Typeable for, Typeable forConductivity) => Nerve from AxonConductive for forConductivity -> [Translatable from] -> IO ()+propagate :: forall from for forConductivity. (Impulse from, Impulse for) => Nerve from AxonConductive for forConductivity -> [TranslatableFor from] -> IO ()+propagate _ [] = return () propagate from for = do   -- we do not manage this neuron, it will be cleaned by RTS at program exit   -- TODO: What if this is not the only thing the program is doing? Should we cleanup this threads at the end of Incubation, too?-  _ <- attach (\o -> o { from, for } :: NeuronOptions (PropagateNeuron from for forConductivity)) undefined+  _ <- attach (\o -> o { for } :: NeuronOptions (PropagateNeuron for from)) (cross from) -- we use cross here so that in neuron we can behave as in normal neuron (use getForNeuron for example)   return ()--{-|-An existentially quantified types encompassing all 'Nerve's which can be 'translate'd from the same 'Impulse' type. Used in 'attachTo'-(and 'propagate') to list all 'Nerve's to which you want a given 'Nerve' to 'attach' to (and 'Impulse's to 'propagate').--}-data Translatable i where-  Translatable :: ImpulseTranslator i for => Nerve from fromConductivity for AxonConductive -> Translatable i
lib/Control/Etage/Sequence.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, GADTs, FlexibleInstances, ScopedTypeVariables, DeriveDataTypeable, TypeSynonymInstances, StandaloneDeriving, NamedFieldPuns #-}+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, GADTs, FlexibleInstances, ScopedTypeVariables, DeriveDataTypeable, TypeSynonymInstances, NamedFieldPuns #-}  {-| This module defines a 'Neuron' which generates values based on a given sequence at a given interval.@@ -6,13 +6,14 @@ You 'grow' default version of it, which gives you an infinite source of random 'Int's at random interval of maximum length of 1 second, in 'Incubation' by using something like: -> nerveRandom <- growNeuron defaultOptions :: NerveOnlyFrom (SequenceNeuron Int)+> nerveRandom <- (growNeuron :: NerveOnlyFrom (SequenceNeuron Int)) defaultOptions  or for an infinite source of ones with same random interval: -> nerveOnes <- growNeuron (\o -> o { valueSource = repeat 1 }) :: NerveOnlyFrom (SequenceNeuron Int)+> nerveOnes <- (growNeuron :: NerveOnlyFrom (SequenceNeuron Int)) (\o -> o { valueSource = repeat 1 }) -It is an example of a 'Neuron' with a parametrized type.+This 'Neuron' is an example of a 'Neuron' with a parametrized type. Check also "Control.Etage.Function" for a 'Neuron' with both receiving+and sending 'Impulse's types parametrized. It does not process any (receiving) 'Impulse's. -}  module Control.Etage.Sequence (@@ -20,14 +21,12 @@   SequenceFromImpulse,   SequenceForImpulse,   SequenceOptions,-  NeuronFromImpulse(..),-  NeuronForImpulse,   NeuronOptions(..) ) where  import Control.Concurrent import Control.Monad-import Data.Typeable+import Data.Data import System.Random  import Control.Etage@@ -35,55 +34,37 @@ defaultMaxInterval :: Int defaultMaxInterval = 1000000 -- microseconds, 1 second -data (Real r, Random r, Show r, Typeable r) => SequenceNeuron r = SequenceNeuron (SequenceOptions r) deriving (Typeable)+data SequenceNeuron v = SequenceNeuron (SequenceOptions v) deriving (Typeable, Data) -instance Typeable r => Show (SequenceNeuron r) where+instance Typeable v => Show (SequenceNeuron v) where   show = show . typeOf  {-|-'Impulse's from 'SequenceNeuron'. This 'Impulse' constructor is defined:--[@Value { impulseTimestamp :: 'ImpulseTime', value :: 'Rational' }@]-@impulseTimestamp@ is time when the value was send, @value@ contains the value.+'Impulse's from 'SequenceNeuron', @'IValue' v@. -}-type SequenceFromImpulse r = NeuronFromImpulse (SequenceNeuron r)--- | 'Impulse's for 'SequenceNeuron'. This 'Neuron' does not define any 'Impulse's it would receive.-type SequenceForImpulse r = NeuronForImpulse (SequenceNeuron r)+type SequenceFromImpulse v = NeuronFromImpulse (SequenceNeuron v)+-- | 'Impulse's for 'SequenceNeuron'. This 'Neuron' does not define any 'Impulse's it would receive, 'NoImpulse'.+type SequenceForImpulse v = NeuronForImpulse (SequenceNeuron v) {-|-Options for 'SequenceNeuron'. This options are defined:+Options for 'SequenceNeuron'. Those options are defined: -[@valueSource :: \[r\]@] The list of values to send. If the end of the list is reached, 'Neuron' initiates 'dissolving'. Default-is an infinite list of values of type @r@ generated by the 'StdGen' random generator.+[@valueSource :: \[v\]@] The list of values to send. If the end of the list is reached, 'Neuron' initiates 'dissolving'. Default+is an infinite list of values of type @v@ generated by the 'StdGen' random generator.  [@intervalSource :: \['Int'\]@] The list of intervals between values. It is defined as a delay in microseconds before the next value is send. If the end of the list is reached, 'Neuron' initiates 'dissolving'. Default is a list of random delays with maximum length of 1 second generated by the 'StdGen' random generator. -}-type SequenceOptions r = NeuronOptions (SequenceNeuron r)---- | Impulse instance for 'SequenceNeuron'.-instance (Real r, Random r, Show r, Typeable r) => Impulse (SequenceFromImpulse r) where-  impulseTime Value { impulseTimestamp } = impulseTimestamp-  impulseValue Value { value } = [toRational value]---- | Impulse instance for 'SequenceNeuron'.-instance (Real r, Random r, Show r, Typeable r) => Impulse (SequenceForImpulse r) where-  impulseTime _ = undefined-  impulseValue _ = undefined--deriving instance Show (SequenceForImpulse r)+type SequenceOptions v = NeuronOptions (SequenceNeuron v)  -- | A 'Neuron' which generates values based on a given sequence at a given interval.-instance (Real r, Random r, Show r, Typeable r) => Neuron (SequenceNeuron r) where-  data NeuronFromImpulse (SequenceNeuron r) = Value {-      impulseTimestamp :: ImpulseTime, -- time is first so that ordering is first by time-      value :: r-    } deriving (Eq, Ord, Read, Show)-  data NeuronForImpulse (SequenceNeuron r)-  data NeuronOptions (SequenceNeuron r) = SequenceOptions {-      valueSource :: [r],+instance (Real v, Random v, Show v, Typeable v) => Neuron (SequenceNeuron v) where+  type NeuronFromImpulse (SequenceNeuron v) = IValue v+  type NeuronForImpulse (SequenceNeuron v) = NoImpulse+  data NeuronOptions (SequenceNeuron v) = SequenceOptions {+      valueSource :: [v],       intervalSource :: [Int] -- microseconds-    } deriving (Eq, Ord, Read, Show)+    } deriving (Eq, Ord, Read, Show, Data)      mkDefaultOptions = do     generator <- newStdGen@@ -99,5 +80,5 @@     forM_ (zip valueSource intervalSource) $ \(v, i) -> do       threadDelay i       time <- getCurrentImpulseTime-      sendFromNeuron nerve $ Value time v+      sendFromNeuron nerve $ IValue time v     dissolving n
lib/Control/Etage/Timeout.hs view
@@ -1,12 +1,15 @@-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, GADTs, FlexibleInstances, ScopedTypeVariables, DeriveDataTypeable, TypeSynonymInstances, StandaloneDeriving, NamedFieldPuns #-}+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, GADTs, FlexibleInstances, ScopedTypeVariables, DeriveDataTypeable, TypeSynonymInstances, 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+> _ <- (growNeuron :: NerveNone TimeoutNeuron) (\o -> o { timeout = 10000000 })  somewhere among (best at the end) 'growNeuron' calls for other 'Neuron's in 'Incubation'.++It is an example of a 'Neuron' which does not 'live' indefinitely (until an exception) but 'dissolve's after some time (by using+'dissolving'). It does not process any 'Impulse's. -}  module Control.Etage.Timeout (@@ -14,28 +17,25 @@   TimeoutFromImpulse,   TimeoutForImpulse,   TimeoutOptions,-  NeuronFromImpulse,-  NeuronForImpulse,   NeuronOptions(..) ) where  import Control.Concurrent-import Control.Monad-import Data.Typeable+import Data.Data  import Control.Etage  defaultTimeout :: Int defaultTimeout = 60000000 -- microseconds, 60 seconds -data TimeoutNeuron = TimeoutNeuron TimeoutOptions deriving (Typeable)+data TimeoutNeuron = TimeoutNeuron TimeoutOptions deriving (Typeable, Data)  instance Show TimeoutNeuron where   show = show . typeOf --- | 'Impulse's from 'TimeoutNeuron'. This 'Neuron' does not define any 'Impulse's it would send.+-- | 'Impulse's from 'TimeoutNeuron'. This 'Neuron' does not define any 'Impulse's it would send, 'NoImpulse'. type TimeoutFromImpulse = NeuronFromImpulse TimeoutNeuron--- | 'Impulse's for 'TimeoutNeuron'. This 'Neuron' does not define any 'Impulse's it would receive.+-- | 'Impulse's for 'TimeoutNeuron'. This 'Neuron' does not define any 'Impulse's it would receive, 'NoImpulse'. type TimeoutForImpulse = NeuronForImpulse TimeoutNeuron {-| Options for 'TimeoutNeuron'. This option is defined:@@ -44,26 +44,13 @@ -} 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+  type NeuronFromImpulse TimeoutNeuron = NoImpulse+  type NeuronForImpulse TimeoutNeuron = NoImpulse   data NeuronOptions TimeoutNeuron = TimeoutOptions {       timeout :: Int -- microseconds-    } deriving (Eq, Ord, Read, Show)+    } deriving (Eq, Ord, Read, Show, Data)      mkDefaultOptions = return TimeoutOptions {       timeout = defaultTimeout
lib/Control/Etage/Worker.hs view
@@ -1,27 +1,28 @@-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, GADTs, FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances, StandaloneDeriving, DeriveDataTypeable, EmptyDataDecls, NamedFieldPuns #-}+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, GADTs, FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances, StandaloneDeriving, DeriveDataTypeable, EmptyDataDecls, NamedFieldPuns, DisambiguateRecordFields #-}  {-| This module defines a worker 'Neuron' which evaluates 'IO' actions it receives. It is useful to offload lengthly 'IO' actions into another thread. In the case of too many queued 'IO' actions they are silently dropped and only newest ones are evaluated. You 'grow' it in 'Incubation' by using something like: -> nerveWorker <- growNeuron defaultOptions :: NerveOnlyFor WorkerNeuron+> nerveWorker <- (growNeuron :: NerveOnlyFor WorkerNeuron) defaultOptions++It is an example of a 'Neuron' which defines 'getNeuronMapCapability'. It processes only the newest 'Impulse's it receives, when+they get queued, so 'Impulse's are dropped if load is too high. -}  module Control.Etage.Worker (   WorkerNeuron,   WorkerFromImpulse,-  WorkerForImpulse,+  WorkerForImpulse(..),   WorkerOptions,-  NeuronFromImpulse,-  NeuronForImpulse(..),   NeuronOptions(..),   WorkType ) where  import Control.Applicative import Control.Monad-import Data.Typeable+import Data.Data  import Control.Etage @@ -35,15 +36,15 @@  data WorkerNeuron deriving (Typeable) --- | 'Impulse's from 'WorkerNeuron'. This 'Neuron' does not define any 'Impulse's it would send.-type WorkerFromImpulse = NeuronFromImpulse WorkerNeuron-{-|-'Impulse's for 'WorkerNeuron'. This 'Impulse' constructor is defined:+deriving instance Data WorkerNeuron -[@Work { impulseTimestamp :: ImpulseTime, work :: WorkType }@]-@impulseTimestamp@ is time when the action was enqueued for evaluation in the 'WorkerNeuron', @work@ is enqueued action.--}-type WorkerForImpulse = NeuronForImpulse WorkerNeuron+-- | 'Impulse's from 'WorkerNeuron'. This 'Neuron' does not define any 'Impulse's it would send, 'NoImpulse'.+type WorkerFromImpulse = NeuronFromImpulse WorkerNeuron+-- | 'Impulse's for 'WorkerNeuron'.+data WorkerForImpulse = Work {+    impulseTimestamp :: ImpulseTime, -- ^ Time when the action was enqueued for evaluation in the 'WorkerNeuron'.+    work :: WorkType -- ^ Enqueued action.+  } deriving (Show, Typeable) {-| Options for 'WorkerNeuron'. This option is defined: @@ -54,28 +55,17 @@ -} type WorkerOptions = NeuronOptions WorkerNeuron --- | Impulse instance for 'WorkerNeuron'.-instance Impulse WorkerFromImpulse where-  impulseTime _ = undefined-  impulseValue _ = undefined---- | Impulse instance for 'WorkerNeuron'. instance Impulse WorkerForImpulse where   impulseTime Work { impulseTimestamp } = impulseTimestamp   impulseValue _ = [] -deriving instance Show WorkerFromImpulse- -- | A worker 'Neuron' which evaluates 'IO' actions it receives. instance Neuron WorkerNeuron where-  data NeuronFromImpulse WorkerNeuron-  data NeuronForImpulse WorkerNeuron = Work {-      impulseTimestamp :: ImpulseTime,-      work :: WorkType-    } deriving (Show)+  type NeuronFromImpulse WorkerNeuron = NoImpulse+  type NeuronForImpulse WorkerNeuron = WorkerForImpulse   data NeuronOptions WorkerNeuron = WorkerOptions {       mapOnCapability :: NeuronMapCapability-    } deriving (Eq, Ord, Read, Show)+    } deriving (Eq, Ord, Read, Show, Data)      mkDefaultOptions = return WorkerOptions {       mapOnCapability = NeuronFreelyMapOnCapability