Rewrite GameChannel

app/frontend/packs/App/App.purs

@@ -6,7 +6,9 @@ import App.Channel.GameChannel as GameChannel
 import App.Command.Command as Command
 import App.Command.CommandGroup as CommandGroup
 import App.Command.CommandManager as CommandManager
+import App.Drawer.PieceActor as PieceActor
 import App.EaselJS.Rectangle as Rectangle
+import App.EaselJS.Stage as Stage
 import App.EaselJS.Ticker as Ticker
 import App.Game (Game)
 import App.Game as Game
@@ -25,9 +27,11 @@ import Data.Array as Array
 import Data.Int as Int
 import Data.String (Pattern(..))
 import Data.String as String
-import Effect.Aff (Aff, error, launchAff_, parallel, sequential, throwError)
+import Debug.Trace (traceM)
+import Effect.Aff (Aff, launchAff_, parallel, sequential)
 import Effect.Class (liftEffect)
 import Effect.Class.Console (log)
+import Effect.Ref as Ref
 import Web.DOM (Element)
 import Web.DOM.Document as Document
 import Web.DOM.Element as Element
@@ -81,13 +85,14 @@ play app = do
 
   pictureUrl <- dataset' "picture" app.playboard
   launchAff_ do
-    obj <- sequential $
-      { image: _, puzzle: _ }
+    { image, content: puzzle /\ subscription } <- sequential $
+      { image: _, content: _ }
       <$> parallel (Utils.loadImage pictureUrl)
       <*> parallel (setupPuzzle gameId app)
     gi <- liftEffect do
       Logger.info "game ready"
-      game <- Game.create gameId obj.puzzle obj.image
+      game <- Game.create gameId puzzle image
+      CommandManager.register game
       setupUi game app
       setupSound app
 
@@ -105,36 +110,69 @@ play app = do
       Utils.fadeOutSlow app.picture
       pure gi
 
-    updateGame gi
+    subscription # maybe
+      (liftEffect $ GameInteractor.shuffle gi)
+      (updateOnlineGame gi)
+
     liftEffect do
       Logger.info "game updated"
+      GameInteractor.fit gi
       query "#game-progress .loading"
         >>= Utils.fadeOutSlow
       GameInteractor.fit gi
     pure unit
 
 
-setupPuzzle :: Int -> App -> Aff Puzzle
+setupPuzzle
+  :: Int -> App -> Aff (Puzzle /\ Maybe GameChannel.Subscription)
 setupPuzzle gameId app = do
-  bool setupStandalonePuzzle setupOnlinePuzzle (0 < gameId) app
+  bool (setupStandalonePuzzle app) (setupOnlinePuzzle gameId) (0 < gameId)
 
-setupStandalonePuzzle :: App -> Aff Puzzle
+
+setupStandalonePuzzle
+  :: App -> Aff (Puzzle /\ Maybe GameChannel.Subscription)
 setupStandalonePuzzle app = liftEffect do
   Logger.info $ "standalone: " <> show true
-  dataset' "puzzle-content" app.playboard
+  puzzle <- dataset' "puzzle-content" app.playboard
     >>= query
     >>= Element.toNode >>> Node.textContent
     >>= Puzzle.parse
+  pure $ puzzle /\ Nothing
+
+
+setupOnlinePuzzle
+  :: Int -> Aff (Puzzle /\ Maybe GameChannel.Subscription)
+setupOnlinePuzzle gameId = do
+  sub <- GameChannel.subscribe gameId
+  Logger.info $ "subscribing: GameChannel-" <> show gameId
+  json <- GameChannel.requestContent sub
+  puzzle <- liftEffect $ Puzzle.decode json # throwOnLeft
+  pure $ puzzle /\ pure sub
+
+
+updateOnlineGame :: GameInteractor -> GameChannel.Subscription -> Aff Unit
+updateOnlineGame gi sub = do
+  liftEffect $ CommandManager.onCommit \group -> do
+    when group.extrinsic do
+      Ref.read group.commands
+        >>= traverse_ \cmd -> do
+          PieceActor.updateFace =<< Game.findPieceActor gi.game (Command.pieceId cmd)
+      Stage.invalidate gi.baseStage
+    when (not group.extrinsic) do
+      GameChannel.commit sub =<< Ref.read group.commands
+
+  GameChannel.requestUpdate sub
+
+  -- connectGameChannel :: Game -> Effect Unit
+  -- connectGameChannel game = do
+  --   sub <- GameChannel.subscribe game
+  --   CommandManager.onCommit(GameChannel.commit sub)
+  --   CommandManager.onCommit \cmds -> do
+  --     f <- CommandGroup.any Command.isMerge cmds
+  --     when (not cmds.extrinsic && f) $
+  --       Game.progress game
+  --       >>= GameChannel.reportProgress sub
 
-setupOnlinePuzzle :: App -> Aff Puzzle
-setupOnlinePuzzle app = throwError (error "Not implemented")
-
-updateGame :: GameInteractor -> Aff Unit
-updateGame gi =
-  liftEffect
-  $ when gi.game.isStandalone do
-    GameInteractor.shuffle gi
-    GameInteractor.fit gi
 
 setupLogger :: App -> Effect Unit
 setupLogger app = do
@@ -144,6 +182,7 @@ setupLogger app = do
     Node.setTextContent msg $ Element.toNode p
     void $ Node.appendChild (Element.toNode p) (Element.toNode app.log)
 
+
 setupUi :: Game -> App -> Effect Unit
 setupUi game app = do
   Ticker.onTick do
@@ -184,11 +223,11 @@ setupUi game app = do
       addEventListener (EventType "click") listener false (Element.toEventTarget btn)
 
   CommandManager.onCommit \cmds -> do
-    progress <- Game.progress game
     f <- CommandGroup.any Command.isMerge cmds
