{-|
Module      : Types.GameState
Description : 
Copyright   : (c) Alexander Vieth, 2015
Licence     : BSD3
Maintainer  : aovieth@gmail.com
Stability   : experimental
Portability : non-portable (GHC only)
-}

{-# LANGUAGE AutoDeriveTypeable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Types.GameState (

      SomeGame(..)
    , GameState(..)
    , GameStateView(..)
    , GameMetadata(..)
    , GameData(..)
    , GameResolution(..)

    , gameStateMatchCredentials
    , gameStateViewMetadata
    , gameStateViewData
    , gameStateViewResolution

    ) where

import GHC.Generics
import Control.DeepSeq
import Control.Monad
import Control.Applicative
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Text as T
import Data.AtLeast
import Data.TypeNat.Nat
import Data.Functor.Identity
import Data.Functor.Constant
import Data.Hourglass
import Data.Aeson
import Data.JSON.Schema as Schema
import Diplomacy.Game
import Diplomacy.Turn
import Diplomacy.Province
import Diplomacy.Zone
import Diplomacy.Aligned
import Diplomacy.Phase
import qualified Diplomacy.Order as DO
import qualified Diplomacy.OrderObject as DOO
import Diplomacy.OrderResolution
import qualified Diplomacy.Unit as DU
import qualified Diplomacy.GreatPower as DGP
import Diplomacy.Control
import Diplomacy.Occupation
import Types.Credentials as Cred
import Types.UserData as UD
import Types.Credentials (Username)
import Types.GreatPower
import Types.Unit
import Types.Order

data SomeGame where
    SomeGame :: Game round RoundUnresolved -> SomeGame

data GameState where

    GameNotStarted
        :: M.Map Username (UserData (Constant ()))
        -> Duration
        -> Duration
        -> GameState

    GameStarted
        :: M.Map Username (UserData S.Set)
        -- ^ we use Set rather than Identity, because one player can control
        --   more than one great power!
        -> AtLeast One SomeGame
        -- ^ All (unresolved) game states seen so far. First entry is the
        --   latest, and other entires retain the orders which were present
        --   when the game was advanced.
        -> Duration
        -- ^ Period of this game; after this duration, the game advances to the
        --   next round if it's in typical phase.
        -> Duration
        -- ^ Second period of this game; after this duration, the game advances
        --   to the next round if it's in adjust or retreat phase.
        -> Elapsed
        -- ^ Unix epoch time when this game was last advanced or when it was
        --   started.
        -> Bool
        -- ^ True iff the game is paused, meaning it should not advance
        --   automatically after a set amount of time.
        -> GameState

deriving instance Generic GameState
instance NFData GameState

-- | The game state viewed as a certain player, who controls a set of
--   GreatPowers.
data GameStateView where
    GameNotStartedView :: GameStateView
    GameStartedView
        :: S.Set DGP.GreatPower
        -> AtLeast One SomeGame
        -> Duration
        -> Duration
        -> Elapsed
        -> Bool
        -> GameStateView

gameStateViewMetadata :: GameStateView -> Maybe GameMetadata
gameStateViewMetadata view = case view of
    GameNotStartedView -> Nothing
    GameStartedView greatPowers games duration secondDuration elapsed paused -> Just $ GameMetadata {
          metadataGreatPowers = S.map GreatPower greatPowers
        , metadataTurn = turn
        , metadataRound = round
        , metadataDuration = duration
        , metadataSecondDuration = secondDuration
        , metadataElapsed = elapsed
        , metadataPaused = paused
        }
      where
        game = Data.AtLeast.head games
        turn = case game of
            SomeGame game -> gameTurn game
        round = case game of
            SomeGame game -> gameRound game

-- | Number of places from the back of a list of SomeGame at which the game
--   for this turn and round is found.
gameIndex :: Turn -> Round -> Int
gameIndex turn round = roundToInt round + 5*(turnToInt turn)

findGame :: Turn -> Round -> AtLeast One SomeGame -> Maybe SomeGame
findGame turn round games =
    let gamesList = Data.AtLeast.toList games
        index = gameIndex turn round
    in  findGame' index (reverse gamesList)
  where
    findGame' :: Int -> [SomeGame] -> Maybe SomeGame
    findGame' n games = case games of
        [] -> Nothing
        (x : xs) -> if n == 0 then Just x else findGame' (n-1) xs

