{-# LANGUAGE TemplateHaskell #-}

module Game.Cosanostra.Plan
    ( actionGroups
    , plan
    , unplan
    , finishPlan
    ) where

import Game.Cosanostra.Action
import Game.Cosanostra.Effect
import Game.Cosanostra.Lenses
import Game.Cosanostra.Selectors
import Game.Cosanostra.Types

import Control.Lens
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.State
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import System.Random

actionGroups :: Players -> Turn -> Phase -> ActionGroups
actionGroups players turn phase =
    M.fromListWith S.union
                   [( eType ^?! effectTypeGrantedGroup
                    , S.singleton PlanBinding{ _planBindingSource = player
                                             , _planBindingAction = action
                                             , _planBindingCompulsion = compulsion
                                             }
                    )
                    | player <- playerKeys players
                    , let effects = playerEffects players player turn phase player
                    , effect <- effectsGrants effects
                    , checkConstraint players player turn phase
                                      (effect ^. effectConstraint)
                    , let eType = effect ^. effectType
                    , let action = eType ^?! effectTypeGrantedAction
                    , let compulsion = eType ^?! effectTypeGrantedCompulsion
                    ]

plan :: ActionGroups -> ActionGroup -> Action -> Player -> [Player] -> Planner ()
plan groups actionGroup action source targets = do
    when (all (==Forced) [binding ^. planBindingCompulsion
                          | binding <- S.elems bindings
                          , check binding
                          ])
         (throwError CompulsionForced)

    plan' actionGroup bindings action source targets
  where
    bindings = M.findWithDefault S.empty actionGroup groups
    check binding = binding ^. planBindingAction == action &&
                    binding ^. planBindingSource == source

plan' :: ActionGroup -> S.Set PlanBinding -> Action -> Player -> [Player] -> Planner ()
plan' actionGroup bindings action source targets = do
    players <- asks (^. plannerInfoPlayers)
    actions <- asks (^. plannerInfoActions)
    turn <- asks (^. plannerInfoTurn)
    phase <- asks (^. plannerInfoPhase)

    planned <- get

    when (actionGroup `M.member` planned)
         (throwError ActionAlreadyPlanned)

    when (not (any check bindings))
         (throwError ActionNotPlannable)

    let Just traits = actions ^. at action
    let selectors = targetSelectors (traits ^. actionTraitsType)

    when (length selectors /= length targets)
         (throwError IncorrectNumberOfTargets)

    forM_ (zip3 [0..] targets selectors) $ \(i, target, selector) -> do
        when (not (selectorCheck players source turn phase selector target))
             (throwError (TargetInvalid i))

    let act = Act{ _actAction = action
                 , _actSource = source
                 , _actTargets = targets
                 , _actTrace = ActFromPlan{ _actTracePlanTurn = turn
                                          , _actTracePlanPhase = phase
                                          , _actTracePlanGroup = actionGroup
                                          }
                 , _actUnaffectable = False
                 }

    modify (M.insert actionGroup act)
  where
    check binding = binding ^. planBindingAction == action &&
                    binding ^. planBindingSource == source

unplan :: ActionGroup -> Player -> Planner ()
unplan actionGroup source = do
    planned <- get

    case M.lookup actionGroup planned of
        Just act -> do
            when (act ^. actSource /= source)
                 (throwError ActionNotPlanned)

            modify (M.delete actionGroup)
        Nothing -> return ()

finishPlan :: RandomGen g => ActionGroups -> StateT g Planner ()
finishPlan groups = do
    players <- lift $ asks (^. plannerInfoPlayers)
    actions <- lift $ asks (^. plannerInfoActions)
    turn <- lift $ asks (^. plannerInfoTurn)
    phase <- lift $ asks (^. plannerInfoPhase)

    planned <- lift get

    let unplanned = M.filterWithKey (\k _ -> not (k `M.member` planned)) groups

    forM_ (M.toList unplanned) $ \(actionGroup, bindings) -> do
        let binding' = S.filter ((/= Voluntary) . (^. planBindingCompulsion))
                                bindings

        when (not (S.null binding')) $ do
            i <- state (randomR (0, S.size binding' - 1))

            let binding = S.elemAt i binding'
            let source = binding ^. planBindingSource
            let action = binding ^. planBindingAction

            let selectors = targetSelectors (actionTraits actions action ^.
                                             actionTraitsType)

            let targetsPerTarget = [S.fromList [target
                                                | target <- playerKeys players
                                                , selectorCheck players
                                                                source
                                                                turn
                                                                phase
                                                                selector
                                                                target
                                                ]
                                    | selector <- selectors
                                    ]

            targets <- forM targetsPerTarget $ \candidates -> do
                j <- state (randomR (0, S.size candidates - 1))
                return $ S.elemAt j candidates

            lift $ plan' actionGroup bindings action source targets
