packages feed

nomyx-language (empty) → 1.0.0

raw patch · 15 files changed

+1139/−0 lines, 15 filesdep +Booleandep +DebugTraceHelpersdep +basesetup-changed

Dependencies added: Boolean, DebugTraceHelpers, base, containers, ghc, imprevu, lens, monad-loops, mtl, old-locale, random, safe, shortcut, text, time, time-recurrence

Files

+ AUTHORS view
@@ -0,0 +1,1 @@+Corentin Dupont <corentin.dupont@gmail.com>
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright 2012, Corentin Dupont. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of its contributors may be+   used to endorse or promote products derived from this software without+   specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,35 @@++Introduction+============++This library is defining the language that allows you to express rules in Nomic.++Installation+============++This libary is used by the package Nomyx, it should be installed through it by typing:++    cabal install Nomyx++However, to activate online documentation, install with:++    cabal install --enable-documentation --haddock-hyperlink-source Nomyx-Language++To install from the git repository:++    git clone git://github.com/cdupont/Nomyx-Language.git+    cabal install --enable-documentation --haddock-hyperlink-source Nomyx-Language/++Documentation+=============++The library comes with haddock documentation you can build+(see above). Check examples/Examples.hs to see a list of example rules. +Simply copy-paste those rules (the function name or the code) in the field "code"+on Nomyx web gui and see what happens!++Contact+=======++Bug-reports, questions, suggestions and patches are all welcome.+
+ Setup.lhs view
@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+
+ nomyx-language.cabal view
@@ -0,0 +1,65 @@+name: nomyx-language+version: 1.0.0+cabal-version: >=1.8+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: 2012 Corentin Dupont+maintainer: Corentin Dupont+stability: Experimental+synopsis: Language to express rules for Nomic+description: A DSL to express rules in a Nomic game. See package Nomyx for a full game implementation.+category: Language+Homepage: http://www.nomyx.net+author: Corentin Dupont++data-files: src/Nomyx/Language.hs+            src/Nomyx/Language/Types.hs+            src/Nomyx/Language/Rules.hs+            src/Nomyx/Language/Inputs.hs+            src/Nomyx/Language/Outputs.hs+            src/Nomyx/Language/Variables.hs+            src/Nomyx/Language/Events.hs+            src/Nomyx/Language/Messages.hs+            src/Nomyx/Language/Players.hs+            src/Nomyx/Language/Utils.hs+data-dir: .+extra-source-files: AUTHORS README.md++library+    build-depends: DebugTraceHelpers  == 0.12.*,+                   Boolean            == 0.2.*,+                   base               >= 4.6 && < 5,+                   containers         == 0.5.*,+                   lens               >= 4.7 && < 4.15,+                   ghc                >= 7.6 && < 8.1,+                   mtl                >= 2.1 && < 2.3,+                   old-locale         == 1.0.*,+                   random             == 1.1.*,+                   safe               == 0.3.*,+                   time               >= 1.4 && < 1.7,+                   text,+                   time-recurrence    == 0.9.*,+                   monad-loops        == 0.4.*,+                   imprevu            == 0.1.*,+                   shortcut           == 0.1.*+    exposed-modules: Nomyx.Language+                     Nomyx.Language.Types+                     Nomyx.Language.Inputs+                     Nomyx.Language.Outputs+                     Nomyx.Language.Players+                     Nomyx.Language.Rules+                     Nomyx.Language.Messages+                     Nomyx.Language.Events+                     Nomyx.Language.Variables+                     Nomyx.Language.Utils+                     Paths_nomyx_language+    exposed: True+    buildable: True+    hs-source-dirs: src+    ghc-options: -W++source-repository head+  type:              git+  location:          https://github.com/cdupont/nomyx-language.git+
+ src/Nomyx/Language.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE Trustworthy #-}++-- | This module re-exports the elements necessary to compose a Nomyx rule.+module Nomyx.Language (+   module Nomyx.Language.Outputs,+   module Nomyx.Language.Inputs,+   module Nomyx.Language.Events,+   module Nomyx.Language.Messages,+   module Nomyx.Language.Players,+   module Nomyx.Language.Variables,+   module Nomyx.Language.Rules,+   module Nomyx.Language.Utils,+   module Nomyx.Language.Types)  where++import Nomyx.Language.Outputs    -- create outputs+import Nomyx.Language.Inputs     -- create inputs+import Nomyx.Language.Events     -- create events+import Nomyx.Language.Messages   -- inter-rule communication+import Nomyx.Language.Players    -- manage players+import Nomyx.Language.Variables  -- create variables+import Nomyx.Language.Rules      -- manage rules+import Nomyx.Language.Types      -- Nomyx Expression DSL+import Nomyx.Language.Utils      -- Nomyx Utils
+ src/Nomyx/Language/Events.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GADTs #-}++-- | All the building blocks to allow rules to build events.+module Nomyx.Language.Events (+   onEvent, onEvent_, onEventOnce,+   delEvent,+   getEvents,+   getIntermediateResults,+   schedule, schedule_, schedule', --schedule'_,+   getCurrentTime,+   oneWeek, oneDay, oneHour, oneMinute,+   --timeEvent, messageEvent, victoryEvent, playerEvent, ruleEvent,+   --signalEvent, inputFormSignal,+   liftEvent,+   victoryEvent, timeEvent,+   Imprevu.EventNumber,+   SomeData,+   Victory(..)+   ) where++import           Nomyx.Language.Types+import           Imprevu (EventNumber)+import qualified Imprevu as Imp+import           Data.Typeable+import           Data.Time hiding (getCurrentTime)+import           Data.Time.Recurrence hiding (filter)+++-- * Events++-- | register a callback on an event+onEvent :: (Typeable e, Show e) => Event e -> ((EventNumber, e) -> Nomex ()) -> Nomex EventNumber+onEvent = Imp.onEvent++-- | register a callback on an event, disregard the event number+onEvent_ :: (Typeable e, Show e) => Event e -> (e -> Nomex ()) -> Nomex EventNumber+onEvent_ = Imp.onEvent_++-- | set an handler for an event that will be triggered only once+onEventOnce :: (Typeable e, Show e) => Event e -> (e -> Nomex ()) -> Nomex EventNumber+onEventOnce = Imp.onEventOnce++delEvent :: EventNumber -> Nomex Bool+delEvent = Imp.delEvent++getEvents :: Nomex [EventInfo]+getEvents = Imp.getEvents++getIntermediateResults :: EventNumber -> Nomex (Maybe [(PlayerNumber, SomeData)])+getIntermediateResults = Imp.getIntermediateResults++-- | on the provided schedule, the supplied function will be called+schedule :: Schedule Freq -> (UTCTime -> Nomex ()) -> Nomex ()+schedule = Imp.schedule++schedule_ :: Schedule Freq -> Nomex () -> Nomex ()+schedule_ = Imp.schedule_++--at each time provided, the supplied function will be called+schedule' :: [UTCTime] -> (UTCTime -> Nomex ()) -> Nomex ()+schedule' = Imp.schedule'++--schedule'_ :: [UTCTime] -> Nomex () -> Nomex ()+--schedule'_ ts f = schedule' ts (const f)++-- | get the current time as UTCTime+getCurrentTime :: Nomex UTCTime+getCurrentTime = GetCurrentTime++-- * Individual events++-- | Build an event firing at a specific time+timeEvent :: UTCTime -> Event UTCTime+timeEvent = Imp.timeEvent++data Victory = Victory+  deriving (Eq, Show)++-- | Build a event firing when the victory condition is changed+victoryEvent :: Event VictoryInfo+victoryEvent = SignalEvent $ Signal Victory++-- | Build a event firing immediatly, yelding the value of the NomexNE+liftEvent :: Nomex a -> Event a+liftEvent = Imp.liftEvent++-- | duration+oneWeek, oneDay, oneHour, oneMinute :: NominalDiffTime+oneWeek = 7 * oneDay+oneDay = 24 * oneHour+oneHour = 60 * oneMinute+oneMinute = 60+++
+ src/Nomyx/Language/Inputs.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE GADTs #-}++-- | All the building blocks to allow rules to get inputs.+-- for example, you can create a button that will display a message like this:+-- do+--    void $ onInputButton_ "Click here:" (const $ outputAll_ "Bravo!") 1++module Nomyx.Language.Inputs (+   inputRadio, inputText, inputCheckbox, inputButton, inputTextarea,+   onInputRadio,    onInputRadio_,    onInputRadioOnce,+   onInputText,     onInputText_,     onInputTextOnce,+   onInputCheckbox, onInputCheckbox_, onInputCheckboxOnce,+   onInputButton,   onInputButton_,   onInputButtonOnce,+   onInputTextarea, onInputTextarea_, onInputTextareaOnce,+   ) where++import           Nomyx.Language.Types+import qualified Imprevu as Imp+import           Data.Typeable++-- * Inputs++-- ** Radio inputs++-- | event based on a radio input choice+inputRadio :: (Enum c) => PlayerNumber -> String -> [(c, String)] -> Event c+inputRadio = Imp.inputRadio++-- | triggers a choice input to the user. The result will be sent to the callback+onInputRadio :: (Enum a, Show a, Typeable a) => String -> [(a, String)] -> (EventNumber -> a -> Nomex ()) -> PlayerNumber -> Nomex EventNumber+onInputRadio = Imp.onInputRadio++-- | the same, disregard the event number+onInputRadio_ :: (Enum a, Show a, Typeable a) => String -> [(a, String)] -> (a -> Nomex ()) -> PlayerNumber -> Nomex EventNumber+onInputRadio_ = Imp.onInputRadio_++-- | the same, suppress the event after first trigger+onInputRadioOnce :: (Enum a, Show a, Typeable a) => String -> [(a, String)] -> (a -> Nomex ()) -> PlayerNumber -> Nomex EventNumber+onInputRadioOnce = Imp.onInputRadioOnce++-- ** Text inputs++-- | event based on a text input+inputText :: PlayerNumber -> String -> Event String+inputText = Imp.inputText++-- | triggers a string input to the user. The result will be sent to the callback+onInputText :: String -> (EventNumber -> String -> Nomex ()) -> PlayerNumber -> Nomex EventNumber+onInputText = Imp.onInputText++-- | asks the player pn to answer a question, and feed the callback with this data.+onInputText_ :: String -> (String -> Nomex ()) -> PlayerNumber -> Nomex EventNumber+onInputText_ = Imp.onInputText_++-- | asks the player pn to answer a question, and feed the callback with this data.+onInputTextOnce :: String -> (String -> Nomex ()) -> PlayerNumber -> Nomex EventNumber+onInputTextOnce = Imp.onInputTextOnce+++-- ** Checkbox inputs++-- | event based on a checkbox input+inputCheckbox :: (Enum c) => PlayerNumber -> String -> [(c, String)] -> Event [c]+inputCheckbox = Imp.inputCheckbox++onInputCheckbox :: (Enum a, Show a, Typeable a) => String -> [(a, String)] -> (EventNumber -> [a] -> Nomex ()) -> PlayerNumber -> Nomex EventNumber+onInputCheckbox = Imp.onInputCheckbox++onInputCheckbox_ :: (Enum a, Show a, Typeable a) => String -> [(a, String)] -> ([a] -> Nomex ()) -> PlayerNumber -> Nomex EventNumber+onInputCheckbox_ = Imp.onInputCheckbox_++onInputCheckboxOnce :: (Enum a, Show a, Typeable a) => String -> [(a, String)] -> ([a] -> Nomex ()) -> PlayerNumber -> Nomex EventNumber+onInputCheckboxOnce = Imp.onInputCheckboxOnce++-- ** Button inputs++-- | event based on a button+inputButton :: PlayerNumber -> String -> Event ()+inputButton = Imp.inputButton++onInputButton :: String -> (EventNumber -> () -> Nomex ()) -> PlayerNumber -> Nomex EventNumber+onInputButton = Imp.onInputButton++onInputButton_ :: String -> (() -> Nomex ()) -> PlayerNumber -> Nomex EventNumber+onInputButton_ = Imp.onInputButton_++onInputButtonOnce :: String -> (() -> Nomex ()) -> PlayerNumber -> Nomex EventNumber+onInputButtonOnce = Imp.onInputButtonOnce+++-- ** Textarea inputs++-- | event based on a text area+inputTextarea :: PlayerNumber -> String -> Event String+inputTextarea = Imp.inputTextarea++onInputTextarea :: String -> (EventNumber -> String -> Nomex ()) -> PlayerNumber -> Nomex EventNumber+onInputTextarea = Imp.onInputTextarea++onInputTextarea_ :: String -> (String -> Nomex ()) -> PlayerNumber -> Nomex EventNumber+onInputTextarea_ = Imp.onInputTextarea_++onInputTextareaOnce :: String -> (String -> Nomex ()) -> PlayerNumber -> Nomex EventNumber+onInputTextareaOnce = Imp.onInputTextareaOnce++
+ src/Nomyx/Language/Messages.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Nomyx.Language.Messages (+  sendMessage, sendMessage_,+  onMessage, onMessageOnce,+  APICall(..), onAPICall, callAPI, callAPIBlocking,+  Msg)+   where++import           Nomyx.Language.Types+import           Imprevu (APICall, Msg)+import qualified Imprevu as Imp+import           Data.Typeable++-- * Messages+-- a rule can send a simple message to another rule, and subscribe to a message.++-- | broadcast a message that can be catched by another rule+sendMessage :: (Typeable a, Show a) => Msg a -> a -> Nomex ()+sendMessage = SendMessage++-- | send an empty message+sendMessage_ :: String -> Nomex ()+sendMessage_ = Imp.sendMessage_++-- | subscribe on a message+onMessage :: (Typeable m, Show m, Eq m) => Msg m -> (m -> Nomex ()) -> Nomex EventNumber+onMessage = Imp.onMessage++-- | subscribe on a message, delete it on the first call+onMessageOnce :: (Typeable m, Show m, Eq m) => Msg m -> (m -> Nomex ()) -> Nomex EventNumber+onMessageOnce = Imp.onMessageOnce++-- * API calls+-- Nomyx Rule can register an API function with 'onAPICall' to provide services to other rules.+-- other Rules are then able to call 'callAPI' or 'callAPIBlocking' to access the services.+-- API calls between Rules are build using message passing.++-- version with one parameters+onAPICall :: (Typeable a, Show a, Eq a, Typeable r, Show r, Eq r) => APICall a r -> (a -> Nomex r) -> Nomex EventNumber+onAPICall = Imp.onAPICall++-- | version with one parameters+callAPI :: (Typeable a, Show a, Eq a, Typeable r, Show r, Eq r) => APICall a r -> a -> (r -> Nomex ()) -> Nomex ()+callAPI = Imp.callAPI++-- | call an API function and wait for the result.+callAPIBlocking :: (Typeable a, Show a, Eq a, Typeable r, Show r, Eq r) => APICall a r -> a -> Nomex r+callAPIBlocking = Imp.callAPIBlocking+
+ src/Nomyx/Language/Outputs.hs view
@@ -0,0 +1,69 @@+-- All the building blocks to allow rules to produce outputs.+-- for example, you can display a message like this:+-- do+--    outputAll_ "hello, world!"++module Nomyx.Language.Outputs (+   OutputNumber,+   newOutput, newOutput_,+   outputAll, outputAll_,+   getOutput, getOutput_,+   updateOutput,+   delOutput,+   displayVar, displayVar',+   displaySimpleVar+   ) where++import Nomyx.Language.Types+import Imprevu+import Data.Typeable+import Control.Monad.State+++-- * Outputs++-- | outputs a message to one player, dynamic version+newOutput :: Maybe PlayerNumber -> Nomex String -> Nomex OutputNumber+newOutput = NewOutput++-- | outputs a message to one player, static version+newOutput_ :: Maybe PlayerNumber -> String -> Nomex OutputNumber+newOutput_ ns mpn = NewOutput ns (return mpn)++-- | output a message to all players+outputAll :: Nomex String -> Nomex OutputNumber+outputAll = newOutput Nothing++-- | output a constant message to all players+outputAll_ :: String -> Nomex ()+outputAll_ s = void $ newOutput Nothing (return s)++-- | get an output by number+getOutput :: OutputNumber -> Nomex (Maybe String)+getOutput = GetOutput++-- | get an output by number, partial version+getOutput_ :: OutputNumber -> Nomex String+getOutput_ on = partial "getOutput_ : Output number not existing" $ getOutput on++-- | update an output+updateOutput :: OutputNumber -> Nomex String -> Nomex Bool+updateOutput = UpdateOutput++-- | delete an output+delOutput :: OutputNumber -> Nomex Bool+delOutput = DelOutput++-- | display a variable+displayVar :: (Typeable a, Show a) => Maybe PlayerNumber -> V a -> (Maybe a -> Nomex String) -> Nomex OutputNumber+displayVar mpn mv dis = newOutput mpn $ readVar mv >>= dis++-- permanently display a variable+displayVar' :: (Typeable a, Show a) => Maybe PlayerNumber -> V a -> (a -> Nomex String) -> Nomex OutputNumber+displayVar' mpn mv dis = displayVar mpn mv dis' where+   dis' Nothing  = return $ "Variable " ++ (varName mv) ++ " deleted"+   dis' (Just a) = (++ "\n") <$> dis a++displaySimpleVar :: (Typeable a, Show a) => Maybe PlayerNumber -> V a -> String -> Nomex OutputNumber+displaySimpleVar mpn mv title = displayVar' mpn mv showVar where+   showVar a = return $ title ++ ": " ++ (show a) ++ "\n"
+ src/Nomyx/Language/Players.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}++-- | All the building blocks to allow rules to manage players.+-- for example, you can change the name of player 1 with:+-- do+--    void $ modifyPlayerName 1 ("King " ++)++module Nomyx.Language.Players (+   PlayerNumber,+   PlayerName,+   PlayerInfo(..),+   Player(..),+   playerEvent,+   playerNumber, playerName,+   getPlayers, getPlayer, getPlayerName, getPlayerName',+   setPlayerName,+   modifyPlayerName,+   getPlayersNumber, getAllPlayerNumbers,+   delPlayer,+   forEachPlayer, forEachPlayer_,+   createValueForEachPlayer, createValueForEachPlayer_,+   getValueOfPlayer,+   modifyValueOfPlayer, modifyAllValues,+   showPlayer,+   getProposerNumber, getProposerNumber_,+   setVictory,+   giveVictory+   ) where++import Nomyx.Language.Types+import Imprevu.Events+import Imprevu.Variables+import Nomyx.Language.Rules+import Data.Typeable+import Data.List+import Control.Lens+import Control.Arrow+import Control.Monad++-- * Players++-- | get all the players+getPlayers :: Nomex [PlayerInfo]+getPlayers = GetPlayers++-- | Get a specific player+getPlayer :: PlayerNumber -> Nomex (Maybe PlayerInfo)+getPlayer pn = do+   pls <- GetPlayers+   return $ find (\a -> a ^. playerNumber == pn) pls++-- | Get the name of a player+getPlayerName :: PlayerNumber -> Nomex (Maybe PlayerName)+getPlayerName pn = do+  p <- getPlayer pn+  return $ _playerName <$> p++-- | Get the name of a player, his number if not found+getPlayerName' :: PlayerNumber -> Nomex PlayerName+getPlayerName' pn = do+  mp <- getPlayer pn+  return $ case mp of+     Just p -> _playerName p+     Nothing -> "Player " ++ (show pn)++-- | Set the name of a player+setPlayerName :: PlayerNumber -> PlayerName -> Nomex Bool+setPlayerName = SetPlayerName++modifyPlayerName :: PlayerNumber -> (PlayerName -> PlayerName) -> Nomex Bool+modifyPlayerName pn f = do+   mn <- getPlayerName pn+   case mn of+      Just name -> setPlayerName pn (f name)+      Nothing -> return False+++-- | Get the total number of players+getPlayersNumber :: Nomex Int+getPlayersNumber = length <$> getPlayers++-- | Get all the players number+getAllPlayerNumbers :: Nomex [PlayerNumber]+getAllPlayerNumbers = map _playerNumber <$> getPlayers++-- | Remove the player from the game (kick)+delPlayer :: PlayerNumber -> Nomex Bool+delPlayer = DelPlayer+++-- | perform an action for each current players, new players and leaving players+-- returns the event numbers for arriving players and leaving players+forEachPlayer :: (PlayerNumber -> Nomex ()) -> (PlayerNumber -> Nomex ()) -> (PlayerNumber -> Nomex ()) -> Nomex (EventNumber, EventNumber)+forEachPlayer action actionWhenArrive actionWhenLeave = do+    pns <- getAllPlayerNumbers+    mapM_ action pns+    an <- onEvent_ (playerEvent Arrive) $ actionWhenArrive . _playerNumber+    ln <- onEvent_ (playerEvent Leave)  $ actionWhenLeave  . _playerNumber+    return (an, ln)++-- | perform the same action for each players, including new players+-- returns the event numbers for arriving players and leaving players+forEachPlayer_ :: (PlayerNumber -> Nomex ()) -> Nomex (EventNumber, EventNumber)+forEachPlayer_ action = forEachPlayer action action (\_ -> return ())++-- | create a value initialized for each players+--manages players joining and leaving+createValueForEachPlayer :: forall a. (Typeable a, Show a, Eq a) => a -> V [(PlayerNumber, a)] -> Nomex (EventNumber, EventNumber)+createValueForEachPlayer initialValue (V mv) = do+    pns <- getAllPlayerNumbers+    v <- newVar_  mv $ map (,initialValue::a) pns+    forEachPlayer (const $ return ())+                  (\p -> void $ modifyVar v ((p, initialValue) : ))+                  (\p -> void $ modifyVar v $ filter $ (/= p) . fst)++-- | create a value initialized for each players initialized to zero+--manages players joining and leaving+createValueForEachPlayer_ :: V [(PlayerNumber, Int)] -> Nomex (EventNumber, EventNumber)+createValueForEachPlayer_ = createValueForEachPlayer 0++getValueOfPlayer :: forall a. (Typeable a, Show a, Eq a) => PlayerNumber -> V [(PlayerNumber, a)] -> Nomex (Maybe a)+getValueOfPlayer pn var = do+   mvalue <- readVar var+   return $ do+      value <- mvalue+      lookup pn value++modifyValueOfPlayer :: (Eq a, Show a, Typeable a) => PlayerNumber -> V [(PlayerNumber, a)] -> (a -> a) -> Nomex Bool+modifyValueOfPlayer pn var f = modifyVar var $ map (\(a,b) -> if a == pn then (a, f b) else (a,b))++modifyAllValues :: (Eq a, Show a, Typeable a) => V [(PlayerNumber, a)] -> (a -> a) -> Nomex ()+modifyAllValues var f = void $ modifyVar var $ map $ second f++-- | show a player name based on his number+showPlayer :: PlayerNumber -> Nomex String+showPlayer pn = do+   mn <- getPlayerName pn+   case mn of+      Just name -> return name+      Nothing -> return ("Player " ++ show pn)+++-- | set victory to a list of players+setVictory :: Nomex [PlayerNumber] -> Nomex ()+setVictory = SetVictory++-- | give victory to one player+giveVictory :: PlayerNumber -> Nomex ()+giveVictory pn = SetVictory $ return [pn]++-- | get the player number of the proposer of the rule+getProposerNumber :: Nomex PlayerNumber+getProposerNumber = _rProposedBy <$> getSelfRule++getProposerNumber_ :: Nomex PlayerNumber+getProposerNumber_ = getProposerNumber++-- | Build a event firing when a player arrives or leaves+playerEvent :: Player -> Event PlayerInfo+playerEvent p = SignalEvent $ Signal p
+ src/Nomyx/Language/Rules.hs view
@@ -0,0 +1,231 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- | Basic rules building blocks.+-- for example, you can suppress rule 1 with:+--do+--   suppressRule 1++module Nomyx.Language.Rules (+   RuleNumber,+   RuleCode,+   RuleEvent(..),+   RuleStatus(..),+   MetaRule,+   activateRule, activateRule_,+   rejectRule, rejectRule_,+   getRules, getActiveRules, getRule,+   getRulesByNumbers,+   getRuleFuncs,+   addRule, addRule_, addRule',+   suppressRule, suppressRule_, suppressAllRules,+   proposeRule, modifyRule,+   autoActivate,+   activateOrRejectRule,+   simulate,+   metaruleVar, createMetaruleVar, addMetarule, testWithMetaRules, displayMetarules,+   legal, illegal, noPlayPlayer, immutableRule,+   autoDelete,+   eraseAllRules,+   getSelfRuleNumber, getSelfRule,+   onRuleProposed,+   showRule,+   ruleEvent+   ) where++import Prelude hiding (foldr)+import Nomyx.Language.Types+import Nomyx.Language.Outputs+import Nomyx.Language.Utils+import Imprevu+import Control.Lens+import Control.Monad+import Data.List+import Data.Maybe++-- * Rule management++-- | activate a rule: change its state to Active and execute it+activateRule :: RuleNumber -> Nomex Bool+activateRule = ActivateRule++activateRule_ :: RuleNumber -> Nomex ()+activateRule_ r = activateRule r >> return ()++-- | reject a rule: change its state to Suppressed and suppresses all its environment (events, variables, inputs, victory)+-- the rule can be activated again later+rejectRule :: RuleNumber -> Nomex Bool+rejectRule = RejectRule++rejectRule_ :: RuleNumber -> Nomex ()+rejectRule_ r = void $ rejectRule r++getRules :: Nomex [RuleInfo]+getRules = GetRules++getActiveRules :: Nomex [RuleInfo]+getActiveRules = filter ((== Active) . _rStatus) <$> getRules++getRule :: RuleNumber -> Nomex (Maybe RuleInfo)+getRule rn = do+   rs <- GetRules+   return $ find (\a -> a ^. rNumber == rn) rs++getRulesByNumbers :: [RuleNumber] -> Nomex [RuleInfo]+getRulesByNumbers = mapMaybeM getRule++getRuleFuncs :: Nomex [Nomex ()]+getRuleFuncs = map _rRule <$> getRules++-- | add a rule to the game, it will have to be activated+addRule :: RuleInfo -> Nomex Bool+addRule = AddRule++addRule_ :: RuleInfo -> Nomex ()+addRule_ = void . AddRule++-- | add a rule to the game as described by the parameters+addRule' :: RuleName -> Rule -> RuleCode -> String -> Nomex RuleNumber+addRule' name rule code desc = do+   rns <- map _rNumber <$> getRules+   let number = head $ [1..] \\ rns+   res <- addRule $ defaultRuleInfo { _rRule = rule, _rNumber = number, _rRuleTemplate = defaultRuleTemplate {_rName = name,  _rRuleCode = code,  _rDescription = desc}}+   return $ if res then number else error "addRule': cannot add rule"+++suppressRule :: RuleNumber -> Nomex Bool+suppressRule = RejectRule++suppressRule_ :: RuleNumber -> Nomex ()+suppressRule_ = void . RejectRule++suppressAllRules :: Nomex Bool+suppressAllRules = do+    rs <- getRules+    res <- mapM (suppressRule . _rNumber) rs+    return $ and res++modifyRule :: RuleNumber -> RuleInfo -> Nomex Bool+modifyRule = ModifyRule++-- | propose a rule that will need to be voted on.+proposeRule :: RuleInfo -> Nomex Bool+proposeRule = ProposeRule++-- | allows a rule to retrieve its own number (for auto-deleting for example)+getSelfRuleNumber :: Nomex RuleNumber+getSelfRuleNumber = SelfRuleNumber++getSelfRule :: Nomex RuleInfo+getSelfRule  = do+   srn <- getSelfRuleNumber+   [rs] <- getRulesByNumbers [srn]+   return rs++-- | activate or reject a rule+activateOrRejectRule :: RuleInfo -> Bool -> Nomex ()+activateOrRejectRule r b = if b then activateRule_ (_rNumber r) else rejectRule_ (_rNumber r)++-- | a rule can autodelete itself (generaly after having performed some actions)+autoDelete :: Nomex ()+autoDelete = getSelfRuleNumber >>= suppressRule_++-- | All rules from player p are erased:+eraseAllRules :: PlayerNumber -> Nomex Bool+eraseAllRules p = do+    rs <- getRules+    let myrs = filter (\a -> a ^. rProposedBy == p) rs+    res <- mapM (suppressRule . _rNumber) myrs+    return $ and res++-- | This rule will activate automatically any new rule.+autoActivate :: Nomex ()+autoActivate = void $ onEvent_ (ruleEvent Proposed) (activateRule_ . _rNumber)++-- * Meta Rules++-- | A meta rule is a rule that can juge the legality of another rule.+type MetaRule = RuleInfo -> Nomex Bool++-- | The meta rules are stored in a list variable+metaruleVar :: V [(String, MetaRule)]+metaruleVar = V "metarules"++-- | create the meta rule variable+createMetaruleVar :: Nomex ()+createMetaruleVar = void $ newVar' metaruleVar []++-- | add a new metarule to the list+addMetarule :: MetaRule -> String -> Nomex ()+addMetarule mr code = void $ modifyVar metaruleVar ((code, mr):)++-- | use the list of meta rules to juge a new rule+testWithMetaRules :: RuleInfo -> Nomex Bool+testWithMetaRules r = do+   mmrs <- readVar metaruleVar+   case mmrs of+      Just mrs -> and <$> mapM (($r) . snd) mrs+      Nothing ->  return False++displayMetarules :: Nomex ()+displayMetarules = void $ displayVar Nothing metaruleVar dispAll where+   dispAll mvs = return $ maybe "No meta rules" (("Meta Rules:\n" ++) . concatMap disp) mvs+   disp (s, _) = s ++ "\n"++-- | A rule will be always legal+legal :: MetaRule+legal = const $ return True++-- | A rule will be always illegal+illegal :: MetaRule+illegal = const $ return False+++-- | Player p cannot propose any more rules+noPlayPlayer :: PlayerNumber -> MetaRule+noPlayPlayer pn rule = return $ _rProposedBy rule /= pn++-- | rule number rn cannot be deleted by any incoming rule+-- we simulate the execution of an incoming rule to make sure it doesn't delete the immutable rule+immutableRule :: RuleNumber -> MetaRule+immutableRule rn rule = do+   immu <- getRule rn+   maybe (return True) (const $ simulate (_rRule rule) (isJust <$> getRule rn)) immu++-- | simulate the execution of rule "sim" and then run rule "test" over the result+simulate :: Nomex a -> Nomex Bool -> Nomex Bool+simulate = Simu++-- | sets a callback called for each rule proposed+onRuleProposed :: (RuleInfo -> Nomex ()) -> Nomex ()+onRuleProposed f = void $ onEvent_ (ruleEvent Proposed) f++-- | a default rule+defaultRuleInfo :: RuleInfo+defaultRuleInfo = RuleInfo  {+    _rNumber       = 1,+    _rProposedBy   = 0,+    _rRule         = return (),+    _rStatus       = Pending,+    _rAssessedBy   = Nothing,+    _rModules      = [],+    _rRuleTemplate = defaultRuleTemplate}++defaultRuleTemplate :: RuleTemplate+defaultRuleTemplate = RuleTemplate {+    _rName         = "",+    _rDescription  = "",+    _rRuleCode     = "",+    _rAuthor       = "",+    _rPicture      = Nothing,+    _rCategory     = [],+    _rDeclarations = []}++mapMaybeM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m [b]+mapMaybeM f = liftM catMaybes . mapM f++showRule :: Show a => a -> Nomex ()+showRule x = void $ NewOutput Nothing (return $ show x)++-- | Build a event firing when an action is made on a rule+ruleEvent :: RuleEvent -> Event RuleInfo+ruleEvent re = SignalEvent $ Signal re
+ src/Nomyx/Language/Types.hs view
@@ -0,0 +1,198 @@+{-# LANGUAGE DeriveDataTypeable        #-}+{-# LANGUAGE DeriveGeneric             #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE GADTs                     #-}+{-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE StandaloneDeriving        #-}+{-# LANGUAGE TemplateHaskell           #-}++-- | This module contains the type definitions necessary to build a Nomic rule.+module Nomyx.Language.Types (+  module Nomyx.Language.Types,+  module Imprevu.Types)+  where++import           Control.Lens+import           Control.Monad.Except+import           Data.Data           (Data)+import           Data.Time+import           Data.Text+import           Data.Typeable+import           GHC.Generics+import           System.Random+import           Imprevu.Types+import           Imprevu++type PlayerNumber = Int+type PlayerName = String+type RuleNumber = Int+type RuleName = String+type RuleDesc = String+type RuleText = String+type RuleCode = String+type OutputNumber = Int+type InputNumber = Int++-- * Nomyx.Types++data Nomex a  where+   --Variables management+   NewVar          :: (Typeable a, Show a) => VarName -> a -> Nomex (Maybe (V a))+   ReadVar         :: (Typeable a, Show a) => V a -> Nomex (Maybe a)+   WriteVar        :: (Typeable a, Show a) => V a -> a -> Nomex Bool+   DelVar          :: (V a) -> Nomex Bool+   --Events management+   OnEvent         :: (Typeable e, Show e) => Event e -> ((EventNumber, e) -> Nomex ()) -> Nomex EventNumber+   DelEvent        :: EventNumber -> Nomex Bool+   GetEvents       :: Nomex [EventInfo]+   SendMessage     :: (Typeable a, Show a) => Msg a -> a -> Nomex ()+   --Rules management+   ProposeRule     :: RuleInfo -> Nomex Bool+   ActivateRule    :: RuleNumber -> Nomex Bool+   RejectRule      :: RuleNumber -> Nomex Bool+   AddRule         :: RuleInfo -> Nomex Bool+   ModifyRule      :: RuleNumber -> RuleInfo -> Nomex Bool+   GetRules        :: Nomex [RuleInfo]+   SelfRuleNumber  :: Nomex RuleNumber+   --Players management+   GetPlayers      :: Nomex [PlayerInfo]+   SetPlayerName   :: PlayerNumber -> PlayerName -> Nomex Bool+   DelPlayer       :: PlayerNumber -> Nomex Bool+   --Outputs+   NewOutput       :: Maybe PlayerNumber -> Nomex String -> Nomex OutputNumber+   GetOutput       :: OutputNumber -> Nomex (Maybe String)+   UpdateOutput    :: OutputNumber -> Nomex String -> Nomex Bool+   DelOutput       :: OutputNumber -> Nomex Bool+   --Victory+   SetVictory      :: Nomex [PlayerNumber] -> Nomex ()+   --Mileacenous+   GetCurrentTime  :: Nomex UTCTime+   GetRandomNumber :: Random a => (a, a) -> Nomex a+   --Monadic bindings+   Return          :: a -> Nomex a+   Bind            :: Nomex a -> (a -> Nomex b) -> Nomex b+   ThrowError      :: String -> Nomex a+   CatchError      :: Nomex a -> (String -> Nomex a) -> Nomex a+   Simu            :: Nomex a -> Nomex Bool -> Nomex Bool++deriving instance Typeable Nomex++instance Typeable a => Show (Nomex a) where+   show _ = "<Nomex a>"++instance Monad Nomex where+   return = Return+   (>>=) = Bind++instance Functor Nomex where+   fmap f e = Bind e $ Return . f++instance Applicative Nomex where+   pure = Return+   f <*> a = do+      f' <- f+      a' <- a+      return $ f' a'++instance MonadError String Nomex where+   throwError = ThrowError+   catchError = CatchError++instance EvMgt Nomex where+   onEvent         = OnEvent+   delEvent        = DelEvent+   getEvents       = GetEvents+   sendMessage     = SendMessage++instance SysMgt Nomex where+   getCurrentTime  = GetCurrentTime+   getRandomNumber = GetRandomNumber++instance VarMgt Nomex where+   newVar       = NewVar+   readVar      = ReadVar+   writeVar     = WriteVar+   delVar       = DelVar+++-- * Events++type Event a = EventM Nomex a+type EventInfo = EventInfoN Nomex++-- | Events parameters+data Player    = Arrive | Leave deriving (Typeable, Show, Eq)+data RuleEvent = Proposed | Activated | Rejected | Added | Modified | Deleted deriving (Typeable, Show, Eq)+++-- * Rule++-- | Type of a rule function.+type Rule = Nomex ()++-- | An informationnal structure about a rule+data RuleInfo = RuleInfo { _rNumber       :: RuleNumber,       -- number of the rule (must be unique)+                           _rProposedBy   :: PlayerNumber,     -- player proposing the rule+                           _rRule         :: Rule,             -- function representing the rule (interpreted from rRuleCode)+                           _rStatus       :: RuleStatus,       -- status of the rule+                           _rAssessedBy   :: Maybe RuleNumber, -- which rule accepted or rejected this rule+                           _rModules      :: [ModuleInfo],     -- list of modules containing definition (in plain text)+                           _rRuleTemplate :: RuleTemplate}+                           deriving (Typeable, Show)+++data RuleTemplate = RuleTemplate { _rName         :: RuleName,         -- short name of the rule+                                   _rDescription  :: String,           -- description of the rule+                                   _rRuleCode     :: RuleCode,         -- code of the rule as a string+                                   _rAuthor       :: String,           -- the name of the original author+                                   _rPicture      :: Maybe FilePath,   -- a file name for the illustration image+                                   _rCategory     :: [String],         -- categories+                                   _rDeclarations :: [FilePath]}       -- additional declarations (Haskell modules)+                                   deriving (Typeable, Show, Read, Data, Generic)++type Module = Text -- content of the module++data ModuleInfo = ModuleInfo {_modPath :: FilePath,  -- file name of the module+                              _modContent :: Module} -- content of the module+                              deriving (Eq, Read, Show, Typeable, Data, Generic, Ord)++instance Eq RuleInfo where+    (RuleInfo {_rNumber=r1}) == (RuleInfo {_rNumber=r2}) = r1 == r2++instance Ord RuleInfo where+    (RuleInfo {_rNumber=r1}) <= (RuleInfo {_rNumber=r2}) = r1 <= r2++instance Eq RuleTemplate where+    (RuleTemplate {_rName=r1}) == (RuleTemplate {_rName=r2}) = r1 == r2++instance Ord RuleTemplate where+    (RuleTemplate {_rName=r1}) <= (RuleTemplate {_rName=r2}) = r1 <= r2++-- | the status of a rule.+data RuleStatus = Active      -- Active rules forms the current Constitution+                | Pending     -- Proposed rules+                | Reject      -- Rejected rules+                deriving (Eq, Show, Typeable)++-- * Player++-- | informations on players+data PlayerInfo = PlayerInfo { _playerNumber :: PlayerNumber,+                               _playerName   :: String,+                               _playingAs    :: Maybe PlayerNumber}+                               deriving (Eq, Typeable, Show)++instance Ord PlayerInfo where+   h <= g = (_playerNumber h) <= (_playerNumber g)++-- * Victory++data VictoryInfo = VictoryInfo { _vRuleNumber :: RuleNumber,+                                 _vCond       :: Nomex [PlayerNumber]}+                                 deriving (Show, Typeable)+++makeLenses ''RuleInfo+makeLenses ''RuleTemplate+makeLenses ''PlayerInfo+makeLenses ''ModuleInfo
+ src/Nomyx/Language/Utils.hs view
@@ -0,0 +1,14 @@++module Nomyx.Language.Utils where++import Data.Typeable+import Control.Monad++concatMapM        :: (Monad m) => (a -> m [b]) -> [a] -> m [b]+concatMapM f xs   =  liftM concat (mapM f xs)++instance (Typeable a, Typeable b) => Show (a -> b) where+    show e = '<' : (show . typeOf) e ++ ">"++enumAll :: (Enum a, Show a, Bounded a) => [(a, String)]+enumAll = map (\a -> (a, show a)) (enumFrom minBound)
+ src/Nomyx/Language/Variables.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | All the building blocks to allow rules to build variables.+-- for example, you can create a variable with:+--do+--   newVar_ "MyMoney" (0::Int)++module Nomyx.Language.Variables (+   V(..),+   newVar, newVar_, newVar',+   readVar, readVar_,+   writeVar,+   modifyVar,+   delVar,+   getTempVar,+   VarName,+   ) where+++import           Nomyx.Language.Types+import           Imprevu (V, VarName, getTempVar)+import qualified Imprevu                          as Imp+import           Data.Typeable++-- * Variables+-- | variable creation+newVar :: (Typeable a, Show a) => VarName -> a -> Nomex (Maybe (V a))+newVar = Imp.newVar++newVar_ :: (Typeable a, Show a) => VarName -> a -> Nomex (V a)+newVar_ = Imp.newVar_++newVar' :: (Typeable a, Show a) => V a -> a -> Nomex Bool+newVar' = Imp.newVar'++-- | variable reading+readVar :: (Typeable a, Show a) => V a -> Nomex (Maybe a)+readVar = Imp.readVar++readVar_ :: (Typeable a, Show a) => V a -> Nomex a+readVar_ = Imp.readVar_++-- | variable writing+writeVar :: (Typeable a, Show a) => V a -> a -> Nomex Bool+writeVar = Imp.writeVar++-- | modify a variable using the provided function+modifyVar :: (Typeable a, Show a) => V a -> (a -> a) -> Nomex Bool+modifyVar = Imp.modifyVar++-- | delete variable+delVar :: V a -> Nomex Bool+delVar = Imp.delVar+