-    when f $
+    when f do
+      progress <- Game.progress game
       query "#progressbar"
-      >>= Element.setAttribute "style" ("width:" <> show (progress * 100.0) <> "%")
+        >>= Element.setAttribute "style" ("width:" <> show (progress * 100.0) <> "%")
 
 
 setupSound :: App -> Effect Unit
@@ -201,16 +240,6 @@ setupSound app = do
       when (Command.isMerge cmd) $
         HTMLMediaElement.play elm
 
-connectGameChannel :: Game -> Effect Unit
-connectGameChannel game = do
-  sub <- GameChannel.subscribe game
-  CommandManager.onCommit(GameChannel.commit sub)
-  CommandManager.onCommit \cmds -> do
-    f <- CommandGroup.any Command.isMerge cmds
-    when (not cmds.extrinsic && f) $
-      Game.progress game
-      >>= GameChannel.report_progress sub
-
 
 -- * Helper functions
 

app/frontend/packs/App/Channel/GameChannel.js

@@ -1,10 +1,57 @@
-const GameChannel = require("../../channel/GameChannel.bs");
+const ActionCable = require("@rails/actioncable");
 
-exports.subscribe = game => () =>
-  GameChannel.subscribe(game);
+exports.createConsumer = ActionCable.createConsumer;
 
-exports.commit = subscriber => game => () =>
-  GameChannel.commit(subscriber, game);
+exports._createSubscription = identifier => funcs => consumer => (onError, onSuccess) => {
+  const sub = consumer.subscriptions.create(
+    identifier, {
+      received: data => {
+        console.log("received: " + data.action);
+        if (!sub.token) {
+          if (data.action === "init" && data.token) {
+            sub.token = data.token;
+            onSuccess(sub);
+          } else {
+            onError("Bad initialization");
+          };
+        } else if (sub["receive_" + data.action]) {
+          sub["receive_" + data.action](data);
+        } else if (funcs[data.action]) {
+          if (sub.token != data.token) {
+            funcs[data.action](data)();
+          };
+        };
+      }
+    });
+  return (cancelError, cancelerError, cancelerSuccess) => {
+    cancelerSuccess();
+  };
+};
 
-exports.report_progress = subscriber => x => () =>
-  GameChannel.report_progress(subscriber, x);
+const request = (sub, action, onError, onSuccess) => {
+  sub[`receive_${action}`] = data => {
+    if (data.success) {
+      if (data.content) {
+        onSuccess(JSON.parse(data.content));
+      } else {
+        onSuccess();
+      };
+    } else {
+      onError("Response is not success");
+    };
+  };
+  sub.perform(`request_${action}`, {});
+  return (cancelError, cancelerError, cancelerSuccess) => {
+    cancelerSuccess();
+  };
+};
+
+exports._requestContent = sub => (onError, onSuccess) =>
+  request(sub, "content", onError, onSuccess);
+
+exports._requestUpdate = sub => (onError, onSuccess) =>
+  request(sub, "update", onError, onSuccess);
+
+
+exports.perform = sub => name => payload => () =>
+  sub.perform(name, payload);

app/frontend/packs/App/Channel/GameChannel.purs

@@ -2,12 +2,70 @@ module App.Channel.GameChannel where
 
 import AppPrelude
 
-import App.Command.CommandGroup (CommandGroup)
-import App.Game (Game)
+import App.Command.Command (Command)
+import App.Command.CommandManager as CommandManager
+import Data.Argonaut (Json, decodeJson, encodeJson)
 import Effect (Effect)
+import Effect.Aff (Aff)
+import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
+import Effect.Class (liftEffect)
 
-foreign import data Subscriber :: Type
 
-foreign import subscribe :: Game -> Effect Subscriber
-foreign import commit :: Subscriber -> CommandGroup -> Effect Unit
-foreign import report_progress :: Subscriber -> Number -> Effect Unit
+foreign import data Consumer :: Type
+foreign import data Subscription :: Type
+
+foreign import createConsumer :: Effect Consumer
+
+foreign import _createSubscription :: forall funcs. Identifier -> funcs -> Consumer -> EffectFnAff Subscription
+
+createSubscription :: forall funcs. Identifier -> funcs -> Consumer -> Aff Subscription
+createSubscription identifier funcs consumer =
+  fromEffectFnAff $ _createSubscription identifier funcs consumer
+
+
+foreign import _requestContent :: Subscription -> EffectFnAff Json
+
+requestContent :: Subscription -> Aff Json
+requestContent sub =
+  fromEffectFnAff $ _requestContent sub
+
+
+foreign import _requestUpdate :: Subscription -> EffectFnAff Unit
+
+requestUpdate :: Subscription -> Aff Unit
+requestUpdate sub =
+  fromEffectFnAff $ _requestUpdate sub
+
+foreign import perform :: Subscription -> String -> Json -> Effect Unit
+
+
+type Identifier =
+  { channel :: String
+  , game_id :: Int
+  }
+
+type Data =
+  { action :: String
+  , commands :: Json
+  }
+
+subscribe :: Int -> Aff Subscription
+subscribe gameId =
+  liftEffect createConsumer
+  >>= createSubscription
+      { channel: "GameChannel", game_id: gameId }
+      { commit: onCommit
+      }
+
+onCommit :: { commands :: Json } -> Effect Unit
+onCommit { commands } = do
+  cmds <- throwOnLeft $ decodeJson commands
+  CommandManager.receive cmds
+
+commit :: Subscription -> Array Command -> Effect Unit
+commit sub commands =
+  perform sub "commit" $ encodeJson { commands }
+
+reportProgress :: Subscription -> Number -> Effect Unit
+reportProgress sub progress =
+  perform sub "report_progress" $ encodeJson { progress }