diff --git a/src/AI.hs b/src/AI.hs index 57831cc..ccaf0fa 100644 --- a/src/AI.hs +++ b/src/AI.hs @@ -1,9 +1,21 @@ +{-# LANGUAGE NamedFieldPuns #-} module AI ( move ) where -import Hanafuda.KoiKoi (Move(..), PlayerKey) +import Data.Map ((!)) +import Hanafuda (cardsOfPack, sameMonth) +import Hanafuda.Player (Player(..), Players(..)) +import Hanafuda.KoiKoi (GameBlueprint(..), Move(..), PlayerKey, Step(..)) import Hanafuda.Message (PublicGame) move :: PlayerKey -> PublicGame -> Move -move = undefined +move me (Game {step = ToPlay, players = Players p}) = + Play . head . cardsOfPack . hand $ p ! me +move me (Game {step = Turned card, river}) = + Choose . last . cardsOfPack $ sameMonth card river + where + last [] = error "Empty list" + last [x] = x + last (x:xs) = last xs +move me _ = KoiKoi True diff --git a/src/Automaton.hs b/src/Automaton.hs index 5036239..6287a04 100644 --- a/src/Automaton.hs +++ b/src/Automaton.hs @@ -15,27 +15,24 @@ import Control.Concurrent (threadDelay) import Control.Monad.Reader (ReaderT, ask) import Control.Monad.State (StateT) import Control.Monad.Trans (lift) -import Hanafuda.KoiKoi (Game, GameBlueprint(..), PlayerKey) -import qualified Hanafuda.Message as Message (T(..), FromClient(..), PublicGame, Room) +import Hanafuda.KoiKoi (Game, GameBlueprint(..), PlayerKey, Step(..)) +import qualified Hanafuda.Message as Message (T(..), FromClient(..), PublicGame) import Network.WebSockets (Connection, receiveData, sendTextData) import Prelude hiding (error, putStrLn) +import System.Exit (exitSuccess) data State = Initial | Connected { key :: PlayerKey - , room :: Message.Room } | LoggedIn { key :: PlayerKey - , room :: Message.Room , name :: Text } | Playing { key :: PlayerKey - , room :: Message.Room , name :: Text - , game :: Message.PublicGame } deriving Show @@ -66,27 +63,26 @@ debug message = lift $ putStrLn message answer :: Message.T -> State -> App State answer welcome@(Message.Welcome {}) Initial = do send $ Message.LogIn {Message.name = "Hannah"} - return $ Connected { - key = Message.key welcome - , room = Message.room welcome - } + return $ Connected {key = Message.key welcome} -answer (Message.Relay {Message.from, Message.message = Message.LogIn {Message.name}}) (Connected {key, room}) - | from == key = return $ LoggedIn {key, room, name} +answer (Message.Relay {Message.from, Message.message = Message.LogIn {Message.name}}) (Connected {key}) + | from == key = return $ LoggedIn {key, name} -answer (Message.Relay {Message.message = Message.Invitation {}}) state@(LoggedIn {key, room, name}) = do +answer (Message.Relay {Message.message = Message.Invitation {}}) (LoggedIn {key, name}) = do send $ Message.Answer {Message.accept = True} - return $ Playing {key, room, name, game = undefined} + return $ Playing {key, name} answer (Message.Relay {Message.message = Message.Invitation {}}) state = do send $ Message.Answer {Message.accept = False} return state -answer (Message.Game {Message.game, Message.logs}) state@(Playing {key}) = do +answer (Message.Game {Message.game, Message.logs}) state@(Playing {key, name}) = do if playing game == key - then send $ Message.Play {Message.move = AI.move key game} - else return () - return $ state {game} + then do + case step game of + Over -> send Message.Quit >> return (LoggedIn {key, name}) + _ -> send (Message.Play {Message.move = AI.move key game}) >> return state + else return state answer Message.Pong state = ping >> return state @@ -102,7 +98,7 @@ answer message state = do ping = do connection <- ask - setTimeout (2*s) (sendIO Message.Ping connection) + setTimeout (20*s) (sendIO Message.Ping connection) where setTimeout delay callback = const () <$> (lift $ forkIO (threadDelay delay >> callback))