Nomyx-Language 0.7.2 → 0.7.3

raw patch · 6 files changed

+113/−88 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Nomyx-Language.cabal +1/−1
• src/Language/Nomyx.hs +3/−3
• src/Language/Nomyx/Events.hs +34/−22
• src/Language/Nomyx/Expression.hs +50/−45
• src/Language/Nomyx/Inputs.hs +15/−15
• src/Language/Nomyx/Players.hs +10/−2

@@ -1,5 +1,5 @@ name: Nomyx-Language-version: 0.7.2+version: 0.7.3 cabal-version: >=1.6 ---Warning: to use "cabal sdist", this patch is needed in cabal: https://github.com/haskell/cabal/pull/1110 ---This allows cabal to work with exported generated modules (Paths_Nomyx_Language)

@@ -2,16 +2,15 @@  -- | This module re-exports the elements necessary to compose a Nomyx rule. module Language.Nomyx (-   module Language.Nomyx.Expression,    module Language.Nomyx.Outputs,    module Language.Nomyx.Inputs,    module Language.Nomyx.Events,    module Language.Nomyx.Players,    module Language.Nomyx.Variables,    module Language.Nomyx.Rules,-   module Language.Nomyx.Vote)  where+   module Language.Nomyx.Vote,+   module Language.Nomyx.Expression)  where -import Language.Nomyx.Expression -- Nomyx Expression DSL import Language.Nomyx.Outputs    -- create outputs import Language.Nomyx.Inputs     -- create inputs import Language.Nomyx.Events     -- create events@@ -19,3 +18,4 @@ import Language.Nomyx.Variables  -- create variables import Language.Nomyx.Rules      -- manage rules import Language.Nomyx.Vote       -- create votations+import Language.Nomyx.Expression -- Nomyx Expression DSL

@@ -12,7 +12,7 @@    getCurrentTime,    oneWeek, oneDay, oneHour, oneMinute,    timeEvent, messageEvent, victoryEvent, playerEvent, ruleEvent,-   baseEvent, baseInputEvent,+   signalEvent, inputFormSignal,    liftEvent    ) where 
@@ -60,8 +60,8 @@       Just ev -> return $ Just $ mapMaybe getInputResult (_env ev)       Nothing -> return Nothing -getInputResult :: FieldResult -> Maybe (PlayerNumber, SomeData)-getInputResult (FieldResult (Input pn _ _) r _) = Just (pn, SomeData r)+getInputResult :: SignalOccurence -> Maybe (PlayerNumber, SomeData)+getInputResult (SignalOccurence (SignalData (Input pn _ _) r) _) = Just (pn, SomeData r) getInputResult _ = Nothing  -- | broadcast a message that can be catched by another rule
@@ -116,37 +116,49 @@ 
 schedule'_ :: [UTCTime] -> Nomex () -> Nomex ()
 schedule'_ ts f = schedule' ts (const f)
-
++-- | get the current time as UTCTime
 getCurrentTime :: NomexNE UTCTime
 getCurrentTime = CurrentTime --- | duration-oneWeek, oneDay, oneHour, oneMinute :: NominalDiffTime
-oneWeek = 7 * oneDay-oneDay = 24 * oneHour-oneHour = 60 * oneMinute-oneMinute = 60--baseEvent :: (Typeable a) => Field a -> Event a-baseEvent = BaseEvent+-- * Individual events +-- | Build an event firing at a specific time timeEvent :: UTCTime -> Event UTCTime-timeEvent = BaseEvent . Time--messageEvent :: (Typeable a) => Msg a -> Event a-messageEvent = BaseEvent . Message+timeEvent = SignalEvent . Time +-- | Build a event firing when the victory condition is changed victoryEvent :: Event VictoryInfo-victoryEvent = BaseEvent Victory+victoryEvent = SignalEvent Victory +-- | Build a event firing when a player arrives or leaves playerEvent :: Player -> Event PlayerInfo-playerEvent = BaseEvent . Player+playerEvent = SignalEvent . Player +-- | Build a event firing when an action is made on a rule ruleEvent :: RuleEvent -> Event RuleInfo-ruleEvent re = BaseEvent $ RuleEv re+ruleEvent re = SignalEvent $ RuleEv re -baseInputEvent :: (Typeable a) => PlayerNumber -> String -> (InputForm a) -> Field a-baseInputEvent pn s iform = Input pn s iform+-- | Build a message event, that can be intercepted by another rule+-- this is useful for message-passing style of communication+messageEvent :: (Typeable a) => Msg a -> Event a+messageEvent = SignalEvent . Message +-- | Build a event firing immediatly, yelding the value of the NomexNE liftEvent :: NomexNE a -> Event a liftEvent = LiftEvent++-- | duration+oneWeek, oneDay, oneHour, oneMinute :: NominalDiffTime
+oneWeek = 7 * oneDay+oneDay = 24 * oneHour+oneHour = 60 * oneMinute+oneMinute = 60++-- * internals++inputFormSignal :: (Typeable a) => PlayerNumber -> String -> (InputForm a) -> Signal a+inputFormSignal pn s iform = Input pn s iform++signalEvent :: (Typeable a) => Signal a -> Event a+signalEvent = SignalEvent

