diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ ## Unreleased changes +## 0.4.1.0 + +- Update to `elm-syntax-0.3.0.0` and `haskell-to-elm-0.3.0.0`, adding support for parameterised types + ## 0.4.0.0 - Make endpoints that return NoContent (HTTP status code 204) return `()` on the Elm side, and remove instances for the `NoContent` type diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -13,7 +13,7 @@ ```haskell type UserAPI = "user" :> Get '[JSON] User - :<|> "user" :> ReqBody '[JSON] User :> Post '[JSON] NoContent + :<|> "user" :> ReqBody '[JSON] User :> PostNoContent '[JSON] NoContent ``` we can generate the Elm code for making requests against it as follows: @@ -43,7 +43,6 @@ import Config import Http import Json.Decode -import NoContent getUser : Cmd (Result (Http.Error , Maybe { metadata : Http.Metadata @@ -74,7 +73,7 @@ postUser : Api.User.User -> Cmd (Result (Http.Error , Maybe { metadata : Http.Metadata - , body : String }) NoContent.NoContent) + , body : String }) ()) postUser a = Http.request { method = "POST" , headers = [] @@ -95,7 +94,7 @@ Http.GoodStatus_ c d -> if d == "" then - Ok NoContent.NoContent + Ok () else Err (Http.BadBody "Expected the response body to be empty" , Just { metadata = c diff --git a/examples/UserAPI.hs b/examples/UserAPI.hs --- a/examples/UserAPI.hs +++ b/examples/UserAPI.hs @@ -1,18 +1,18 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} +{-# language DataKinds #-} +{-# language DeriveAnyClass #-} +{-# language DeriveGeneric #-} +{-# language MultiParamTypeClasses #-} +{-# language OverloadedStrings #-} +{-# language TypeApplications #-} +{-# language TypeOperators #-} module UserAPI where -import Protolude - import qualified Data.Aeson as Aeson +import Data.Foldable import qualified Data.HashMap.Lazy as HashMap +import Data.Text (Text) import qualified Generics.SOP as SOP +import GHC.Generics import Servant.API import qualified Language.Elm.Pretty as Pretty @@ -39,7 +39,7 @@ type UserAPI = "user" :> Get '[JSON] User - :<|> "user" :> ReqBody '[JSON] User :> Post '[JSON] NoContent + :<|> "user" :> ReqBody '[JSON] User :> PostNoContent '[JSON] NoContent main :: IO () main = do diff --git a/servant-to-elm.cabal b/servant-to-elm.cabal --- a/servant-to-elm.cabal +++ b/servant-to-elm.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 9bc8ea51733447a3197fbc2ff1b7df7f9e35bd30ad2a262087efea102701806b +-- hash: 76dda62e30819622cd48fbd148358cdb0b25fddec8951c2cca91efd425813fcb name: servant-to-elm -version: 0.4.0.0 +version: 0.4.1.0 synopsis: Automatically generate Elm clients for Servant APIs description: Please see the README on GitHub at category: Servant, API, Elm, Compiler @@ -18,6 +18,7 @@ copyright: 2019 Olle Fredriksson license: BSD3 license-file: LICENSE +tested-with: GHC == 8.4.3, GHC == 8.6.5, GHC == 8.8.3 build-type: Simple extra-source-files: README.md @@ -44,10 +45,9 @@ aeson >=1.4.0 , base >=4.7 && <5 , bound >=2.0.0 - , elm-syntax >=0.2.0 && <0.2.1 - , haskell-to-elm >=0.2.0 && <0.2.2 + , elm-syntax >=0.3.0 && <0.3.1 + , haskell-to-elm >=0.3.0 && <0.3.1 , http-types >=0.12.0 - , protolude >=0.2.3 , servant >=0.16.0 , servant-multipart >=0.11.0 , text >=1.2.0 @@ -64,11 +64,10 @@ aeson >=1.4.0 , base >=4.7 && <5 , bound >=2.0.0 - , elm-syntax >=0.2.0 && <0.2.1 + , elm-syntax >=0.3.0 && <0.3.1 , generics-sop - , haskell-to-elm >=0.2.0 && <0.2.2 + , haskell-to-elm >=0.3.0 && <0.3.1 , http-types >=0.12.0 - , protolude >=0.2.3 , servant , servant-multipart >=0.11.0 , servant-to-elm @@ -90,10 +89,9 @@ aeson >=1.4.0 , base >=4.7 && <5 , bound >=2.0.0 - , elm-syntax >=0.2.0 && <0.2.1 - , haskell-to-elm >=0.2.0 && <0.2.2 + , elm-syntax >=0.3.0 && <0.3.1 + , haskell-to-elm >=0.3.0 && <0.3.1 , http-types >=0.12.0 - , protolude >=0.2.3 , servant >=0.16.0 , servant-multipart >=0.11.0 , servant-to-elm diff --git a/src/Servant/To/Elm.hs b/src/Servant/To/Elm.hs --- a/src/Servant/To/Elm.hs +++ b/src/Servant/To/Elm.hs @@ -1,32 +1,35 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# language AllowAmbiguousTypes #-} +{-# language BangPatterns #-} +{-# language DataKinds #-} +{-# language DuplicateRecordFields #-} +{-# language FlexibleContexts #-} +{-# language FlexibleInstances #-} +{-# language GADTs #-} +{-# language MultiParamTypeClasses #-} +{-# language OverloadedStrings #-} +{-# language PolyKinds #-} +{-# language ScopedTypeVariables #-} +{-# language TypeApplications #-} +{-# language TypeOperators #-} +{-# language UndecidableInstances #-} +{-# options_ghc -fno-warn-orphans #-} module Servant.To.Elm where -import Protolude hiding (Type, functionName, moduleName) - import qualified Bound import qualified Data.Aeson as Aeson import qualified Data.Char as Char +import Data.Proxy +import Data.String +import Data.Text (Text) import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import Data.Void +import GHC.TypeLits import qualified Network.HTTP.Types as HTTP import Servant.API ((:<|>), (:>)) import qualified Servant.API as Servant -import qualified Servant.Multipart as Servant import qualified Servant.API.Modifiers as Servant +import qualified Servant.Multipart as Servant import Language.Elm.Definition (Definition) import qualified Language.Elm.Definition as Definition @@ -47,8 +50,9 @@ elmEndpointDefinition urlBase moduleName endpoint = Definition.Constant (Name.Qualified moduleName functionName) - elmTypeSig - (panic "expression not closed" <$> lambdaArgs argNames elmLambdaBody) + 0 + (Bound.toScope $ vacuous $ elmTypeSig) + (error "expression not closed" <$> lambdaArgs argNames elmLambdaBody) where functionName = case _functionName endpoint of @@ -161,7 +165,7 @@ Expression.App "Http.request" (Expression.Record - [ ("method", Expression.String $ toS $ _method endpoint) + [ ("method", Expression.String $ Text.decodeUtf8 $ _method endpoint) , ("headers", elmHeaders) , ("url", elmUrl) , ("body", elmBody) @@ -324,7 +328,7 @@ , Bound.toScope $ case _returnType endpoint of Nothing -> - panic "elmRequest: No return type" -- TODO? + error "elmRequest: No return type" -- TODO? Just (Left Servant.NoContent) -> Expression.if_ (Expression.apps ("Basics.==") [pure $ Bound.B 1, Expression.String ""]) @@ -366,15 +370,15 @@ headerArgName :: Int -> Text headerArgName i = - "header" <> show i + "header" <> fromString (show i) capturedArgName :: Int -> Text capturedArgName i = - "capture" <> show i + "capture" <> fromString (show i) paramArgName :: Int -> Text paramArgName i = - "param" <> show i + "param" <> fromString (show i) ------------------------------------------------------------------------------- -- * Endpoints @@ -459,7 +463,7 @@ } where str = - toS $ symbolVal $ Proxy @symbol + fromString $ symbolVal $ Proxy @symbol instance (KnownSymbol symbol, HasElmEncoder Text a, HasElmEndpoints api) => HasElmEndpoints (Servant.CaptureAll symbol a :> api) where @@ -472,7 +476,7 @@ } where str = - toS $ symbolVal $ Proxy @symbol + fromString $ symbolVal $ Proxy @symbol instance (Servant.ReflectMethod method, HasElmDecoder Aeson.Value a, list ~ '[Servant.JSON]) => HasElmEndpoints (Servant.Verb method 200 list a) where @@ -480,7 +484,7 @@ [ prefix { _method = method , _returnType = Just $ Right $ makeDecoder @Aeson.Value @a - , _functionName = Text.toLower (toS method) : _functionName prefix + , _functionName = Text.toLower (Text.decodeUtf8 method) : _functionName prefix } ] where @@ -492,7 +496,7 @@ [ prefix { _method = method , _returnType = Just $ Left Servant.NoContent - , _functionName = Text.toLower (toS method) : _functionName prefix + , _functionName = Text.toLower (Text.decodeUtf8 method) : _functionName prefix } ] where @@ -508,7 +512,7 @@ elmEndpoints' prefix = elmEndpoints' @api prefix { _headers = _headers prefix <> - [ ( toS $ symbolVal $ Proxy @symbol + [ ( fromString $ symbolVal $ Proxy @symbol , makeEncoder @(Servant.RequiredArgument mods Text) @(Servant.RequiredArgument mods a) , case Servant.sbool @(Servant.FoldRequired mods) of Servant.STrue -> @@ -531,7 +535,7 @@ { _url = (_url prefix) { _queryString = _queryString (_url prefix) <> - [ ( toS $ symbolVal $ Proxy @symbol + [ ( fromString $ symbolVal $ Proxy @symbol , case Servant.sbool @(Servant.FoldRequired mods) of Servant.STrue -> Required @@ -551,7 +555,7 @@ { _url = (_url prefix) { _queryString = _queryString (_url prefix) <> - [ ( toS $ symbolVal $ Proxy @symbol + [ ( fromString $ symbolVal $ Proxy @symbol , List , makeEncoder @Text @a ) @@ -566,7 +570,7 @@ { _url = (_url prefix) { _queryString = _queryString (_url prefix) <> - [ ( toS $ symbolVal $ Proxy @symbol + [ ( fromString $ symbolVal $ Proxy @symbol , Flag , Encoder "Basics.identity" "Basics.Bool" ) @@ -598,7 +602,7 @@ } where path = - toS $ symbolVal $ Proxy @path + fromString $ symbolVal $ Proxy @path instance HasElmEndpoints api => HasElmEndpoints (Servant.RemoteHost :> api) where elmEndpoints' = elmEndpoints' @api