Draft a very stupid AI and simplify Automaton states a bit

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

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))