Nomyx-Language 0.2.3 → 0.3.0

raw patch · 9 files changed

+629/−333 lines, 9 filesdep +transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• Nomyx-Language.cabal +27/−12
• src/Language/Nomyx/Definition.hs +264/−105
• src/Language/Nomyx/Evaluation.hs +85/−57
• src/Language/Nomyx/Examples.hs +17/−8
• src/Language/Nomyx/Expression.hs +97/−61
• src/Language/Nomyx/Game.hs +32/−44
• src/Language/Nomyx/Test.hs +48/−27
• src/Language/Nomyx/Utils.hs +6/−0
• src/Language/Nomyx/Vote.hs +53/−19

@@ -1,5 +1,5 @@ name: Nomyx-Language-version: 0.2.3+version: 0.3.0 cabal-version: >=1.6 ---Warning: For using "cabal sdist", this patch is needed in cabal: https://github.com/haskell/cabal/pull/1110 ---To allow sdist to work with exported generated modules (Paths_Nomyx_Language)@@ -14,26 +14,41 @@ category: Language author: Corentin Dupont data-files: src/Language/Nomyx/Definition.hs-            src/Language/Nomyx/Examples.hs src/Language/Nomyx/Expression.hs-            src/Language/Nomyx/Rule.hs src/Language/Nomyx/Test.hs +            src/Language/Nomyx/Examples.hs+            src/Language/Nomyx/Expression.hs+            src/Language/Nomyx/Rule.hs+            src/Language/Nomyx/Test.hs             src/Language/Nomyx/Vote.hs data-dir: "" extra-source-files: AUTHORS README   library-    build-depends: base ==4.*, containers -any, ghc -any,-                   hint-server -any, hslogger -any, mtl -any, old-locale -any,-                   safe -any, stm -any, template-haskell -any, time -any,-                   time-recurrence -any, DebugTraceHelpers -any, data-lens -any,-                   data-lens-template -any, data-lens-fd -any, Boolean -any,-                   safecopy -any+    build-depends: base ==4.*,+                   containers -any,+                   ghc -any,+                   hint-server -any,+                   hslogger -any,+                   mtl -any,+                   old-locale -any,+                   safe -any,+                   stm -any,+                   template-haskell -any,+                   time -any,+                   time-recurrence -any,+                   DebugTraceHelpers -any,+                   data-lens -any,+                   data-lens-template -any,+                   data-lens-fd -any,+                   Boolean -any,+                   safecopy -any,+                   transformers -any     exposed-modules: Language.Nomyx-                     Language.Nomyx.Expression +                     Language.Nomyx.Expression                      Language.Nomyx.Definition-                     Language.Nomyx.Evaluation +                     Language.Nomyx.Evaluation                      Language.Nomyx.Examples                      Language.Nomyx.Rule-                     Language.Nomyx.Vote +                     Language.Nomyx.Vote                      Language.Nomyx.Test                      Language.Nomyx.Game                      Language.Nomyx.Utils

@@ -25,33 +25,21 @@ newVar = NewVar
 
 newVar_ :: (Typeable a, Show a, Eq a) => VarName -> a -> Nomex (V a)
-newVar_ s a = do
-    mv <- NewVar s a
-    case mv of
-        Just var -> return var
-        Nothing -> throwError "newVar_: Variable existing"
+newVar_ s a = partial "newVar_: Variable existing" (newVar s a)
 
 -- | variable reading
 readVar :: (Typeable a, Show a, Eq a) => (V a) -> Nomex (Maybe a)
 readVar = ReadVar
 
 readVar_ :: forall a. (Typeable a, Show a, Eq a) => (V a) -> Nomex a
-readVar_ v@(V a) = do
-    ma <- ReadVar v
-    case ma of
-        Just (val:: a) -> return val
-        Nothing -> throwError $ "readVar_: Variable \"" ++ a ++ "\" with type \"" ++ (show $ typeOf v) ++ "\" not existing"
+readVar_ v@(V a) = partial ("readVar_: Variable \"" ++ a ++ "\" with type \"" ++ (show $ typeOf v) ++ "\" not existing") (readVar v)
 
 -- | variable writing
 writeVar :: (Typeable a, Show a, Eq a) => (V a) -> a -> Nomex Bool
 writeVar = WriteVar
 
 writeVar_ :: (Typeable a, Show a, Eq a) => (V a) -> a -> Nomex ()
-writeVar_ var val = do
-    ma <- WriteVar var val
-    case ma of
-       True -> return ()
-       False -> throwError "writeVar_: Variable not existing"
+writeVar_ var val = void $ writeVar var val 
 -- | modify a variable using the provided function
 modifyVar :: (Typeable a, Show a, Eq a) => (V a) -> (a -> a) -> Nomex ()
@@ -62,69 +50,141 @@ delVar = DelVar
 
 delVar_ :: (V a) -> Nomex ()
-delVar_ v = DelVar v >> return ()
+delVar_ v = void $ delVar v
+++data VEvent a = VUpdated a | VDeleted deriving (Typeable, Show, Eq)+data MsgVar a = MsgVar (Msg (VEvent a)) (V a)++msgVar :: String -> MsgVar a+msgVar a = MsgVar (Message a) (V a)++newMsgVar :: (Typeable a, Show a, Eq a) => VarName -> a -> Nomex (Maybe (MsgVar a))
+newMsgVar name a = do
+    mv <- newVar name a+    return $ mv >>= Just . MsgVar (Message name) 
++newMsgVar' :: (Typeable a, Show a, Eq a) => VarName -> a -> (VEvent a -> Nomex()) -> Nomex (Maybe (MsgVar a))
+newMsgVar' name a f = do
+    mv <- newMsgVar name a+    case mv of+       Just (MsgVar m _) -> do+          onMessage m $ f . messageData
+          return mv+       Nothing -> return Nothing
++writeMsgVar :: (Typeable a, Show a, Eq a) => MsgVar a -> a -> Nomex Bool
+writeMsgVar (MsgVar m v) a = do
+   r <- writeVar v a+   sendMessage m (VUpdated a)+   return r++writeMsgVar_ :: (Typeable a, Show a, Eq a) => MsgVar a -> a -> Nomex ()+writeMsgVar_ mv a = void $ writeMsgVar mv a++readMsgVar :: (Typeable a, Show a, Eq a) => MsgVar a -> Nomex (Maybe a)
+readMsgVar (MsgVar _ v) = readVar v++readMsgVar_ :: (Typeable a, Show a, Eq a) => MsgVar a -> Nomex a
+readMsgVar_ mv = partial "readMsgVar_: variable not existing" (readMsgVar mv)++delMsgVar :: (Typeable a, Show a, Eq a) => MsgVar a -> Nomex Bool
+delMsgVar (MsgVar m v) = do+   sendMessage m VDeleted+   delAllEvents m+   delVar v++onMsgVarChange :: (Typeable a, Show a, Eq a) => MsgVar a -> (VEvent a -> Nomex()) -> Nomex ()+onMsgVarChange mv f = do+   m <- getMsgVarMessage mv+   onMessage m $ \(MessageData v) -> f v++onMsgVarEvent :: (Typeable a, Show a, Eq a)+               => MsgVar a+               -> (a -> Nomex b)+               -> (a -> b -> Nomex())+               -> (b -> Nomex())+               -> Nomex ()+onMsgVarEvent mv create update delete = do+   val <- readMsgVar_ mv+   c <- create val+   onMsgVarChange mv $ f c where+      f c' (VUpdated v) = update v c'+      f c' VDeleted     = delete c'+++-- | get the messsage triggered when the array is filled
+getMsgVarMessage :: (Typeable a, Show a, Eq a) => (MsgVar a) -> Nomex (Msg (VEvent a))
+getMsgVarMessage (MsgVar m _) = return m
++-- | get the association array
+getMsgVarData :: (Typeable a, Show a, Eq a) => (MsgVar a) -> Nomex (Maybe a)
+getMsgVarData (MsgVar _ v) = readVar v
++getMsgVarData_ :: (Typeable a, Show a, Eq a) => (MsgVar a) -> Nomex a
+getMsgVarData_ (MsgVar _ v) = readVar_ v++    
 -- * Variable arrays
--- | ArrayVar is an indexed array with a signal attached to warn when the array is filled.
--- | each indexed elements starts empty (value=Nothing), and when the array is full, the signal is triggered.
--- | This is useful to wait for a serie of events to happen, and trigger a computation on the collected results.
-data ArrayVar i a = ArrayVar (Msg [(i, Maybe a)]) (V (Map i (Maybe a)))
+-- | ArrayVar is an indexed array with a signal attached triggered at every change.
+-- | each indexed elements starts empty (value=Nothing).
+type ArrayVar i a = MsgVar [(i, Maybe a)]
 
 -- | initialize an empty ArrayVar
-newArrayVar :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => VarName -> [i] -> Nomex (ArrayVar i a)
+newArrayVar :: (Typeable a, Show a, Eq a, Typeable i, Show i, Eq i) => VarName -> [i] -> Nomex (Maybe (ArrayVar i a))
 newArrayVar name l = do
     let list = map (\i -> (i, Nothing)) l
-    v <- newVar_ name (fromList list)
-    return $ ArrayVar (Message name) v
+    newMsgVar name list++newArrayVar_ :: (Typeable a, Show a, Eq a, Typeable i, Show i, Eq i) => VarName -> [i] -> Nomex (ArrayVar i a)
+newArrayVar_ name l = partial "newArrayVar_: Variable existing" (newArrayVar name l)
 
--- | initialize an empty ArrayVar, registering a callback that will be triggered when the array is filled
-newArrayVar' :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => VarName -> [i] -> ([(i,Maybe a)] -> Nomex ()) -> Nomex (ArrayVar i a)
-newArrayVar' name l f = do
-    av@(ArrayVar m _) <- newArrayVar name l
-    onMessage m $ f . messageData
-    return av
+-- | initialize an empty ArrayVar, registering a callback that will be triggered at every change
+newArrayVar' :: (Typeable a, Show a, Eq a, Typeable i, Show i, Eq i) => VarName -> [i] -> (VEvent [(i,Maybe a)] -> Nomex ()) -> Nomex (Maybe (ArrayVar i a))
+newArrayVar' name l f = do+    let list = map (\i -> (i, Nothing)) l
+    newMsgVar' name list f
 
 -- | initialize an empty ArrayVar, registering a callback.
