add frontend (boilerplate)

frontend/app/Main.hs

@@ -0,0 +1,77 @@
+module Main where
+
+#ifndef ghcjs_HOST_OS
+import Language.Javascript.JSaddle.Warp as JSaddle
+#endif
+
+import Data.ByteString.UTF8 qualified as B
+import Data.Maybe
+import Miso
+import Miso.String
+
+#ifndef ghcjs_HOST_OS
+import Network.HTTP.Simple
+import Data.String
+#else
+import JavaScript.Web.XMLHttpRequest
+#endif
+
+type Model = Maybe Schema
+
+type Schema = String
+
+data Action
+  = FetchSchema
+  | SetSchema Schema
+  deriving (Show, Eq)
+
+#ifndef ghcjs_HOST_OS
+runApp :: JSM () -> IO ()
+runApp f = JSaddle.debugOr 8080 (f >> syncPoint) JSaddle.jsaddleApp
+#else
+runApp :: IO () -> IO ()
+runApp app = app
+#endif
+
+main :: IO ()
+main = runApp $ startApp App {..}
+  where
+    initialAction = FetchSchema
+    model = Nothing
+    update = updateModel
+    view = viewModel
+    events = defaultEvents
+    subs = []
+    mountPoint = Nothing
+    logLevel = Off
+
+updateModel :: Action -> Model -> Effect Action Model
+updateModel action m =
+  case action of
+    FetchSchema -> m <# do SetSchema <$> fetchSchema
+    SetSchema schema -> noEff (Just schema)
+
+fetchSchema :: JSM String
+fetchSchema = fetch "http://localhost:8081/posts.schema.json"
+
+#ifndef ghcjs_HOST_OS
+fetch :: String -> JSM String
+fetch url = B.toString . getResponseBody <$> httpBS (fromString url)
+#else
+fetch :: String -> JSM String
+fetch url = maybe "" B.toString . contents <$> xhrByteString req
+  where
+    req =
+      Request
+        { reqMethod = GET,
+          reqURI = pack url,
+          reqLogin = Nothing,
+          reqHeaders = [],
+          reqWithCredentials = False,
+          reqData = NoData
+        }
+#endif
+
+viewModel :: Model -> View Action
+viewModel schema =
+  div_ [] [text (toMisoString (fromMaybe ".." schema))]