diff options
author | 2025-02-19 17:05:11 +0100 | |
---|---|---|
committer | 2025-02-19 19:26:11 +0100 | |
commit | c36c4cf37737ba972482a34c8df2b61a541e7f0a (patch) | |
tree | 5682b53cd5b9d03fa56a4a11ba12f4916dd69ea3 /backend/lib/ACMS | |
parent | 09809ae4df9ea2536bb6d9d6295cd3fdfd357945 (diff) |
add `acms query`
Diffstat (limited to 'backend/lib/ACMS')
-rw-r--r-- | backend/lib/ACMS/API/Fetch.hs | 63 | ||||
-rw-r--r-- | backend/lib/ACMS/API/Query.hs | 17 | ||||
-rw-r--r-- | backend/lib/ACMS/API/REST.hs | 50 | ||||
-rw-r--r-- | backend/lib/ACMS/API/REST/Collection.hs | 8 | ||||
-rw-r--r-- | backend/lib/ACMS/API/REST/Collection/Paginated.hs | 3 |
5 files changed, 86 insertions, 55 deletions
diff --git a/backend/lib/ACMS/API/Fetch.hs b/backend/lib/ACMS/API/Fetch.hs new file mode 100644 index 0000000..84330b1 --- /dev/null +++ b/backend/lib/ACMS/API/Fetch.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE OverloadedStrings #-} + +module ACMS.API.Fetch + ( APIMonad(fetch), +#ifndef ghcjs_HOST_OS + Network.HTTP.Simple.Request, + Network.HTTP.Simple.setRequestMethod, + Network.HTTP.Simple.setRequestBodyLBS, +#else + JavaScript.Web.XMLHttpRequest.Request, + setRequestMethod, + setRequestBodyLBS, +#endif + ) +where + +#ifndef ghcjs_HOST_OS +import Network.HTTP.Simple +#else +import Data.ByteString.Lazy.UTF8 qualified as LB +import Data.Maybe +import Data.String +import JavaScript.Web.XMLHttpRequest +import Miso.String qualified as J +import Data.ByteString qualified as B +#endif +import Control.Monad.Catch (MonadThrow) +import Data.ByteString.Lazy.Char8 qualified as LB +import Miso (JSM) + +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 diff --git a/backend/lib/ACMS/API/Query.hs b/backend/lib/ACMS/API/Query.hs new file mode 100644 index 0000000..ab2cabc --- /dev/null +++ b/backend/lib/ACMS/API/Query.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedStrings #-} + +module ACMS.API.Query where + +import ACMS.API.Fetch +import Data.Aeson qualified as A +import Data.ByteString.Lazy.UTF8 qualified as LB +import Data.Function ((&)) +import Data.String (IsString (fromString)) + +query :: (APIMonad m) => String -> m A.Value +query q = + fromString ("http://localhost:8081/api/query") + & setRequestMethod "POST" + & setRequestBodyLBS (LB.fromString q) + & fetch + >>= A.throwDecode diff --git a/backend/lib/ACMS/API/REST.hs b/backend/lib/ACMS/API/REST.hs index baf9adb..6cd2982 100644 --- a/backend/lib/ACMS/API/REST.hs +++ b/backend/lib/ACMS/API/REST.hs @@ -2,22 +2,10 @@ module ACMS.API.REST where -#ifndef ghcjs_HOST_OS -import Network.HTTP.Simple -import Data.String (IsString(fromString)) -#else -import Data.ByteString.Lazy.UTF8 qualified as LB -import Data.ByteString qualified as B -import Data.Maybe -import Data.String -import JavaScript.Web.XMLHttpRequest -import Miso.String qualified as J -#endif -import Control.Monad.Catch (MonadThrow) +import ACMS.API.Fetch import Data.Aeson qualified as A -import Data.ByteString.Lazy.Char8 qualified as LB import Data.Function ((&)) -import Miso (JSM) +import Data.String (IsString (fromString)) import Miso.String (MisoString) restRequest :: String -> Request @@ -43,37 +31,3 @@ createCollection collection = & 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 diff --git a/backend/lib/ACMS/API/REST/Collection.hs b/backend/lib/ACMS/API/REST/Collection.hs index 7eea23b..7de1909 100644 --- a/backend/lib/ACMS/API/REST/Collection.hs +++ b/backend/lib/ACMS/API/REST/Collection.hs @@ -2,12 +2,8 @@ module ACMS.API.REST.Collection where -#ifndef ghcjs_HOST_OS -import Network.HTTP.Simple -#else -import ACMS.API.REST (setRequestMethod, setRequestBodyLBS) -#endif -import ACMS.API.REST (APIMonad, fetch, restRequest) +import ACMS.API.Fetch +import ACMS.API.REST (restRequest) import Collection import Data.Aeson qualified as A import Data.Function ((&)) diff --git a/backend/lib/ACMS/API/REST/Collection/Paginated.hs b/backend/lib/ACMS/API/REST/Collection/Paginated.hs index ad98888..159754a 100644 --- a/backend/lib/ACMS/API/REST/Collection/Paginated.hs +++ b/backend/lib/ACMS/API/REST/Collection/Paginated.hs @@ -3,7 +3,8 @@ module ACMS.API.REST.Collection.Paginated where -import ACMS.API.REST (APIMonad, fetch, restRequest) +import ACMS.API.Fetch +import ACMS.API.REST (restRequest) import Collection import Data.Aeson qualified as A import Data.Function ((&)) |