From 262b6e3e79c351bd7e5d6e72ca27a8f0111f5ec5 Mon Sep 17 00:00:00 2001
From: Sasha <sasha+frama@marvid.fr>
Date: Sun, 15 Jul 2018 17:57:40 +0200
Subject: [PATCH] Revert to storing only 'On' games

---
 src/Automaton.hs |  6 +++---
 src/Game.hs      | 16 +++++-----------
 src/Message.hs   |  8 ++------
 3 files changed, 10 insertions(+), 20 deletions(-)

diff --git a/src/Automaton.hs b/src/Automaton.hs
index 8aa513a..5909b47 100644
--- a/src/Automaton.hs
+++ b/src/Automaton.hs
@@ -65,9 +65,9 @@ edges status@(Session.Playing gameKey) (Message.Play {Message.move}) = do
   case newGame of
     KoiKoi.Error s -> status `withError` s
     KoiKoi.Over _ -> undefined
-    KoiKoi.On _ -> do
-      App.update_ $ Server.update gameKey (const newGame)
-      Message.notifyPlayers newGame
+    KoiKoi.On on -> do
+      App.update_ $ Server.update gameKey (const on)
+      Message.notifyPlayers on
       return status
 
 edges state _ =
diff --git a/src/Game.hs b/src/Game.hs
index e4a734b..36fd58b 100644
--- a/src/Game.hs
+++ b/src/Game.hs
@@ -80,10 +80,7 @@ instance ToJSON (Hanafuda.Player.Players Player.Key Hanafuda.KoiKoi.Score) where
   toJSON = toJSON1
   toEncoding = toEncoding1
 
-instance ToJSON On
-instance ToJSON Over
-
-type T = Hanafuda.KoiKoi.Game Player.Key
+type T = Hanafuda.KoiKoi.On Player.Key
 
 instance ToJSON T
 
@@ -91,11 +88,10 @@ type Key = Data.Key T
 
 new :: Player.Key -> Player.Key -> IO T
 new p1 p2 = do
-  on <- Hanafuda.KoiKoi.new [p1, p2] Hanafuda.KoiKoi.WholeYear
-  return $ Hanafuda.KoiKoi.On on
+  Hanafuda.KoiKoi.new [p1, p2] Hanafuda.KoiKoi.WholeYear
 
 export :: Player.Key -> T -> T
-export key (Hanafuda.KoiKoi.On on) = Hanafuda.KoiKoi.On $ on {
+export key on = on {
       Hanafuda.KoiKoi.deck = []
     , Hanafuda.KoiKoi.players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered
   }
@@ -104,12 +100,10 @@ export key (Hanafuda.KoiKoi.On on) = Hanafuda.KoiKoi.On $ on {
     maskOpponentsHand k player
       | k == key = player
       | otherwise = player {Hanafuda.Player.hand = Hanafuda.empty}
-export _ game = game
 
-play :: Player.Key -> Hanafuda.KoiKoi.Move -> T -> IO T
-play key move (Hanafuda.KoiKoi.On on)
+play :: Player.Key -> Hanafuda.KoiKoi.Move -> T -> IO (Hanafuda.KoiKoi.Game Player.Key)
+play key move on
   | Hanafuda.KoiKoi.playing on == key = do
     newState <- Hanafuda.KoiKoi.play move on
     return $ newState
   | otherwise = return $ Hanafuda.KoiKoi.Error "Not your turn"
-play _ _ _ = return $ Hanafuda.KoiKoi.Error "This game is over"
diff --git a/src/Message.hs b/src/Message.hs
index dd9b3cf..48a04ba 100644
--- a/src/Message.hs
+++ b/src/Message.hs
@@ -27,7 +27,7 @@ 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 (Game(..), On(..), Over(..), Move(..))
+import qualified Hanafuda.KoiKoi as KoiKoi (On(..), Move(..))
 import GHC.Generics (Generic)
 
 data FromClient =
@@ -100,9 +100,5 @@ update = Update {alone = [], paired = []}
 
 notifyPlayers :: Game.T -> App.T ()
 notifyPlayers game =
-  forM_ (keys $ scores game) $ \k ->
+  forM_ (keys $ KoiKoi.scores game) $ \k ->
     sendTo [k] $ Game {game = Game.export k game}
-  where
-    scores (KoiKoi.On on) = KoiKoi.scores on
-    scores (KoiKoi.Over over) = KoiKoi.finalScores over
-    scores _ = mempty