@@ -12,7 +12,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} 
--- | This module containt the type definitions necessary to build a Nomic rule. 
+-- | This module contains the type definitions necessary to build a Nomic rule.
 module Language.Nomyx.Expression where
 
 import Data.Typeable
@@ -46,10 +46,10 @@ type NoEffect = 'NoEffect 
 -- | A Nomex (Nomyx Expression) allows the players to write rules.--- within the rules, you can access and modify the state of the game.+-- Within the rules, you can access and modify the state of the game. type Nomex = Exp Effect --- | A NomexNE (Nomyx Expression No Effect) is a specialisation of the type that guaranties+-- | A NomexNE (Nomyx Expression No Effect) is a specialisation of the type that guarantees -- that the instructions will have no effects. type NomexNE = Exp NoEffect 
@@ -98,16 +98,26 @@ deriving instance Typeable Exp deriving instance Typeable 'Effect deriving instance Typeable 'NoEffect++instance Typeable a => Show (Exp NoEffect a) where
+   show _ = "<" ++ (show $ typeRep (Proxy :: Proxy a)) ++ ">"
++instance Typeable a => Show (Exp Effect a) where
+   show _ = "<" ++ (show $ typeRep (Proxy :: Proxy a)) ++ ">"
+ #else instance Typeable1 (Exp NoEffect) where     typeOf1 _ = mkTyConApp (mkTyCon3 "main" "Language.Nomyx.Expression" "Exp NoEffect") []  instance Typeable1 (Exp Effect) where     typeOf1 _ = mkTyConApp (mkTyCon3 "main" "Language.Nomyx.Expression" "Exp Effect") []-#endif -liftEffect :: NomexNE a -> Nomex a-liftEffect = LiftEffect  
+instance Typeable a => Show (Exp NoEffect a) where
+   show e = "<" ++ (show $ typeOf e) ++ ">"
++instance Typeable a => Show (Exp Effect a) where
+   show e = "<" ++ (show $ typeOf e) ++ ">"
+#endif 
 instance Monad (Exp a) where
    return = Return
@@ -127,22 +137,8 @@    throwError = ThrowError    catchError = CatchError -instance Typeable a => Show (Exp NoEffect a) where
-#if __GLASGOW_HASKELL__ < 708-   show e = "<" ++ (show $ typeOf e) ++ ">"
-#else-   show e = "<" ++ (show $ typeRep (Proxy :: Proxy a)) ++ ">"
-#endif--instance Typeable a => Show (Exp Effect a) where
-#if __GLASGOW_HASKELL__ < 708-   show e = "<" ++ (show $ typeOf e) ++ ">"
-#else-   show e = "<" ++ (show $ typeRep (Proxy :: Proxy a)) ++ ">"
-#endif-
-instance (Typeable a, Typeable b) => Show (a -> b) where-    show e = '<' : (show . typeOf) e ++ ">"+liftEffect :: NomexNE a -> Nomex a+liftEffect = LiftEffect  -- * Variables
 
