module Language.Nomyx.Rules where
import Prelude hiding (foldr)
import Language.Nomyx.Expression
import Language.Nomyx.Events
import Data.Lens
import Control.Monad
import Data.List
import Data.Maybe
voidRule :: Nomex a -> Nomex RuleResp
voidRule e = e >> return Void
activateRule :: RuleNumber -> Nomex Bool
activateRule = ActivateRule
activateRule_ :: RuleNumber -> Nomex ()
activateRule_ r = activateRule r >> return ()
rejectRule :: RuleNumber -> Nomex Bool
rejectRule = RejectRule
rejectRule_ :: RuleNumber -> Nomex ()
rejectRule_ r = void $ rejectRule r
getRules :: Nomex [Rule]
getRules = GetRules
getActiveRules :: Nomex [Rule]
getActiveRules = return . (filter ((== Active) . _rStatus) ) =<< getRules
getRule :: RuleNumber -> Nomex (Maybe Rule)
getRule rn = do
rs <- GetRules
return $ find ((== rn) . getL rNumber) rs
getRulesByNumbers :: [RuleNumber] -> Nomex [Rule]
getRulesByNumbers rns = mapMaybeM getRule rns
getRuleFuncs :: Nomex [RuleFunc]
getRuleFuncs = return . (map _rRuleFunc) =<< getRules
addRule :: Rule -> Nomex Bool
addRule r = AddRule r
addRule_ :: Rule -> Nomex ()
addRule_ r = void $ AddRule r
addRuleParams :: RuleName -> RuleFunc -> RuleCode -> String -> Nomex RuleNumber
addRuleParams name func code desc = do
number <- getFreeRuleNumber
res <- addRule $ defaultRule {_rName = name, _rRuleFunc = func, _rRuleCode = code, _rNumber = number, _rDescription = desc}
return $ if res then number else error "addRuleParams: cannot add rule"
getFreeRuleNumber :: Nomex RuleNumber
getFreeRuleNumber = do
rs <- getRules
return $ getFreeNumber $ map _rNumber rs
getFreeNumber :: (Eq a, Num a, Enum a) => [a] -> a
getFreeNumber l = head [a| a <- [1..], not $ a `elem` l]
suppressRule :: RuleNumber -> Nomex Bool
suppressRule rn = RejectRule rn
suppressRule_ :: RuleNumber -> Nomex ()
suppressRule_ rn = void $ RejectRule rn
suppressAllRules :: Nomex Bool
suppressAllRules = do
rs <- getRules
res <- mapM (suppressRule . _rNumber) rs
return $ and res
modifyRule :: RuleNumber -> Rule -> Nomex Bool
modifyRule rn r = ModifyRule rn r
autoActivate :: RuleFunc
autoActivate = voidRule $ onEvent_ (RuleEv Proposed) (activateRule_ . _rNumber . ruleData)
legal :: RuleFunc
legal = return $ Meta (\_ -> return $ BoolResp True)
illegal :: RuleFunc
illegal = return $ Meta (\_ -> return $ BoolResp False)
maybeMetaRule :: Rule -> Nomex (Maybe (Rule -> Nomex BoolResp))
maybeMetaRule Rule {_rRuleFunc = rule} = do
meta <- rule
case meta of
(Meta m) -> return $ Just m
_ -> return Nothing
activateOrReject :: Rule -> Bool -> Nomex ()
activateOrReject r b = if b then activateRule_ (_rNumber r) else rejectRule_ (_rNumber r)
noPlayPlayer :: PlayerNumber -> RuleFunc
noPlayPlayer p = return $ Meta $ \r -> return $ BoolResp $ (_rProposedBy r) /= p
autoDelete :: Nomex ()
autoDelete = getSelfRuleNumber >>= suppressRule_
eraseAllRules :: PlayerNumber -> Nomex Bool
eraseAllRules p = do
rs <- getRules
let myrs = filter ((== p) . getL rProposedBy) rs
res <- mapM (suppressRule . _rNumber) myrs
return $ and res
getSelfRuleNumber :: Nomex RuleNumber
getSelfRuleNumber = SelfRuleNumber
getSelfRule :: Nomex Rule
getSelfRule = do
srn <- getSelfRuleNumber
rs:[] <- getRulesByNumbers [srn]
return rs
defaultRule = Rule {
_rNumber = 1,
_rName = "",
_rDescription = "",
_rProposedBy = 0,
_rRuleCode = "",
_rRuleFunc = return Void,
_rStatus = Pending,
_rAssessedBy = Nothing}
mapMaybeM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM f = liftM catMaybes . mapM f