add edit page

5 files changed, 108 insertions, 4 deletions

diff --git a/frontend/app/Api.hs b/frontend/app/Api.hs
index 2a26c66..c16e269 100644
--- a/frontend/app/Api.hs
+++ b/frontend/app/Api.hs
@@ -3,6 +3,8 @@
 module Api
   ( fetchSchema,
     fetchPosts,
+    fetchPost,
+    updatePost,
   )
 where
 
@@ -18,8 +20,10 @@ import Miso.String qualified as J
 #endif
 import Data.Aeson qualified as A
 import Data.ByteString.Lazy.Char8 qualified as LB
+import Data.ByteString.Lazy.UTF8 qualified as LB
 import Data.Function
 import Miso
+import Safe
 import Schema
 
 fetchSchema :: JSM (Either String Schema)
@@ -35,6 +39,24 @@ fetchPosts =
           & setRequestBodyLBS "SELECT posts FROM posts"
       )
 
+fetchPost :: String -> JSM (Either String (Maybe A.Value))
+fetchPost fileName =
+  fmap headMay . A.eitherDecode
+    <$> fetch
+      ( fromString "http://localhost:8081"
+          & setRequestMethod "POST"
+          & setRequestBodyLBS ("SELECT posts FROM posts WHERE posts.$fileName == \"" <> LB.fromString fileName <> "\"")
+      )
+
+updatePost :: String -> A.Value -> JSM (Either String ())
+updatePost fileName value =
+  A.eitherDecode
+    <$> fetch
+      ( fromString "http://localhost:8081"
+          & setRequestMethod "POST"
+          & setRequestBodyLBS ("UPDATE posts SET " <> A.encode value <> " WHERE posts.$fileName == \"" <> LB.fromString fileName <> "\"")
+      )
+
 fetch :: Request -> JSM LB.ByteString
 fetch req = LB.fromStrict . getResponseBody <$> httpBS req
 
diff --git a/frontend/app/Page.hs b/frontend/app/Page.hs
index 84a551f..762ae90 100644
--- a/frontend/app/Page.hs
+++ b/frontend/app/Page.hs
@@ -11,6 +11,7 @@ import Data.Bifunctor
 import Data.Default
 import Data.Function
 import Miso
+import Page.EditValue qualified as EditValue
 import Page.ListCollection qualified as ListCollection
 import Route (Route)
 import Route qualified as Route
@@ -18,26 +19,35 @@ import Route qualified as Route
 data Page
   = Home
   | ListCollection ListCollection.Model
+  | EditValue EditValue.Model
   deriving (Show, Eq)
 
-instance Default Page where
-  def = Home
-
 data Action
   = HandleListCollection ListCollection.Action
+  | HandleEditValue EditValue.Action
   deriving (Show, Eq)
 
+instance Default Page where
+  def = Home
+
 initialPage :: Route -> JSM (Either String Page)
 initialPage Route.Home = pure (Right Home)
 initialPage (Route.ListCollection c) =
   fmap ListCollection <$> ListCollection.initialModel c
+initialPage (Route.EditValue c f) =
+  fmap EditValue <$> EditValue.initialModel c f
 
 updatePage :: Action -> Page -> Effect Action Page
 updatePage (HandleListCollection action) (ListCollection m) =
   ListCollection.updateModel action m
     & bimap HandleListCollection ListCollection
 updatePage (HandleListCollection _) p = noEff p
+updatePage (HandleEditValue action) (EditValue m) =
+  EditValue.updateModel action m
+    & bimap HandleEditValue EditValue
+updatePage (HandleEditValue _) p = noEff p
 
 viewPage :: Page -> View Action
 viewPage Home = text "home"
 viewPage (ListCollection m) = HandleListCollection <$> ListCollection.viewModel m
+viewPage (EditValue m) = HandleEditValue <$> EditValue.viewModel m
diff --git a/frontend/app/Page/EditValue.hs b/frontend/app/Page/EditValue.hs
new file mode 100644
index 0000000..294d1c9
--- /dev/null
+++ b/frontend/app/Page/EditValue.hs
@@ -0,0 +1,66 @@
+module Page.EditValue
+  ( Model,
+    initialModel,
+    Action,
+    updateModel,
+    viewModel,
+  )
+where
+
+import Api
+import Data.Aeson qualified as A
+import Data.Aeson.KeyMap qualified as AM
+import Data.Maybe
+import Form qualified as F
+import Miso
+import Miso.String (toMisoString)
+import Schema
+
+data Model = Model
+  { collection :: String,
+    fileName :: String,
+    input :: Maybe A.Value,
+    schema :: Schema
+  }
+  deriving (Show, Eq)
+
+initialModel :: String -> String -> JSM (Either String Model)
+initialModel collection fileName = do
+  schema' <- fetchSchema
+  input' <- fetchPost fileName
+  pure do
+    schema <- schema'
+    input <- input'
+    pure $ Model {..}
+
+data Action
+  = NoOp
+  | FormChanged A.Value
+  | FormSubmitted A.Value
+  | EntityWritten (Either String ())
+  deriving (Eq, Show)
+
+updateModel :: Action -> Model -> Effect Action Model
+updateModel NoOp m = noEff m
+updateModel (FormChanged (Just -> input)) m = noEff m {input}
+updateModel (FormSubmitted output) m =
+  m <# do EntityWritten <$> updatePost m.fileName output
+updateModel (EntityWritten _) m = noEff m
+
+viewModel :: Model -> View Action
+viewModel m = do
+  let input = (fromMaybe (A.Object AM.empty) m.input)
+  div_ [] $
+    [ viewForm input m.schema,
+      viewInput input
+    ]
+
+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))]
diff --git a/frontend/app/Route.hs b/frontend/app/Route.hs
index 36e1462..18a3273 100644
--- a/frontend/app/Route.hs
+++ b/frontend/app/Route.hs
@@ -12,6 +12,7 @@ import Miso
 data Route
   = Home
   | ListCollection String
+  | EditValue String String
   deriving (Show, Eq)
 
 instance Default Route where
@@ -22,7 +23,10 @@ parseURI uri =
   either (const def) id $
     P.parseOnly
       ( P.choice
-          [ ListCollection <$> (P.string "#collection/" *> P.many1 P.anyChar),
+          [ EditValue
+              <$> (P.string "#collection/" *> P.manyTill P.anyChar (P.string "/"))
+              <*> (P.many1 P.anyChar),
+            ListCollection <$> (P.string "#collection/" *> P.many1 P.anyChar),
             pure Home
           ]
           <* P.endOfInput
diff --git a/frontend/frontend.cabal b/frontend/frontend.cabal
index 263b26e..3260c51 100644
--- a/frontend/frontend.cabal
+++ b/frontend/frontend.cabal
@@ -17,6 +17,7 @@ executable frontend
         Form.Input
         Form.Internal
         Page
+        Page.EditValue
         Page.ListCollection
         Route
         Schema
@@ -40,6 +41,7 @@ executable frontend
         data-default,
         miso,
         neat-interpolation,
+        safe,
         text,
         utf8-string