-- Careful! This will give the resolved orders for any turn/round pair found,
-- even if it's the latest (ongoing) game! The client-facing code must be
-- careful not to fulfill a user's request for the resolutions of the latest
-- round.
gameStateViewResolution :: Turn -> Round -> GameStateView -> Maybe GameResolution
gameStateViewResolution turn round view = case view of
    GameNotStartedView -> Nothing
    GameStartedView _ games _ _ _ _ -> case findGame turn round games of
        Nothing -> Nothing
        Just (SomeGame game) -> Just $ case resolve game of
            TypicalGame _ _ _ zonedResolvedOrders control -> GameResolutionTypical (M.map mapper zonedResolvedOrders) (M.map GreatPower control)
            RetreatGame _ _ _ _ zonedResolvedOrders occupation control -> GameResolutionRetreat (M.map mapper zonedResolvedOrders) (M.map (fmap Unit) occupation) (M.map GreatPower control)
            AdjustGame _ _ _ zonedResolvedOrders control -> GameResolutionAdjust (M.map mapper zonedResolvedOrders) (M.map GreatPower control)
  where
    mapper
        :: (Aligned DU.Unit, SomeResolved DOO.OrderObject phase)
        -> (Aligned Unit, SomeOrderObject phase, Bool)
    mapper (aunit, SomeResolved (object, res)) = (align unit greatPower, someObject, bool)
      where
        greatPower = alignedGreatPower aunit
        unit = Unit (alignedThing aunit)
        someObject = SomeOrderObject (DOO.SomeOrderObject object)
        bool = case res of
            Nothing -> True
            _ -> False

gameStateViewData :: Turn -> Round -> GameStateView -> Maybe GameData
gameStateViewData turn round view = case view of
    GameNotStartedView -> Nothing
    GameStartedView greatPowers games _ _ _ _ -> case findGame turn round games of
        Nothing -> Nothing
        Just (SomeGame game) -> Just $ case game of
            TypicalGame _ _ _ zonedOrders control -> GameDataTypical (M.map (mapper greatPowers) zonedOrders) (M.map GreatPower control)
            RetreatGame _ _ _ _ zonedOrders occupation control -> GameDataRetreat (M.map (mapper greatPowers) zonedOrders) (M.map (fmap Unit) occupation) (M.map GreatPower control)
            AdjustGame _ _ _ zonedOrders control -> GameDataAdjust (M.map (mapper greatPowers) zonedOrders) (M.map GreatPower control)
  where
    mapper
        :: S.Set DGP.GreatPower
        -> (Aligned DU.Unit, DOO.SomeOrderObject phase)
        -> (Aligned Unit, Maybe (SomeOrderObject phase))
    mapper greatPowers (aunit, someOrderObject) = (align unit greatPower, maybeSomeOrderObject)
      where
        greatPower = alignedGreatPower aunit
        unit = Unit (alignedThing aunit)
        maybeSomeOrderObject = case S.member greatPower greatPowers of
            True -> Just (SomeOrderObject someOrderObject)
            False -> Nothing

data GameMetadata = GameMetadata {
      metadataGreatPowers :: S.Set GreatPower
    , metadataTurn :: Turn
    , metadataRound :: Round
    , metadataDuration :: Duration
    , metadataSecondDuration :: Duration
    , metadataElapsed :: Elapsed
    , metadataPaused :: Bool
    }

