Msg.hs

{-# LANGUAGE DeriveGeneric, CPP #-}
module Game.Hanabi.Msg where
import Game.Hanabi
import GHC.Generics
import Data.List(transpose, tails)

import System.Random
#ifdef TFRANDOM
import System.Random.TF
#endif

#ifdef AESON
import Data.Aeson

instance ToJSON Msg
instance FromJSON Msg
instance ToJSON State
instance FromJSON State
instance ToJSON PrivateView
instance FromJSON PrivateView
instance ToJSON PublicInfo
instance FromJSON PublicInfo
instance ToJSON EndGame
instance FromJSON EndGame
instance ToJSON Move
instance FromJSON Move
instance ToJSON Card
instance FromJSON Card
instance ToJSON Color
instance FromJSON Color
instance ToJSON Rank
instance FromJSON Rank
instance ToJSON GameSpec
instance FromJSON GameSpec
instance ToJSON Rule
instance FromJSON Rule
instance ToJSON Game.Hanabi.Result
instance FromJSON Game.Hanabi.Result
#endif

-- WhatsUp and WhatsUp1 should be minimized after better clients are implemented. 効率上はminimizeすべきだが、テスト目的ではとりあえずこのままの方がやりやすい。
data Msg = Str String | Invalid | WhatsUp String [PrivateView] [Move] | WhatsUp1 PrivateView Move | PrettyEndGame [Card] (Maybe (EndGame, [State], [Move])) | Watch State [Move] | PrettyAvailable [(Int, (Int, Int))] | CreateGame | PlayAgain | Scores [Int] deriving (Show, Read, Eq, Generic)
prettyMsg :: Verbosity -> Msg -> String
prettyMsg _    (Str xs)        = xs
prettyMsg _    Invalid         = "Invalid move!"
prettyMsg verb (WhatsUp name ps ms) = what'sUp  verb name ps ms
prettyMsg verb (WhatsUp1     p  m)  = what'sUp1 verb      p  m
prettyMsg _    (PrettyEndGame cards tup)  = prettyDeckMbEndGame cards tup
prettyMsg _    (Watch st [])        = prettySt ithPlayerFromTheLast st
prettyMsg _    (Watch st (mv:_))    = replicate 20 '-' ++ '\n' :
                showTrial (const "") undefined (view st) mv ++ '\n' :
                replicate 20 '-' ++ '\n' : prettySt ithPlayerFromTheLast st
prettyMsg _    (PrettyAvailable available) = unlines $ map prettyAvailableGame available
prettyMsg _    PlayAgain = "Play with the same member? Adaptive strategies (if any) may have learned your play style (to some extent) [Y/n]\n"
prettyMsg _    (Scores revScores)   = "Scores so far: " ++ show (reverse revScores) ++
                                      "\nThe number of Games: " ++ show numGames ++ ", Average: " ++ show (fromIntegral (sum revScores) / fromIntegral numGames) ++
                                      if numGames >= 5 then "\nAverages of the last 5 games = " ++ show (reverse $ take (numGames - 4) $ map ((/5) . fromIntegral . sum) $ transpose $ take 5 $ tails revScores)
                                                       else ""
  where numGames = length revScores

prettyMbEndGame :: Maybe (EndGame, [State], [Move]) -> String
prettyMbEndGame = prettyDeckMbEndGame []
prettyDeckMbEndGame :: [Card] -> Maybe (EndGame, [State], [Move]) -> String
prettyDeckMbEndGame _ Nothing    = "Game ended abnormally, possibly by connection failure.\n"
prettyDeckMbEndGame d (Just tup) = prettyDeckEndGame d tup
prettyAvailableGame :: (Int, (Int, Int)) -> String
prettyAvailableGame (gameid, (missing, total)) = "Game ID " ++ shows gameid ": available " ++ shows missing " out of " ++ shows total "."


defaultOptions :: Options
defaultOptions = Opt{version    = error "The verion field should be set to Game.Hanabi.VersionInfo.versionInfo",
                     port       = 8720,
                     strategies = [],
                     lazy       = False
                    }
data Options = Opt{ version    :: String     -- ^ the version string to be shown by the `version' command.
                                             --   This is supposed to be set to 'versionInfo', but can just be @""@
                  , port       :: Int        -- ^ the port number. This can be overridden by `-p' option.
                  , strategies :: [(String, Maybe (Bool -> IO (IO (DynamicStrategy IO))))] -- ^ the association list of the tuples of the strategy name and (the constructor for) the strategy. Nothing is used if the strategy is not implemented by the current compiler (typically GHCJS), but can be executed by the server by handing the name.
                  , lazy       :: Bool -- ^ initialize lazily even if initialization takes time when the first game starts.
                  }

isWS :: String -> Bool
isWS = (`elem` ["0", "WS", "via WebSocket"])

# ifdef TFRANDOM
newGen :: IO TFGen
newGen = newTFGen
# else
newGen :: IO StdGen
newGen = newStdGen
# endif

orderPlayers :: (RandomGen g) => Maybe Int -> g -> [p] -> ([p], g)
orderPlayers (Just n) gen players = (dr++tk, gen)  where (tk,dr) = splitAt n players
orderPlayers Nothing  gen players = shuffle players gen