refactor pages

frontend/app/Api.hs

@@ -0,0 +1,64 @@
+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
+
+module Api
+  ( fetchSchema,
+    fetchPosts,
+  )
+where
+
+#ifndef ghcjs_HOST_OS
+import Data.String
+import Network.HTTP.Simple
+#else
+import Data.ByteString.Char8 qualified as B
+import Data.Maybe
+import Data.String
+import JavaScript.Web.XMLHttpRequest
+import Miso.String qualified as J
+#endif
+import Data.Aeson qualified as A
+import Data.ByteString.Lazy.Char8 qualified as LB
+import Data.Function
+import Miso
+import Schema
+
+fetchSchema :: JSM (Either String Schema)
+fetchSchema =
+  A.eitherDecode <$> fetch (fromString "http://localhost:8081/posts.schema.json")
+
+fetchPosts :: JSM (Either String [A.Value])
+fetchPosts =
+  A.eitherDecode
+    <$> fetch
+      ( fromString "http://localhost:8081"
+          & setRequestMethod "POST"
+          & setRequestBodyLBS "SELECT posts FROM posts"
+      )
+
+fetch :: Request -> JSM LB.ByteString
+fetch req = LB.fromStrict . getResponseBody <$> httpBS req
+
+#ifdef ghcjs_HOST_OS
+httpBS :: Request -> JSM (Response B.ByteString)
+httpBS req = xhrByteString req
+
+instance IsString Request where
+  fromString uri =
+    Request
+      { reqMethod = GET,
+        reqURI = J.pack uri,
+        reqLogin = Nothing,
+        reqHeaders = [],
+        reqWithCredentials = False,
+        reqData = NoData
+      }
+
+setRequestMethod :: B.ByteString -> Request -> Request
+setRequestMethod "POST" req = req {reqMethod = POST}
+
+setRequestBodyLBS :: LB.ByteString -> Request -> Request
+setRequestBodyLBS body req = req {reqData = StringData (J.pack (LB.unpack body))}
+
+getResponseBody :: Response B.ByteString -> B.ByteString
+getResponseBody = fromMaybe "" . contents
+#endif