@@ -159,22 +155,22 @@    EmptyEvent     :: Event a                                              -- An event that is never fired.    BindEvent      :: Event a -> (a -> Event b) -> Event b                 -- A First event should fire, then a second event is constructed    ShortcutEvents :: [Event a] -> ([Maybe a] -> Bool) -> Event [Maybe a]  -- Return the intermediate results as soon as the function evaluates to True, dismissing the events that hasn't fired yet-   BaseEvent      :: (Typeable a) => Field a -> Event a                   -- Embed a base event+   SignalEvent    :: (Typeable a) => Signal a -> Event a                  -- Embed a single Signal as an Event    LiftEvent      :: NomexNE a -> Event a                                 -- create an event containing the result of the NomexNE.    deriving Typeable --- | Base events-data Field a where-   Input   :: PlayerNumber -> String -> (InputForm a) -> Field a-   Player  :: Player    -> Field PlayerInfo-   RuleEv  :: RuleEvent -> Field RuleInfo-   Time    :: UTCTime   -> Field UTCTime-   Message :: Msg a     -> Field a-   Victory ::              Field VictoryInfo+-- | Signals+data Signal a where+   Input   :: PlayerNumber -> String -> (InputForm a) -> Signal a+   Player  :: Player    -> Signal PlayerInfo+   RuleEv  :: RuleEvent -> Signal RuleInfo+   Time    :: UTCTime   -> Signal UTCTime+   Message :: Msg a     -> Signal a+   Victory ::              Signal VictoryInfo    deriving Typeable  -- | Type agnostic base event-data SomeField = forall a. (Typeable a) => SomeField (Field a)+data SomeSignal = forall a. (Typeable a) => SomeSignal (Signal a)  -- | Type agnostic result data data SomeData = forall e. (Typeable e, Show e) => SomeData e@@ -195,9 +191,9 @@    deriving Typeable  deriving instance Show (InputForm a)-deriving instance Show (Field a)-deriving instance Show SomeField-deriving instance Eq (Field e)+deriving instance Show (Signal a)+deriving instance Show SomeSignal+deriving instance Eq (Signal e) deriving instance Eq (InputForm e)
 deriving instance Eq (Msg e) @@ -231,19 +227,22 @@               event        :: Event e,               handler      :: EventHandler e,               _evStatus    :: Status,-              _env         :: [FieldResult]}+              _env         :: [SignalOccurence]} -data FieldAddressElem = SumR | SumL | AppR | AppL | BindR | BindL | Shortcut deriving (Show, Read, Ord, Eq, Generic)-type FieldAddress = [FieldAddressElem]+data SignalAddressElem = SumR | SumL | AppR | AppL | BindR | BindL | Shortcut deriving (Show, Read, Ord, Eq, Generic)+type SignalAddress = [SignalAddressElem] -data FieldResult = forall e. (Typeable e, Show e) =>-   FieldResult {field         :: Field e,-                fieldResult   :: e,-                _fieldAddress :: Maybe FieldAddress}+data SignalData = forall e. (Typeable e, Show e) =>+   SignalData {signal     :: Signal e,+               signalData :: e} +data SignalOccurence = SignalOccurence {_signalOccData    :: SignalData,+                                        _signalOccAddress :: SignalAddress}+ type EventHandler e = (EventNumber, e) -> Nomex () -deriving instance Show FieldResult+deriving instance Show SignalData+deriving instance Show SignalOccurence  data Status = SActive | SDeleted deriving (Eq, Show) @@ -260,7 +259,7 @@ type Rule = Nomex ()   
 -- | An informationnal structure about a rule
-data RuleInfo = RuleInfo { _rNumber      :: RuleNumber,       -- number of the rule (must be unique) TO CHECK
+data RuleInfo = RuleInfo { _rNumber      :: RuleNumber,       -- number of the rule (must be unique)
                            _rName        :: RuleName,         -- short name of the rule 
                            _rDescription :: String,           -- description of the rule
                            _rProposedBy  :: PlayerNumber,     -- player proposing the rule
@@ -299,6 +298,8 @@                                  _vCond :: NomexNE [PlayerNumber]}                                  deriving (Show, Typeable) +-- * Miscellaneous+ partial :: String -> Nomex (Maybe a) -> Nomex a partial s nm = do    m <- nm@@ -308,6 +309,10 @@  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 ++ ">" -$( makeLenses [''RuleInfo, ''PlayerInfo, ''EventInfo, ''FieldResult] )
++$( makeLenses [''RuleInfo, ''PlayerInfo, ''EventInfo, ''SignalOccurence] )
 

@@ -26,7 +26,7 @@  -- | event based on a radio input choice inputRadio :: (Eq c, Show c, Typeable c) => PlayerNumber -> String -> [(c, String)] -> Event c
-inputRadio pn title cs = baseEvent $ baseInputRadio pn title cs+inputRadio pn title cs = signalEvent $ inputRadioSignal pn title cs  inputRadio' :: (Eq c, Show c, Typeable c) => PlayerNumber -> String -> [c] -> Event c
 inputRadio' pn title cs = inputRadio pn title (zip cs (show <$> cs))@@ -47,7 +47,7 @@  -- | event based on a text input inputText :: PlayerNumber -> String -> Event String
-inputText pn title = baseEvent $ baseInputText pn title+inputText pn title = signalEvent $ inputTextSignal pn title 
 -- | triggers a string input to the user. The result will be sent to the callback
 onInputText :: String -> (EventNumber -> String -> Nomex ()) -> PlayerNumber -> Nomex EventNumber
@@ -66,7 +66,7 @@  -- | event based on a checkbox input inputCheckbox :: (Eq c, Show c, Typeable c) => PlayerNumber -> String -> [(c, String)] -> Event [c]
-inputCheckbox pn title cs = baseEvent $ baseInputCheckbox pn title cs+inputCheckbox pn title cs = signalEvent $ inputCheckboxSignal pn title 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, a) -> handler en a)
@@ -81,7 +81,7 @@  -- | event based on a button
 inputButton :: PlayerNumber -> String -> Event ()
