diff options
author | Alexander Foremny <aforemny@posteo.de> | 2024-06-04 14:36:26 +0200 |
---|---|---|
committer | Alexander Foremny <aforemny@posteo.de> | 2024-06-04 14:46:41 +0200 |
commit | ed753b04104b27a9b258f174a501e2ae058b41ee (patch) | |
tree | ddddddddbe2e92e13140926eea7193f093383754 /frontend/app/Api.hs | |
parent | 03b019ca96ceb83113a5ea34f4b48b039c56f02d (diff) |
refactor pages
Diffstat (limited to 'frontend/app/Api.hs')
-rw-r--r-- | frontend/app/Api.hs | 64 |
1 files changed, 64 insertions, 0 deletions
diff --git a/frontend/app/Api.hs b/frontend/app/Api.hs new file mode 100644 index 0000000..2a26c66 --- /dev/null +++ b/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 |