{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, RankNTypes, FlexibleContexts #-}

-- | Datatypes for a subsite serving a single-user dungeon.
module Web.Antagonist.Server.Data where

import Data.Dynamic
import Game.Antisplice
import Game.Antisplice.Utils.AVL
import Game.Antisplice.Utils.TST
import Game.Antisplice.Monad.Dungeon
import Game.Antisplice.Monad.Vocab
import Text.Chatty.Expansion
import Text.Chatty.Expansion.Vars
import Data.IORef
import Data.Time.Clock
import Yesod

-- | Server-side session state. Everything we need to know about the dungeon.
type SessionState = ((((DungeonState,TST Token),AVL (Int,Dynamic)),Int),[(String,EnvVar)])

-- | Subsite foundation type, containing the dungeon constructor and the session states.
data SingleUserSub = SingleUserSub { currentCounter :: IORef Int, dungeonStates :: IORef (AVL (Int,SessionState,String,NominalDiffTime)), constructor :: Constructor () }

mkYesodSubData "SingleUserSub" [parseRoutes|
/ PlayR GET
/put PutR POST
/news NewsR POST
|]