{-# LANGUAGE NamedFieldPuns #-} module Session ( State(..) , deleteGame , initial , storeID , storeGame ) where import Config (libDir) import Control.Monad (foldM) import Control.Monad.Except (MonadError(..), ExceptT(..), runExceptT) import Control.Monad.IO.Class (MonadIO(..)) import Data.Aeson (encodeFile, eitherDecodeFileStrict') import Data.Map (Map) import qualified Data.Map as Map (delete, empty, insert) import Hanafuda.KoiKoi (GameID, PlayerID) import qualified Hanafuda.Message as Message (PublicGame) import System.Directory ( createDirectoryIfMissing, doesFileExist, listDirectory, removeFile ) import System.FilePath (()) import System.IO (stderr, hPutStrLn) import Text.Read (readEither) type Games = Map GameID Message.PublicGame data State = New | Connected { playerID :: PlayerID , games :: Games } deriving Show stateFile :: FilePath stateFile = libDir "state" gamesDir :: FilePath gamesDir = libDir "games" warn :: a -> String -> IO a warn defaultValue errorMessage = hPutStrLn stderr errorMessage >> return defaultValue initial :: IO State initial = do createDirectoryIfMissing True libDir fileExists <- doesFileExist stateFile runExceptT (if fileExists then loadFile else stateFileMissing) >>= either (warn New) return where stateFileMissing = throwError $ "State file missing : " ++ stateFile loadFile = do playerID <- ExceptT $ readEither <$> readFile stateFile Connected playerID <$> liftIO loadGames storeID :: Show a => a -> IO () storeID = writeFile stateFile . show loadGames :: IO Games loadGames = do createDirectoryIfMissing True gamesDir listDirectory gamesDir >>= foldM loadGame Map.empty loadGame :: Games -> FilePath -> IO Games loadGame tmpGames fileName = runExceptT exceptLoad >>= either (warn tmpGames) return where exceptLoad = do gameID <- ExceptT . return $ readEither fileName publicGame <- ExceptT . eitherDecodeFileStrict' $ gamesDir fileName return $ Map.insert gameID publicGame tmpGames storeGame :: MonadIO m => GameID -> Message.PublicGame -> State -> m State storeGame gameID publicGame state = do liftIO $ createDirectoryIfMissing True gamesDir >> encodeFile (gamesDir show gameID) publicGame return $ state {games = Map.insert gameID publicGame $ games state} deleteGame :: MonadIO m => GameID -> State -> m State deleteGame gameID state = do liftIO $ removeFile (gamesDir show gameID) return $ state {games = Map.delete gameID $ games state}