{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable#-}

-- | This module defines a Rule (in Types.hs), which is a structure that allow the player to define if an input Rule is legal or not.
-- That means, a Rule defines if a Rule is legal or not. 
module Rule where

import Observable
import Data.List
import Data.Typeable
import Text.Printf


-- | the Rule type allows to describe laws over Rules themselves.
data Rule = MustBeEgalTo Rule          -- a rule must be equal to the rule in parameter
          | Legal                      -- a rule will allways be declared legal
          | Illegal                    -- a rule will allways be declared illegal
          | Rand Rule Rule             -- a rule must be legal acpropocording to both rules in parameters
          | Ror Rule Rule              -- a rule must be legal according to one of the rules in parameters
          | Rnot Rule                  -- a rule must be illegal according to the rule in parameter
          | Cond (Obs Bool) Rule Rule       -- a rule must be legal to the first rule in parameter or the other, dependign one the Observable
          | TestRuleOver Rule        -- a rule must declare the rule in parameter as legal
          | OfficialRule Int           -- a rule must be legal to the official rule n�N
          deriving (Typeable) 

defaultRule = "Legal"

-- | Une règle sera toujours illegale.
legal :: Rule
legal = Legal

-- | Une règle sera toujours illegale.

illegal :: Rule
illegal = Illegal

-- | La regle cond choisit une regle ou une autre en fonction d’un critere :

cond :: Obs Bool -> Rule -> Rule -> Rule
cond = Cond

-- | Une règle sera légale si l'observable est vrai (et inversement)

mustBe :: Obs Bool -> Rule
mustBe o = cond o legal illegal 

mustBe' :: Obs Bool -> Rule
mustBe' o = cond o legal illegal 

-- | Une règle sera illégale si l'observable est vrai (et inversement)

mustNotBe :: Obs Bool -> Rule
mustNotBe o = cond o illegal legal 

-- | Une règle sera légale si les deux règles en argument sont légales

rAnd :: Rule -> Rule -> Rule
rAnd = Rand

-- | Une règle sera légale si une des deux règles en argument est légale

rOr :: Rule -> Rule -> Rule
rOr = Ror

-- | Une règle sera légale si une des deux règles en argument est légale, mais pas les deux:

rXOr :: Rule -> Rule -> Rule
rXOr a b = (a `rAnd` (rNot b)) `rOr` ((rNot a) `rAnd` b)

-- | Le regle mustBeEgalTo oblige a etre egale a une regle donnee :

mustBeEgalTo :: Rule -> Rule
mustBeEgalTo = MustBeEgalTo 

-- | La regle not est legal si une regle ne l’est pas, et inversement :

rNot :: Rule -> Rule
rNot = Rnot 



--  Exemple de regles :

-- | Vote pour une cause donnée.

voteFor :: String -> PlayerNumber -> Rule
voteFor s n = mustBe (oVote (oConst s) (oConst n))

-- | Vote d'une personne. (exemple #14)

voteRule :: PlayerNumber -> Rule
voteRule p = voteFor "Veuillez voter pour cette regle en repondant par Oui ou Non" p

-- | Vote à l'unanimité. (exemple #4)

allVoteRule :: Rule
allVoteRule = voteRule 1 `rAnd` voteRule 2
--allVoteRule = rListAnd $ map voteRule [1..] --1 `rAnd` voteRule 2 -- to fix

-- | Règle qui ne modifie pas les règles déjà officielles lors de son éxecution (dont elle même):

noModify :: Rule
noModify = mustBe oRuleOfficial

noModify' :: Rule -> Rule
noModify' r = cond oRuleOfficial legal r

-- | Règle égale à la règle officielle N°n:

officialRule :: Int -> Rule
officialRule n = OfficialRule n

-- | Interdiction de supprimer la règle n: (exemple #18)

immutable :: Int -> Rule
immutable n = TestRuleOver $ OfficialRule n  --TODO check


-- | Suppression de la règle n: (exemple #2)

eraseRule :: Int -> Rule
eraseRule n = cond (oRuleNumber `oEqu` (oConst n)) illegal legal

-- Exemple 13: La démocratie est abolie. Vive le nouveau Roi, Joueur #1! 
-- Cette exemple doit être accompli en plusieurs fois.
-- 1. Dabord supprimer la règle de protection des immuables: eraseRule 2
-- 2. supprimer le vote à l'unanimité: eraseRule 1
-- 2. Instaurer la monarchie, avec le joueur 1 comme Roi: voteRule 1


-- Referendum des joueurs: (exemple #15)
-- 1er argument: Titre du référendum
-- 2° argument: loi si majorité de oui
-- 3° argument: joueurs participant au référendum

--referendum :: String -> Rule -> [PlayerNumber] -> Rule  TODO: reactivate
--referendum s r1 js = cond (oListAnd $ map (\j -> oVote s j) ojs) r1 zeroRule where --todo fix. un référendum s'applique t'il aux règle déjà présentes?
--     ojs = map oInt js  	

-- Le joueur p ne peut plus jouer:

--noPlayPlayer :: PlayerNumber -> Rule   TODO: reactivate
--noPlayPlayer p = mustNotBe (oPlayerTurn `oEqu` (oInt p))


-- | Toutes les règles du joueur p sont supprimées de la législation:

eraseAllRules :: PlayerNumber -> Rule
eraseAllRules p = mustNotBe (oRuleProposedBy `oEqu` (oConst p))


-- Personne ne peut jouer au tour n:

--noPlayTurn :: Turn -> Rule
--noPlayTurn t = mustNotBe (oTurn `oEqu` (oConst t))


-- Le joueur 1 ne peut pas jouer au prochain tour (exemple #17)
-- Les règles du joueur donné en argument seront toujours rejectées (illégales):

--ex17 = noPlayPlayer 1 `rOr` noPlayTurn 2


-- | Règle qui ne fait rien:
zeroRule :: Rule  
zeroRule = legal --todo fix: erase self


-- Le joueur 2 doit faire un tour sur lui-même (exemple #19)

--  actionForPlayer :: Player -String -Rule -Rule -Rule
--  actionForPlayer p whatToDo ifOK ifNOK = cond (oListAnd $ oMap (\j -oVote s j) ojs) ifOK ifNOK  --todo fix


-- | Regle qui disparait d’elle-meme une fois executée: (exemple #15)
autoErase :: Rule
autoErase = mustNotBe (oRuleNumber `oEqu` oSelfNumber)

autoErase' :: Rule -> Rule
autoErase' = rAnd autoErase

-- Une regle ne doit pas contenir la regle « illegal » :

-- noZero :: Rule -Rule
-- noZero = not . included $ illegal 


--  sanityCheck :: Rule
 -- sanityCheck = 



-- named Rules


-- | An informationnal structure about a rule:
data NamedRule = NamedRule { rNumber :: RuleNumber,          -- number of the rule (must be unique) TO CHECK
                             rName :: String,                -- short name of the rule 
                             rText :: String,                -- descrition of the rule
                             rProposedBy :: PlayerNumber,    -- player proposing the rule
                             rule :: String,                 -- code of the rule
                             rStatus :: RuleStatus,          -- status of the rule
                             rejectedBy :: Maybe RuleNumber} -- who rejected this rule

-- | the status of a rule.
data RuleStatus = Active      -- The current Constitution
                | Pending     -- Proposed rules
                | Rejected    -- Proposed and rejected rules
                | Suppressed  -- Once Active but suppressed rules
                deriving (Eq, Show)

defaultNR = NamedRule { rNumber = 1,
                        rName = "",
                        rText = "",
                        rProposedBy = 0, 
                        rule = defaultRule,
                        rStatus = Active,
                        rejectedBy = Nothing}

defaultNRStatus s = NamedRule { rNumber = 1,
                                rName = "",
                                rText = "",
                                rProposedBy = 0, 
                                rule = defaultRule,
                                rStatus = s,
                                rejectedBy = Nothing}

type RuleSet = [NamedRule]

defaultRS = [defaultNR]
defaultRSWithPropRule = (defaultNRStatus Pending):defaultRS


-- | show a rule set.
showRS :: RuleSet -> String
showRS a = (concat $ intersperse "\n" (map show (sort a)))

-- | find a rule in the rule set.
findNamedRule :: RuleNumber -> RuleSet -> Maybe NamedRule
findNamedRule rn rs = find (\NamedRule { rNumber = myrn} -> myrn == rn ) rs


-- Initial rules


-- | the initial rule set for a game.
initialRuleSet :: RuleSet
initialRuleSet = [nrVote, nrImmutable]
  
-- | initial rule #1 that states that rules must be voted unanimously
nrVote = NamedRule {rNumber=1, rName ="Vote", rText="Unanimous vote", rProposedBy=0, rule = "allVoteRule", rStatus = Active, rejectedBy = Nothing}

-- | initial rule #2 that states that rules must not erase rules #1.
nrImmutable = NamedRule {rNumber=2, rName ="Immutable Rules", rText="The rule #1 must not be suppressed", rProposedBy=0, rule = "immutable 1", rStatus = Active, rejectedBy = Nothing}


rListAnd        = foldr rAnd Legal
rListOr         = foldr rOr Illegal
	
-- instances

instance Ord NamedRule where
   (NamedRule {rNumber=n}) <= (NamedRule {rNumber=m}) = n <= m

instance Show NamedRule where
   show (NamedRule rNumber rName rText rProposedBy rule rStatus rejectedBy) =
        printf "%d. %s    Proposed by player %d   Status: %s %s \n %s\n %s\n" rNumber rName rProposedBy (show rStatus) (maybe "" (printf "by rule %d") rejectedBy) rText (show rule)
        

deriving instance Eq NamedRule

deriving instance Show Rule

deriving instance Eq Rule