Msg.hs

{-# LANGUAGE DeriveGeneric, CPP #-}
module Game.Hanabi.Msg where
import Game.Hanabi
import GHC.Generics

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 | WhatsUp String [PrivateView] [Move] | WhatsUp1 PrivateView Move | PrettyEndGame [Card] (Maybe (EndGame, [State], [Move])) | Watch State [Move] | PrettyAvailable [(Int, (Int, Int))] | CreateGame deriving (Show, Read, Eq, Generic)
prettyMsg :: Verbosity -> Msg -> String
prettyMsg _    (Str xs)        = xs
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)  = prettyMbEndGame tup ++ "By the way, the initial deck was " ++ shows cards ".\n"
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
prettyMbEndGame :: Maybe (EndGame, [State], [Move]) -> String
prettyMbEndGame Nothing    = "Game ended abnormally, possibly by connection failure.\n"
prettyMbEndGame (Just tup) = prettyEndGame tup
prettyAvailableGame :: (Int, (Int, Int)) -> String
prettyAvailableGame (gameid, (missing, total)) = "Game ID " ++ shows gameid ": available " ++ shows missing " out of " ++ shows total "."

-- Both CreateGame and PrettyAvailable have the "Create a Game" UI. Since CreateGame can work offline, sometimes CreateGame is printed before PrettyAvailable is printed. That looks redundant when online, so in such cases CreateGame is removed when PrettyAvailable is received.
suppressCG :: [Msg] -> [Msg]
suppressCG (pr@(PrettyAvailable _) : CreateGame : rest) = pr : rest
suppressCG (pr@(PrettyAvailable _) : PrettyAvailable _ : rest) = pr : rest -- this line makes the state less informative, but makes the UI more sophisticated
suppressCG xs = xs

defaultOptions :: Options
defaultOptions = Opt{version    = error "The verion field should be set to Game.Hanabi.VersionInfo.versionInfo",
                     port       = 8720,
                     strategies = []
                    }
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, IO (DynamicStrategy IO))] -- ^ the association list of the tuples of the strategy name and (the constructor for) the strategy.
                  }

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