-inputButton pn title = baseEvent $ baseInputButton pn title+inputButton pn title = signalEvent $ inputButtonSignal pn title 
 onInputButton :: String -> (EventNumber -> () -> Nomex ()) -> PlayerNumber -> Nomex EventNumber
 onInputButton title handler pn = onEvent (inputButton pn title) (\(en, ()) -> handler en ())
@@ -97,7 +97,7 @@  -- | event based on a text area
 inputTextarea :: PlayerNumber -> String -> Event String
-inputTextarea pn title = baseEvent $ baseInputTextarea pn title+inputTextarea pn title = signalEvent $ inputTextareaSignal pn title 
 onInputTextarea :: String -> (EventNumber -> String -> Nomex ()) -> PlayerNumber -> Nomex EventNumber
 onInputTextarea title handler pn = onEvent (inputTextarea pn title) (\(en, a) -> handler en a)
@@ -112,17 +112,17 @@  -- ** Internals -baseInputRadio :: (Eq c, Show c, Typeable c) => PlayerNumber -> String -> [(c, String)] -> Field c
-baseInputRadio pn title cs = baseInputEvent pn title (Radio cs)+inputRadioSignal :: (Eq c, Show c, Typeable c) => PlayerNumber -> String -> [(c, String)] -> Signal c
+inputRadioSignal pn title cs = inputFormSignal pn title (Radio cs) -baseInputText :: PlayerNumber -> String -> Field String
-baseInputText pn title = baseInputEvent pn title Text+inputTextSignal :: PlayerNumber -> String -> Signal String
+inputTextSignal pn title = inputFormSignal pn title Text -baseInputCheckbox :: (Eq c, Show c, Typeable c) => PlayerNumber -> String -> [(c, String)] -> Field [c]
-baseInputCheckbox pn title cs = baseInputEvent pn title (Checkbox cs)
+inputCheckboxSignal :: (Eq c, Show c, Typeable c) => PlayerNumber -> String -> [(c, String)] -> Signal [c]
+inputCheckboxSignal pn title cs = inputFormSignal pn title (Checkbox cs)
 -baseInputButton :: PlayerNumber -> String -> Field ()
-baseInputButton pn title = baseInputEvent pn title Button+inputButtonSignal :: PlayerNumber -> String -> Signal ()
+inputButtonSignal pn title = inputFormSignal pn title Button -baseInputTextarea :: PlayerNumber -> String -> Field String
-baseInputTextarea pn title = baseInputEvent pn title TextArea+inputTextareaSignal :: PlayerNumber -> String -> Signal String
+inputTextareaSignal pn title = inputFormSignal pn title TextArea

@@ -14,7 +14,7 @@    Player(..),    playerEvent,    playerNumber, playerName,-   getPlayers, getPlayer, getPlayerName,
+   getPlayers, getPlayer, getPlayerName, getPlayerName',
    setPlayerName,
    modifyPlayerName,
    getPlayersNumber, getAllPlayerNumbers,
@@ -54,11 +54,19 @@    pls <- GetPlayers
    return $ find ((== pn) . getL playerNumber) pls
 
--- | Set the name of a player
+-- | Get the name of a player
 getPlayerName :: PlayerNumber -> NomexNE (Maybe PlayerName)
 getPlayerName pn = do
   p <- getPlayer pn
   return $ _playerName <$> p
++-- | Get the name of a player, his number if not found
+getPlayerName' :: PlayerNumber -> NomexNE 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