---the callback will be triggered when the array is filled, and then the ArrayVar will be deleted
-newArrayVarOnce :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => VarName -> [i] -> ([(i, Maybe a)] -> Nomex ()) -> Nomex (ArrayVar i a)
+-- the ArrayVar will be deleted when full
+newArrayVarOnce :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => VarName -> [i] -> (VEvent [(i, Maybe a)] -> Nomex ()) -> Nomex (Maybe (ArrayVar i a))
 newArrayVarOnce name l f = do
-   av@(ArrayVar m _) <- newArrayVar name l
-   onMessage m $ \a -> do
-      f $ messageData a
-      full <- (isFullArrayVar av)
-      when full $ delArrayVar av
-   return av where
-
+   mv <- newArrayVar' name l f+   when (isJust mv) $ cleanOnFull $ fromJust mv
+   return mv++cleanOnFull :: (Typeable a, Show a, Eq a, Ord i, Typeable i, Show i) => (ArrayVar i a) -> Nomex ()+cleanOnFull ar = do+   m <- getMsgVarMessage ar 
+   onMessage m $ \_ -> do
+      full <- (isFullArrayVar_ ar)
+      when full $ void $ delMsgVar ar+      return ()+   return () 
-isFullArrayVar :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => (ArrayVar i a) -> Nomex (Bool)
-isFullArrayVar av = do
-   d <- getArrayVarData av
-   let full = and $ map isJust $ map snd d
-   return full
+isFullArrayVar_ :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => (ArrayVar i a) -> Nomex Bool
+isFullArrayVar_ av = do
+   md <- getMsgVarData av+   return $ and $ map isJust $ map snd $ fromJust md
+       
    
 -- | store one value and the given index. If this is the last filled element, the registered callbacks are triggered.
-putArrayVar :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => (ArrayVar i a) -> i -> a -> Nomex ()
-putArrayVar (ArrayVar m v) i a = do
-    ar <- readVar_ v
-    let ar2 = M.insert i (Just a) ar
-    writeVar_ v ar2
-    sendMessage m (toList ar2)
+putArrayVar :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => (ArrayVar i a) -> i -> a -> Nomex Bool
+putArrayVar mv i a = do
+    ma <- readMsgVar mv+    case ma of+       Just ar -> do+          let ar2 = M.insert i (Just a) (fromList ar)
+          writeMsgVar mv (toList ar2)+       Nothing -> return False++putArrayVar_ :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => (ArrayVar i a) -> i -> a -> Nomex ()
+putArrayVar_ mv i a = void $ putArrayVar mv i a       
 
--- | get the messsage triggered when the array is filled
-getArrayVarMessage :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => (ArrayVar i a) -> Nomex (Msg [(i, Maybe a)])
-getArrayVarMessage (ArrayVar m _) = return m
+ 
--- | get the association array
-getArrayVarData :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => (ArrayVar i a) -> Nomex ([(i, Maybe a)])
-getArrayVarData (ArrayVar _ v) = toList <$> (readVar_ v)
 
--- | get the association array with only the filled values
-getArrayVarData' :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => (ArrayVar i a) -> Nomex ([(i, a)])
-getArrayVarData' v = catMaybes . map sndMaybe <$> (getArrayVarData v)
-
-delArrayVar :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => (ArrayVar i a) -> Nomex ()
-delArrayVar (ArrayVar m v) = delAllEvents m >> delVar_ v
-
 -- * Events
 
 -- | register a callback on an event
@@ -287,62 +347,122 @@ 
 
 -- * Inputs
-
-inputChoice :: (Eq c, Show c) => PlayerNumber -> String -> [c] -> c -> Event (InputChoice c)
-inputChoice = InputChoice
+++-- ** Radio inputs 
-inputChoiceHead :: (Eq c, Show c) => PlayerNumber -> String -> [c] -> Event (InputChoice c)
-inputChoiceHead pn title choices = inputChoice pn title choices (head choices)
+inputRadio :: (Eq c, Show c, Typeable c) => PlayerNumber -> String -> [c] -> c -> Event (Input c)
+inputRadio pn title cs _ = InputEv (Input pn title (Radio (zip cs (show <$> cs))))
 
-inputChoiceEnum :: forall c. (Enum c, Bounded c, Typeable c, Eq c,  Show c) => PlayerNumber -> String -> c -> Event (InputChoice c)
-inputChoiceEnum pn title defaultChoice = inputChoice pn title (enumFrom (minBound::c)) defaultChoice
+inputRadioHead :: (Eq c, Show c, Typeable c) => PlayerNumber -> String -> [c] -> Event (Input c)
+inputRadioHead pn title choices = inputRadio pn title choices (head choices)
 
-inputString :: PlayerNumber -> String -> Event InputString
-inputString = InputString
+inputRadioEnum :: forall c. (Enum c, Bounded c, Typeable c, Eq c,  Show c) => PlayerNumber -> String -> c -> Event (Input c)
+inputRadioEnum pn title defaultChoice = inputRadio pn title (enumFrom (minBound::c)) defaultChoice
++inputRadioData :: (Show c) => EventData (Input c) -> c+inputRadioData (InputData (RadioData a)) = a+inputRadioData a = error $ "Not a Radio Data: " ++ (show a) 
 -- | triggers a choice input to the user. The result will be sent to the callback
-onInputChoice :: (Typeable a, Eq a,  Show a) => String -> [a] -> (EventNumber -> a -> Nomex ()) -> PlayerNumber -> Nomex EventNumber
-onInputChoice title choices handler pn = onEvent (inputChoiceHead pn title choices) (\(en, a) -> handler en (inputChoiceData a))
+onInputRadio :: (Typeable a, Eq a,  Show a) => String -> [a] -> (EventNumber -> a -> Nomex ()) -> PlayerNumber -> Nomex EventNumber
+onInputRadio title choices handler pn = onEvent (inputRadioHead pn title choices) (\(en, InputData (RadioData a)) -> handler en a)
 
 -- | the same, disregard the event number
-onInputChoice_ :: (Typeable a, Eq a, Show a) => String -> [a] -> (a -> Nomex ()) -> PlayerNumber -> Nomex ()
-onInputChoice_ title choices handler pn = onEvent_ (inputChoiceHead pn title choices) (handler . inputChoiceData)
+onInputRadio_ :: (Typeable a, Eq a, Show a) => String -> [a] -> (a -> Nomex ()) -> PlayerNumber -> Nomex ()
+onInputRadio_ title choices handler pn = onEvent_ (inputRadioHead pn title choices) (handler . inputRadioData)
 
 -- | the same, suppress the event after first trigger
-onInputChoiceOnce :: (Typeable a, Eq a, Show a) => String -> [a] -> (a -> Nomex ()) -> PlayerNumber -> Nomex EventNumber
-onInputChoiceOnce title choices handler pn = onEventOnce (inputChoiceHead pn title choices) (handler . inputChoiceData)
+onInputRadioOnce :: (Typeable a, Eq a, Show a) => String -> [a] -> (a -> Nomex ()) -> PlayerNumber -> Nomex EventNumber
+onInputRadioOnce title choices handler pn = onEventOnce (inputRadioHead pn title choices) (handler . inputRadioData)
 
 -- | the same, disregard the event number
-onInputChoiceOnce_ :: (Typeable a, Eq a, Show a) => String -> [a] -> (a -> Nomex ()) -> PlayerNumber -> Nomex ()
-onInputChoiceOnce_ title choices handler pn = onEventOnce_ (inputChoiceHead pn title choices) (handler . inputChoiceData)
+onInputRadioOnce_ :: (Typeable a, Eq a, Show a) => String -> [a] -> (a -> Nomex ()) -> PlayerNumber -> Nomex ()
+onInputRadioOnce_ title choices handler pn = onEventOnce_ (inputRadioHead pn title choices) (handler . inputRadioData)
 
 -- | triggers a choice input to the user, using an enumerate as input
-onInputChoiceEnum :: forall a. (Enum a, Bounded a, Typeable a, Eq a,  Show a) => String -> a -> (EventNumber -> a -> Nomex ()) -> PlayerNumber -> Nomex EventNumber
-onInputChoiceEnum title defaultChoice handler pn = onEvent (inputChoiceEnum pn title defaultChoice) (\(en, a) -> handler en (inputChoiceData a))
+onInputRadioEnum :: forall a. (Enum a, Bounded a, Typeable a, Eq a,  Show a) => String -> a -> (EventNumber -> a -> Nomex ()) -> PlayerNumber -> Nomex EventNumber
+onInputRadioEnum title defaultChoice handler pn = onEvent (inputRadioEnum pn title defaultChoice) (\(en, a) -> handler en (inputRadioData a))
 
 -- | the same, disregard the event number
-onInputChoiceEnum_ :: forall a. (Enum a, Bounded a, Typeable a, Eq a,  Show a) => String -> a -> (a -> Nomex ()) -> PlayerNumber -> Nomex ()
-onInputChoiceEnum_ title defaultChoice handler pn = onEvent_ (inputChoiceEnum pn title defaultChoice) (handler . inputChoiceData)
+onInputRadioEnum_ :: forall a. (Enum a, Bounded a, Typeable a, Eq a,  Show a) => String -> a -> (a -> Nomex ()) -> PlayerNumber -> Nomex ()
+onInputRadioEnum_ title defaultChoice handler pn = onEvent_ (inputRadioEnum pn title defaultChoice) (handler . inputRadioData)
 
 -- | the same, suppress the event after first trigger
