From fbad40afdc351bdd91412d74e33e0443a166710e Mon Sep 17 00:00:00 2001
From: Tissevert <tissevert+devel@marvid.fr>
Date: Mon, 19 Aug 2019 18:59:48 +0200
Subject: [PATCH] Continue emptying Game into APILanguage and update the rest
 of the code accordingly

---
 src/Automaton.hs |  2 +-
 src/Game.hs      | 56 ++++++++----------------------------------------
 src/Messaging.hs |  2 +-
 3 files changed, 11 insertions(+), 49 deletions(-)

diff --git a/src/Automaton.hs b/src/Automaton.hs
index 9813455..cc84a9c 100644
--- a/src/Automaton.hs
+++ b/src/Automaton.hs
@@ -9,7 +9,7 @@ import Control.Monad.Writer (runWriterT)
 import qualified Data (RW(..))
 import Data.Map (Map, (!?))
 import qualified Game (Key, T, new, play)
-import qualified Hanafuda.KoiKoi as KoiKoi (Game(..), Step(..))
+import qualified Hanafuda.KoiKoi as KoiKoi (GameBlueprint(..), Step(..))
 import qualified Session (Status(..), T(..), Update)
 import qualified Server (endGame, get, logIn, logOut, update, register, room)
 import qualified App (Context(..), T, current, debug, get, server, try, update, update_)
diff --git a/src/Game.hs b/src/Game.hs
index 8b29eff..7569bc3 100644
--- a/src/Game.hs
+++ b/src/Game.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -15,70 +14,33 @@ module Game (
   ) where
 
 import Control.Monad.Except (throwError)
-import Data.Text (pack)
 import Data.Map (mapWithKey)
-import Data.HashMap.Strict (insert)
-import Data.Aeson (ToJSON(..), ToJSONKey(..), Value(..), defaultOptions, genericToEncoding)
-import Data.Aeson.Types (toJSONKeyText)
 import qualified Data (Key)
-import qualified Hanafuda (Flower(..), Pack, cardsOfPack, empty)
-import qualified Hanafuda.KoiKoi (Game(..), Environment, Mode(..), Move(..), PlayerKey, Score, Step(..), Yaku(..), new, play)
+import qualified Hanafuda (empty)
+import qualified Hanafuda.KoiKoi (Game, Environment, Mode(..), Move(..), PlayerKey, new, play)
+import Hanafuda.KoiKoi (GameBlueprint(..))
 import qualified Hanafuda.Player (Player(..), Players(..))
-import Hanafuda.Message()
-import GHC.Generics
+import Hanafuda.Message (PublicGame)
 
-deriving instance Generic Hanafuda.Flower
-deriving instance Generic Hanafuda.KoiKoi.Mode
-deriving instance Generic Hanafuda.KoiKoi.Yaku
-deriving instance Generic Hanafuda.KoiKoi.Step
 
 type T = Hanafuda.KoiKoi.Game
 
-deriving instance Generic T
-
-instance ToJSON T where
-  toEncoding = genericToEncoding defaultOptions
-
-instance ToJSON Hanafuda.Flower
-
-instance ToJSON Hanafuda.Pack where
-  toJSON = toJSON . Hanafuda.cardsOfPack
-  toEncoding = toEncoding . Hanafuda.cardsOfPack
-
-instance ToJSON Hanafuda.KoiKoi.Mode
-
-instance ToJSON Hanafuda.KoiKoi.Step where
-  toEncoding = genericToEncoding defaultOptions
-
-instance ToJSON (Hanafuda.Player.Player Hanafuda.KoiKoi.Score) where
-  toJSON = toJSON
-  toEncoding = toEncoding
-
-instance ToJSON Hanafuda.KoiKoi.Yaku where
-  toEncoding = genericToEncoding defaultOptions
-instance ToJSONKey Hanafuda.KoiKoi.Yaku where
-  toJSONKey = toJSONKeyText (pack . show)
-
-instance ToJSON (Hanafuda.Player.Players Hanafuda.KoiKoi.Score) where
-  toJSON = toJSON
-  toEncoding = toEncoding
-
 type Key = Data.Key T
 
 new :: Hanafuda.KoiKoi.PlayerKey -> Hanafuda.KoiKoi.PlayerKey -> IO T
 new p1 p2 = do
   Hanafuda.KoiKoi.new [p1, p2] $ Hanafuda.KoiKoi.WholeYear
 
-export :: Hanafuda.KoiKoi.PlayerKey -> T -> Value
-export key game = Object $ insert "deck" (toJSON $ length $ Hanafuda.KoiKoi.deck game) $ ast
+export :: Hanafuda.KoiKoi.PlayerKey -> T -> PublicGame
+export key game = game {
+      deck = length $ deck game
+    , players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered
+  }
   where
     Hanafuda.Player.Players unfiltered = Hanafuda.KoiKoi.players game
     maskOpponentsHand k player
       | k == key = player
       | otherwise = player {Hanafuda.Player.hand = Hanafuda.empty}
-    Object ast = toJSON $ game {
-        Hanafuda.KoiKoi.players = Hanafuda.Player.Players $ mapWithKey maskOpponentsHand unfiltered
-      }
 
 play :: Hanafuda.KoiKoi.Environment m => Hanafuda.KoiKoi.PlayerKey -> Hanafuda.KoiKoi.Move -> T -> m T
 play key move game
diff --git a/src/Messaging.hs b/src/Messaging.hs
index a19df27..0bc5a3c 100644
--- a/src/Messaging.hs
+++ b/src/Messaging.hs
@@ -24,7 +24,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 (Action, Game(..), PlayerKey)
+import qualified Hanafuda.KoiKoi as KoiKoi (Action, GameBlueprint(..), PlayerKey)
 import qualified Hanafuda.Message as Message (T)
 import Hanafuda.Message (FromClient(..), T(..))