{-# LANGUAGE   TemplateHaskell
             , BangPatterns
             , DeriveDataTypeable #-}

module Merchandise.Types.Game
    ( Game(..)
    -- Game's lenses
    , events
    , coreState
    , playerState
    , messageState
    , includedModules

    , newGame
    , writeGame
    , loadGame

    , Module(..)
    -- and its lenses
    , moduleName
    , moduleDependencies
    , moduleEvents
    , moduleState

    , newModule
    , writeModule
    , loadModule
    , mergeModules
    , mergeManyModules

    , SaveGame(..)
    -- and its lenses
    , player
    , message
    , dependencies

    , newSaveGame
    , writeSaveGame
    , loadSaveGame
    ) where

import Control.Lens
import Control.Monad       (liftM)
import Control.Monad.State

-- TODO: Use an AcidState DB instead of lazy IO for the write/load functions
import Data.Acid
import Data.SafeCopy
import Data.Typeable

import           Data.List       (foldl1')
import qualified Data.Map.Strict as M
import qualified Data.Set        as S
import qualified Data.Text       as T

import System.IO

import qualified Merchandise.Types.Event     as Ev
import qualified Merchandise.Types.CoreState as CS
import qualified Merchandise.Types.Player    as Pl


-- | The prefixes we'll be using to store the Games, Modules, and SaveGames.
dataPath :: FilePath
dataPath   = "data/"

-- | The paths for Game, Module, and SaveGame, respectively.
gamePath   :: FilePath
modulePath :: FilePath
savePath   :: FilePath
gamePath   = "core/"
modulePath = "mods/"
savePath   = "saves/"

-- convenient type synonyms
type Prefix       = String
type Release      = Float
type Dependencies = S.Set (String, Release)

-- | Writes data to ./prefix/filepath.
writeData :: Show a => Prefix -> FilePath -> a -> IO ()
writeData p fp d = withFile (dataPath ++ p ++ fp)
                            WriteMode
                            (flip hPutStr $ show d)

-- | Loads data from ./prefix/filepath.
loadData :: Read a => Prefix -> FilePath -> IO a
loadData p fp = withFile (dataPath ++ p ++ fp)
                         ReadMode
                         (liftM read . hGetContents)

-- | All of the state. Composed of a Module (for core state) and a SaveGame
-- (for player state).
data Game = Game
    { _events          :: M.Map T.Text Ev.Event
    , _coreState       :: CS.CoreState
    , _playerState     :: Pl.Player
    , _messageState    :: CS.MessageState
    , _includedModules :: Dependencies
    } deriving (Show, Read, Typeable)
makeLenses ''Game
$(deriveSafeCopy 0 'base ''Game)

-- | Make an empty Game.
newGame :: Game
newGame = Game M.empty
               CS.newCoreState
               Pl.newPlayer
               CS.newMessageState
               S.empty

-- | Writes the master state to a file. The _gameState and _displayState are
-- the state that a new game will start with.
writeGame :: FilePath -> Game -> IO ()
writeGame fp g = writeData gamePath fp g

-- | Loads a Game from disk.
loadGame :: FilePath -> IO Game
loadGame fp = loadData gamePath fp


-- | A distributable unit of game data. Can be the core data for a Game, or a
-- modification (mod) for a Game.
data Module = Module
    { _moduleName         :: (String, Release)
    , _moduleDependencies :: Dependencies
    , _moduleEvents       :: M.Map T.Text Ev.Event
    , _moduleState        :: CS.CoreState
    } deriving (Show, Read, Typeable)
makeLenses ''Module
$(deriveSafeCopy 0 'base ''Module)

-- | Make an empty Module.
newModule :: Module
newModule = Module ("My Module", 0.1)
                   S.empty
                   M.empty
                   CS.newCoreState

-- | Writes a Module to a file.
writeModule :: FilePath -> Module -> IO ()
writeModule fp m = writeData (modulePath) fp m

-- | Loads a Module from disk.
loadModule :: FilePath -> IO Module
loadModule fp = loadData (modulePath) fp

-- | Merges two Modules. If there are any collisions, the data from the second
-- module will overwrite the data from the first module.
mergeModules :: Module -> Module -> Module
mergeModules m1 m2 = m1 & moduleDependencies   .~ newModuleDependencies
                        & moduleEvents %~ M.union (_moduleEvents m2)
                        & moduleState  .~ newModuleState
  where
    newModuleDependencies  = S.union (_moduleDependencies m1)
                                     (_moduleDependencies m2)
    ms             = _moduleState m2
    newModuleState =
        _moduleState m1 & CS.world   %~ M.union (ms ^. CS.world  )
                        & CS.people  %~ M.union (ms ^. CS.people )
                        & CS.items   %~ M.union (ms ^. CS.items  )
                        & CS.skills  %~ M.union (ms ^. CS.skills )
                        & CS.flags   %~ M.union (ms ^. CS.flags  )
                        & CS.strings %~ M.union (ms ^. CS.strings)
                        & CS.vars    %~ M.union (ms ^. CS.vars   )

-- | Merges many Modules into a single Module. Used for incorporating a list of
-- user-made modifications.
mergeManyModules :: [Module] -> Maybe Module
mergeManyModules [] = Nothing
mergeManyModules ms = Just $ foldl1' mergeModules ms


-- | Player-specific state. When written out, becomes a save file.
data SaveGame = SaveGame
    { _player       :: Pl.Player
    , _message      :: CS.MessageState
    , _dependencies :: Dependencies
    } deriving (Show, Read, Typeable)
makeLenses ''SaveGame
$(deriveSafeCopy 0 'base ''SaveGame)

-- | Make an empty SaveGame.
newSaveGame :: SaveGame
newSaveGame = SaveGame Pl.newPlayer
                       CS.newMessageState
                       S.empty

-- | Writes the player state to a file.
writeSaveGame :: FilePath -> SaveGame -> IO ()
writeSaveGame fp sg = writeData (savePath) fp sg

-- | Loads a SaveGame from disk.
loadSaveGame :: FilePath -> IO SaveGame
loadSaveGame fp = loadData (savePath) fp


-- | From a Game, create a SaveGame
mkSave :: Game -> SaveGame
mkSave g = SaveGame (_playerState g) (_messageState g) (_includedModules g)

-- | Extract the Module portion of a Game.
extractModule :: Game -> Module
extractModule g = Module ("Extracted Module", 0.0)
                         (_includedModules g)
                         (_events          g)
                         (_coreState       g)

-- | From a SaveGame and a Module, construct a Game.
makeGame :: Module -> SaveGame
         -> (Game, Either String ( [(String, Float)]   -- missing dependencies
                                 , [(String, Float)])) -- new dependencies
makeGame m s = ( Game (_moduleEvents m)
                      (_moduleState  m)
                      (_player  s)
                      (_message s)
                      mDeps
               , err)
  where
    mDeps  = S.insert (_moduleName m) (_moduleDependencies m)
    sDeps  = (_dependencies s)

    -- find the symmetric difference between the two sets of dependencies, which
    -- provides all dependency mismatches.
    diff   = S.union (S.difference mDeps sDeps)
                     (S.difference sDeps mDeps)
    -- dependencies that the save knows of, and relies on for data, that are
    -- missing.
    missingDeps = S.intersection sDeps diff
    -- dependencies that the save is not aware of (new mods), and are being
    -- introduced.
    newDeps     = S.difference   diff  missingDeps
    err = if diff == S.empty
          then Left"All dependencies found."
          else Right ( S.elems missingDeps
                     , S.elems newDeps    )