-onInputChoiceEnumOnce_ :: forall a. (Enum a, Bounded a, Typeable a, Eq a,  Show a) => String -> a -> (a -> Nomex ()) -> PlayerNumber -> Nomex ()
-onInputChoiceEnumOnce_ title defaultChoice handler pn = onEventOnce_ (inputChoiceEnum pn title defaultChoice) (handler . inputChoiceData)
+onInputRadioEnumOnce_ :: forall a. (Enum a, Bounded a, Typeable a, Eq a,  Show a) => String -> a -> (a -> Nomex ()) -> PlayerNumber -> Nomex ()
+onInputRadioEnumOnce_ title defaultChoice handler pn = onEventOnce_ (inputRadioEnum pn title defaultChoice) (handler . inputRadioData)
 
+-- ** Text inputs 
+inputText :: PlayerNumber -> String -> Event (Input String)
+inputText pn title = InputEv (Input pn title Text)++inputTextData :: EventData (Input String) -> String+inputTextData (InputData (TextData a)) = a+inputTextData a = error $ "Not a Text Data: " ++ (show a)+
 -- | triggers a string input to the user. The result will be sent to the callback
-onInputString :: String -> (EventNumber -> String -> Nomex ()) -> PlayerNumber -> Nomex EventNumber
-onInputString title handler pn = onEvent (inputString pn title) (\(en, a) -> handler en (inputStringData a))
+onInputText :: String -> (EventNumber -> String -> Nomex ()) -> PlayerNumber -> Nomex EventNumber
+onInputText title handler pn = onEvent (inputText pn title) (\(en, a) -> handler en (inputTextData a))
 
 -- | asks the player pn to answer a question, and feed the callback with this data.
-onInputString_ :: String -> (String -> Nomex ()) -> PlayerNumber -> Nomex ()
-onInputString_ title handler pn = onEvent_ (inputString pn title) (handler . inputStringData)
+onInputText_ :: String -> (String -> Nomex ()) -> PlayerNumber -> Nomex ()
+onInputText_ title handler pn = onEvent_ (inputText pn title) (handler . inputTextData)
 
 -- | asks the player pn to answer a question, and feed the callback with this data.
-onInputStringOnce_ :: String -> (String -> Nomex ()) -> PlayerNumber -> Nomex ()
-onInputStringOnce_ title handler pn = onEventOnce_ (inputString pn title) (handler . inputStringData)
+onInputTextOnce_ :: String -> (String -> Nomex ()) -> PlayerNumber -> Nomex ()
+onInputTextOnce_ title handler pn = onEventOnce_ (inputText pn title) (handler . inputTextData)
++-- ** Checkbox inputs++inputCheckboxData :: (Show c) => EventData (Input c) -> [c]+inputCheckboxData (InputData (CheckboxData a)) = a+inputCheckboxData a = error $ "Not a Checkbox Data: " ++ (show a)++inputCheckbox :: (Eq c, Show c, Typeable c) => PlayerNumber -> String -> [(c, String)] -> Event (Input c)
+inputCheckbox pn title cs = InputEv (Input pn title (Checkbox cs))++onInputCheckbox :: (Typeable a, Eq a,  Show a) => String -> [(a, String)] -> (EventNumber -> [a] -> Nomex ()) -> PlayerNumber -> Nomex EventNumber
+onInputCheckbox title choices handler pn = onEvent (inputCheckbox pn title choices) (\(en, InputData (CheckboxData a)) -> handler en a)++onInputCheckbox_ :: (Typeable a, Eq a,  Show a) => String -> [(a, String)] -> ([a] -> Nomex ()) -> PlayerNumber -> Nomex ()
+onInputCheckbox_ title choices handler pn = onEvent_ (inputCheckbox pn title choices) (handler . inputCheckboxData)++-- ** Button inputs++inputButtonData :: EventData (Input ()) -> ()+inputButtonData (InputData ButtonData) = ()+inputButtonData a = error $ "Not a Button Data: " ++ (show a)++inputButton :: PlayerNumber -> String -> Event (Input ())
+inputButton pn title = InputEv (Input pn title Button)++onInputButton :: String -> (EventNumber -> () -> Nomex ()) -> PlayerNumber -> Nomex EventNumber
+onInputButton title handler pn = onEvent (inputButton pn title) (\(en, InputData ButtonData) -> handler en ())++onInputButton_ :: String -> (() -> Nomex ()) -> PlayerNumber -> Nomex ()
+onInputButton_ title handler pn = onEvent_ (inputButton pn title) (handler . inputButtonData)++-- ** Textarea inputs++inputTextareaData :: EventData (Input String) -> String+inputTextareaData (InputData (TextAreaData a)) = a+inputTextareaData a = error $ "Not a Textarea Data: " ++ (show a)++inputTextarea :: PlayerNumber -> String -> Event (Input String)
+inputTextarea pn title = InputEv (Input pn title TextArea)++onInputTextarea :: String -> (EventNumber -> String -> Nomex ()) -> PlayerNumber -> Nomex EventNumber
+onInputTextarea title handler pn = onEvent (inputTextarea pn title) (\(en, a) -> handler en (inputTextareaData a))
 
--- * Victory, players+onInputTextarea_ :: String -> (String -> Nomex ()) -> PlayerNumber -> Nomex ()
+onInputTextarea_ title handler pn = onEvent_ (inputTextarea pn title) (handler . inputTextareaData)
 
+onInputTextareaOnce_ :: String -> (String -> Nomex ()) -> PlayerNumber -> Nomex ()
+onInputTextareaOnce_ title handler pn = onEventOnce_ (inputTextarea pn title) (handler . inputTextareaData)+
+-- * Players+
 -- | get all the players getPlayers :: Nomex [PlayerInfo]
 getPlayers = GetPlayers
@@ -382,10 +502,50 @@ delPlayer :: PlayerNumber -> Nomex Bool
 delPlayer = DelPlayer
 +-- * Outputs+
+-- | outputs a message to one player
+newOutput :: String -> PlayerNumber -> Nomex OutputNumber
+newOutput s pn = NewOutput pn s
 +newOutput_ :: String -> PlayerNumber -> Nomex ()
+newOutput_ s pn = void $ NewOutput pn s 
--- * Victory, output, time and self-number
+outputAll :: String -> Nomex ()
+outputAll s = getPlayers >>= mapM_ ((newOutput s) . _playerNumber)
++updateOutput :: OutputNumber -> String -> Nomex Bool+updateOutput = UpdateOutput++updateOutput_ :: OutputNumber -> String -> Nomex ()+updateOutput_ on s = void $ updateOutput on s++delOutput :: OutputNumber -> Nomex Bool+delOutput = DelOutput++delOutput_ :: OutputNumber -> Nomex ()+delOutput_ on = void $ delOutput on++-- permanently display a variable (update display when variable is updated)+displayVar :: (Typeable a, Show a, Eq a) => PlayerNumber -> MsgVar a -> (a -> String) -> Nomex ()+displayVar pn mv dis = onMsgVarEvent+   mv+   (\a -> newOutput (dis a) pn)+   (\a n -> updateOutput_ n (dis a))+   delOutput_++displaySimpleVar :: (Typeable a, Show a, Eq a) => PlayerNumber -> String -> MsgVar a -> Nomex ()+displaySimpleVar pn title mv = displayVar pn mv (\a -> title ++ ": " ++ (show a) ++ "\n")++displayArrayVar :: (Typeable a, Show a, Eq a, Typeable i, Show i, Eq i) => PlayerNumber -> String -> ArrayVar i a -> Nomex ()+displayArrayVar pn title mv = displayVar pn mv (showArrayVar title)++showArrayVar :: (Show a, Show i) => String -> [(i,a)] -> String+showArrayVar title l = title ++ "\n" +++                      concatMap (\(i,a) -> (show i) ++ "\t" ++ (show a) ++ "\n") l 
+-- * Victory, time and self-number
+
 -- | set victory to a list of players
 setVictory :: [PlayerNumber] -> Nomex ()
 setVictory = SetVictory
@@ -394,17 +554,10 @@ giveVictory :: PlayerNumber -> Nomex ()
 giveVictory pn = SetVictory [pn]
 
--- | outputs a message to one player
-output :: String -> PlayerNumber -> Nomex ()
-output s pn = Output pn s
-
-outputAll :: String -> Nomex ()
-outputAll s = getPlayers >>= mapM_ ((output s) . _playerNumber)
-
 getCurrentTime :: Nomex UTCTime
 getCurrentTime = CurrentTime
 
--- | allows a rule to retrieve its self number (for auto-deleting for example)
+-- | allows a rule to retrieve its own number (for auto-deleting for example)
 getSelfRuleNumber :: Nomex RuleNumber
 getSelfRuleNumber = SelfRuleNumber
 
@@ -416,11 +569,9 @@ 
 getSelfProposedByPlayer :: Nomex PlayerNumber
 getSelfProposedByPlayer = getSelfRule >>= return . _rProposedBy
-  
+ -- * Miscellaneous
 
-
-
 voidRule :: Nomex a -> Nomex RuleResp
 voidRule e = e >> return Void @@ -453,8 +604,16 @@    let m = Message ((show a) ++ " &&* " ++ (show b))
    newArrayVarOnce ((show a) ++ ", " ++ (show b)) [1::Integer, 2] (f m)
    return m where
-        f m ((_, Just a):(_, Just b):[]) = sendMessage m $ a && b+        f m (VUpdated ((_, Just a):(_, Just b):[])) = sendMessage m $ a && b         f _ _ = return ()+++partial :: String -> Nomex (Maybe a) -> Nomex a+partial s nm = do+   m <- nm+   case m of+      Just a -> return a+      Nothing -> throwError s 
 
 -- | a default rule

