servant-reason (empty) → 0.1.0.0
raw patch · 24 files changed
+1349/−0 lines, 24 filesdep +Diffdep +HUnitdep +aesonsetup-changed
Dependencies added: Diff, HUnit, aeson, base, directory, hspec, interpolate, lens, mockery, process, reason-export, servant, servant-foreign, servant-reason, text, wl-pprint-text
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +87/−0
- Setup.hs +2/−0
- servant-reason.cabal +118/−0
- src/Servant/Reason.hs +36/−0
- src/Servant/Reason/Internal/Foreign.hs +27/−0
- src/Servant/Reason/Internal/Generate.hs +563/−0
- src/Servant/Reason/Internal/Orphans.hs +21/−0
- test/Common.hs +60/−0
- test/CompileSpec.hs +129/−0
- test/GenerateSpec.hs +83/−0
- test/reason-sources/BookType.re +7/−0
- test/reason-sources/getBooksByIdSource.re +13/−0
- test/reason-sources/getBooksByTitleSource.re +13/−0
- test/reason-sources/getBooksSource.re +37/−0
- test/reason-sources/getNothingSource.re +12/−0
- test/reason-sources/getOneSource.re +11/−0
- test/reason-sources/getOneWithDynamicUrlSource.re +12/−0
- test/reason-sources/getWithaheaderSource.re +24/−0
- test/reason-sources/getWitharesponseheaderSource.re +12/−0
- test/reason-sources/postBooksSource.re +19/−0
- test/reason-sources/postTwoSource.re +18/−0
- test/reason-sources/putNothingSource.re +12/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for servant-reason++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Andrei Barbu (c) 2019, Matt Bray (c) 2015-2016++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 Matt Bray 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.
+ README.md view
@@ -0,0 +1,87 @@+# Servant Reason++[](https://travis-ci.org/abarbu/servant-reason)+<img src="https://cdn.svgporn.com/logos/reasonml.svg" alt="reason" height="20"/>+<img src="https://www.haskell.org/img/haskell-logo.svg" alt="reason" height="20"/>++Automatically derive bindings for Servant APIs in Reason. Originally build by+converting [servant-elm](http://hackage.haskell.org/package/servant-elm) to+Reason. Types are generated using+[reason-export](https://github.com/abarbu/reason-export).++More docs on [Hackage](http://hackage.haskell.org/package/servant-reason).++A full example of how to integrate Servant and Reason is available at+[servant-reason-example](https://github.com/abarbu/servant-reason-example).++## Usage++Run the tests if you want a concrete example. They will build a _test-cache+directory that contains a sample Reason repository for a servant API. test also+contain example output files for different kinds of bindings.++Usage is simple and automatic. If you have an API like the one below++```haskell+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++import Reason (Spec (Spec), specsToDir, toReasonDecoderSource,+ toReasonTypeSource)+import GHC.Generics (Generic)+import Servant.API ((:>), Capture, Get, JSON)+import Servant.Reason (ReasonType, Proxy (Proxy), defReasonImports,+ generateReasonForAPI)++data Book = Book+ { name :: String+ } deriving (Generic)++instance ReasonType Book++type BooksApi = "books" :> Capture "bookId" Int :> Get '[JSON] Book+```++You can expose your API to reason with:++```haskell+module Main where++import Data.Proxy+import Reason+import Data.Text hiding (intercalate, map)+import Db++main :: IO ()+main = do+ let code = defReasonImports+ : toReasonTypeSource (Proxy :: Proxy Book)+ : toReasonDecoderSource (Proxy :: Proxy Book)+ : generateReasonForAPI (Proxy :: Proxy BooksApi))+ writeFile "Api.re" $ intercalate "\n\n" $ map unpack code+```++That's it. You can now include `Api.re` in a Reason project.++## Reason setup++The generated code needs access to two Reason libraries+[@glennsl/bs-json](https://github.com/glennsl/bs-json) and+[bs-fetch](https://github.com/reasonml-community/bs-fetch). Get the latest+install instructions from the upstream repos, but at the time of writing these+were:++```sh+npm install --save @glennsl/bs-json+npm install --save bs-fetch+```++Then add `@glennsl/bs-json` and `bs-fetch` to `bs-dependencies` in your `bsconfig.json`:+```js+{+ ...+ "bs-dependencies": ["@glennsl/bs-json", "bs-fetch"]+}+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ servant-reason.cabal view
@@ -0,0 +1,118 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: 6c0ebb17fd103163c20ec58213afcdd0311c5f540d9fd64e4894fc8349bea6b3++name: servant-reason+version: 0.1.0.0+synopsis: Derive Reason types to interact with a Haskell backend+description: Please see the README on GitHub at <https://github.com/abarbu/servant-reason#readme>+category: Web+homepage: https://github.com/abarbu/servant-reason#readme+bug-reports: https://github.com/abarbu/servant-reason/issues+author: Andrei Barbu+maintainer: andrei@0xab.com+copyright: 2019 Andrei Barbu+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md+ test/reason-sources/BookType.re+ test/reason-sources/getBooksByIdSource.re+ test/reason-sources/getBooksByTitleSource.re+ test/reason-sources/getBooksSource.re+ test/reason-sources/getNothingSource.re+ test/reason-sources/getOneSource.re+ test/reason-sources/getOneWithDynamicUrlSource.re+ test/reason-sources/getWithaheaderSource.re+ test/reason-sources/getWitharesponseheaderSource.re+ test/reason-sources/postBooksSource.re+ test/reason-sources/postTwoSource.re+ test/reason-sources/putNothingSource.re++source-repository head+ type: git+ location: https://github.com/abarbu/servant-reason++library+ exposed-modules:+ Servant.Reason+ Servant.Reason.Internal.Foreign+ Servant.Reason.Internal.Generate+ Servant.Reason.Internal.Orphans+ other-modules:+ Paths_servant_reason+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , lens+ , reason-export+ , servant+ , servant-foreign+ , text+ , wl-pprint-text+ default-language: Haskell2010++test-suite servant-reason-compile-test+ type: exitcode-stdio-1.0+ main-is: CompileSpec.hs+ other-modules:+ Common+ GenerateSpec+ Paths_servant_reason+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -main-is CompileSpec+ build-depends:+ Diff+ , HUnit+ , aeson+ , base >=4.7 && <5+ , directory+ , hspec+ , interpolate+ , lens+ , mockery+ , process+ , reason-export+ , servant+ , servant-foreign+ , servant-reason+ , text+ , wl-pprint-text+ default-language: Haskell2010++test-suite servant-reason-test+ type: exitcode-stdio-1.0+ main-is: GenerateSpec.hs+ other-modules:+ Common+ CompileSpec+ Paths_servant_reason+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -main-is GenerateSpec+ build-depends:+ Diff+ , HUnit+ , aeson+ , base >=4.7 && <5+ , directory+ , hspec+ , interpolate+ , lens+ , mockery+ , process+ , reason-export+ , servant+ , servant-foreign+ , servant-reason+ , text+ , wl-pprint-text+ default-language: Haskell2010
+ src/Servant/Reason.hs view
@@ -0,0 +1,36 @@+{-|+Basic usage:++> import MyLib (MyServantApiType)+> import Servant.Reason+>+> spec :: Spec+> spec = Spec ["Generated", "MyApi"]+> (defReasonImports : generateReasonForAPI (Proxy :: Proxy MyServantApiType))+>+> main :: IO ()+> main = specsToDir [spec] "my-reason-dir"+-}+module Servant.Reason+ ( generateReasonForAPI+ , generateReasonForAPIWith+ , ReasonOptions(..)+ , UrlPrefix(..)+ , defReasonOptions+ , defReasonImports+ -- * Convenience re-exports from the "Reason" module+ , Spec(Spec)+ , ReasonType+ , specsToDir+ -- * Convenience re-exports from "Data.Proxy"+ , Proxy(Proxy)+ ) where++import Servant.Reason.Internal.Generate (ReasonOptions (..), UrlPrefix (..),+ defReasonImports, defReasonOptions,+ generateReasonForAPI,+ generateReasonForAPIWith)++import Data.Proxy (Proxy (Proxy))+import Reason (ReasonType, Spec (Spec),+ specsToDir)
+ src/Servant/Reason/Internal/Foreign.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++module Servant.Reason.Internal.Foreign where++import Data.Proxy (Proxy (Proxy))+import Reason (ReasonDatatype, ReasonType, toReasonType)+import Servant.Foreign (Foreign, GenerateList, HasForeign,+ HasForeignType, Req, listFromAPI, typeFor)+++data LangReason++instance (ReasonType a) => HasForeignType LangReason ReasonDatatype a where+ typeFor _ _ _ =+ toReasonType (Proxy :: Proxy a)++getEndpoints+ :: ( HasForeign LangReason ReasonDatatype api+ , GenerateList ReasonDatatype (Foreign ReasonDatatype api))+ => Proxy api+ -> [Req ReasonDatatype]+getEndpoints =+ listFromAPI (Proxy :: Proxy LangReason) (Proxy :: Proxy ReasonDatatype)
+ src/Servant/Reason/Internal/Generate.hs view
@@ -0,0 +1,563 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+module Servant.Reason.Internal.Generate where++import Prelude hiding ((<$>))+import Control.Lens (to, (^.))+import Data.Int (Int32)+import Data.List (nub)+import Data.Maybe (catMaybes)+import Data.Proxy (Proxy)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import qualified Data.Text.Encoding as T+import Reason (ReasonDatatype(..), ReasonPrimitive(..))+import qualified Reason+import Servant.API (NoContent (..))+import Servant.Reason.Internal.Foreign (LangReason, getEndpoints)+import Servant.Reason.Internal.Orphans ()+import qualified Servant.Foreign as F+import Text.PrettyPrint.Leijen.Text+++{-|+Options to configure how code is generated.+-}+data ReasonOptions = ReasonOptions+ { {- | The protocol, host and any path prefix to be used as the base for all+ requests.++ Example: @Static "https://mydomain.com/api/v1"@++ When @Dynamic@, the generated Reason functions take the base URL as the first+ argument.+ -}+ urlPrefix :: UrlPrefix+ , reasonExportOptions :: Reason.Options+ -- ^ Options to pass to reason-export+ , emptyResponseReasonTypes :: [ReasonDatatype]+ -- ^ Types that represent an empty Http response.+ , stringReasonTypes :: [ReasonDatatype]+ -- ^ Types that represent a String.+ , intReasonTypes :: [ReasonDatatype]+ -- ^ Types that represent a Int.+ , floatReasonTypes :: [ReasonDatatype]+ -- ^ Types that represent a Float.+ , boolReasonTypes :: [ReasonDatatype]+ -- ^ Types that represent a Bool.+ , charReasonTypes :: [ReasonDatatype]+ -- ^ Types that represent a Char.+ }+++data UrlPrefix+ = Static T.Text+ | Dynamic+++{-|+Default options for generating Reason code.++The default options are:++> { urlPrefix =+> Static ""+> , reasonExportOptions =+> Reason.defaultOptions+> , emptyResponseReasonTypes =+> [ toReasonType NoContent ]+> , stringReasonTypes =+> [ toReasonType "" ]+> }+-}+defReasonOptions :: ReasonOptions+defReasonOptions = ReasonOptions+ { urlPrefix = Static ""+ , reasonExportOptions = Reason.defaultOptions+ , emptyResponseReasonTypes =+ [ Reason.toReasonType NoContent+ , Reason.toReasonType ()+ ]+ , stringReasonTypes =+ [ Reason.toReasonType ("" :: String)+ , Reason.toReasonType ("" :: T.Text)+ ]+ , intReasonTypes =+ [ Reason.toReasonType (0 :: Int)+ , Reason.toReasonType (0 :: Int32)+ ]+ , floatReasonTypes =+ [ Reason.toReasonType (0 :: Float) ]+ , boolReasonTypes =+ [ Reason.toReasonType (False :: Bool) ]+ , charReasonTypes =+ [ Reason.toReasonType (' ' :: Char) ]+ }+++{-|+Default imports required by generated Reason code.++You probably want to include this at the top of your generated Reason module.+-}+defReasonImports :: Text+defReasonImports = T.unlines []+++{-|+Generate Reason code for the API with default options.++Returns a list of Reason functions to query your Servant API from Reason.++You could spit these out to a file and call them from your Reason code, but you+would be better off creating a 'Spec' with the result and using 'specsToDir',+which handles the module name for you.+-}+generateReasonForAPI+ :: ( F.HasForeign LangReason ReasonDatatype api+ , F.GenerateList ReasonDatatype (F.Foreign ReasonDatatype api))+ => Proxy api+ -> [Text]+generateReasonForAPI =+ generateReasonForAPIWith defReasonOptions+++{-|+Generate Reason code for the API with custom options.+-}+generateReasonForAPIWith+ :: ( F.HasForeign LangReason ReasonDatatype api+ , F.GenerateList ReasonDatatype (F.Foreign ReasonDatatype api))+ => ReasonOptions+ -> Proxy api+ -> [Text]+generateReasonForAPIWith opts =+ nub . map docToText . map (generateReasonForRequest opts) . getEndpoints++i :: Int+i = 4++{-|+Generate an Reason function for one endpoint.+-}+generateReasonForRequest :: ReasonOptions -> F.Req ReasonDatatype -> Doc+generateReasonForRequest opts request =+ funcDef+ where+ funcDef =+ vsep+ [ -- fnName <+> ":" <+> typeSignature+ -- , + "let" <+> fnName <+> "=" <+> args <+> "=> {"+ , case letParams of+ Just params ->+ indent i+ (vsep ["let"+ , indent i params <> ";"+ , indent i reasonRequest+ ])+ Nothing ->+ indent i reasonRequest+ , "}"+ ]++ fnName =+ request ^. F.reqFuncName . to (T.replace "-" "" . F.camelCase) . to stext++ typeSignature =+ mkTypeSignature opts request++ args =+ mkArgs opts request++ letParams =+ mkLetParams opts request++ reasonRequest =+ mkRequest opts request+++mkTypeSignature :: ReasonOptions -> F.Req ReasonDatatype -> Doc+mkTypeSignature opts request =+ (hsep . punctuate " ->" . concat)+ [ catMaybes [urlPrefixType]+ , headerTypes+ , urlCaptureTypes+ , queryTypes+ , catMaybes [bodyType, returnType]+ ]+ where+ urlPrefixType :: Maybe Doc+ urlPrefixType =+ case (urlPrefix opts) of+ Dynamic -> Just "String"+ Static _ -> Nothing++ reasonTypeRef :: ReasonDatatype -> Doc+ reasonTypeRef eType =+ stext (Reason.toReasonTypeRefWith (reasonExportOptions opts) eType)++ headerTypes :: [Doc]+ headerTypes =+ [ header ^. F.headerArg . F.argType . to reasonTypeRef+ | header <- request ^. F.reqHeaders+ , isNotCookie header+ ]++ urlCaptureTypes :: [Doc]+ urlCaptureTypes =+ [ F.captureArg capture ^. F.argType . to reasonTypeRef+ | capture <- request ^. F.reqUrl . F.path+ , F.isCapture capture+ ]++ queryTypes :: [Doc]+ queryTypes =+ [ arg ^. F.queryArgName . F.argType . to reasonTypeRef+ | arg <- request ^. F.reqUrl . F.queryStr+ ]++ bodyType :: Maybe Doc+ bodyType =+ fmap reasonTypeRef $ request ^. F.reqBody++ returnType :: Maybe Doc+ returnType = do+ result <- fmap reasonTypeRef $ request ^. F.reqReturnType+ pure ("Http.Request" <+> parens result)+++reasonHeaderArg :: F.HeaderArg ReasonDatatype -> Doc+reasonHeaderArg header =+ "header_" <>+ header ^. F.headerArg . F.argName . to (stext . T.replace "-" "_" . F.unPathSegment)+++reasonCaptureArg :: F.Segment ReasonDatatype -> Doc+reasonCaptureArg segment =+ "capture_" <>+ F.captureArg segment ^. F.argName . to (stext . F.unPathSegment)+++reasonQueryArg :: F.QueryArg ReasonDatatype -> Doc+reasonQueryArg arg =+ "query_" <>+ arg ^. F.queryArgName . F.argName . to (stext . F.unPathSegment)+++reasonBodyArg :: Doc+reasonBodyArg =+ "body"+++isNotCookie :: F.HeaderArg f -> Bool+isNotCookie header =+ header+ ^. F.headerArg+ . F.argName+ . to ((/= "cookie") . T.toLower . F.unPathSegment)+++mkArgs+ :: ReasonOptions+ -> F.Req ReasonDatatype+ -> Doc+mkArgs opts request =+ (tupled . concat) $+ [ -- Dynamic url prefix+ case urlPrefix opts of+ Dynamic -> ["urlBase"]+ Static _ -> []+ , -- Headers+ [ reasonHeaderArg header+ | header <- request ^. F.reqHeaders+ , isNotCookie header+ ]+ , -- URL Captures+ [ reasonCaptureArg segment+ | segment <- request ^. F.reqUrl . F.path+ , F.isCapture segment+ ]+ , -- Query params+ [ reasonQueryArg arg+ | arg <- request ^. F.reqUrl . F.queryStr+ ]+ , -- Request body+ maybe [] (const [reasonBodyArg]) (request ^. F.reqBody)+ ]+++mkLetParams :: ReasonOptions -> F.Req ReasonDatatype -> Maybe Doc+mkLetParams opts request =+ if null (request ^. F.reqUrl . F.queryStr) then+ Nothing+ else+ Just $ "params =" <$>+ indent i ("List.filter" <> tupled ["((x) => (String.length(x) > 0))", reasonList params])+ where+ params :: [Doc]+ params = map paramToDoc (request ^. F.reqUrl . F.queryStr)++ paramToDoc :: F.QueryArg ReasonDatatype -> Doc+ paramToDoc qarg =+ -- something wrong with indentation here...+ case qarg ^. F.queryArgType of+ F.Normal ->+ let+ toStringSrc' = toStringSrc opts (qarg ^. F.queryArgName . F.argType)+ in+ reasonName+ <$$> indent 2 ("|>" <+> toStringSrc'+ <$$> "|> Js_global.encodeURIComponent"+ <$$> "|>" <+> "((x__) => if(String.length(x__) > 0) { "+ <> dquotes (reasonName <> equals)+ <+> "++ x__ } else {\"\"})")++ F.Flag ->+ "if" <> parens reasonName <+> braces (dquotes (name <> equals)) <+> "else" <+> braces (dquotes empty)++ F.List ->+ "String.concat" <> tupled [dquotes "&"+ ,"List.map((x) => "+ <> dquotes (name <> "[]=")+ <> " ++ Js_global.encodeURIComponent(" <> toStringSrc opts (qarg ^. F.queryArgName . F.argType) <> "(x)), " <> reasonName <> ")"]+ where+ reasonName = reasonQueryArg qarg+ name = qarg ^. F.queryArgName . F.argName . to (stext . F.unPathSegment)+++mkRequest :: ReasonOptions -> F.Req ReasonDatatype -> Doc+mkRequest opts request =+ "Js.Promise." <> parens (+ line <> indent i+ ("Fetch.fetchWithInit" <>+ tupled [url+ ,"Fetch.RequestInit.make" <>+ tupled (catMaybes [Just $ "~method_=" <> method+ ,case headers of+ [] -> Nothing+ _ -> Just $ "~headers="+ <$$> indent 2 "Fetch.HeadersInit.makeWithDict("+ <$$> indent 3 ("Js.Dict.fromList(")+ <$$> indent 4 (reasonListOfMaybes headers) <> "))"+ ,case body of+ Nothing -> Nothing+ Just b -> Just $ "~body=" <> b+ ,Just $ "()"])])+ <$$> "|> then_" <> parens ("Fetch.Response." <> expectResponse)+ <$$> "|> then_" <> parens ("response => (response |>" <+> expectDecoder <> ")"))+ -- , "timeout =" <$>+ -- indent i "Nothing"+ -- ]))+ where+ method =+ request ^. F.reqMethod . to (stext . T.toTitle . T.decodeUtf8)++ mkHeader header =+ let headerName = header ^. F.headerArg . F.argName . to (stext . F.unPathSegment)+ headerArgName = reasonHeaderArg header+ argType = header ^. F.headerArg . F.argType+ wrapped = isReasonMaybeType argType+ toStringSrc' = toStringSrc opts (case argType of+ (ReasonPrimitive (ROption t)) -> t+ x -> x)+ -- toStringSrc =+ -- if isReasonMaybeStringType opts argType || isReasonStringType opts argType then+ -- mempty+ -- else+ -- " << toString"+ in+ "Belt.Option.map" <> parens ((if wrapped then headerArgName else parens ("Some" <> parens headerArgName))+ <> ", x => " <> parens (dquotes headerName <> ", x |>" <+> toStringSrc'))++ headers =+ (case (request ^. F.reqBody, request ^. F.reqBodyContentType) of+ (Just _, F.ReqBodyJSON) ->+ ["Some" <> parens (parens ("\"Content-Type\"" <> comma <> stext "\"application/json\""))]+ _ -> [])+ +++ [ mkHeader header+ | header <- request ^. F.reqHeaders+ , isNotCookie header+ ]++ url =+ mkUrl opts (request ^. F.reqUrl . F.path)+ <> mkQueryParams request++ body =+ case request ^. F.reqBody of+ Nothing -> Nothing+ Just reasonTypeExpr ->+ let encoderName = Reason.toReasonEncoderRefWith (reasonExportOptions opts) reasonTypeExpr+ in Just $ "Fetch.BodyInit.make" <> parens ("Js.Json.stringify" <> parens (stext encoderName <> parens reasonBodyArg))++ expectResponse =+ case request ^. F.reqReturnType of+ Just reasonTypeExpr | isEmptyType opts reasonTypeExpr ->+ "text"+ Just reasonTypeExpr ->+ "json"+ Nothing ->+ error "mkHttpRequest: no reqReturnType?"++ expectDecoder =+ case request ^. F.reqReturnType of+ Just reasonTypeExpr | isEmptyType opts reasonTypeExpr ->+ "((x) => if(String.length(x) != 0) { resolve(Belt_Result.Error(\"Expected the response body to empty\")) } else { resolve(Belt_Result.Ok(x)) })"+ -- let reasonConstructor =+ -- Reason.toReasonTypeRefWith (reasonExportOptions opts) reasonTypeExpr+ -- in+ -- "Http.expectStringResponse" <$>+ -- indent i (parens (backslash <> braces " body " <+> "->" <$>+ -- indent i ("if String.isEmpty body then" <$>+ -- indent i "Ok" <+> stext reasonConstructor <$>+ -- "else" <$>+ -- indent i ("Err" <+> dquotes "Expected the response body to be empty")) <> line))+ Just reasonTypeExpr ->+ stext (Reason.toReasonDecoderRefWith (reasonExportOptions opts) reasonTypeExpr) <+> "|> ((x) => Belt_Result.Ok(x)) |> resolve"+ Nothing -> error "mkHttpRequest: no reqReturnType?"+++mkUrl :: ReasonOptions -> [F.Segment ReasonDatatype] -> Doc+mkUrl opts segments =+ "String.concat" <> tupled [dquotes "/",+ (reasonList)+ ( case urlPrefix opts of+ Dynamic -> "urlBase"+ Static url -> dquotes (stext url)+ : map segmentToDoc segments)]+ where++ segmentToDoc :: F.Segment ReasonDatatype -> Doc+ segmentToDoc s =+ case F.unSegment s of+ F.Static path ->+ dquotes (stext (F.unPathSegment path))+ F.Cap arg ->+ let+ -- Don't use "toString" on Reason Strings, otherwise we get extraneous quotes.+ toStringSrc' = toStringSrc opts (arg ^. F.argType)+ -- toStringSrc =+ -- if isReasonStringType opts (arg ^. F.argType) then+ -- empty+ -- else+ -- "|> string_of_" <> stext (Reason.toReasonTypeRef (arg ^. F.argType))+ in+ (reasonCaptureArg s) <+> "|>" <+> toStringSrc' <+> "|>" <+> "Js_global.encodeURIComponent"+++mkQueryParams+ :: F.Req ReasonDatatype+ -> Doc+mkQueryParams request =+ if null (request ^. F.reqUrl . F.queryStr) then+ empty+ else+ line <> "++" <+> align ("if(List.length(params)==0)" <+> braces (dquotes empty)+ <+> "else" <+> braces (dquotes "?" <+> "++ String.concat" <> tupled [dquotes "&", "params"]))+++{- | Determines whether we construct an Reason function that expects an empty+response body.+-}+isEmptyType :: ReasonOptions -> ReasonDatatype -> Bool+isEmptyType opts reasonTypeExpr =+ reasonTypeExpr `elem` emptyResponseReasonTypes opts++{- | Determines how to stringify a value.+-}+toStringSrc :: ReasonOptions -> ReasonDatatype -> Doc+toStringSrc opts argType+ -- Don't use "toString" on Reason Strings, otherwise we get extraneous quotes.+ -- We don't append an operator in this case+ | isReasonStringType opts argType = stext "((x) => x)"+ | otherwise = toStringSrcTypes opts argType+++toStringSrcTypes :: ReasonOptions -> ReasonDatatype -> Doc+toStringSrcTypes opts (ReasonPrimitive (ROption argType)) =+ "((x) => Belt.Option.mapWithDefault(x, \"\", " <> toStringSrcTypes opts argType <> "))" + -- "Maybe.map (" <> toStringSrcTypes operator opts argType <> ") |> Maybe.withDefault \"\""+ -- [Char] == String so we can just use identity here.+ -- We can't return `""` here, because this string might be nested in a `Maybe` or `List`.+toStringSrcTypes _ (ReasonPrimitive (RList (ReasonPrimitive RChar))) = "((x) => x)"+toStringSrcTypes opts (ReasonPrimitive (RList argType)) = toStringSrcTypes opts argType+toStringSrcTypes opts argType+ | isReasonStringType opts argType = "((x) => x)"+ | isReasonIntType opts argType = "string_of_int"+ | isReasonFloatType opts argType = "string_of_float"+ | isReasonBoolType opts argType = "string_of_bool" -- We should change this to return `true`/`false` but this mimics the old behavior.+ | isReasonCharType opts argType = "string_of_char"+ | otherwise = error $ "Sorry, we don't support other types than `String`, `Int`, `Float`, `Bool`, and `Char` right now. " <> show argType++++{- | Determines whether we call `toString` on URL captures and query params of+this type in Reason.+-}+isReasonStringType :: ReasonOptions -> ReasonDatatype -> Bool+isReasonStringType opts reasonTypeExpr =+ reasonTypeExpr `elem` stringReasonTypes opts++{- | Determines whether we call `String.fromInt` on URL captures and query params of this type in Reason.+-}+isReasonIntType :: ReasonOptions -> ReasonDatatype -> Bool+isReasonIntType opts reasonTypeExpr =+ reasonTypeExpr `elem` intReasonTypes opts+++{- | Determines whether we call `String.fromFloat` on URL captures and query params of+this type in Reason.+-}+isReasonFloatType :: ReasonOptions -> ReasonDatatype -> Bool+isReasonFloatType opts reasonTypeExpr =+ reasonTypeExpr `elem` floatReasonTypes opts+++{- | Determines whether we convert to `true` or `false`+-}+isReasonBoolType :: ReasonOptions -> ReasonDatatype -> Bool+isReasonBoolType opts reasonTypeExpr =+ reasonTypeExpr `elem` boolReasonTypes opts++{- | Determines whether we call `String.fromChar` on URL captures and query params of+this type in Reason.+-}+isReasonCharType :: ReasonOptions -> ReasonDatatype -> Bool+isReasonCharType opts reasonTypeExpr =+ reasonTypeExpr `elem` charReasonTypes opts++{- | Determines whether a type is 'Maybe a' where 'a' is something akin to a 'String'.+-}+isReasonMaybeStringType :: ReasonOptions -> ReasonDatatype -> Bool+isReasonMaybeStringType opts (ReasonPrimitive (ROption reasonTypeExpr)) = reasonTypeExpr `elem` stringReasonTypes opts+isReasonMaybeStringType _ _ = False++isReasonMaybeType :: ReasonDatatype -> Bool+isReasonMaybeType (ReasonPrimitive (ROption _)) = True+isReasonMaybeType _ = False+++-- Doc helpers+++docToText :: Doc -> Text+docToText =+ L.toStrict . displayT . renderPretty 0.4 100++stext :: Text -> Doc+stext = text . L.fromStrict++reasonRecord :: [Doc] -> Doc+reasonRecord = encloseSep (lbrace <> space) (line <> rbrace) (comma <> space)++reasonList :: [Doc] -> Doc+reasonList [] = lbracket <> rbracket+reasonList ds = lbracket <+> hsep (punctuate (line <> comma) ds) <$> rbracket++reasonListOfMaybes :: [Doc] -> Doc+reasonListOfMaybes [] = lbracket <> rbracket+reasonListOfMaybes ds = "Belt.List.keepMap" <> parens (line <> reasonList ds <> ", x => x")
+ src/Servant/Reason/Internal/Orphans.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Servant.Reason.Internal.Orphans where++import Reason (ReasonDatatype, ReasonType, toReasonType)+import Servant.API (NoContent, Headers, getResponse)+++instance ReasonType ReasonDatatype where+ toReasonType = id+++instance ReasonType NoContent+++-- TODO: Generate Reason functions that can handle the response headers. PRs+-- welcome!+instance (ReasonType a) => ReasonType (Headers ls a) where+ toReasonType = toReasonType . getResponse
+ test/Common.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeOperators #-}+module Common where++import Data.Aeson (ToJSON)+import Data.Proxy (Proxy (Proxy))+import Data.Text (Text)+import Reason (ReasonType)+import GHC.Generics (Generic)+import Servant.API ((:<|>), (:>), Capture, Get, GetNoContent, Header,+ Header', Headers, JSON, NoContent, Post,+ PostNoContent, Put, QueryFlag, QueryParam,+ QueryParam', QueryParams, ReqBody, Required)++data Book = Book+ { title :: String+ } deriving (Generic)++instance ToJSON Book+instance ReasonType Book++type TestApi =+ "one"+ :> Get '[JSON] Int+ :<|> "two"+ :> ReqBody '[JSON] String+ :> Post '[JSON] (Maybe Int)+ :<|> "books"+ :> Capture "id" Int+ :> Get '[JSON] Book+ :<|> "books"+ :> Capture "title" Text+ :> Get '[JSON] Book+ :<|> "books"+ :> QueryFlag "published"+ :> QueryParam "sort" String+ :> QueryParam "year" Int+ :> QueryParam' '[Required] "category" String+ :> QueryParams "filters" (Maybe Bool)+ :> Get '[JSON] [Book]+ :<|> "books"+ :> ReqBody '[JSON] Book+ :> PostNoContent '[JSON] NoContent+ :<|> "nothing"+ :> GetNoContent '[JSON] NoContent+ :<|> "nothing"+ :> Put '[JSON] () -- old way to specify no content+ :<|> "with-a-header"+ :> Header "Cookie" String+ :> Header "myStringHeader" String+ :> Header "MyIntHeader" Int+ :> Header' '[Required] "MyRequiredStringHeader" String+ :> Header' '[Required] "MyRequiredIntHeader" Int+ :> Get '[JSON] String+ :<|> "with-a-response-header"+ :> Get '[JSON] (Headers '[Header "myResponse" String] String)++testApi :: Proxy TestApi+testApi = Proxy
+ test/CompileSpec.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module CompileSpec where++import Test.Hspec+import Test.Mockery.Directory++import Control.Exception+import Control.Monad (when)+import Data.String.Interpolate+import Data.String.Interpolate.Util+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Reason (toReasonDecoderSource,+ toReasonEncoderSource,+ toReasonTypeSource)+import Servant.API (NoContent)+import Servant.Reason+import System.Directory (canonicalizePath,+ createDirectoryIfMissing,+ doesDirectoryExist,+ getCurrentDirectory, removeFile,+ setCurrentDirectory)+import System.Process++import Common (Book, testApi)++main :: IO ()+main =+ hspec spec++spec :: Test.Hspec.Spec+spec = do+ describe "generateReasonForAPI" $ do+ it "creates compilable javascript" $ do+ inTempReasonDir $ do+ let generated =+ T.intercalate "\n\n" $+ defReasonImports :+ [ toReasonTypeSource (Proxy :: Proxy NoContent)+ , toReasonTypeSource (Proxy :: Proxy Book)+ , toReasonDecoderSource (Proxy :: Proxy Book)+ , toReasonEncoderSource (Proxy :: Proxy Book)+ ] +++ generateReasonForAPI testApi+ T.writeFile "src/Api.re" generated+ callCommand "yarn build"++inTempReasonDir :: IO a -> IO a+inTempReasonDir action = do+ cacheExists <- doesDirectoryExist "_test-cache"+ when (not cacheExists)+ createCache+ cacheSrcExists <- doesDirectoryExist "_test-cache/src"+ when (not cacheSrcExists) $ do+ createDirectoryIfMissing True "_test-cache/src"+ cacheDir <- canonicalizePath "_test-cache"+ inTempDirectory $ do+ callCommand ("cp -r " ++ cacheDir ++ "/* .")+ action++createCache :: IO ()+createCache = do+ createDirectoryIfMissing True "_test-cache"+ withCurrentDirectory "_test-cache" $ do+ writeFile "package.json" $ unindent $ [i|+{+ "name": "json-test-project",+ "version": "0.1.0",+ "scripts": {+ "build": "bsb -make-world",+ "start": "bsb -make-world -w",+ "clean": "bsb -clean-world"+ },+ "keywords": [+ "BuckleScript"+ ],+ "author": "",+ "license": "MIT",+ "devDependencies": {+ "bs-platform": "^5.0.0"+ },+ "dependencies": {+ "@glennsl/bs-json": "^3.0.0",+ "bs-fetch": "^0.3.1"+ }+}+ |]+ writeFile "bsconfig.json" $ unindent $ [i|+{+ "name": "json-test-project",+ "version": "0.1.0",+ "sources": {+ "dir" : "src",+ "subdirs" : true+ },+ "package-specs": {+ "module": "commonjs",+ "in-source": true+ },+ "suffix": ".bs.js",+ "bs-dependencies": [+ "bs-fetch",+ "@glennsl/bs-json"+ ],+ "warnings": {+ "error" : "+101"+ },+ "namespace": true,+ "refmt": 3+}+ |]+ callCommand "yarn install"+ compileDependencies++compileDependencies :: IO ()+compileDependencies = do+ pure ()++withCurrentDirectory :: FilePath -> IO a -> IO a+withCurrentDirectory dir action =+ bracket enter recover (const action)+ where+ enter = do+ original <- getCurrentDirectory+ setCurrentDirectory dir+ return original+ recover = setCurrentDirectory
+ test/GenerateSpec.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++module GenerateSpec where++import Control.Monad (zipWithM_)+import qualified Data.Algorithm.Diff as Diff+import qualified Data.Algorithm.DiffOutput as Diff+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Servant.API ((:>), Get, JSON)+import Servant.Reason+import Reason+import Test.Hspec (Spec, describe, hspec, it, runIO)+import Test.HUnit (Assertion, assertBool)++import Common (testApi, Book)+++main :: IO ()+main = hspec spec++spec :: Test.Hspec.Spec+spec = do+ runIO $ putStrLn $ T.unpack $ toReasonTypeSourceWith defaultOptions (Proxy :: Proxy Book)+ runIO $ putStrLn $ T.unpack $ toReasonDecoderSourceWith defaultOptions (Proxy :: Proxy Book)+ runIO $ putStrLn $ T.unpack $ toReasonEncoderSourceWith defaultOptions (Proxy :: Proxy Book)+ describe "encoding a simple api" $+ do it "does it" $+ do expected <-+ mapM+ (\(fpath,header) -> do+ source <- T.readFile fpath+ return (fpath, header, source))+ [ ( "test/reason-sources/getOneSource.re", "")+ , ( "test/reason-sources/postTwoSource.re", "")+ , ( "test/reason-sources/getBooksByIdSource.re", "open BookType;\n")+ , ( "test/reason-sources/getBooksByTitleSource.re", "open BookType;\n")+ , ( "test/reason-sources/getBooksSource.re", "open BookType;\n")+ , ( "test/reason-sources/postBooksSource.re", "open BookType;\n")+ , ( "test/reason-sources/getNothingSource.re", "open BookType;\n")+ , ( "test/reason-sources/putNothingSource.re", "open BookType;\n")+ , ( "test/reason-sources/getWithaheaderSource.re", "open BookType;\n")+ , ( "test/reason-sources/getWitharesponseheaderSource.re", "open BookType;\n")]+ let generated = map (<> "\n") (generateReasonForAPI testApi)+ generated `itemsShouldBe` expected+ it "with dynamic URLs" $+ do expected <-+ mapM+ (\(fpath,header) -> do+ source <- T.readFile fpath+ return (fpath, header, source))+ [( "test/reason-sources/getOneWithDynamicUrlSource.re", "open BookType;\n")]+ let generated =+ map+ (<> "\n")+ (generateReasonForAPIWith+ (defReasonOptions+ { urlPrefix = Dynamic+ })+ (Proxy :: Proxy ("one" :> Get '[JSON] Int)))+ generated `itemsShouldBe` expected++itemsShouldBe :: [Text] -> [(String, Text, Text)] -> IO ()+itemsShouldBe actual expected =+ zipWithM_+ shouldBeDiff+ (actual ++ replicate (length expected - length actual) mempty)+ (expected ++ replicate (length actual - length expected) mempty)++shouldBeDiff :: Text -> (String, Text, Text) -> Assertion+shouldBeDiff a (fpath,header,b) =+ assertBool+ ("< generated\n" <> "> " <> fpath <> "\n" <>+ Diff.ppDiff+ (Diff.getGroupedDiff+ (lines (T.unpack (header <> a)))+ (lines (T.unpack b))))+ (header <> a == b)
+ test/reason-sources/BookType.re view
@@ -0,0 +1,7 @@+type book = { title : string}++let rec decodeBook = json =>+ {title : json |> Json.Decode.field ("title" ,Json.Decode.string),}++let rec encodeBook = (x : book) => + Json.Encode.object_ ([ ( "title", Json.Encode.string(x.title) )])
+ test/reason-sources/getBooksByIdSource.re view
@@ -0,0 +1,13 @@+open BookType;+let getBooksById = (capture_id) => {+ Js.Promise.(+ Fetch.fetchWithInit(String.concat("/"+ ,[ ""+ , "books"+ , capture_id |> string_of_int |> Js_global.encodeURIComponent+ ])+ ,Fetch.RequestInit.make(~method_=Get+ ,()))+ |> then_(Fetch.Response.json)+ |> then_(response => (response |> decodeBook |> ((x) => Belt_Result.Ok(x)) |> resolve)))+}
+ test/reason-sources/getBooksByTitleSource.re view
@@ -0,0 +1,13 @@+open BookType;+let getBooksByTitle = (capture_title) => {+ Js.Promise.(+ Fetch.fetchWithInit(String.concat("/"+ ,[ ""+ , "books"+ , capture_title |> ((x) => x) |> Js_global.encodeURIComponent+ ])+ ,Fetch.RequestInit.make(~method_=Get+ ,()))+ |> then_(Fetch.Response.json)+ |> then_(response => (response |> decodeBook |> ((x) => Belt_Result.Ok(x)) |> resolve)))+}
+ test/reason-sources/getBooksSource.re view
@@ -0,0 +1,37 @@+open BookType;+let getBooks = (query_published+ ,query_sort+ ,query_year+ ,query_category+ ,query_filters) => {+ let+ params =+ List.filter(((x) => (String.length(x) > 0))+ ,[ if(query_published) {"published="} else {""}+ , query_sort+ |> ((x) => Belt.Option.mapWithDefault(x, "", ((x) => x)))+ |> Js_global.encodeURIComponent+ |> ((x__) => if(String.length(x__) > 0) { "query_sort=" ++ x__ } else {""})+ , query_year+ |> ((x) => Belt.Option.mapWithDefault(x, "", string_of_int))+ |> Js_global.encodeURIComponent+ |> ((x__) => if(String.length(x__) > 0) { "query_year=" ++ x__ } else {""})+ , query_category+ |> ((x) => x)+ |> Js_global.encodeURIComponent+ |> ((x__) => if(String.length(x__) > 0) { "query_category=" ++ x__ } else {""})+ , String.concat("&"+ ,List.map((x) => "filters[]=" ++ Js_global.encodeURIComponent(((x) => Belt.Option.mapWithDefault(x, "", string_of_bool))(x)), query_filters))+ ]);+ Js.Promise.(+ Fetch.fetchWithInit(String.concat("/"+ ,[ ""+ , "books"+ ])+ ++ if(List.length(params)==0) {""} else {"?" ++ String.concat("&"+ ,params)}+ ,Fetch.RequestInit.make(~method_=Get+ ,()))+ |> then_(Fetch.Response.json)+ |> then_(response => (response |> Json.Decode.list(decodeBook) |> ((x) => Belt_Result.Ok(x)) |> resolve)))+}
+ test/reason-sources/getNothingSource.re view
@@ -0,0 +1,12 @@+open BookType;+let getNothing = () => {+ Js.Promise.(+ Fetch.fetchWithInit(String.concat("/"+ ,[ ""+ , "nothing"+ ])+ ,Fetch.RequestInit.make(~method_=Get+ ,()))+ |> then_(Fetch.Response.text)+ |> then_(response => (response |> ((x) => if(String.length(x) != 0) { resolve(Belt_Result.Error("Expected the response body to empty")) } else { resolve(Belt_Result.Ok(x)) }))))+}
+ test/reason-sources/getOneSource.re view
@@ -0,0 +1,11 @@+let getOne = () => {+ Js.Promise.(+ Fetch.fetchWithInit(String.concat("/"+ ,[ ""+ , "one"+ ])+ ,Fetch.RequestInit.make(~method_=Get+ ,()))+ |> then_(Fetch.Response.json)+ |> then_(response => (response |> Json.Decode.int |> ((x) => Belt_Result.Ok(x)) |> resolve)))+}
+ test/reason-sources/getOneWithDynamicUrlSource.re view
@@ -0,0 +1,12 @@+open BookType;+let getOne = (urlBase) => {+ Js.Promise.(+ Fetch.fetchWithInit(String.concat("/"+ ,[ urlBase+ , "one"+ ])+ ,Fetch.RequestInit.make(~method_=Get+ ,()))+ |> then_(Fetch.Response.json)+ |> then_(response => (response |> Json.Decode.int |> ((x) => Belt_Result.Ok(x)) |> resolve)))+}
+ test/reason-sources/getWithaheaderSource.re view
@@ -0,0 +1,24 @@+open BookType;+let getWithaheader = (header_myStringHeader+ ,header_MyIntHeader+ ,header_MyRequiredStringHeader+ ,header_MyRequiredIntHeader) => {+ Js.Promise.(+ Fetch.fetchWithInit(String.concat("/"+ ,[ ""+ , "with-a-header"+ ])+ ,Fetch.RequestInit.make(~method_=Get+ ,~headers=+ Fetch.HeadersInit.makeWithDict(+ Js.Dict.fromList(+ Belt.List.keepMap(+ [ Belt.Option.map(header_myStringHeader, x => ("myStringHeader", x |> ((x) => x)))+ , Belt.Option.map(header_MyIntHeader, x => ("MyIntHeader", x |> string_of_int))+ , Belt.Option.map((Some(header_MyRequiredStringHeader)), x => ("MyRequiredStringHeader", x |> ((x) => x)))+ , Belt.Option.map((Some(header_MyRequiredIntHeader)), x => ("MyRequiredIntHeader", x |> string_of_int))+ ], x => x)))+ ,()))+ |> then_(Fetch.Response.json)+ |> then_(response => (response |> Json.Decode.string |> ((x) => Belt_Result.Ok(x)) |> resolve)))+}
+ test/reason-sources/getWitharesponseheaderSource.re view
@@ -0,0 +1,12 @@+open BookType;+let getWitharesponseheader = () => {+ Js.Promise.(+ Fetch.fetchWithInit(String.concat("/"+ ,[ ""+ , "with-a-response-header"+ ])+ ,Fetch.RequestInit.make(~method_=Get+ ,()))+ |> then_(Fetch.Response.json)+ |> then_(response => (response |> Json.Decode.string |> ((x) => Belt_Result.Ok(x)) |> resolve)))+}
+ test/reason-sources/postBooksSource.re view
@@ -0,0 +1,19 @@+open BookType;+let postBooks = (body) => {+ Js.Promise.(+ Fetch.fetchWithInit(String.concat("/"+ ,[ ""+ , "books"+ ])+ ,Fetch.RequestInit.make(~method_=Post+ ,~headers=+ Fetch.HeadersInit.makeWithDict(+ Js.Dict.fromList(+ Belt.List.keepMap(+ [ Some(("Content-Type","application/json"))+ ], x => x)))+ ,~body=Fetch.BodyInit.make(Js.Json.stringify(encodeBook(body)))+ ,()))+ |> then_(Fetch.Response.text)+ |> then_(response => (response |> ((x) => if(String.length(x) != 0) { resolve(Belt_Result.Error("Expected the response body to empty")) } else { resolve(Belt_Result.Ok(x)) }))))+}
+ test/reason-sources/postTwoSource.re view
@@ -0,0 +1,18 @@+let postTwo = (body) => {+ Js.Promise.(+ Fetch.fetchWithInit(String.concat("/"+ ,[ ""+ , "two"+ ])+ ,Fetch.RequestInit.make(~method_=Post+ ,~headers=+ Fetch.HeadersInit.makeWithDict(+ Js.Dict.fromList(+ Belt.List.keepMap(+ [ Some(("Content-Type","application/json"))+ ], x => x)))+ ,~body=Fetch.BodyInit.make(Js.Json.stringify(Json.Encode.string(body)))+ ,()))+ |> then_(Fetch.Response.json)+ |> then_(response => (response |> Json.Decode.optional(Json.Decode.int) |> ((x) => Belt_Result.Ok(x)) |> resolve)))+}
+ test/reason-sources/putNothingSource.re view
@@ -0,0 +1,12 @@+open BookType;+let putNothing = () => {+ Js.Promise.(+ Fetch.fetchWithInit(String.concat("/"+ ,[ ""+ , "nothing"+ ])+ ,Fetch.RequestInit.make(~method_=Put+ ,()))+ |> then_(Fetch.Response.text)+ |> then_(response => (response |> ((x) => if(String.length(x) != 0) { resolve(Belt_Result.Error("Expected the response body to empty")) } else { resolve(Belt_Result.Ok(x)) }))))+}