module Language.Nomyx.Expression where
import Data.Typeable
import Data.Time
import Control.Applicative hiding (Const)
import Data.Lens.Template
import Control.Monad.Error
type PlayerNumber = Int
type PlayerName = String
type RuleNumber = Int
type RuleName = String
type RuleDesc = String
type RuleText = String
type RuleCode = String
type EventNumber = Int
type EventName = String
type VarName = String
type Code = String
type OutputNumber = Int
data Eff = Effect | NoEffect
type Effect = 'Effect
type NoEffect = 'NoEffect
type Nomex = Exp Effect
type NomexNE = Exp NoEffect
data Exp :: Eff -> * -> * where
NewVar :: (Typeable a, Show a) => VarName -> a -> Nomex (Maybe (V a))
ReadVar :: (Typeable a, Show a) => V a -> Exp NoEffect (Maybe a)
WriteVar :: (Typeable a, Show a) => V a -> a -> Nomex Bool
DelVar :: (V a) -> Nomex Bool
OnEvent :: Typeable e => Event e -> ((EventNumber, EventData e) -> Nomex ()) -> Nomex EventNumber
DelEvent :: EventNumber -> Nomex Bool
DelAllEvents :: Typeable e => Event e -> Nomex ()
SendMessage :: (Typeable a, Show a) => Event (Message a) -> a -> Nomex ()
ProposeRule :: RuleInfo -> Nomex Bool
ActivateRule :: RuleNumber -> Nomex Bool
RejectRule :: RuleNumber -> Nomex Bool
AddRule :: RuleInfo -> Nomex Bool
ModifyRule :: RuleNumber -> RuleInfo -> Nomex Bool
GetRules :: NomexNE [RuleInfo]
GetPlayers :: NomexNE [PlayerInfo]
SetPlayerName :: PlayerNumber -> PlayerName -> Nomex Bool
DelPlayer :: PlayerNumber -> Nomex Bool
--Outputs
NewOutput :: Maybe PlayerNumber -> NomexNE String -> Nomex OutputNumber
GetOutput :: OutputNumber -> NomexNE (Maybe String)
UpdateOutput :: OutputNumber -> NomexNE String -> Nomex Bool
DelOutput :: OutputNumber -> Nomex Bool
--Mileacenous
SetVictory :: NomexNE [PlayerNumber] -> Nomex ()
CurrentTime :: NomexNE UTCTime
SelfRuleNumber :: NomexNE RuleNumber
Return :: a -> Exp e a
Bind :: Exp e a -> (a -> Exp e b) -> Exp e b
ThrowError :: String -> Exp Effect a
CatchError :: Nomex a -> (String -> Nomex a) -> Nomex a
LiftEffect :: NomexNE a -> Nomex a
Simu :: Nomex a -> NomexNE Bool -> NomexNE Bool
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") []
liftEffect :: NomexNE a -> Nomex a
liftEffect = LiftEffect
instance Monad (Exp a) where
return = Return
(>>=) = Bind
instance Functor (Exp a) where
fmap f e = Bind e $ Return . f
instance Applicative (Exp a) where
pure = Return
f <*> a = do
f' <- f
a' <- a
return $ f' a'
instance MonadError String Nomex where
throwError = ThrowError
catchError = CatchError
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) ++ ">"
instance (Typeable a, Typeable b) => Show (a -> b) where
show e = '<' : (show . typeOf) e ++ ">"
data V a = V {varName :: String} deriving Typeable
data Player = Arrive | Leave deriving (Typeable, Show, Eq)
data RuleEvent = Proposed | Activated | Rejected | Added | Modified | Deleted deriving (Typeable, Show, Eq)
data Time deriving Typeable
data EvRule deriving Typeable
data Message m deriving Typeable
data Victory deriving Typeable
data Input a = Input PlayerNumber String (InputForm a) deriving Typeable
data InputForm a = Radio [(a, String)]
| Text
| TextArea
| Button
| Checkbox [(a, String)]
deriving Typeable
data Event a where
Player :: Player -> Event Player
RuleEv :: RuleEvent -> Event RuleEvent
Time :: UTCTime -> Event Time
Message :: String -> Event (Message m)
InputEv :: (Typeable a, Show a, Eq a) => Input a -> Event (Input a)
Victory :: Event Victory
deriving (Typeable)
data InputData a = RadioData a
| CheckboxData [a]
| TextData String
| TextAreaData String
| ButtonData
data EventData a where
PlayerData :: {playerData :: PlayerInfo} -> EventData Player
RuleData :: {ruleData :: RuleInfo} -> 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 :: VictoryCond} -> EventData Victory
deriving (Typeable)
deriving instance Show (Event a)
deriving instance (Show a) => Show (InputForm a)
deriving instance (Show a) => Show (Input a)
deriving instance Show (EventData a)
deriving instance (Show a) => Show (InputData a)
deriving instance (Show a) => Show (Message a)
deriving instance Show Victory
deriving instance Show Time
deriving instance Eq Time
deriving instance Eq Victory
deriving instance Eq EvRule
deriving instance Eq (Message m)
deriving instance Eq (Event e)
deriving instance (Eq e) => Eq (Input e)
deriving instance (Eq e) => Eq (InputForm e)
type Msg a = Event (Message a)
type MsgData a = EventData (Message a)
type Rule = Nomex ()
data RuleInfo = RuleInfo { _rNumber :: RuleNumber,
_rName :: RuleName,
_rDescription :: String,
_rProposedBy :: PlayerNumber,
_rRuleCode :: Code,
_rRule :: Rule,
_rStatus :: RuleStatus,
_rAssessedBy :: Maybe RuleNumber}
deriving (Typeable, Show)
instance Eq RuleInfo where
(RuleInfo {_rNumber=r1}) == (RuleInfo {_rNumber=r2}) = r1 == r2
instance Ord RuleInfo where
(RuleInfo {_rNumber=r1}) <= (RuleInfo {_rNumber=r2}) = r1 <= r2
data RuleStatus = Active
| Pending
| Reject
deriving (Eq, Show, Typeable)
data PlayerInfo = PlayerInfo { _playerNumber :: PlayerNumber,
_playerName :: String,
_playAs :: Maybe PlayerNumber}
deriving (Eq, Typeable, Show)
instance Ord PlayerInfo where
h <= g = (_playerNumber h) <= (_playerNumber g)
data VictoryCond = VictoryCond RuleNumber (NomexNE [PlayerNumber]) deriving (Show, Typeable)
partial :: String -> Nomex (Maybe a) -> Nomex a
partial s nm = do
m <- nm
case m of
Just a -> return a
Nothing -> throwError s
concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
concatMapM f xs = liftM concat (mapM f xs)
$( makeLenses [''RuleInfo, ''PlayerInfo] )