@@ -2,7 +2,7 @@  module Language.Nomyx.Evaluation where -import Prelude hiding ((.))+import Prelude hiding ((.), log) import Language.Nomyx.Utils import Control.Monad import Control.Monad.State.Lazy@@ -14,11 +14,9 @@ import Control.Category import Control.Monad.Error (ErrorT(..)) import Control.Monad.Error.Class (MonadError(..))-import Language.Nomyx.Definition (outputAll) import Control.Applicative ((<$>)) import Language.Nomyx.Expression - type Evaluate a = ErrorT String (State Game) a  -- | evaluate an expression.@@ -32,7 +30,6 @@          return $ Just (V name)       Just _ -> return Nothing - evalExp (DelVar (V name)) _ = do    vars <- access variables    case find ((== name) . getL vName) vars of@@ -50,19 +47,18 @@           Just v -> return $ Just v           Nothing -> return Nothing -evalExp (WriteVar (V name) val) rn = do+evalExp (WriteVar (V name) val) _ = do    vars <- access variables-   let newVars = replaceWith ((== name) . getL vName) (Var rn name val) vars    case find (\(Var _ myName _) -> myName == name) vars of       Nothing -> return False-      Just _ -> do-         variables ~= newVars+      Just (Var rn myName _) -> do+         variables %= replaceWith ((== name) . getL vName) (Var rn myName val)          return True  evalExp (OnEvent event handler) rn = do    evs <- access events    let en = getFreeNumber (map _eventNumber evs)-   events %= ((EH en rn event handler EvActive) : )+   events %= ((EH en rn event handler SActive) : )    return en  evalExp (DelEvent en) _ = evDelEvent en@@ -70,17 +66,17 @@ evalExp (DelAllEvents e) _ = do    evs <- access events    let filtered = filter (\EH {event} -> event === e) evs-   --traceM ("DelAllEvents: deleting " ++ show filtered)    mapM_ (\e -> evDelEvent e) (_eventNumber <$> filtered)  evalExp (SendMessage (Message id) myData) _ = triggerEvent_ (Message id) (MessageData myData) -evalExp (Output pn string)    _  = outputS pn string >> return ()+evalExp (NewOutput pn s)      rn = evNewOutput pn rn s+evalExp (UpdateOutput on s) _    = evUpdateOutput on s+evalExp (DelOutput on) _         = evDelOutput on evalExp (ProposeRule rule)    _  = evProposeRule rule evalExp (ActivateRule rule)   rn = evActivateRule rule rn evalExp (RejectRule rule)     rn = evRejectRule rule rn evalExp (AddRule rule)        _  = evAddRule rule-evalExp (DelRule del)         _  = evDelRule del evalExp (ModifyRule mod rule) _  = evModifyRule mod rule evalExp GetRules              _  = access rules evalExp GetPlayers            _  = access players@@ -97,8 +93,6 @@    let victorious = filter (\pl -> _playerNumber pl `elem` ps) pls    triggerEvent_ Victory (VictoryData victorious) -- evalExp (Bind exp f) rn = do    a <- evalExp exp rn    evalExp (f a) rn@@ -108,36 +102,42 @@ triggerEvent :: (Typeable e, Show e, Eq e) => Event e -> EventData e -> Evaluate Bool triggerEvent e dat = do    evs <- access events-   let filtered = filter (\(EH {event, _evStatus}) -> e === event && _evStatus == EvActive) evs+   let filtered = filter (\(EH {event, _evStatus}) -> e === event && _evStatus == SActive) (reverse evs)    case filtered of-      [] -> do-         --traceM $ "triggerEvent: Event not found:" ++ (show e)-         return False+      [] -> return False       xs -> do-         mapM_ f xs-         return True where-            f (EH {_ruleNumber, _eventNumber, handler}) = case cast handler of-               Just castedH -> do-                  let (exp :: Nomex ()) = castedH (_eventNumber, dat)-                  evalExp (exp `catchError` errorHandler) _ruleNumber-               Nothing -> outputS 1 ("failed " ++ (show $ typeOf handler))+         mapM_ (triggerHandler dat) xs+         return True ++triggerHandler :: (Typeable e, Show e, Eq e) => EventData e -> EventHandler -> Evaluate ()+triggerHandler dat (EH {_ruleNumber, _eventNumber, handler}) = case cast handler of+    Just castedH -> do+       let (exp :: Nomex ()) = castedH (_eventNumber, dat)+       (evalExp exp _ruleNumber) `catchError` (errorHandler _ruleNumber _eventNumber)+    Nothing -> logAll ("failed " ++ (show $ typeOf handler))+ triggerEvent_ :: (Typeable e, Show e, Eq e) => Event e -> EventData e -> Evaluate () triggerEvent_ e ed = void $ triggerEvent e ed -errorHandler :: String -> Nomex ()-errorHandler s = outputAll $ "Error: " ++ s+errorHandler :: RuleNumber -> EventNumber -> String -> Evaluate ()+errorHandler rn en s = logAll $ "Error in rule " ++ (show rn) ++ " (triggered by event " ++ (show en) ++ "): " ++ s -triggerChoice :: EventNumber -> Int -> Evaluate ()-triggerChoice en choiceIndex = do+-- trigger the input event with the input data+triggerInput :: EventNumber -> UInputData -> Evaluate ()+triggerInput en ir = do    evs <- access events    let filtered = filter ((== en) . getL eventNumber) evs-   mapM_ (execChoiceHandler en choiceIndex) filtered--execChoiceHandler :: EventNumber -> Int -> EventHandler -> Evaluate ()-execChoiceHandler eventNumber choiceIndex (EH _ rn (InputChoice _ _ cs _) handler _) = evalExp (handler (eventNumber, InputChoiceData (cs!!choiceIndex))) rn-execChoiceHandler _ _ _ = return ()+   mapM_ (execInputHandler ir) filtered +-- execute the event handler using the data received from user+execInputHandler :: UInputData -> EventHandler -> Evaluate ()+execInputHandler (UTextData s)      (EH en rn (InputEv (Input _ _ Text))          h SActive) = evalExp (h (en, InputData $ TextData s)) rn+execInputHandler (UTextAreaData s)  (EH en rn (InputEv (Input _ _ TextArea))      h SActive) = evalExp (h (en, InputData $ TextAreaData s)) rn+execInputHandler (UButtonData)      (EH en rn (InputEv (Input _ _ Button))        h SActive) = evalExp (h (en, InputData $ ButtonData)) rn+execInputHandler (URadioData i)     (EH en rn (InputEv (Input _ _ (Radio cs)))    h SActive) = evalExp (h (en, InputData $ RadioData $ fst $ cs!!i)) rn+execInputHandler (UCheckboxData is) (EH en rn (InputEv (Input _ _ (Checkbox cs))) h SActive) = evalExp (h (en, InputData $ CheckboxData $ fst <$> cs `sel` is)) rn+execInputHandler _ _ = return ()  findEvent :: EventNumber -> [EventHandler] -> Maybe (EventHandler) findEvent en evs = find ((== en) . getL eventNumber) evs@@ -146,11 +146,9 @@ getChoiceEvents = do    evs <- access events    return $ map _eventNumber $ filter choiceEvent evs-   where choiceEvent (EH _ _ (InputChoice _ _ _ _) _ _) = True+   where choiceEvent (EH _ _ (InputEv (Input _ _ (Radio _))) _ _) = True          choiceEvent _ = False -outputS :: PlayerNumber -> String -> Evaluate ()-outputS pn s = void $ outputs %= ((pn, s) : )  evProposeRule :: Rule -> Evaluate Bool evProposeRule rule = do@@ -166,7 +164,7 @@ evActivateRule :: RuleNumber -> RuleNumber -> Evaluate Bool evActivateRule rn by = do    rs <- access rules-   case find ((== rn) . getL rNumber) rs of+   case find (\r -> _rNumber r == rn && _rStatus r /= Active) rs of       Nothing -> return False       Just r -> do          let newrules = replaceWith ((== rn) . getL rNumber) r{_rStatus = Active, _rAssessedBy = Just by} rs@@ -179,7 +177,7 @@ evRejectRule :: RuleNumber -> RuleNumber -> Evaluate Bool evRejectRule rn by = do    rs <- access rules-   case find ((== rn) . getL rNumber) rs of+   case find (\r -> _rNumber r == rn && _rStatus r /= Reject) rs of       Nothing -> return False       Just r -> do          let newrules = replaceWith ((== rn) . getL rNumber) r{_rStatus = Reject, _rAssessedBy = Just by} rs@@ -199,18 +197,6 @@          return True       Just _ -> return False -evDelRule :: RuleNumber -> Evaluate Bool-evDelRule del = do-   rs <- access rules-   case find ((== del) . getL rNumber) rs of-      Nothing -> return False-      Just r -> do-         let newRules = filter ((/= del) . getL rNumber) rs-         rules ~= newRules-         delVarsRule del-         delEventsRule del-         triggerEvent_ (RuleEv Deleted) (RuleData r)-         return True  --TODO: clean and execute new rule evModifyRule :: RuleNumber -> Rule -> Evaluate Bool@@ -265,17 +251,15 @@          return False       Just eh -> do          case (_evStatus eh) of-            EvActive -> do+            SActive -> do                --traceM ("DelEvent: deleting event en=" ++ (show en) ++ " rn=" ++ (show rn))-               let newEvents = replaceWith ((== en) . getL eventNumber) eh{_evStatus = EvDeleted} evs+               let newEvents = replaceWith ((== en) . getL eventNumber) eh{_evStatus = SDeleted} evs                events ~= newEvents                return True-            EvDeleted -> do+            SDeleted -> do                --traceM ("DelEvent: Event already deleted! en=" ++ (show en) ++ "rn event=" ++ (show $ _ruleNumber eh) ++ " rn=" ++ (show rn))                return False -evInputChoice :: (Eq d, Show d, Typeable d, Read d) => Event(InputChoice d) -> d -> Evaluate Bool-evInputChoice ic d = triggerEvent ic (InputChoiceData d)  evTriggerTime :: UTCTime -> Evaluate Bool evTriggerTime t = triggerEvent (Time t) (TimeData t)@@ -292,6 +276,50 @@    let toDelete = filter ((== rn) . getL ruleNumber) evs    mapM_ (evDelEvent . _eventNumber) toDelete ++evNewOutput :: PlayerNumber -> RuleNumber -> String -> Evaluate OutputNumber+evNewOutput pn rn s = do+   ops <- access outputs+   let on = getFreeNumber (map _outputNumber ops)+   outputs %= ((Output on rn pn s SActive) : )+   return on++evUpdateOutput :: OutputNumber -> String -> Evaluate Bool+evUpdateOutput on s = do+   ops <- access outputs+   case find (\(Output myOn _ _ _ s) -> myOn == on && s == SActive) ops of+      Nothing -> return False+      Just (Output _ rn pn _ _) -> do+         outputs %= replaceWith ((== on) . getL outputNumber) (Output on rn pn s SActive)+         return True++evDelOutput :: OutputNumber -> Evaluate Bool+evDelOutput on = do+   ops <- access outputs+   case find ((== on) . getL outputNumber) ops of+      Nothing -> do+         return False+      Just o -> do+         case (_oStatus o) of+            SActive -> do+               let newOutputs = replaceWith ((== on) . getL outputNumber) o{_oStatus = SDeleted} ops+               outputs ~= newOutputs+               return True+            SDeleted -> do+               return False++logPlayer :: PlayerNumber -> String -> Evaluate ()+logPlayer pn s = log (Just pn) s++logAll :: String -> Evaluate ()+logAll s = log Nothing s++log :: Maybe PlayerNumber -> String -> Evaluate ()+log mpn s = do+   time <- access currentTime+   void $ logs %= (Log mpn time s : )++ runEvalError :: PlayerNumber -> Evaluate () -> State Game () runEvalError pn egs = do    e <- runErrorT egs@@ -299,4 +327,4 @@       Right gs -> return gs       Left e -> do          tracePN pn $ "Error: " ++ e-         void $ outputs %= ((pn, "Error: " ++ e) : )+         void $ runErrorT (logPlayer pn "Error: ")

