Follow the simplication of Game data type on lib's side

src/Automaton.hs

@@ -50,7 +50,7 @@ receive (Session.Answering to) message@(Message.Answer {Message.accept}) = do
           then do
             gameKey <- Server.register <$> (lift $ Game.new for to) >>= App.update
             game <- Server.get gameKey <$> App.server
-            Message.notifyPlayers (KoiKoi.On game) []
+            Message.notifyPlayers game []
             return $ Session.Playing gameKey
           else do
             Message.broadcast $ Message.update {Message.alone = [key, to]}
@@ -66,17 +66,17 @@ receive (Session.Playing gameKey) played@(Message.Play {}) = do
   case result of
     Left message -> sendError message
     Right newGame ->
-      case newGame of
+      if KoiKoi.on newGame
-        KoiKoi.Over _ -> do
+        then do
+          App.update_ $ Server.update gameKey (const newGame)
+          Message.notifyPlayers newGame logs
+        else do
           let newStatus = Session.LoggedIn True
-          let opponent = Player.next (KoiKoi.players game) key
+          let opponent = Player.next (KoiKoi.players newGame) key
           App.update_ $ Server.endGame gameKey
           App.update_ $ Server.update opponent (Data.set newStatus :: Session.Update)
           Message.notifyPlayers newGame logs
           move newStatus
-        KoiKoi.On on -> do
-          App.update_ $ Server.update gameKey (const on)
-          Message.notifyPlayers newGame logs
 
 receive state _ = sendError $ "Invalid message in state " ++ show state
 

src/Game.hs

@@ -8,7 +8,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Game (
       Key
-    , View
     , T
     , export
     , new
@@ -26,7 +25,7 @@ import qualified Data (Key)
 import qualified Player (Key)
 import qualified Hanafuda (Flower(..), Card(..), Pack, cardsOfPack, empty)
 import qualified Hanafuda.Player (Player(..), Players(..))
-import qualified Hanafuda.KoiKoi (Action(..), Game(..), Environment, Mode(..), Move(..), On(..), Over(..), Score, Source(..), Step(..), Yaku(..), new, play)
+import qualified Hanafuda.KoiKoi (Action(..), Game(..), Environment, Mode(..), Move(..), Score, Source(..), Step(..), Yaku(..), new, play)
 import GHC.Generics
 
 deriving instance Generic Hanafuda.Card
@@ -40,17 +39,11 @@ deriving instance Generic Hanafuda.KoiKoi.Step
 deriving instance Generic1 (Hanafuda.Player.Player Player.Key)
 deriving instance Generic1 (Hanafuda.Player.Players Player.Key)
 
-type On = Hanafuda.KoiKoi.On Player.Key
+type T = Hanafuda.KoiKoi.Game Player.Key
-type Over = Hanafuda.KoiKoi.Over Player.Key
-type View = Hanafuda.KoiKoi.Game Player.Key
 
-deriving instance Generic On
+deriving instance Generic T
-deriving instance Generic Over
-deriving instance Generic View
 
-instance ToJSON On where
+instance ToJSON T where
-  toEncoding = genericToEncoding JSON.defaultOptions
-instance ToJSON Over where
   toEncoding = genericToEncoding JSON.defaultOptions
 
 instance FromJSON Hanafuda.Card
@@ -95,28 +88,25 @@ instance ToJSON (Hanafuda.Player.Players Player.Key Hanafuda.KoiKoi.Score) where
   toJSON = toJSON1
   toEncoding = toEncoding1
 
-type T = On
-
 type Key = Data.Key T
 
 new :: Player.Key -> Player.Key -> IO T
 new p1 p2 = do
-  Hanafuda.KoiKoi.new [p1, p2] Hanafuda.KoiKoi.WholeYear
+  Hanafuda.KoiKoi.new [p1, p2] $ Hanafuda.KoiKoi.FirstAt 1
 
-export :: Player.Key -> View -> Value
+export :: Player.Key -> T -> Value
-export _ (Hanafuda.KoiKoi.Over over) = toJSON over
+export key game = Object $ insert "deck" (toJSON $ length $ Hanafuda.KoiKoi.deck game) $ ast
-export key (Hanafuda.KoiKoi.On on) = Object $ insert "deck" (toJSON $ length $ Hanafuda.KoiKoi.deck on) $ ast
   where
-    Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players on
+    Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players game
     maskOpponentsHand k player
       | k == key = player
       | otherwise = player {Hanafuda.Player.hand = Hanafuda.empty}
-    Object ast = toJSON $ on {
+    Object ast = toJSON $ game {
         Hanafuda.KoiKoi.players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered
       }
 
 play :: Hanafuda.KoiKoi.Environment m => Player.Key -> Hanafuda.KoiKoi.Move -> T -> m (Hanafuda.KoiKoi.Game Player.Key)
-play key move on
+play key move game
-  | Hanafuda.KoiKoi.playing on == key =
+  | Hanafuda.KoiKoi.playing game == key =
-    Hanafuda.KoiKoi.play move on
+    Hanafuda.KoiKoi.play move game
   | otherwise = throwError "Not your turn"

src/Message.hs

@@ -23,11 +23,11 @@ import Data.ByteString.Lazy.Char8 (unpack)
 import Data.Text (Text)
 import Control.Monad.Reader (asks, lift)
 import qualified Player (Key)
-import qualified Game (View, export)
+import qualified Game (T, export)
 import qualified Session (T(..))
 import qualified Server (T(..), get)
 import qualified App (Context(..), T, connection, debug, server)
-import qualified Hanafuda.KoiKoi as KoiKoi (Action, Game(..), On(..), Over(..), Move(..))
+import qualified Hanafuda.KoiKoi as KoiKoi (Action, Game(..), Move(..))
 import GHC.Generics (Generic)
 
 data FromClient =
@@ -98,10 +98,7 @@ get =
 update :: T
 update = Update {alone = [], paired = []}
 
-notifyPlayers :: Game.View -> [KoiKoi.Action] -> App.T ()
+notifyPlayers :: Game.T -> [KoiKoi.Action] -> App.T ()
-notifyPlayers game@(KoiKoi.Over over) logs =
+notifyPlayers game logs =
-  forM_ (keys $ KoiKoi.finalScores over) $ \k ->
+  forM_ (keys $ KoiKoi.scores game) $ \k ->
-    sendTo [k] $ Game {game = Game.export k game, logs}
-notifyPlayers game@(KoiKoi.On on) logs =
-  forM_ (keys $ KoiKoi.scores on) $ \k ->
     sendTo [k] $ Game {game = Game.export k game, logs}