From 9d3c32956baab4dc4e1fd114e586b48d850a14c9 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Tue, 4 Jun 2024 09:59:10 +0200
Subject: show form input

---
 frontend/app/Form/Input.hs    |  5 +++--
 frontend/app/Form/Internal.hs |  9 ++++-----
 frontend/app/Main.hs          | 40 +++++++++++++++++++++++-----------------
 3 files changed, 30 insertions(+), 24 deletions(-)

(limited to 'frontend/app')

diff --git a/frontend/app/Form/Input.hs b/frontend/app/Form/Input.hs
index a9648c4..4b1eac8 100644
--- a/frontend/app/Form/Input.hs
+++ b/frontend/app/Form/Input.hs
@@ -6,7 +6,7 @@ where
 import Data.Text qualified as T
 import Form.Internal
 import Miso
-import Miso.String (toMisoString)
+import Miso.String (fromMisoString, toMisoString)
 
 string :: String -> Form T.Text T.Text
 string label =
@@ -17,7 +17,8 @@ string label =
                 [ text (toMisoString label),
                   input_
                     [ type_ "text",
-                      value_ (toMisoString i)
+                      value_ (toMisoString i),
+                      onInput fromMisoString
                     ]
                 ]
             ]
diff --git a/frontend/app/Form/Internal.hs b/frontend/app/Form/Internal.hs
index 7782368..8c9935f 100644
--- a/frontend/app/Form/Internal.hs
+++ b/frontend/app/Form/Internal.hs
@@ -53,8 +53,7 @@ mapValues get set (Form {view, fill}) =
     }
 
 runForm :: Form i o -> i -> View (Either i o)
-runForm (Form {view}) i =
-  div_ [] $
-    (fmap Left <$> view i)
-      <> [ button_ [type_ "submit"] [text "submit"]
-         ]
+runForm form i =
+  form_ [onSubmit (either (\_ -> Left i) (Right) (form.fill i))] $
+    (fmap Left <$> form.view i)
+      <> [button_ [type_ "submit"] [text "submit"]]
diff --git a/frontend/app/Main.hs b/frontend/app/Main.hs
index 45b828b..356aa6e 100644
--- a/frontend/app/Main.hs
+++ b/frontend/app/Main.hs
@@ -29,7 +29,8 @@ import Miso.String (toMisoString)
 
 data Model = Model
   { schema :: Maybe (Either String Schema),
-    posts :: Maybe (Either String [A.Value])
+    posts :: Maybe (Either String [A.Value]),
+    input :: Maybe A.Value
   }
   deriving (Show, Eq, Generic, Default)
 
@@ -111,8 +112,10 @@ updateModel action m =
       let setPosts :: Either String [A.Value] -> Model -> Model
           setPosts posts m = m {posts = Just posts}
        in noEff (setPosts posts m)
-    FormChanged _ -> noEff m
-    FormSubmitted _ -> noEff m
+    FormChanged (Just -> input) -> noEff m {input}
+    FormSubmitted output ->
+      m <# do
+        const NoOp <$> consoleLog (toMisoString (A.encode output))
 
 fetchSchema :: JSM (Either String Schema)
 fetchSchema =
@@ -157,20 +160,13 @@ getResponseBody = fromMaybe "" . contents
 
 viewModel :: Model -> View Action
 viewModel model =
-  div_ [] $
-    [ maybe (text "..") (either err viewSchema) model.schema,
-      maybe (text "..") (either err viewPosts) model.posts,
-      maybe
-        (text "..")
-        ( either
-            err
-            ( fmap (either FormChanged FormSubmitted)
-                . flip F.runForm (A.Object AM.empty)
-                . schemaForm
-            )
-        )
-        model.schema
-    ]
+  let input = fromMaybe (A.Object AM.empty) model.input
+   in div_ [] $
+        [ maybe (text "..") (either err viewSchema) model.schema,
+          maybe (text "..") (either err viewPosts) model.posts,
+          maybe (text "..") (either err (viewForm input)) model.schema,
+          viewInput input
+        ]
 
 err :: String -> View Action
 err = text . toMisoString . ("err! " <>)
@@ -189,6 +185,16 @@ viewSchema schema =
         )
           <$> (M.toList properties)
 
+viewForm :: A.Value -> Schema -> View Action
+viewForm input =
+  fmap (either FormChanged FormSubmitted)
+    . flip F.runForm input
+    . schemaForm
+
+viewInput :: A.Value -> View Action
+viewInput input =
+  pre_ [] [text (toMisoString (A.encode input))]
+
 schemaForm :: Schema -> F.Form A.Value A.Value
 schemaForm schema =
   fmap mergeJson . sequence $
-- 
cgit v1.2.3