@@ -7,7 +7,8 @@ module Language.Nomyx.Examples(nothing, helloWorld, accounts, createBankAccount, winXEcuPerDay,     winXEcuOnRuleAccepted, moneyTransfer, delRule, voteWithMajority, king, makeKing, monarchy,     revolution, victoryXRules, victoryXEcu, displayTime, noGroupVictory, iWin, returnToDemocracy,-    banPlayer, referendum, referendumOnKickPlayer, gameMasterElections, gameMaster,+    banPlayer, referendum, referendumOnKickPlayer, gameMasterElections, gameMaster, bravoButton,+    enterHaiku,     module Data.Time.Recurrence, module Control.Monad, module Data.List, module Data.Time.Clock) where  import Language.Nomyx.Definition@@ -22,6 +23,7 @@ import Language.Nomyx.Vote        (elections, referendum, assessOnTimeDelay, assessOnEveryVote, withQuorum, majority, voteWith_) import Language.Nomyx.Utils (oneDay)+import Safe (readDef)  -- | A rule that does nothing nothing :: RuleFunc@@ -54,13 +56,13 @@ moneyTransfer = voidRule $ do     pls <- getAllPlayerNumbers     when (length pls >= 2) $ forEachPlayer_ (selPlayer pls) where-       selPlayer pls src = onInputChoice_ "Transfer money to player: " (delete src $ sort pls) (selAmount src) src-       selAmount src dst = onInputStringOnce_ ("Select Amount to transfert to player: " ++ show dst) (transfer src dst) src+       selPlayer pls src = onInputRadio_ "Transfer money to player: " (delete src $ sort pls) (selAmount src) src+       selAmount src dst = onInputTextOnce_ ("Select Amount to transfert to player: " ++ show dst) (transfer src dst) src        transfer src dst amount = do-           modifyValueOfPlayer dst accounts (\a -> a + (read amount))-           modifyValueOfPlayer src accounts (\a -> a - (read amount))-           output ("You gave " ++ amount ++ " to " ++ show dst) src-           output (show src ++ " gaved you " ++ amount ++ " Ecus") dst+           modifyValueOfPlayer dst accounts (\a -> a + (readDef 0 amount))+           modifyValueOfPlayer src accounts (\a -> a - (readDef 0 amount))+           newOutput_ ("You gave " ++ amount ++ " to " ++ show dst) src+           newOutput_ (show src ++ " gaved you " ++ amount ++ " Ecus") dst   -- | delete a rule@@ -81,7 +83,7 @@ monarchy :: RuleFunc monarchy = voidRule $ onEvent_ (RuleEv Proposed) $ \(RuleData rule) -> do     k <- readVar_ king-    onInputChoiceEnumOnce_ ("Your Royal Highness, do you accept rule " ++ (show $ _rNumber rule) ++ "?") True (activateOrReject rule) k+    onInputRadioEnumOnce_ ("Your Royal Highness, do you accept rule " ++ (show $ _rNumber rule) ++ "?") True (activateOrReject rule) k   -- | Revolution! Hail to the king!@@ -165,3 +167,10 @@  gameMaster :: V PlayerNumber gameMaster = V "GameMaster"++-- | display a button and greets you when pressed (for player 1)+bravoButton :: RuleFunc+bravoButton = voidRule $ voidRule $ onInputButton_ "Click here:" (const $ outputAll "Bravo!") 1++enterHaiku :: RuleFunc+enterHaiku = voidRule $ onInputTextarea_ "Enter a haiku:" outputAll 1

@@ -34,8 +34,10 @@ type EventName = String
 type VarName = String
 type GameName = String
-type Code = String
+type Code = String+type OutputNumber = Int 
+
 -- * Nomyx Expression
 
 -- | A Nomex (Nomyx Expression) allows the players to write rules.@@ -57,16 +59,18 @@    ActivateRule ::                               RuleNumber        -> Nomex Bool
    RejectRule   ::                               RuleNumber        -> Nomex Bool
    AddRule      ::                               Rule              -> Nomex Bool
-   DelRule      ::                               RuleNumber        -> Nomex Bool
    ModifyRule   ::                               RuleNumber        -> Rule           -> Nomex Bool
    GetRules     ::                               Nomex [Rule]
    --Players management    GetPlayers   ::                               Nomex [PlayerInfo]    SetPlayerName::                               PlayerNumber      -> PlayerName     -> Nomex Bool    DelPlayer    ::                               PlayerNumber      -> Nomex Bool+   --Output+   NewOutput    ::                               PlayerNumber      -> String         -> Nomex OutputNumber+   UpdateOutput ::                               OutputNumber      -> String         -> Nomex Bool+   DelOutput    ::                               OutputNumber      -> Nomex Bool    --Mileacenous    SetVictory   ::                               [PlayerNumber]    -> Nomex ()
-   Output       ::                               PlayerNumber      -> String         -> Nomex ()    CurrentTime  ::                               Nomex UTCTime
    SelfRuleNumber ::                             Nomex RuleNumber    --Monadic bindings@@ -75,7 +79,6 @@    ThrowError   ::                               String            -> Nomex a    CatchError   ::                               Nomex a           -> (String -> Nomex a) -> Nomex a
    deriving (Typeable)
-      
 instance Monad Nomex where
    return = Return
@@ -95,10 +98,10 @@    throwError = ThrowError    catchError = CatchError -instance Show a => Show (Nomex a) where
-   show _ = "Nomex" -- ++ (show a)
+instance Typeable a => Show (Nomex a) where
+   show e = '<' : (show . typeOf) e ++ ">"
 -
+    
 -- * Variables
 
 -- | a container for a variable name and type
@@ -106,19 +109,16 @@ 
 -- | stores the variable's data
 data Var = forall a . (Typeable a, Show a, Eq a) =>
-        Var { _vRuleNumber :: Int,
-              _vName :: String,
-              vData :: a}
+        Var { _vRuleNumber :: RuleNumber,
+              _vName       :: String,
+              vData        :: a}
 
 instance Show Var where
-    show (Var a b c) = (show a) ++ " " ++ (show b) ++ " " ++ (show c)
+    show (Var a b c) = "Rule number = " ++ (show a) ++ ", Name = " ++ (show b) ++ ", Value = " ++ (show c) ++ "\n"
 
 instance Eq Var where
     Var a b c == Var d e f = (a,b,c) === (d,e,f)
 
-type Output = (PlayerNumber, String)
-
-type Id a = a
 -- * Events
 
 -- | events types
@@ -127,48 +127,67 @@ data Time           deriving Typeable
 data EvRule         deriving Typeable
 data Message m      deriving Typeable
-data InputChoice c  deriving Typeable
-data InputString    deriving Typeable
-data Victory        deriving Typeable
+data Victory        deriving Typeable+data Input a = Input PlayerNumber String (InputForm a)+data InputForm a = Radio [(a, String)]+                 | Text+                 | TextArea+                 | Button+                 | Checkbox [(a, String)] 
 -- | events names
 data Event a where
-    Player      :: Player ->                 Event Player
-    RuleEv      :: RuleEvent ->              Event RuleEvent
-    Time        :: UTCTime ->                Event Time
-    Message     :: String ->                 Event (Message m)
-    InputChoice :: (Eq c, Show c) => PlayerNumber -> String -> [c] -> c -> Event (InputChoice c)
-    InputString :: PlayerNumber -> String -> Event InputString
-    Victory     ::                           Event Victory
-
+    Player      :: Player ->                     Event Player
+    RuleEv      :: RuleEvent ->                  Event RuleEvent
+    Time        :: UTCTime ->                    Event Time
+    Message     :: String ->                     Event (Message m)
+    InputEv     :: (Eq a, Show a, Typeable a) => Input a -> Event (Input a)
+    Victory     ::                               Event Victory
++-- data sent back by inputs+data InputData a = RadioData a+                 | CheckboxData [a]+                 | TextData String+                 | TextAreaData String+                 | ButtonData+-- an untyped version of InputData for serialization+data UInputData = URadioData Int+                | UCheckboxData [Int]+                | UTextData String+                | UTextAreaData String+                | UButtonData+                  deriving (Show, Read, Eq, Ord)+                  
 -- | data associated with each events
 data EventData a where
