From 72e66a55f6803ae399012531bf44a6063f9eeca2 Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Sat, 8 Feb 2020 23:12:36 +0000
Subject: [PATCH] Add very basic client main

This client does not yet do anything besides displaying a single test node.
---
 client/Main.hs | 68 +++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 67 insertions(+), 1 deletion(-)

diff --git a/client/Main.hs b/client/Main.hs
index f0452d6..0652333 100644
--- a/client/Main.hs
+++ b/client/Main.hs
@@ -1,2 +1,68 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import           Brick
+import           Control.Concurrent.Chan
+import           Control.Exception
+import           Control.Monad
+import qualified Data.Text                  as T
+import qualified Graphics.Vty               as Vty
+import qualified Network.WebSockets         as WS
+
+import           Forest.Api
+import           Forest.Client.NodeEditor
+import           Forest.Client.ResourceName
+import           Forest.Client.Tree
+import           Forest.Tree
+import           Forest.Util
+
+{- Listening for server events -}
+
+data Event = EventNode Node | EventConnectionClosed T.Text
+
+wsClientApp :: Chan Event -> WS.ClientApp ()
+wsClientApp eventChan conn = handle handleConnectionException $ forever $ do
+  maybePacket <- receivePacket conn
+  case maybePacket of
+    Nothing -> pure ()
+    Just packet -> case packet of
+      ServerHello _ node  -> writeChan eventChan (EventNode node)
+      -- TODO properly insert node into existing tree
+      ServerUpdate _ node -> writeChan eventChan (EventNode node)
+  where
+    handleConnectionException :: WS.ConnectionException -> IO ()
+    handleConnectionException e =
+      writeChan eventChan $ EventConnectionClosed $ T.pack $ show e
+
+{- Brick client application-}
+
+data ClientState = ClientState
+  { csTree   :: Tree
+  , csEditor :: Maybe NodeEditor
+  }
+
+newClientState :: ClientState
+newClientState = ClientState
+  { csTree = newTree $ emptyNode "Connecting..." False False False False
+  , csEditor = Nothing
+  }
+
+clientDraw :: ClientState -> [Widget ResourceName]
+clientDraw cs = [renderTree (csEditor cs) (csTree cs)]
+
+clientHandleEvent :: ClientState -> BrickEvent ResourceName () -> EventM ResourceName (Next ClientState)
+clientHandleEvent cs (VtyEvent (Vty.EvKey (Vty.KChar 'q') [])) = halt cs
+clientHandleEvent cs _ = continue cs
+
+clientApp :: App ClientState () ResourceName
+clientApp = App
+  { appDraw = clientDraw
+  , appChooseCursor = showFirstCursor
+  , appHandleEvent = clientHandleEvent
+  , appStartEvent = pure
+  , appAttrMap = const $ attrMap Vty.defAttr []
+  }
+
 main :: IO ()
-main = putStrLn "The universe expands into itself."
+main = void $ defaultMain clientApp newClientState