{-# LANGUAGE OverloadedStrings #-} module ACMS.API.REST where #ifndef ghcjs_HOST_OS import Network.HTTP.Simple #else import Data.ByteString.Char8 qualified as B import Data.ByteString.Lazy.UTF8 qualified as LB import Data.Maybe import Data.String import JavaScript.Web.XMLHttpRequest import Miso.String qualified as J #endif import Control.Monad.Catch (MonadThrow) import Data.Aeson qualified as A import Data.ByteString.Lazy.Char8 qualified as LB import Data.Function ((&)) import Miso (JSM) import Miso.String (MisoString) schemaVersion :: (APIMonad m, A.FromJSON a) => m a schemaVersion = "http://localhost:8081/api/rest/schemaVersion" & fetch >>= A.throwDecode listCollections :: (APIMonad m) => m [MisoString] listCollections = "http://localhost:8081/api/rest/collection" & fetch >>= A.throwDecode createCollection :: (APIMonad m) => MisoString -> m () createCollection collection = "http://localhost:8081/api/rest/collections" & setRequestMethod "POST" & setRequestBodyLBS (A.encode (A.toJSON collection)) & fetch >>= A.throwDecode class (MonadThrow m) => APIMonad m where fetch :: Request -> m LB.ByteString instance APIMonad JSM where 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.toString body))} getResponseBody :: Response B.ByteString -> B.ByteString getResponseBody = fromMaybe "" . contents #else instance APIMonad IO where fetch req = LB.fromStrict . getResponseBody <$> httpBS req #endif