65 lines
1.6 KiB
Haskell
65 lines
1.6 KiB
Haskell
|
{-# 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
|