Update frontend

3 files changed, 85 insertions, 25 deletions

diff --git a/fig-frontend/src/Fig/Frontend.hs b/fig-frontend/src/Fig/Frontend.hs
index fa1965a..036420a 100644
--- a/fig-frontend/src/Fig/Frontend.hs
+++ b/fig-frontend/src/Fig/Frontend.hs
@@ -2,41 +2,58 @@ module Fig.Frontend where
 
 import Fig.Prelude
 
+import Control.Lens (use)
+
 import qualified Network.Wai.Middleware.Static as Wai.Static
 import qualified Network.Wai.Handler.Warp as Warp
 
 import qualified Web.Twain as Tw
 
 import qualified Lucid as L
+import qualified Lucid.Base as L
 
 import Fig.Frontend.Utils
 import Fig.Frontend.Auth
+import Fig.Frontend.State
 
 server :: Config -> IO ()
 server cfg = do
   log $ "Frontend server running on port " <> tshow cfg.port
-  Warp.run cfg.port $ app cfg
-
-app :: Config -> Tw.Application
-app cfg = foldr' @[] ($)
-  (Tw.notFound . Tw.send $ Tw.text "not found")
-  [ Wai.Static.staticPolicy $ Wai.Static.addBase cfg.assetPath
-  , Tw.get "/"
-    . Tw.send . Tw.html
-    . L.renderBS
-    $ L.doctypehtml_ do
-        L.head_ do
-          L.title_ "The Junkyard"
-          L.link_ [L.rel_ "stylesheet", L.href_ "js/index.css"]
-          L.link_ [L.rel_ "stylesheet", L.href_ "https://fonts.googleapis.com/css?family=Rubik+Maps"]
-          L.link_ [L.rel_ "icon", L.href_ "data:;base64,iVBORw0KGgo="]
-          L.script_ [L.type_ "module", L.src_ "js/index.js"] ("" :: L.Html ())
-        L.body_ do
-          L.term "fig-backdrop" ""
-          L.term "fig-header" ""
-          L.term "fig-login" ""
-          L.term "fig-window" do
-            L.h1_ "hello"
-  , Tw.get "/api/check" $ authed cfg \auth -> do
-      Tw.send $ Tw.json @[Text] [auth.id, auth.name]
-  ]
+  Warp.run cfg.port =<< app cfg
+
+window :: Text -> Text -> L.Html () -> L.Html ()
+window id_ title body = 
+  L.term "fig-window" [L.id_ id_, L.makeAttributes "title" title] do
+    body
+
+app :: Config -> IO Tw.Application
+app cfg = do
+  st <- stateRef
+  pure $ foldr' @[] ($)
+    (Tw.notFound . Tw.send $ Tw.text "not found")
+    [ Wai.Static.staticPolicy $ Wai.Static.addBase cfg.assetPath
+    , Tw.get "/"
+      . Tw.send . Tw.html
+      . L.renderBS
+      $ L.doctypehtml_ do
+          L.head_ do
+            L.title_ "The Junkyard"
+            L.link_ [L.rel_ "stylesheet", L.href_ "js/index.css"]
+            L.link_ [L.rel_ "stylesheet", L.href_ "https://fonts.googleapis.com/css?family=Rubik+Maps"]
+            L.link_ [L.rel_ "icon", L.href_ "data:;base64,iVBORw0KGgo="]
+            L.script_ [L.type_ "module", L.src_ "js/index.js"] ("" :: L.Html ())
+          L.body_ do
+            L.term "fig-backdrop" ""
+            L.term "fig-header" ""
+            L.term "fig-footer" ""
+            window "test1" "window one" do
+              L.p_ "Deserunt consequatur neque autem. Dicta assumenda autem consequatur sunt animi. Dolor voluptatem rerum aut id ut vel. Labore soluta itaque voluptas dolores repellat. Voluptatem dolor fugit necessitatibus amet et natus velit. Enim nihil voluptate qui quasi architecto. Reprehenderit porro aperiam eaque sequi veritatis in quos. Odio tenetur labore cupiditate nisi. Deserunt aut dolore consequuntur inventore quod veniam commodi. Incidunt qui sequi dolor. Quia adipisci dolores ab. Dolor molestias est earum ea. Possimus ullam repellat qui consequatur dolorem excepturi non. Incidunt magnam quaerat temporibus quisquam. Vero nihil possimus ratione voluptas sunt. Qui quisquam ipsa omnis est totam iure odio. Ab fugiat in id nisi. Dolor sit est soluta eaque ut eveniet. Eveniet rerum fuga doloremque repellendus eligendi sunt asperiores. Tenetur iure vitae ea sapiente et. Aspernatur natus aut rerum magnam occaecati. Veritatis exercitationem necessitatibus assumenda est assumenda eaque molestiae."
+            window "test2" "window two" do
+              L.h1_ "hello"
+            L.term "fig-gizmo" [L.id_ "gizmo1"] ""
+    , Tw.get "/api/check" $ authed cfg \auth -> do
+        Tw.send $ Tw.json @[Text] [auth.id, auth.name]
+    , Tw.put "/api/buffer" do
+        buf <- withState st $ use buffer 
+        Tw.send $ Tw.text buf
+    ]
diff --git a/fig-frontend/src/Fig/Frontend/State.hs b/fig-frontend/src/Fig/Frontend/State.hs
new file mode 100644
index 0000000..6053105
--- /dev/null
+++ b/fig-frontend/src/Fig/Frontend/State.hs
@@ -0,0 +1,41 @@
+{-# Language TemplateHaskell #-}
+
+module Fig.Frontend.State where
+
+import Control.Lens.TH (makeLensesFor)
+import Control.Lens ((<>=))
+import Control.Monad.State (runStateT)
+
+import Fig.Prelude
+
+import qualified Data.IORef as IORef
+
+newtype State = State
+  { buffer :: Text
+  }
+makeLensesFor [("buffer", "buffer")] ''State
+
+defaultState :: State
+defaultState = State
+  { buffer = ""
+  }
+
+type StateRef = IORef.IORef State
+
+stateRef :: IO StateRef
+stateRef = IORef.newIORef defaultState
+
+withState ::
+  MonadIO m' =>
+  StateRef ->
+  (forall m. (MonadIO m, MonadState State m) => m a) ->
+  m' a
+withState ref f = do
+  s <- liftIO $ IORef.readIORef ref
+  (res, s') <- liftIO $ runStateT f s
+  liftIO $ IORef.writeIORef ref s'
+  pure res
+
+sayHi :: StateRef -> IO ()
+sayHi ref = withState ref do
+  buffer <>= "hi"
diff --git a/fig-frontend/src/Fig/Frontend/Utils.hs b/fig-frontend/src/Fig/Frontend/Utils.hs
index 1ba1d5f..20234e7 100644
--- a/fig-frontend/src/Fig/Frontend/Utils.hs
+++ b/fig-frontend/src/Fig/Frontend/Utils.hs
@@ -22,6 +22,7 @@ data Config = Config
   { port :: Int
   , assetPath :: FilePath
   , clientId :: Text
+  , authToken :: Text
   } deriving (Show, Eq, Ord)
 
 configCodec :: Toml.TomlCodec Config
@@ -29,6 +30,7 @@ configCodec = do
   port <- Toml.int "port" Toml..= (\a -> a.port)
   assetPath <- Toml.string "asset_path" Toml..= (\a -> a.assetPath)
   clientId <- Toml.text "client_id" Toml..= (\a -> a.clientId)
+  authToken <- Toml.text "auth_token" Toml..= (\a -> a.authToken)
   pure $ Config{..}
 
 loadConfig :: FilePath -> IO Config