instance ToJSON GameMetadata where
    toJSON metadata = object [
          "greatPowers" .= greatPowers
        , "turn" .= turn
        , "round" .= round
        , "duration" .= duration
        , "secondDuration" .= secondDuration
        , "elapsed" .= secondsElapsed
        , "paused" .= paused
        ]
      where
        greatPowers = metadataGreatPowers metadata
        turn = turnToInt (metadataTurn metadata)
        round = roundToInt (metadataRound metadata)
        -- We only show the duration up to the minute.
        -- These (hours and minutes) are Int64. Can't be bothered to
        -- import that so I can write the type signature.
        Hours hours = durationHours (metadataDuration metadata)
        Minutes minutes = durationMinutes (metadataDuration metadata)
        Hours secondHours = durationHours (metadataSecondDuration metadata)
        Minutes secondMinutes = durationMinutes (metadataSecondDuration metadata)
        -- seconds is an Int64 giving unix time when the game was last
        -- advanced (or started, in case it's round 1 turn 1).
        Elapsed (Seconds secondsElapsed) = metadataElapsed metadata
        duration = object [
              "hours" .= hours
            , "minutes" .= minutes
            ]
        secondDuration = object [
              "hours" .= secondHours
            , "minutes" .= secondMinutes
            ]
        paused = metadataPaused metadata

instance JSONSchema GameMetadata where
    schema _ = Schema.Object [
          greatPowersField
        , turnField
        , roundField
        , durationField
        , secondDurationField
        , elapsedField
        , pausedField
        ]
      where
        greatPowersField = Field "greatPowers" True (Schema.Array (LengthBound (Just 1) (Just 7)) True (Value unboundedLength))
        turnField = Field "turn" True (Schema.Number (Bound (Just 0) Nothing))
        roundField = Field "round" True (Schema.Number (Bound (Just 0) (Just 4)))
        durationField = Field "duration" True (Schema.Object [hoursField, minutesField])
        secondDurationField = Field "secondDuration" True (Schema.Object [hoursField, minutesField])
        elapsedField = Field "elapsed" True (Schema.Number (Bound (Just 0) Nothing))
        pausedField = Field "paused" True Boolean
        hoursField = Field "hours" True (Schema.Number (Bound (Just 0) Nothing))
        minutesField = Field "minutes" True (Schema.Number (Bound (Just 0) (Just 59)))

-- For now we give only a Bool to indicate success or failure (true for
-- success). In the future we should give the reason. This is not super easy
-- to do because we use GADTs with phase and order type parameters, so we
-- can't just derive generic JSON instances.
data GameResolution where
    GameResolutionTypical
        :: M.Map Zone (Aligned Unit, SomeOrderObject Typical, Bool)
        -> M.Map Province GreatPower
        -> GameResolution
    GameResolutionRetreat
        :: M.Map Zone (Aligned Unit, SomeOrderObject Retreat, Bool)
        -> M.Map Zone (Aligned Unit)
        -> M.Map Province GreatPower
        -> GameResolution
    GameResolutionAdjust
        :: M.Map Zone (Aligned Unit, SomeOrderObject Adjust, Bool)
        -> M.Map Province GreatPower
        -> GameResolution

instance ToJSON GameResolution where
    toJSON gameResolution = case gameResolution of
        GameResolutionTypical zonedResolvedOrders control -> object [
              "resolved" .= zonedResolvedOrders
            , "control" .= control
            ]
        GameResolutionRetreat zonedResolvedOrders occupation control -> object [
              "resolved" .= zonedResolvedOrders
            , "occupation" .= occupation
            , "control" .= control
            ]
        GameResolutionAdjust zonedResolvedOrders control -> object [
              "resolved" .= zonedResolvedOrders
            , "control" .= control
            ]

instance JSONSchema GameResolution where
    schema _ = Schema.Object []

data GameData where
    GameDataTypical
        :: M.Map Zone (Aligned Unit, Maybe (SomeOrderObject Typical))
        -> M.Map Province GreatPower
        -> GameData
    GameDataRetreat
        :: M.Map Zone (Aligned Unit, Maybe (SomeOrderObject Retreat))
        -> M.Map Zone (Aligned Unit)
        -> M.Map Province GreatPower
        -> GameData
    GameDataAdjust
        :: M.Map Zone (Aligned Unit, Maybe (SomeOrderObject Adjust))
        -> M.Map Province GreatPower
        -> GameData

instance ToJSON GameData where
    toJSON gameData = case gameData of
        GameDataTypical zonedOrders control -> object [
              "occupation" .= zonedOrders
            , "control" .= control
            ]
        GameDataRetreat zonedOrders occupation control -> object [
              "dislodgement" .= zonedOrders
            , "occupation" .= occupation
            , "control" .= control
            ]
        GameDataAdjust zonedOrders control -> object [
              "occupation" .= zonedOrders
            , "control" .= control
            ]

instance JSONSchema GameData where
    schema _ = Schema.Object []

instance ToJSON t => ToJSON (M.Map Zone t) where
    toJSON map = toJSON textKeyedMap
      where
        textKeyedMap :: M.Map T.Text t
        textKeyedMap = M.foldWithKey (\z x -> M.insert (zoneToText z) x) M.empty map
        zoneToText :: Zone -> T.Text
        zoneToText = printProvinceTarget . zoneProvinceTarget

instance ToJSON t => ToJSON (M.Map Province t) where
    toJSON map = toJSON textKeyedMap
      where
        textKeyedMap :: M.Map T.Text t
        textKeyedMap = M.foldWithKey(\p x -> M.insert (printProvince p) x) M.empty map

instance ToJSON (Aligned Unit) where
    toJSON aunit = toJSON (greatPower, unit)
      where
        greatPower = GreatPower (alignedGreatPower aunit)
        unit = alignedThing aunit

instance ToJSON (Aligned Unit, Maybe (SomeOrderObject phase)) where
    toJSON (aunit, maybeObject) = toJSON (greatPower, unit, maybeObject)
      where
        greatPower = GreatPower (alignedGreatPower aunit)
        unit = alignedThing aunit

instance ToJSON (Aligned Unit, SomeOrderObject phase, Bool) where
    toJSON (aunit, object, bool) = toJSON (greatPower, unit, object, bool)
      where
        greatPower = GreatPower (alignedGreatPower aunit)
        unit = alignedThing aunit

-- | Get a GameStateView for given Credentials, i.e. the set of GreatPowers
--   that this user controls, along with a SomeGame if the game is started,
--   no information if the game is not started, or Nothing in case the
--   Credentials do not match anyone.
gameStateMatchCredentials :: Credentials -> GameState -> Maybe GameStateView
gameStateMatchCredentials creds gameState = case gameState of
    GameNotStarted map _ _ -> case M.lookup uname map of
        Nothing -> Nothing
        Just ud -> case pwd == UD.password ud of
            False -> Nothing
            True -> Just GameNotStartedView
    GameStarted map someGames duration duration' elapsed paused -> case M.lookup uname map of
        Nothing -> Nothing
        Just ud -> case pwd == UD.password ud of
            False -> Nothing
            True -> Just (GameStartedView (UD.greatPower ud) someGames duration duration' elapsed paused)
  where
    uname = Cred.username creds
    pwd = Cred.password creds