Get rid of modules rendered obsolete by recent refactoring

.gitignore

@@ -1,3 +1 @@
-/dist*
-cabal.project.local
-.ghc*
+/dist/*

ChangeLog.md

@@ -1,10 +1,5 @@
 # Revision history for hanafudapi
 
-## 0.2.3.0  -- 2019-08-24
-
-* Huge refactoring to use the new APILanguage that basically vampirized Game module which become more of a toolbox for the Automaton
-* Fix a couple race conditions in JS client and server encountered when developping and testing Hannah the bot soon to come
-
 ## 0.2.2.0  -- 2019-08-12
 
 * Handle the end of games

hanafuda-webapp.cabal

@@ -2,14 +2,14 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                hanafuda-webapp
-version:             0.2.3.0
+version:             0.2.2.0
 synopsis:            A webapp for the Haskell hanafuda library
 -- description:         
-homepage:            https://git.marvid.fr/hanafuda
+homepage:            https://framagit.org/hanafuda
 license:             BSD3
 license-file:        LICENSE
-author:              Tissevert
-maintainer:          tissevert+devel@marvid.fr
+author:              Sasha
+maintainer:          sasha+frama@marvid.fr
 -- copyright:           
 category:            Web
 build-type:          Simple
@@ -17,7 +17,7 @@ extra-source-files:  ChangeLog.md
 cabal-version:       >=1.10
 source-repository head
   type:              git
-  location:          https://git.marvid.fr/hanafuda/webapp
+  location:          https://framagit.org/hanafuda/api
 
 executable hanafudapi
   main-is:             Main.hs
@@ -26,7 +26,7 @@ executable hanafudapi
                      , Config
                      , Messaging
                      , Game
-                     , RW
+                     , Data
                      , Server
                      , Session
   -- other-extensions:    
@@ -34,8 +34,8 @@ executable hanafudapi
                      , bytestring
                      , containers >= 0.5.9
                      , unordered-containers
-                     , hanafuda >= 0.3.3
-                     , hanafuda-APILanguage >= 0.1.0
+                     , hanafuda >= 0.3.0
+                     , hanafuda-APILanguage
                      , http-types
                      , aeson
                      , mtl

src/App.hs

@@ -12,13 +12,13 @@ module App (
     , update_
   ) where
 
+import Data.Map ((!))
 import Control.Concurrent (MVar, modifyMVar, putMVar, readMVar, takeMVar)
 import Control.Monad.Reader (ReaderT(..), ask, asks, lift)
-import Data.Map ((!))
-import Hanafuda.KoiKoi (PlayerID)
 import Network.WebSockets (Connection)
-import qualified Server (T(..))
+import Hanafuda.KoiKoi (PlayerID)
 import qualified Session (T(..))
+import qualified Server (T(..))
 
 data Context = Context {
       mServer :: MVar Server.T

src/Automaton.hs

@@ -3,20 +3,20 @@ module Automaton (
     start
   ) where
 
-import qualified App (Context(..), T, current, debug, get, server, try, update_)
 import Control.Monad.Reader (asks)
+import qualified Data (RW(..))
 import Data.Map (Map, (!?))
 import qualified Game (new, play)
 import qualified Hanafuda.KoiKoi as KoiKoi (
     Game, GameBlueprint(..), GameID, Step(..)
   )
+import qualified Session (Status(..), T(..), Update)
+import qualified Server (endGame, get, logIn, logOut, update, room)
+import qualified App (Context(..), T, current, debug, get, server, try, update_)
 import qualified Hanafuda.Message as Message (FromClient(..), T(..))
 import qualified Messaging (
     broadcast, get, notifyPlayers, relay, send, sendTo, update
   )
-import qualified RW (RW(..))
-import qualified Server (endGame, get, logIn, logOut, update, room)
-import qualified Session (Status(..), T(..), Update)
 
 receive :: Session.Status -> Message.FromClient -> App.T ()
 
@@ -36,7 +36,7 @@ receive (Session.LoggedIn True) invitation@(Message.Invitation {Message.to}) = d
   case Session.status session of
     Session.LoggedIn True -> do
       from <- asks App.playerID
-      App.update_ (Server.update to (RW.set $ Session.Answering from :: Session.Update))
+      App.update_ (Server.update to (Data.set $ Session.Answering from :: Session.Update))
       Messaging.broadcast $ Messaging.update {Message.paired = [from, to]}
       (Messaging.relay invitation $ Messaging.sendTo [to])
       setSessionStatus (Session.Waiting to)
@@ -58,7 +58,7 @@ receive (Session.Answering to) message@(Message.Answer {Message.accept}) = do
           else do
             Messaging.broadcast $ Messaging.update {Message.alone = [for, to]}
             return $ Session.LoggedIn True
-      App.update_ $ Server.update to (RW.set newStatus :: Session.Update)
+      App.update_ $ Server.update to (Data.set newStatus :: Session.Update)
       setSessionStatus newStatus
     _ -> sendError "They're not waiting for your answer"
 
@@ -77,7 +77,7 @@ receive (Session.Playing gameID) played@(Message.Play {}) = do
       Messaging.notifyPlayers newGame logs
 
 receive (Session.Playing gameID) Message.Quit = do
-  games <- (RW.get <$> App.server :: App.T (Map KoiKoi.GameID KoiKoi.Game))
+  games <- (Data.get <$> App.server :: App.T (Map KoiKoi.GameID KoiKoi.Game))
   case games !? gameID of
     Nothing -> do
       playerID <- asks App.playerID
@@ -93,7 +93,7 @@ sendError = Messaging.send . Message.Error
 setSessionStatus :: Session.Status -> App.T ()
 setSessionStatus newStatus = do
   playerID <- asks App.playerID
-  App.update_ $ Server.update playerID $ (RW.set newStatus :: Session.Update)
+  App.update_ $ Server.update playerID $ (Data.set newStatus :: Session.Update)
   App.debug $ show newStatus
 
 loop :: App.T ()

src/Data.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
-module RW (
+module Data (
     RW(..)
   ) where
 

src/Game.hs

@@ -10,12 +10,12 @@ import Control.Monad.Reader (lift)
 import Control.Monad.Writer (runWriterT)
 import Data.Map (mapWithKey)
 import qualified Hanafuda (empty)
-import Hanafuda.KoiKoi (Game, GameBlueprint(..), GameID, Mode(..), PlayerID)
 import qualified Hanafuda.KoiKoi as KoiKoi (
     Action, Move(..), play, new
   )
-import Hanafuda.Message (PublicGame)
+import Hanafuda.KoiKoi (Game, GameBlueprint(..), GameID, Mode(..), PlayerID)
 import qualified Hanafuda.Player (Player(..), Players(..))
+import Hanafuda.Message (PublicGame)
 import qualified Server (register)
 
 new :: (PlayerID, PlayerID) -> App.T GameID

src/Main.hs

@@ -2,21 +2,21 @@
 {-# LANGUAGE NamedFieldPuns #-}
 module Main where
 
-import qualified App (Context(..), T, update_)
-import qualified Automaton (start)
-import qualified Config (listenPort)
+import Network.Wai.Handler.Warp (run)
+import Network.HTTP.Types.Status (badRequest400)
+import Network.WebSockets (ServerApp, acceptRequest, defaultConnectionOptions)
+import Network.Wai.Handler.WebSockets (websocketsOr)
+import Network.Wai (responseLBS)
+import Control.Monad.Reader (ReaderT(..), asks)
 import Control.Concurrent (newMVar, modifyMVar)
 import Control.Exception (finally)
-import Control.Monad.Reader (ReaderT(..), asks)
+import qualified Config (listenPort)
+import qualified Session (open)
+import qualified Server (disconnect, new, register)
+import qualified App (Context(..), T, update_)
 import qualified Hanafuda.Message as Message (FromClient(..))
 import Messaging (broadcast, relay)
-import Network.HTTP.Types.Status (badRequest400)
-import Network.Wai (responseLBS)
-import Network.Wai.Handler.Warp (run)
-import Network.Wai.Handler.WebSockets (websocketsOr)
-import Network.WebSockets (ServerApp, acceptRequest, defaultConnectionOptions)
-import qualified Server (disconnect, new, register)
-import qualified Session (open)
+import qualified Automaton (start)
 
 exit :: App.T ()
 exit = do

src/Messaging.hs

@@ -13,20 +13,20 @@ module Messaging (
     , update
   ) where
 
-import qualified App (Context(..), T, connection, debug, server)
-import Control.Monad.Reader (asks, lift)
-import Data.Aeson (eitherDecode', encode)
-import Data.ByteString.Lazy.Char8 (unpack)
-import Data.Foldable (forM_)
 import Data.List (intercalate)
+import Data.Foldable (forM_)
 import Data.Map (keys)
-import qualified Hanafuda.KoiKoi as KoiKoi (Action, Game, GameBlueprint(..), PlayerID)
-import Hanafuda.Message (FromClient(..), T(..))
-import qualified Hanafuda.Message as Message (T)
+import Data.Aeson (eitherDecode', encode)
 import Network.WebSockets (receiveData, sendTextData)
+import Data.ByteString.Lazy.Char8 (unpack)
+import Control.Monad.Reader (asks, lift)
 import qualified Game (export)
-import qualified Server (T(..), get)
 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, GameBlueprint(..), PlayerID)
+import qualified Hanafuda.Message as Message (T)
+import Hanafuda.Message (FromClient(..), T(..))
 
 sendTo :: [KoiKoi.PlayerID] -> Message.T -> App.T ()
 sendTo playerIDs obj = do

src/Server.hs

@@ -23,7 +23,7 @@ import qualified Data.Set as Set (delete, empty, insert)
 import Data.Text (Text)
 import Hanafuda.KoiKoi (Game, GameID, PlayerID)
 import Hanafuda.Message (PlayerStatus(..), Room)
-import qualified RW (RW(..))
+import qualified Data (RW(..))
 import qualified Session (Status(..), T(..), Update)
 
 type Names = Set Text
@@ -37,19 +37,19 @@ data T = T {
     , games :: Games
   }
 
-instance RW.RW Names T where
+instance Data.RW Names T where
   get = names
   set names server = server {names}
 
-instance RW.RW Players T where
+instance Data.RW Players T where
   get = players
   set players server = server {players}
 
-instance RW.RW Sessions T where
+instance Data.RW Sessions T where
   get = sessions
   set sessions server = server {sessions}
 
-instance RW.RW Games T where
+instance Data.RW Games T where
   get = games
   set games server = server {games}
 
@@ -72,31 +72,31 @@ new = T {
     , games = Map.empty
   }
 
-register :: forall a b. (Enum a, Ord a, RW.RW (Map a b) T) => b -> T -> (T, a)
+register :: forall a b. (Enum a, Ord a, Data.RW (Map a b) T) => b -> T -> (T, a)
 register x server =
-  let playerID = maybe (toEnum 0) (\(n, _) -> succ n) $ lookupMax $ (RW.get server :: Map a b) in
-  (RW.update (insert playerID x) server, playerID)
+  let playerID = maybe (toEnum 0) (\(n, _) -> succ n) $ lookupMax $ (Data.get server :: Map a b) in
+  (Data.update (insert playerID x) server, playerID)
 
-get :: forall a b. (Ord a, RW.RW (Map a b) T) => a -> T -> b
-get playerID server = (RW.get server :: Map a b) ! playerID
+get :: forall a b. (Ord a, Data.RW (Map a b) T) => a -> T -> b
+get playerID server = (Data.get server :: Map a b) ! playerID
 
-update :: forall a b. (Ord a, RW.RW (Map a b) T) => a -> (b -> b) -> T -> T
+update :: forall a b. (Ord a, Data.RW (Map a b) T) => a -> (b -> b) -> T -> T
 update playerID updator =
-  RW.update (adjust updator playerID :: Map a b -> Map a b)
+  Data.update (adjust updator playerID :: Map a b -> Map a b)
 
 disconnect :: PlayerID -> T -> T
 disconnect playerID =
-  RW.update (delete playerID :: Sessions -> Sessions) . logOut playerID
+  Data.update (delete playerID :: Sessions -> Sessions) . logOut playerID
 
 endGame :: GameID -> T -> T
 endGame playerID =
-  RW.update (delete playerID :: Games -> Games)
+  Data.update (delete playerID :: Games -> Games)
 
 logIn :: Text -> PlayerID -> T -> Either String T
 logIn name playerID server =
-  RW.update (Set.insert name) .
-  RW.update (insert playerID name) .
-  update playerID (RW.set $ Session.LoggedIn True :: Session.Update) <$>
+  Data.update (Set.insert name) .
+  Data.update (insert playerID name) .
+  update playerID (Data.set $ Session.LoggedIn True :: Session.Update) <$>
   if name `member` names server
     then Left "This name is already registered"
     else Right server
@@ -106,7 +106,7 @@ logOut playerID server =
   maybe
     server
     (\playerName ->
-      RW.update (delete playerID :: Players -> Players) $
-      update playerID (RW.set $ Session.LoggedIn False :: Session.Update) $
-      RW.update (Set.delete playerName :: Names -> Names) server)
+      Data.update (delete playerID :: Players -> Players) $
+      update playerID (Data.set $ Session.LoggedIn False :: Session.Update) $
+      Data.update (Set.delete playerName :: Names -> Names) server)
     (players server !? playerID)

src/Session.hs

@@ -7,9 +7,9 @@ module Session (
     , open
   ) where
 
-import Hanafuda.KoiKoi (GameID, PlayerID)
 import Network.WebSockets (Connection)
-import qualified RW (RW(..))
+import Hanafuda.KoiKoi (GameID, PlayerID)
+import qualified Data (RW(..))
 
 data Status =
     LoggedIn Bool
@@ -24,7 +24,7 @@ data T = T {
   }
 type Update = T -> T
 
-instance RW.RW Status T where
+instance Data.RW Status T where
   get = status
   set status session = session {status}
 

www/game.js

@@ -9,7 +9,6 @@ function Game(modules) {
   };
   var sets = buildSets();
   var selected = null;
-  var turnedCard = null;
 	var queue = [];
 
   function buildSets() {
@@ -175,8 +174,7 @@ function Game(modules) {
 					movingCards.push([sets[side].hand, dest, card]);
 				} else {
 					var cardSet = {};
-					cardSet[card.name] = turnedCard || new TurnedCard(card.name);
-					turnedCard = null;
+					cardSet[card.name] = turnedCard(card.name);
 					movingCards.push([{card: cardSet, dom: deck}, dest, card]);
 				}
 				return movingCards;
@@ -191,7 +189,7 @@ function Game(modules) {
 
   function moveCard(fromSet, toSet, card) {
     var from, originalCard;
-    var slot = modules.dom.make('li', {class: ['card', 'slot']});
+		var slot = modules.dom.make('li', {class: ['card', 'slot']});
     if (fromSet.card[card.name] != undefined) {
 			originalCard = fromSet.card[card.name].dom;
 			delete fromSet.card[card.name];
@@ -302,11 +300,18 @@ function Game(modules) {
     }
   }
 
+	function turnedCard(cardName) {
+    var card = new Card(cardName);
+    card.dom.id = "turned";
+    deck.appendChild(card.dom);
+		return card;
+	}
+
   function setTurned(cardName) {
-		turnedCard = new TurnedCard(cardName);
+		turnedCard(cardName);
     if(status.playing) {
-      selected = turnedCard;
-      showCandidates(modules.hanafuda.Card[cardName], true);
+      selected = cardName;
+      showCandidates(modules.hanafuda.Card[selected], true);
     }
   }
 
@@ -314,12 +319,6 @@ function Game(modules) {
     matchingInRiver(card).forEach(function(riverCard) {riverCard.setCandidate(yes);});
   }
 
-  function setSelected(yes) {
-    selected = yes ? this : null;
-    this.dom.classList.toggle('selected', yes);
-    showCandidates(this.value, yes);
-  }
-
   function Card(name) {
     this.value = modules.hanafuda.Card[name];
     this.name = name;
@@ -344,8 +343,9 @@ function Game(modules) {
     var card = this;
     return function() {
       if(card.candidate) {
-        var withCard = selected.name;
-        selected.setSelected(false);
+        var withCard = selected;
+        selected = null;
+				showCandidates(card.value, false);
         play(
           status.step == 'ToPlay' ? {capture: [withCard, card.name]} : {choose: card.name}
         );
@@ -358,15 +358,6 @@ function Game(modules) {
     this.dom.classList.toggle("candidate", yes);
   }
 
-  function TurnedCard() {
-    Card.apply(this, arguments);
-    this.dom.id = "turned";
-    deck.appendChild(this.dom);
-  }
-
-  TurnedCard.prototype.onClick = Card.prototype.onClick;
-  TurnedCard.prototype.setSelected = setSelected;
-
   function HandCard() {
     Card.apply(this, arguments);
   }
@@ -376,7 +367,7 @@ function Game(modules) {
     return function() {
       if(status.playing && status.step == "ToPlay") {
         if(selected != undefined) {
-          selected.setSelected(false);
+          sets.you.hand.card[selected].setSelected(false);
         } else {
           card.play();
         }
@@ -384,7 +375,11 @@ function Game(modules) {
     };
   };
 
-  HandCard.prototype.setSelected = setSelected;
+  HandCard.prototype.setSelected = function(yes) {
+    selected = yes ? this.name : null;
+    this.dom.classList.toggle('selected', yes);
+    showCandidates(this.value, yes);
+  }
 
   HandCard.prototype.play = function() {
     var matching = matchingInRiver(this.value);

www/index.html

@@ -70,6 +70,6 @@
     </div>
     <div id="dialog">
     </div>
-    <p id="error"></p>
+    <p id="debug"></p>
   </body>
 </html>

www/main.js

@@ -5,7 +5,7 @@ window.addEventListener('load', function() {
   var i18n = I18n({translations: translations});
   var fun = Fun();
   var screen = Screen({dom: dom, i18n: i18n});
-  var messaging = Messaging({screen: screen});
+  var messaging = Messaging();
   var session = Session({messaging: messaging});
   var room = Room({dom: dom, messaging: messaging, session: session, fun: fun});
   var statusHandler = StatusHandler();

www/messaging.js

@@ -1,4 +1,4 @@
-function Messaging(modules) {
+function Messaging(screen) {
   var ws = new WebSocket(window.location.origin.replace(/^http/, 'ws') + '/play/');
   var debug = getParameters().debug;
   var doLog = debug != undefined && debug.match(/^(?:1|t(?:rue)?|v(?:rai)?)$/i);
@@ -53,7 +53,7 @@ function Messaging(modules) {
     if(route != undefined && route.callbacks != undefined) {
       route.callbacks.forEach(function(f) {f(o);});
     } else {
-      console.log("No route found for " + event.data);
+      debug.textContent = event.data;
     }
     o.direction = 'client < server';
     log(o);
@@ -69,7 +69,6 @@ function Messaging(modules) {
     ws.addEventListener('message', messageListener);
     ws.addEventListener('open', ping);
     addEventListener(["Pong"], ping);
-    addEventListener(["Error"], function(o) {modules.screen.error(o.error);});
   }
 
   function send(o) {

www/screen.css

@@ -33,22 +33,3 @@ body > div.on {
 #dialog button {
   display: inline-block;
 }
-
-#error {
-  position: absolute;
-  z-index: 1;
-  top: 1em;
-  right: 1em;
-  max-width: 20em;
-  border: 1px solid #e0afac;
-  padding: 1em;
-  border-radius: 0.5em;
-  background: bisque;
-  cursor: pointer;
-  margin: 0;
-  display: none;
-}
-
-#error.on {
-  display: block;
-}

www/screen.js

@@ -1,12 +1,7 @@
 function Screen(modules) {
   var current = document.querySelector("body > div.on");
-  var errorBox = document.getElementById('error');
-  errorBox.addEventListener('click', function() {
-    errorBox.className = "";
-  });
 
   return {
-    error: error,
     dialog: dialog,
     select: select
   };
@@ -40,9 +35,4 @@ function Screen(modules) {
     layer.appendChild(dialog);
     layer.className = "on";
   }
-
-  function error(message) {
-    errorBox.textContent = message;
-    errorBox.className = "on";
-  }
 }