Spock-api-ghcjs (empty) → 0.11.0.0
raw patch · 4 files changed
+176/−0 lines, 4 filesdep +Spock-apidep +aesondep +basesetup-changed
Dependencies added: Spock-api, aeson, base, bytestring, ghcjs-base, hvect, text
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- Spock-api-ghcjs.cabal +31/−0
- src/Web/Spock/Api/Client.hs +113/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013 - 2016, Alexander Thiemann <mail@athiemann.net>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Alexander Thiemann <mail@agrafix.net> nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Spock-api-ghcjs.cabal view
@@ -0,0 +1,31 @@+name: Spock-api-ghcjs+version: 0.11.0.0+synopsis: Another Haskell web framework for rapid development+description: GHCJS client side wiring for Spock-api APIs+Homepage: https://www.spock.li+Bug-reports: https://github.com/agrafix/Spock/issues+license: BSD3+license-file: LICENSE+author: Alexander Thiemann <mail@athiemann.net>+maintainer: Alexander Thiemann <mail@athiemann.net>+copyright: (c) 2013 - 2016 Alexander Thiemann+category: Web+build-type: Simple+cabal-version: >=1.8++library+ hs-source-dirs: src+ exposed-modules: Web.Spock.Api.Client+ build-depends:+ base >= 4 && < 5,+ ghcjs-base,+ aeson,+ bytestring,+ text,+ Spock-api,+ hvect >= 0.3.1+ ghc-options: -auto-all -Wall++source-repository head+ type: git+ location: https://github.com/agrafix/Spock
+ src/Web/Spock/Api/Client.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+module Web.Spock.Api.Client+ ( callEndpoint, callEndpoint' )+where++import Web.Spock.Api++import Data.HVect+import JavaScript.Web.XMLHttpRequest+import qualified Data.Aeson as A+import qualified Data.ByteString.Lazy as BSL+import qualified Data.HVect as HV+import qualified Data.JSString as J+import qualified Data.JSString.Text as J+import qualified Data.Text.Encoding as T++type Header = (J.JSString, J.JSString)++-- | Call an 'Endpoint' defined using the @Spock-api@ package passing extra headers+callEndpoint' ::+ forall p i o. (HasRep (MaybeToList i), HasRep p)+ => Endpoint p i o+ -> [Header]+ -> HVectElim p (HVectElim (MaybeToList i) (IO (Maybe o)))+callEndpoint' ep extraHeaders =+ HV.curry $ \hv -> HV.curry (callEndpointCore' ep extraHeaders hv)++-- | Call an 'Endpoint' defined using the @Spock-api@ package+callEndpoint ::+ forall p i o. (HasRep (MaybeToList i), HasRep p)+ => Endpoint p i o -> HVectElim p (HVectElim (MaybeToList i) (IO (Maybe o)))+callEndpoint ep = callEndpoint' ep []++data EndpointCall p i o+ = EndpointCall+ { epc_point :: !(Endpoint p i o)+ , epc_headers :: ![Header]+ , epc_params :: !(HVect p)+ , epc_body :: !(HVect (MaybeToList i))+ }++callEndpointCore' ::+ forall p i o.+ Endpoint p i o+ -> [Header]+ -> HVect p+ -> HVect (MaybeToList i)+ -> IO (Maybe o)+callEndpointCore' ep hdrs hv b = callEndpointCore (EndpointCall ep hdrs hv b)++callEndpointCore :: forall p i o. EndpointCall p i o -> IO (Maybe o)+callEndpointCore call =+ case call of+ EndpointCall (MethodPost Proxy path) hdrs params (body :&: HNil) ->+ do let rt = J.textToJSString $ renderRoute path params+ bodyText = J.textToJSString $ T.decodeUtf8 $ BSL.toStrict $ A.encode body+ req =+ Request+ { reqMethod = POST+ , reqURI = rt+ , reqLogin = Nothing+ , reqHeaders = (("Content-Type", "application/json;charset=UTF-8") : hdrs)+ , reqWithCredentials = False+ , reqData = StringData bodyText+ }+ runJsonReq req+ EndpointCall (MethodPut Proxy path) hdrs params (body :&: HNil) ->+ do let rt = J.textToJSString $ renderRoute path params+ bodyText = J.textToJSString $ T.decodeUtf8 $ BSL.toStrict $ A.encode body+ req =+ Request+ { reqMethod = PUT+ , reqURI = rt+ , reqLogin = Nothing+ , reqHeaders = (("Content-Type", "application/json;charset=UTF-8") : hdrs)+ , reqWithCredentials = False+ , reqData = StringData bodyText+ }+ runJsonReq req+ EndpointCall (MethodGet path) hdrs params HNil ->+ do let rt = J.textToJSString $ renderRoute path params+ req =+ Request+ { reqMethod = GET+ , reqURI = rt+ , reqLogin = Nothing+ , reqHeaders = hdrs+ , reqWithCredentials = False+ , reqData = NoData+ }+ runJsonReq req++runJsonReq :: A.FromJSON o => Request -> IO (Maybe o)+runJsonReq req =+ do response <- xhrText req+ case (status response, contents response) of+ (200, Just txt) ->+ do let res = A.eitherDecodeStrict' (T.encodeUtf8 txt)+ case res of+ Left errMsg ->+ do putStrLn errMsg+ pure Nothing+ Right val ->+ pure (Just val)+ _ -> pure Nothing