-    PlayerData      :: {playerData :: PlayerInfo}         -> EventData Player
-    RuleData        :: {ruleData :: Rule}                 -> EventData RuleEvent
-    TimeData        :: {timeData :: UTCTime}              -> EventData Time
-    MessageData     :: (Show m) => {messageData :: m}     -> EventData (Message m)
-    InputChoiceData :: (Show c) => {inputChoiceData :: c} -> EventData (InputChoice c)
-    InputStringData :: {inputStringData :: String}        -> EventData InputString
-    VictoryData     :: {victoryData :: [PlayerInfo]}      -> EventData Victory
+    PlayerData  ::             {playerData :: PlayerInfo}    -> EventData Player
+    RuleData    ::             {ruleData :: Rule}            -> EventData RuleEvent
+    TimeData    ::             {timeData :: UTCTime}         -> EventData Time
+    MessageData :: (Show m) => {messageData :: m}            -> EventData (Message m)
+    InputData   :: (Show a) => {inputData :: InputData a}    -> EventData (Input a)
+    VictoryData ::             {victoryData :: [PlayerInfo]} -> EventData Victory
 
 deriving instance             Typeable1 EventData
-deriving instance             Typeable1 Event
-deriving instance (Show a) => Show      (Event a)
+deriving instance             Typeable1 Event+deriving instance             Typeable1 Input+deriving instance             Typeable1 InputForm
+deriving instance (Show a) => Show      (Event a)+deriving instance (Show a) => Show      (InputForm a)+deriving instance (Show a) => Show      (Input a)
 deriving instance (Show a) => Show      (EventData a)+deriving instance (Show a) => Show      (InputData a) deriving instance (Show a) => Show      (Message a)
-deriving instance (Show a) => Show      (InputChoice a) deriving instance             Show      Time
-deriving instance             Show      InputString
 deriving instance             Show      Victory
 deriving instance             Eq        Time
 deriving instance             Eq        Victory
 deriving instance             Eq        EvRule
-deriving instance             Eq        (InputChoice a)
-deriving instance             Eq        InputString
 deriving instance             Eq        (Message m)
-deriving instance (Eq e) =>   Eq        (Event e)
+deriving instance (Eq e) =>   Eq        (Event e)+deriving instance (Eq e) =>   Eq        (Input e)+deriving instance (Eq e) =>   Eq        (InputForm e)
 
-data EventStatus = EvActive | EvDeleted deriving (Eq, Show)+data Status = SActive | SDeleted deriving (Eq, Show)  data EventHandler where
     EH :: (Typeable e, Show e, Eq e) =>
@@ -176,7 +195,7 @@          _ruleNumber  :: RuleNumber,
          event        :: Event e,
          handler      :: (EventNumber, EventData e) -> Nomex (),-         _evStatus    :: EventStatus} -> EventHandler
+         _evStatus    :: Status} -> EventHandler
 
 instance Show EventHandler where
     show (EH en rn e _ _) = (show en) ++ " " ++ (show rn) ++ " (" ++ (show e) ++"),\n"
@@ -189,6 +208,22 @@  type Msg a = Event (Message a) type MsgData a = EventData (Message a)++-- * Outputs++data Output = Output { _outputNumber  :: OutputNumber,+                       _oRuleNumber   :: PlayerNumber,+                       _oPlayerNumber :: PlayerNumber,+                       _output        :: String,+                       _oStatus       :: Status}+                         deriving (Show)++-- * Logs++data Log = Log { _lPlayerNumber :: Maybe PlayerNumber,+                 _lTime         :: UTCTime,+                 _lMsg          :: String}+                 deriving (Show) 
 -- * Rule
 
@@ -204,7 +239,6 @@ --An extended type for booleans supporting immediate or delayed response (through a message)
 data BoolResp = BoolResp Bool
               | MsgResp (Msg Bool)
- 
 instance Show RuleResp where
    show _ = "RuleResp"
@@ -242,18 +276,20 @@                                _playerName   :: String}
                                deriving (Eq, Typeable, Show)
 
--- * Game
+-- * Game+            
 -- | The state of the game:
-data Game = Game { _gameName      :: GameName,
-                   _gameDesc      :: GameDesc,
-                   _rules         :: [Rule],
-                   _players       :: [PlayerInfo],
-                   _variables     :: [Var],
-                   _events        :: [EventHandler],
-                   _outputs       :: [Output],
-                   _victory       :: [PlayerNumber],
-                   _currentTime   :: UTCTime+data Game = Game { _gameName    :: GameName,
+                   _gameDesc    :: GameDesc,
+                   _rules       :: [Rule],
+                   _players     :: [PlayerInfo],
+                   _variables   :: [Var],
+                   _events      :: [EventHandler],
+                   _outputs     :: [Output],
+                   _victory     :: [PlayerNumber],+                   _logs        :: [Log],
+                   _currentTime :: UTCTime                  }
                    deriving (Typeable)
                    
@@ -272,31 +308,31 @@      Punc "{" <- lexP;      Ident "_gameName" <- lexP;      Punc "=" <- lexP;-     a1 <- reset readPrec;+     name <- reset readPrec;      Punc "," <- lexP;      Ident "_gameDesc" <- lexP;      Punc "=" <- lexP;-     a2 <- reset readPrec;+     desc <- reset readPrec;      Punc "," <- lexP;      Ident "_currentTime" <- lexP;      Punc "=" <- lexP;-     a3 <- reset readPrec;+     time <- reset readPrec;      Punc "}" <- lexP;-     return $ Game a1 a2 [] [] [] [] [] [] a3+     return $ Game name desc [] [] [] [] [] [] [] time   readList = readListDefault   readListPrec = readListPrecDefault 
 instance Show Game where-   showsPrec p(Game b1 b2 _ _ _ _ _ _ b3) = showParen (p >= 11) $+   showsPrec p(Game name desc _ _ _ _ _ _ _ time) = showParen (p >= 11) $       showString "Game {" .       showString "_gameName = " .-      showsPrec 0 b1 .+      showsPrec 0 name .       showString ", " .       showString "_gameDesc = " .-      showsPrec 0 b2 .+      showsPrec 0 desc .       showString ", " .       showString "_currentTime = " .-      showsPrec 0 b3 .+      showsPrec 0 time .       showString "}"    showList = showList__ (showsPrec 0) @@ -305,5 +341,5 @@         "Game Name = " ++ (show _gameName) ++ "\n Rules = " ++ (concat $ intersperse "\n " $ map show _rules) ++ "\n Players = " ++ (show _players) ++ "\n Variables = " ++
         (show _variables) ++ "\n Events = " ++ (show _events) ++ "\n Outputs = " ++ (show _outputs) ++ "\n Victory = " ++ (show _victory) ++ "\n currentTime = " ++ (show _currentTime) ++ "\n"
 
-$( makeLenses [''Game, ''GameDesc, ''Rule, ''PlayerInfo, ''EventHandler, ''Var] )
+$( makeLenses [''Game, ''GameDesc, ''Rule, ''PlayerInfo, ''EventHandler, ''Var, ''Output] )
 

@@ -1,5 +1,5 @@ {-# LANGUAGE StandaloneDeriving, GADTs, DeriveDataTypeable,-    FlexibleContexts, GeneralizedNewtypeDeriving,+    FlexibleContexts, GeneralizedNewtypeDeriving, ScopedTypeVariables,     MultiParamTypeClasses, TemplateHaskell, TypeFamilies,     TypeOperators, FlexibleInstances, NoMonomorphismRestriction,     TypeSynonymInstances, DoAndIfThenElse, RecordWildCards #-}@@ -8,9 +8,10 @@ -- a game is a set of rules, and results of actions made by players (usually vote results) -- the module manages the effects of rules over each others. module Language.Nomyx.Game (GameEvent(..), update, update', LoggedGame(..), game, gameLog, emptyGame,-  execWithGame, execWithGame', outputAll, getLoggedGame, tracePN, getTimes, activeRules, pendingRules, rejectedRules)  where+  execWithGame, execWithGame', getLoggedGame, tracePN, getTimes, activeRules, pendingRules,+  rejectedRules, UInputData(..))  where -import Prelude+import Prelude hiding (log) import Control.Monad.State import Data.List import Language.Nomyx hiding (outputAll)@@ -18,7 +19,7 @@ import Control.Category ((>>>)) import Data.Lens.Template import Control.Exception-+import Control.Monad.Trans.State hiding (get)  data TimedEvent = TimedEvent UTCTime GameEvent deriving (Show, Read, Eq, Ord) @@ -26,9 +27,8 @@                | JoinGame          PlayerNumber PlayerName                | LeaveGame         PlayerNumber                | ProposeRuleEv     PlayerNumber SubmitRule-               | InputChoiceResult PlayerNumber EventNumber Int-               | InputStringResult PlayerNumber String String-               | OutputPlayer      PlayerNumber String+               | InputResult       PlayerNumber EventNumber UInputData+               | GLog              (Maybe PlayerNumber) String                | TimeEvent         UTCTime                | SystemAddRule     SubmitRule                  deriving (Show, Read, Eq, Ord)@@ -54,6 +54,7 @@     _events        = [],     _outputs       = [],     _victory       = [],+    _logs          = [],     _currentTime   = date}  $( makeLens ''LoggedGame)@@ -64,19 +65,25 @@ enactEvent (JoinGame pn name) _               = mapStateIO $ joinGame name pn enactEvent (LeaveGame pn) _                   = mapStateIO $ leaveGame pn enactEvent (ProposeRuleEv pn sr) (Just inter) = void $ proposeRule sr pn inter-enactEvent (InputChoiceResult pn en ci) _     = mapStateIO $ inputChoiceResult en ci pn-enactEvent (InputStringResult pn ti res) _    = mapStateIO $ inputStringResult (InputString pn ti) res pn-enactEvent (OutputPlayer pn s) _              = mapStateIO $ outputPlayer s pn+enactEvent (InputResult pn en ir) _           = mapStateIO $ inputResult pn en ir+enactEvent (GLog mpn s) _                     = mapStateIO $ logGame s mpn enactEvent (TimeEvent t) _                    = mapStateIO $ runEvalError 0 $ void $ evTriggerTime t enactEvent (SystemAddRule r) (Just inter)     = systemAddRule r inter enactEvent (ProposeRuleEv _ _) Nothing        = error "ProposeRuleEv: interpreter function needed" enactEvent (SystemAddRule _) Nothing          = error "SystemAddRule: interpreter function needed"  enactTimedEvent :: Maybe (RuleCode -> IO RuleFunc) -> TimedEvent -> StateT Game IO ()-enactTimedEvent inter (TimedEvent t ge) = do+enactTimedEvent inter (TimedEvent t ge) = flip stateCatch updateError $ do    currentTime ~= t    enactEvent ge inter+   lg <- get+   lift $ evaluate lg+   return () +updateError :: SomeException -> StateT Game IO ()+updateError e = do+   liftIO $ putStrLn $ "IO error: " ++ (show e)+   mapStateIO $ logGame ("IO error: " ++ (show e)) Nothing  update :: GameEvent -> StateT LoggedGame IO () update ge = update' Nothing ge@@ -86,15 +93,7 @@    t <- access $ game >>> currentTime    let te = TimedEvent t ge    gameLog %= \gl -> gl ++ [te]-   evalTimedEvent te inter--evalTimedEvent :: TimedEvent -> Maybe (RuleCode -> IO RuleFunc) -> StateT LoggedGame IO ()-evalTimedEvent (TimedEvent _ e) inter = focus game $ do-   enactEvent e inter-   lg <- get-   lift $ evaluate lg-   --liftIO $! putStrLn $ "evaluating " ++ (show e)-   return ()+   focus game $ enactTimedEvent inter te  getLoggedGame :: Game -> (RuleCode -> IO RuleFunc) -> [TimedEvent] -> IO LoggedGame getLoggedGame g mInter tes = do@@ -129,7 +128,6 @@ leaveGame :: PlayerNumber -> State Game () leaveGame pn = runEvalError pn $ void $ evDelPlayer pn - -- | insert a rule in pending rules. proposeRule :: SubmitRule -> PlayerNumber -> (RuleCode -> IO RuleFunc) -> StateT Game IO () proposeRule sr pn inter = do@@ -139,33 +137,21 @@       if r == True then tracePN pn $ "Your rule has been added to pending rules."       else tracePN pn $ "Error: Rule could not be proposed" --outputPlayer :: String -> PlayerNumber -> State Game ()-outputPlayer s pn = void $ outputs %= ((pn, s) : )--outputAll :: String -> StateT LoggedGame IO ()
-outputAll s = do-   pls <- access (game >>> players)-   mapM_ (update . ((flip OutputPlayer) s)) (map _playerNumber pls)--inputChoiceResult :: EventNumber -> Int -> PlayerNumber -> State Game ()-inputChoiceResult eventNumber choiceIndex pn = do-   tracePN pn $ "input choice result: Event " ++ (show eventNumber) ++ ", choice " ++  (show choiceIndex)-   runEvalError pn $ triggerChoice eventNumber choiceIndex---- TODO maybe homogeneise both inputs event-inputStringResult :: Event InputString -> String -> PlayerNumber -> State Game ()-inputStringResult event input pn = do-   tracePN pn $ "input String result: input " ++ input-   runEvalError pn $ triggerEvent_ event (InputStringData input)+logGame :: String -> (Maybe PlayerNumber) -> State Game ()+logGame s mpn = do+   time <- access currentTime+   void $ logs %= (Log mpn time s : ) +inputResult :: PlayerNumber -> EventNumber -> UInputData -> State Game ()+inputResult pn en ir = do+   tracePN pn $ "input result: Event " ++ (show en) ++ ", choice " ++  (show ir)+   runEvalError pn $ triggerInput en ir  getTimes :: EventHandler -> Maybe UTCTime-getTimes (EH _ _ (Time t) _ EvActive) = Just t+getTimes (EH _ _ (Time t) _ SActive) = Just t getTimes _ = Nothing ---- | An helper function to use the state transformer GameState.+-- | A helper function to use the state transformer GameState. -- It additionally sets the current time. execWithGame :: UTCTime -> State LoggedGame () -> LoggedGame -> LoggedGame execWithGame t gs g = execState gs $ ((game >>> currentTime) `setL` t $ g)@@ -205,6 +191,8 @@ systemAddRule :: SubmitRule -> (RuleCode -> IO RuleFunc) -> StateT Game IO () systemAddRule sr inter = do    rule <- createRule sr 0 inter-   let sysRule = (rStatus ^= Active).(rAssessedBy ^= Just 0)+   let sysRule = (rStatus ^= Active) >>> (rAssessedBy ^= Just 0)    rules %= (sysRule rule : )    mapStateIO $ runEvalError 0 $ void $ evalExp (_rRuleFunc rule) (_rNumber rule)++stateCatch = liftCatch catch

@@ -24,6 +24,7 @@                   _events        = [],                   _outputs       = [],                   _victory       = [],+                  _logs          = [],                   _currentTime   = date1}  testRule = Rule  { _rNumber       = 0,@@ -47,6 +48,7 @@          ("test var 4", testVarEx4),          ("test var 5", testVarEx5),          ("test single input", testSingleInputEx),+         ("test multiple input", testMultipleInputsEx),          ("test input string", testInputStringEx),          ("test send messsage", testSendMessageEx),          ("test send message 2", testSendMessageEx2),@@ -97,10 +99,10 @@    var <- newVar_ "toto" (1::Int)    a <- readVar var    case a of-      Just (1::Int) -> output "ok" 1-      _ -> output "nok" 1+      Just (1::Int) -> newOutput_ "ok" 1+      _ -> newOutput_ "nok" 1 -testVarEx3 = _outputs (execRuleFunc testVar3) == [(1,"ok")]+testVarEx3 = isOutput "ok" (execRuleFunc testVar3)  --Test variable writing testVar4 :: RuleFunc@@ -109,10 +111,10 @@    writeVar var (2::Int)    a <- readVar var    case a of-      Just (2::Int) -> output "ok" 1-      _ -> output "nok" 1+      Just (2::Int) -> newOutput_ "ok" 1+      _ -> newOutput_ "nok" 1 -testVarEx4 = _outputs (execRuleFunc testVar4) == [(1,"ok")]+testVarEx4 = isOutput "ok" (execRuleFunc testVar4)  --Test variable writing testVar5 :: RuleFunc@@ -124,7 +126,7 @@       Just (a::[Int]) -> do          writeVar var (2:a)          return ()-      Nothing -> output "nok" 1+      Nothing -> newOutput_ "nok" 1  testVarEx5 = _variables (execRuleFunc testVar5) == [(Var 0 "toto" ([2,1]::[Int]))] @@ -133,17 +135,28 @@ -- Test input testSingleInput :: RuleFunc testSingleInput = voidRule $ do-    onInputChoiceEnum_ "Vote for Holland or Sarkozy" Holland h 1 where-        h a = output ("voted for " ++ (show a)) 1+    onInputRadioEnum_ "Vote for Holland or Sarkozy" Holland h 1 where+        h a = newOutput_ ("voted for " ++ (show a)) 1 -testSingleInputEx = (_outputs $ execRuleFuncEvent testSingleInput (inputChoiceEnum 1 "Vote for Holland or Sarkozy" Holland) (InputChoiceData Holland)) == [(1, "voted for Holland")]+testSingleInputEx = isOutput "voted for Holland" g where+   g = execRuleFuncEvent testSingleInput (inputRadioEnum 1 "Vote for Holland or Sarkozy" Holland) (InputData (RadioData Holland)) +testMultipleInputs :: RuleFunc+testMultipleInputs = voidRule $ do+    onInputCheckbox_ "Vote for Holland and Sarkozy" [(Holland, "Holland"), (Sarkozy, "Sarkozy")] h 1 where+        h a = newOutput_ ("voted for " ++ (show a)) 1++testMultipleInputsEx = isOutput "voted for [Holland,Sarkozy]" g where+   g = execRuleFuncEvent testMultipleInputs (inputCheckbox 1 "Vote for Holland and Sarkozy" [(Holland, "Holland"), (Sarkozy, "Sarkozy")]) (InputData (CheckboxData [Holland, Sarkozy]))++ testInputString :: RuleFunc testInputString = voidRule $ do-    onInputString_ "Enter a number:" h 1 where-        h a = output ("You entered: " ++ a) 1+    onInputText_ "Enter a number:" h 1 where+        h a = newOutput_ ("You entered: " ++ a) 1 -testInputStringEx = (_outputs $ execRuleFuncEvent testInputString (inputString 1 "Enter a number:") (InputStringData "1")) == [(1, "You entered: 1")]+testInputStringEx = isOutput "You entered: 1" g where+   g = execRuleFuncEvent testInputString (inputText 1 "Enter a number:") (InputData (TextData "1"))  -- Test message testSendMessage :: RuleFunc@@ -151,17 +164,17 @@     let msg = Message "msg" :: Event(Message String)     onEvent_ msg f     sendMessage msg "toto" where-        f (MessageData a :: EventData(Message String)) = output a 1+        f (MessageData a :: EventData(Message String)) = newOutput_ a 1 -testSendMessageEx = _outputs (execRuleFunc testSendMessage) == [(1,"toto")]+testSendMessageEx = isOutput "toto" (execRuleFunc testSendMessage)  testSendMessage2 :: RuleFunc testSendMessage2 = voidRule $ do-    onEvent_ (Message "msg":: Event(Message ())) $ const $ output "Received" 1+    onEvent_ (Message "msg":: Event(Message ())) $ const $ newOutput_ "Received" 1     sendMessage_ (Message "msg")  -testSendMessageEx2 = _outputs (execRuleFunc testSendMessage2) == [(1,"Received")]+testSendMessageEx2 = isOutput "Received" (execRuleFunc testSendMessage2)  data Choice2 = Me | You deriving (Enum, Typeable, Show, Eq, Bounded) @@ -170,18 +183,20 @@ testUserInputWrite = voidRule $ do     newVar_ "vote" (Nothing::Maybe Choice2)     onEvent_ (Message "voted" :: Event (Message ())) h2-    onEvent_ (InputChoice 1 "Vote for" [Me, You] Me) h1 where-        h1 (InputChoiceData a :: EventData (InputChoice Choice2)) = do+    onEvent_ (InputEv (Input 1 "Vote for" (Radio [(Me, "Me"), (You, "You")]))) h1 where+        h1 (InputData (RadioData a) :: EventData (Input Choice2)) = do             writeVar (V "vote") (Just a)             SendMessage (Message "voted") ()+        h1 _ = undefined         h2 (MessageData _) = do             a <- readVar (V "vote")             case a of-                Just (Just Me) -> output "voted Me" 1-                _ -> output "problem" 1+                Just (Just Me) -> newOutput_ "voted Me" 1+                _ -> newOutput_ "problem" 1         h2 _ = undefined -testUserInputWriteEx = (_outputs $ execRuleFuncEvent testUserInputWrite (InputChoice 1 "Vote for" [Me, You] Me) (InputChoiceData Me)) == [(1,"voted Me")]+testUserInputWriteEx = isOutput "voted Me" g where+   g = execRuleFuncEvent testUserInputWrite (InputEv (Input 1 "Vote for" (Radio [(Me, "Me"), (You, "You")]))) (InputData (RadioData Me))  -- Test rule activation testActivateRule :: RuleFunc@@ -204,12 +219,14 @@     onEvent_ (Time date1) f where         f _ = outputAll $ show date1 -testTimeEventEx = (_outputs $ execRuleFuncEvent testTimeEvent (Time date1) (TimeData date1)) == [(1,show date1)]+testTimeEventEx = isOutput (show date1) g where+   g = execRuleFuncEvent testTimeEvent (Time date1) (TimeData date1)  testTimeEvent2 :: Nomex () testTimeEvent2 = schedule' [date1, date2] (outputAll . show) -testTimeEventEx2 = (_outputs $ flip execState testGame (runEvalError 0 $ evalExp testTimeEvent2 0 >> void gameEvs)) == [(1,show date2), (1,show date1)] where+testTimeEventEx2 = isOutput (show date1) g && isOutput (show date2) g where+    g = flip execState testGame (runEvalError 0 $ evalExp testTimeEvent2 0 >> void gameEvs)     gameEvs = do         evTriggerTime date1         evTriggerTime date2@@ -225,13 +242,13 @@     evs <- getChoiceEvents     let pos = take positives evs     let neg = take negatives $ drop positives evs-    mapM_ (\x -> triggerChoice x (fromEnum For)) pos-    mapM_ (\x -> triggerChoice x (fromEnum Against)) neg+    mapM_ (\x -> triggerInput x (URadioData $ fromEnum For)) pos+    mapM_ (\x -> triggerInput x (URadioData $ fromEnum Against)) neg     when timeEvent $ void $ evTriggerTime date2  voteGame' :: Int -> Int -> Int -> Bool -> RuleFunc -> Game voteGame' positives negatives notVoted timeEvent rf  = voteGameActions positives negatives notVoted timeEvent $ do-   let rule = testRule {_rName = "testRule", _rRuleFunc = rf, _rNumber = 1, _rStatus = Active}+   let rule = testRule {_rName = "testRule", _rRuleFunc = rf, _rNumber = 1, _rStatus = Pending}    evAddRule rule    evActivateRule (_rNumber rule) 0    return ()@@ -273,4 +290,8 @@ testVoteAssessOnTimeLimit5    = testVoteRule Pending $ voteGameTimed 10 0 10 $ onRuleProposed $ voteWith_ unanimity $ assessOnTimeLimit date3  testVoteRule s g = (_rStatus $ head $ _rules g) == s++isOutput :: String -> Game -> Bool+isOutput s g = any (\(Output _ _ _ mys SActive) -> mys == s) (_outputs g)+ 

@@ -54,3 +54,9 @@  getFreeNumber :: (Eq a, Num a, Enum a) => [a] -> a getFreeNumber l = head [a| a <- [1..], not $ a `elem` l]+++sel :: [a]   -- ^ List of indices to select+    -> [Int] -- ^ List of elements+    -> [a]   -- ^ List composed of elements selected from original set by indices provided+sel xs is = map (\i -> xs!!i) is

@@ -13,11 +13,12 @@ import Data.Time hiding (getCurrentTime)
 import Control.Arrow
 import Control.Applicative
-import Data.List (sort, group)-import Language.Nomyx.Utils (oneDay)+import Language.Nomyx.Utils+import Data.List import qualified Data.Map as M import Control.Monad.Error (MonadError(..)) + data VoteType a = ExclusiveVote (Maybe (Alts a))                 | NonExclusiveVote [Alts a] @@ -50,8 +51,6 @@                              assessFunction :: VoteResult a}           -- function used to count the votes
 type Assessor a = StateT (VoteData a) Nomex ()
 --
 -- | Perform a vote. voteWith :: (Votable a) => VoteResult a         -- ^ the function used to count the votes.                         -> Assessor a           -- ^ assessors: when and how to perform the vote assessment (several assessors can be chained).@@ -63,12 +62,14 @@     let toVoteName = name toVote
     let msgEnd = Message ("Result of votes for " ++ toVoteName) :: Msg [Alts a]
     --create an array variable to store the votes.
-    (voteVar :: ArrayVar PlayerNumber (Alts a)) <- newArrayVar ("Votes for " ++ toVoteName) pns
-    let askPlayer pn = onInputChoiceOnce ("Vote for " ++ toVoteName ++ ":") als (putArrayVar voteVar pn) pn
+    (voteVar :: ArrayVar PlayerNumber (Alts a)) <- newArrayVar_ ("Votes for " ++ toVoteName) pns
+    let askPlayer pn = onInputRadioOnce ("Vote for " ++ toVoteName ++ ":") als (putArrayVar_ voteVar pn) pn
     inputs <- mapM askPlayer pns
     let voteData = VoteData msgEnd voteVar inputs countVotes
-    evalStateT assessors voteData
-    cleanVote voteData
+    evalStateT assessors voteData+    mapM (\n -> displayVoteVar n ("Votes for " ++ toVoteName ++ ":") voteVar) pns+    displayVoteResult toVoteName voteData+    cleanVote voteData     return $ msgEnd  -- | Performs a vote, all the possible alternatives are selected.@@ -81,10 +82,11 @@ assessOnEveryVote = do
    (VoteData msgEnd voteVar _ assess) <- get
    lift $ do
-      msgVotes <- getArrayVarMessage voteVar
-      onMessage msgVotes $ \(MessageData votes) -> do-         let res = assess $ getVoteStats votes False-         when (not $ null res) $ sendMessage msgEnd res
+      onMsgVarChange voteVar $ f assess msgEnd where+         f assess msgEnd (VUpdated votes) = do+            let res = assess $ getVoteStats votes False+            when (not $ null res) $ sendMessage msgEnd res+         f _ _ _ = return ()   
 
 
 -- | assess the vote with the assess function when time is reached, and sends a signal with the issue (positive of negative)
@@ -93,7 +95,7 @@    (VoteData msgEnd voteVar _ assess) <- get
    lift $ do
       onEvent_ (Time time) $ \_ -> do
-         votes <- getArrayVarData voteVar
+         votes <- getMsgVarData_ voteVar
          sendMessage msgEnd (assess $ getVoteStats votes True)
     
@@ -108,16 +110,16 @@ assessWhenEverybodyVoted = do
    (VoteData msgEnd voteVar _ assess) <- get
    lift $ do
-      msgVotes <- getArrayVarMessage voteVar
-      onMessage msgVotes $ \(MessageData vs) -> do-         when (all isJust (map snd vs)) $ sendMessage msgEnd $ assess $ getVoteStats vs True
+      onMsgVarChange voteVar $ f assess msgEnd where+         f assess msgEnd (VUpdated votes) = when (all isJust (map snd votes)) $ sendMessage msgEnd $ assess $ getVoteStats votes True
+         f _ _ _ = return () 
 
 -- | clean events and variables necessary for the vote
 cleanVote :: (Votable a) => VoteData a -> Nomex ()
-cleanVote (VoteData msgEnd voteVar inputsNumber _) = onMessage msgEnd$ \_ -> do
+cleanVote (VoteData msgEnd voteVar inputsNumber _) = onMessage msgEnd $ \_ -> do
    delAllEvents msgEnd
-   delArrayVar voteVar
+   delMsgVar voteVar
    mapM_ delEvent inputsNumber
 
 
@@ -179,7 +181,39 @@  counts :: (Eq a, Ord a) => [a] -> [(a, Int)] counts as = map (head &&& length) (group $ sort as)-   
+++displayVoteVar :: (Votable a) => PlayerNumber -> String -> ArrayVar PlayerNumber (Alts a) -> Nomex ()+displayVoteVar pn title mv = do+   sp <- showPlayer+   displayVar pn mv (showVotes title sp)++showPlayer :: Nomex (PlayerNumber -> String)+showPlayer = do+   pls <- getPlayers+   return $ (\pn -> _playerName $ fromJust $ find (\(PlayerInfo mypn _) -> mypn == pn) pls)++showChoice :: (Votable a) => Maybe (Alts a) -> String+showChoice (Just a) = show a+showChoice Nothing  = "Not Voted "++showChoices :: (Votable a) => [(Alts a)] -> String+showChoices cs = concat $ intersperse ", " $ map show cs++showVotes :: (Votable a) => String -> (PlayerNumber -> String) -> [(PlayerNumber, Maybe (Alts a))] -> String+showVotes title showPlayer l = title ++ "\n" +++                     concatMap (\(i,a) -> (showPlayer i) ++ "\t" ++ (showChoice a) ++ "\n") l++showVotes' :: (Votable a) => (PlayerNumber -> String) -> [(PlayerNumber, Maybe (Alts a))] -> String+showVotes' showPlayer l = concat $ intersperse ", " $ map (\(i,a) -> (showPlayer i) ++ ": " ++ (showChoice a)) voted where+   voted = filter (\(_, r) -> isJust r) l+                                              
+displayVoteResult :: (Votable a) => String -> VoteData a -> Nomex ()+displayVoteResult toVoteName (VoteData msgEnd voteVar _ _) = onMessage msgEnd $ \(MessageData result) -> do
+   vs <- getMsgVarData_ voteVar+   sp <- showPlayer+   outputAll $ "Vote result for " ++ toVoteName ++ ": " ++ (showChoices result) +++               " (" ++ showVotes' sp vs ++ ")"  -- * Referendum & elections