{-# 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
  ( elmEndpointDefinition
  , elmEndpointRequestInfo
  , HasElmEndpoints(..)
  , elmEndpoints
  , Endpoint(..)
  , PathSegment (..)
  , QueryParamType(..)
  , URL(..)
  , Encoder(..)
  , Decoder(..)
  , makeEncoder
  , makeDecoder
  ) where

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.API.Modifiers as Servant
import qualified Servant.Multipart as Servant

import Language.Elm.Definition (Definition)
import qualified Language.Elm.Definition as Definition
import Language.Elm.Expression (Expression)
import qualified Language.Elm.Expression as Expression
import qualified Language.Elm.Name as Name
import qualified Language.Elm.Pattern as Pattern
import Language.Elm.Type (Type)
import qualified Language.Elm.Type as Type
import Language.Haskell.To.Elm

-- | Generate an Elm function for making a request to a Servant endpoint.
--
-- See 'elmEndpointRequestInfo' if you need more flexibility,
-- such as setting timeouts.
elmEndpointDefinition
  :: Expression Void -- ^ The URL base of the endpoint
  -> Name.Module -- ^ The module that the function should be generated into
  -> Endpoint -- ^ A description of the endpoint
  -> Definition
elmEndpointDefinition :: Expression Void -> Module -> Endpoint -> Definition
elmEndpointDefinition Expression Void
urlBase Module
moduleName Endpoint
endpoint =
  Qualified
-> Int -> Scope Int Type Void -> Expression Void -> Definition
Definition.Constant
    (Module -> Text -> Qualified
Name.Qualified Module
moduleName (Endpoint -> Text
functionName Endpoint
endpoint))
    Int
0
    (Type (Var Int Void) -> Scope Int Type Void
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Type (Var Int Void) -> Scope Int Type Void)
-> Type (Var Int Void) -> Scope Int Type Void
forall a b. (a -> b) -> a -> b
$ Type Void -> Type (Var Int Void)
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Type Void -> Type (Var Int Void))
-> Type Void -> Type (Var Int Void)
forall a b. (a -> b) -> a -> b
$ Type Void
elmTypeSig)
    ([Char] -> Text -> Void
forall a. HasCallStack => [Char] -> a
error [Char]
"expression not closed" (Text -> Void) -> Expression Text -> Expression Void
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module -> Expression Text -> Expression Text
lambdaArgs (Endpoint -> Module
argNames Endpoint
endpoint) Expression Text
elmLambdaBody)
  where
    elmTypeSig :: Type Void
    elmTypeSig :: Type Void
elmTypeSig =
      [Type Void] -> Type Void -> Type Void
forall v. [Type v] -> Type v -> Type v
Type.funs
        ([[Type Void]] -> [Type Void]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [ Encoder -> Type Void
_encodedType Encoder
arg
            | (Text
_, Encoder
arg, Bool
_) <- Endpoint -> [(Text, Encoder, Bool)]
_headers Endpoint
endpoint
            ]
          , [ Encoder -> Type Void
_encodedType Encoder
arg
            | Capture Text
_ (Int
_, Encoder
arg) <- Endpoint -> [PathSegment (Int, Encoder)]
numberedPathSegments Endpoint
endpoint
            ]
          , [ case QueryParamType
type_ of
                QueryParamType
Required ->
                  Type Void -> Type Void
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Type Void -> Type Void) -> Type Void -> Type Void
forall a b. (a -> b) -> a -> b
$ Encoder -> Type Void
_encodedType Encoder
arg

                QueryParamType
Optional ->
                  Type Void -> Type Void
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Type Void -> Type Void) -> Type Void -> Type Void
forall a b. (a -> b) -> a -> b
$ Encoder -> Type Void
_encodedType Encoder
arg

                QueryParamType
Flag ->
                  Type Void -> Type Void
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Type Void -> Type Void) -> Type Void -> Type Void
forall a b. (a -> b) -> a -> b
$ Encoder -> Type Void
_encodedType Encoder
arg

                QueryParamType
List ->
                  Type Void -> Type Void
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Type Void -> Type Void) -> Type Void -> Type Void
forall a b. (a -> b) -> a -> b
$ Type Void -> Type Void -> Type Void
forall v. Type v -> Type v -> Type v
Type.App Type Void
"List.List" (Type Void -> Type Void) -> Type Void -> Type Void
forall a b. (a -> b) -> a -> b
$ Encoder -> Type Void
_encodedType Encoder
arg
            | (Text
_, QueryParamType
type_, Encoder
arg) <- URL -> [(Text, QueryParamType, Encoder)]
_queryString (URL -> [(Text, QueryParamType, Encoder)])
-> URL -> [(Text, QueryParamType, Encoder)]
forall a b. (a -> b) -> a -> b
$ Endpoint -> URL
_url Endpoint
endpoint
            ]
          , [ Encoder -> Type Void
_encodedType Encoder
body
            | Just (Expression Void
_, Encoder
body) <- [Endpoint -> Maybe (Expression Void, Encoder)
_body Endpoint
endpoint]
            ]
          ]
        )
        Type Void
elmReturnType

    elmReturnType :: Type Void
elmReturnType =
      let
        type_ :: Type Void
type_ =
          case Endpoint -> Maybe (Either NoContent Decoder)
_returnType Endpoint
endpoint of
            Maybe (Either NoContent Decoder)
Nothing ->
              Type Void
"Basics.()"

            Just (Left NoContent
Servant.NoContent) ->
              Type Void
"Basics.()"

            Just (Right Decoder
decoder) ->
              Decoder -> Type Void
_decodedType Decoder
decoder
      in
      Type Void -> Type Void -> Type Void
forall v. Type v -> Type v -> Type v
Type.App
        Type Void
"Cmd.Cmd"
        (Type Void -> [Type Void] -> Type Void
forall v. Type v -> [Type v] -> Type v
Type.apps
          Type Void
"Result.Result"
          [Type Void -> Type Void -> Type Void
forall v. Type v -> Type v -> Type v
Type.tuple Type Void
"Http.Error" (Type Void -> Type Void -> Type Void
forall v. Type v -> Type v -> Type v
Type.App Type Void
"Maybe.Maybe" (Type Void -> Type Void) -> Type Void -> Type Void
forall a b. (a -> b) -> a -> b
$ [(Field, Type Void)] -> Type Void
forall v. [(Field, Type v)] -> Type v
Type.Record [(Field
"metadata", Type Void
"Http.Metadata"), (Field
"body", Type Void
"String.String")]), Type Void
type_]
        )

    elmLambdaBody :: Expression Text
    elmLambdaBody :: Expression Text
elmLambdaBody =
      Expression Text -> Expression Text -> Expression Text
forall v. Expression v -> Expression v -> Expression v
Expression.App
        Expression Text
"Http.request"
        ([(Field, Expression Text)] -> Expression Text
forall v. [(Field, Expression v)] -> Expression v
Expression.Record
          [ (Field
"method", Text -> Expression Text
forall v. Text -> Expression v
Expression.String (Text -> Expression Text) -> Text -> Expression Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Endpoint -> ByteString
_method Endpoint
endpoint)
          , (Field
"headers", Endpoint -> Expression Text
elmHeaders Endpoint
endpoint)
          , (Field
"url", Expression Text
elmUrl)
          , (Field
"body", Endpoint -> Expression Text
elmBody Endpoint
endpoint)
          , (Field
"expect", Endpoint -> Expression Text
forall a. Endpoint -> Expression a
elmExpect Endpoint
endpoint)
          , (Field
"timeout", Expression Text
"Maybe.Nothing")
          , (Field
"tracker", Expression Text
"Maybe.Nothing")
          ]
        )

    elmUrl :: Expression Text
elmUrl =
      Expression Text -> [Expression Text] -> Expression Text
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps
        Expression Text
"Url.Builder.crossOrigin"
        [ Expression Void -> Expression Text
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous Expression Void
urlBase
        , [Expression Text] -> Expression Text
forall v. [Expression v] -> Expression v
Expression.List ([Expression Text] -> Expression Text)
-> [Expression Text] -> Expression Text
forall a b. (a -> b) -> a -> b
$ (PathSegment (Int, Encoder) -> Expression Text)
-> [PathSegment (Int, Encoder)] -> [Expression Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathSegment (Int, Encoder) -> Expression Text
elmPathSegment (Endpoint -> [PathSegment (Int, Encoder)]
numberedPathSegments Endpoint
endpoint)
        , Expression Text -> Expression Text -> Expression Text
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression Text
"List.concat" (Expression Text -> Expression Text)
-> Expression Text -> Expression Text
forall a b. (a -> b) -> a -> b
$ [Expression Text] -> Expression Text
forall v. [Expression v] -> Expression v
Expression.List (Endpoint -> [Expression Text]
elmParams Endpoint
endpoint)
        ]

-- | Generate an Elm function for creating information needed to make an HTTP request.
-- This gives the user flexibility in how to actually make the request.
--
-- For example, they can use the <https://package.elm-lang.org/packages/elm/http/latest/Http#request>
-- function and provide it with their own @timeout@ and @tracker@ arguments.
--
-- It also leaves building the final URL to the Elm user.
-- This gives them the flexibility to do things like vary the domain used at runtime
-- based on whether the app's in staging or production.
-- Note that they must remember to use BOTH @urlPath@ and @urlQueryParams@.
elmEndpointRequestInfo
  :: Name.Module -- ^ The module that the function should be generated into
  -> Endpoint -- ^ A description of the endpoint
  -> Definition
elmEndpointRequestInfo :: Module -> Endpoint -> Definition
elmEndpointRequestInfo Module
moduleName Endpoint
endpoint =
  Qualified
-> Int -> Scope Int Type Void -> Expression Void -> Definition
Definition.Constant
    (Module -> Text -> Qualified
Name.Qualified Module
moduleName (Endpoint -> Text
functionName Endpoint
endpoint))
    Int
0
    (Type (Var Int Void) -> Scope Int Type Void
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Type (Var Int Void) -> Scope Int Type Void)
-> Type (Var Int Void) -> Scope Int Type Void
forall a b. (a -> b) -> a -> b
$ Type Void -> Type (Var Int Void)
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Type Void -> Type (Var Int Void))
-> Type Void -> Type (Var Int Void)
forall a b. (a -> b) -> a -> b
$ Type Void
elmTypeSig)
    ([Char] -> Text -> Void
forall a. HasCallStack => [Char] -> a
error [Char]
"expression not closed" (Text -> Void) -> Expression Text -> Expression Void
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module -> Expression Text -> Expression Text
lambdaArgs (Endpoint -> Module
argNames Endpoint
endpoint) Expression Text
elmLambdaBody)
  where
    elmTypeSig :: Type Void
    elmTypeSig :: Type Void
elmTypeSig =
      [Type Void] -> Type Void -> Type Void
forall v. [Type v] -> Type v -> Type v
Type.funs
        ([[Type Void]] -> [Type Void]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [ Encoder -> Type Void
_encodedType Encoder
arg
            | (Text
_, Encoder
arg, Bool
_) <- Endpoint -> [(Text, Encoder, Bool)]
_headers Endpoint
endpoint
            ]
          , [ Encoder -> Type Void
_encodedType Encoder
arg
            | Capture Text
_ (Int
_, Encoder
arg) <- Endpoint -> [PathSegment (Int, Encoder)]
numberedPathSegments Endpoint
endpoint
            ]
          , [ case QueryParamType
type_ of
                QueryParamType
Required ->
                  Type Void -> Type Void
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Type Void -> Type Void) -> Type Void -> Type Void
forall a b. (a -> b) -> a -> b
$ Encoder -> Type Void
_encodedType Encoder
arg

                QueryParamType
Optional ->
                  Type Void -> Type Void
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Type Void -> Type Void) -> Type Void -> Type Void
forall a b. (a -> b) -> a -> b
$ Encoder -> Type Void
_encodedType Encoder
arg

                QueryParamType
Flag ->
                  Type Void -> Type Void
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Type Void -> Type Void) -> Type Void -> Type Void
forall a b. (a -> b) -> a -> b
$ Encoder -> Type Void
_encodedType Encoder
arg

                QueryParamType
List ->
                  Type Void -> Type Void
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Type Void -> Type Void) -> Type Void -> Type Void
forall a b. (a -> b) -> a -> b
$ Type Void -> Type Void -> Type Void
forall v. Type v -> Type v -> Type v
Type.App Type Void
"List.List" (Type Void -> Type Void) -> Type Void -> Type Void
forall a b. (a -> b) -> a -> b
$ Encoder -> Type Void
_encodedType Encoder
arg
            | (Text
_, QueryParamType
type_, Encoder
arg) <- URL -> [(Text, QueryParamType, Encoder)]
_queryString (URL -> [(Text, QueryParamType, Encoder)])
-> URL -> [(Text, QueryParamType, Encoder)]
forall a b. (a -> b) -> a -> b
$ Endpoint -> URL
_url Endpoint
endpoint
            ]
          , [ Encoder -> Type Void
_encodedType Encoder
body
            | Just (Expression Void
_, Encoder
body) <- [Endpoint -> Maybe (Expression Void, Encoder)
_body Endpoint
endpoint]
            ]
          ]
        )
        Type Void
elmReturnType

    elmReturnType :: Type Void
elmReturnType =
      let
        type_ :: Type Void
type_ =
          case Endpoint -> Maybe (Either NoContent Decoder)
_returnType Endpoint
endpoint of
            Maybe (Either NoContent Decoder)
Nothing ->
              Type Void
"Basics.()"

            Just (Left NoContent
Servant.NoContent) ->
              Type Void
"Basics.()"

            Just (Right Decoder
decoder) ->
              Decoder -> Type Void
_decodedType Decoder
decoder

        expectType :: Type Void
expectType =
          Type Void -> Type Void -> Type Void
forall v. Type v -> Type v -> Type v
Type.App
            Type Void
"Http.Expect"
            (Type Void -> [Type Void] -> Type Void
forall v. Type v -> [Type v] -> Type v
Type.apps
              Type Void
"Result.Result"
              [ Type Void -> Type Void -> Type Void
forall v. Type v -> Type v -> Type v
Type.tuple
                  Type Void
"Http.Error"
                  (Type Void -> Type Void -> Type Void
forall v. Type v -> Type v -> Type v
Type.App Type Void
"Maybe.Maybe" (Type Void -> Type Void) -> Type Void -> Type Void
forall a b. (a -> b) -> a -> b
$ [(Field, Type Void)] -> Type Void
forall v. [(Field, Type v)] -> Type v
Type.Record [(Field
"metadata", Type Void
"Http.Metadata"), (Field
"body", Type Void
"String.String")])
              , Type Void
type_
              ])
      in
      [(Field, Type Void)] -> Type Void
forall v. [(Field, Type v)] -> Type v
Type.Record
        [ (Field
"method", Type Void
"String.String")
        , (Field
"headers", Type Void -> Type Void -> Type Void
forall v. Type v -> Type v -> Type v
Type.App Type Void
"List.List" Type Void
"Http.Header")
        , (Field
"urlPath", Type Void -> Type Void -> Type Void
forall v. Type v -> Type v -> Type v
Type.App Type Void
"List.List" Type Void
"String.String")
        , (Field
"urlQueryParams", Type Void -> Type Void -> Type Void
forall v. Type v -> Type v -> Type v
Type.App Type Void
"List.List" Type Void
"Url.Builder.QueryParameter")
        , (Field
"body", Type Void
"Http.Body")
        , (Field
"expect", Type Void
expectType)
        ]

    elmLambdaBody :: Expression Text
    elmLambdaBody :: Expression Text
elmLambdaBody =
      [(Field, Expression Text)] -> Expression Text
forall v. [(Field, Expression v)] -> Expression v
Expression.Record
        [ (Field
"method", Text -> Expression Text
forall v. Text -> Expression v
Expression.String (Text -> Expression Text) -> Text -> Expression Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Endpoint -> ByteString
_method Endpoint
endpoint)
        , (Field
"headers", Endpoint -> Expression Text
elmHeaders Endpoint
endpoint)
        , (Field
"urlPath", [Expression Text] -> Expression Text
forall v. [Expression v] -> Expression v
Expression.List ((PathSegment (Int, Encoder) -> Expression Text)
-> [PathSegment (Int, Encoder)] -> [Expression Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathSegment (Int, Encoder) -> Expression Text
elmPathSegment (Endpoint -> [PathSegment (Int, Encoder)]
numberedPathSegments Endpoint
endpoint)))
        , (Field
"urlQueryParams", [Expression Text] -> Expression Text
forall v. [Expression v] -> Expression v
Expression.List (Endpoint -> [Expression Text]
elmParams Endpoint
endpoint))
        , (Field
"body", Endpoint -> Expression Text
elmBody Endpoint
endpoint)
        , (Field
"expect", Endpoint -> Expression Text
forall a. Endpoint -> Expression a
elmExpect Endpoint
endpoint)
        ]

-------------------------------------------------------------------------------
-- * Endpoints

-- | @'HasElmEndpoints' api@ means that the Servant API @api@ can be converted
-- to a list of 'Endpoint's, which contains the information we need to generate
-- an Elm client library for the API.
class HasElmEndpoints api where
  elmEndpoints' :: Endpoint -> [Endpoint]

-- | Convert an API to a list of Elm endpoint descriptors, 'Endpoint'.
--
-- Usage: @'elmEndpoints' \@MyAPI@
elmEndpoints :: forall api. HasElmEndpoints api => [Endpoint]
elmEndpoints :: [Endpoint]
elmEndpoints = Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api Endpoint :: URL
-> ByteString
-> [(Text, Encoder, Bool)]
-> Maybe (Expression Void, Encoder)
-> Maybe (Either NoContent Decoder)
-> Module
-> Endpoint
Endpoint
  { $sel:_url:Endpoint :: URL
_url = URL :: [PathSegment Encoder] -> [(Text, QueryParamType, Encoder)] -> URL
URL
    { $sel:_path:URL :: [PathSegment Encoder]
_path = []
    , $sel:_queryString:URL :: [(Text, QueryParamType, Encoder)]
_queryString = []
    }
  , $sel:_method:Endpoint :: ByteString
_method = ByteString
"GET"
  , $sel:_headers:Endpoint :: [(Text, Encoder, Bool)]
_headers = []
  , $sel:_body:Endpoint :: Maybe (Expression Void, Encoder)
_body = Maybe (Expression Void, Encoder)
forall a. Maybe a
Nothing
  , $sel:_returnType:Endpoint :: Maybe (Either NoContent Decoder)
_returnType = Maybe (Either NoContent Decoder)
forall a. Maybe a
Nothing
  , $sel:_functionName:Endpoint :: Module
_functionName = []
  }

-- | Contains the information we need about an endpoint to generate an Elm
-- definition that calls it.
data Endpoint = Endpoint
  { Endpoint -> URL
_url :: URL
  , Endpoint -> ByteString
_method :: HTTP.Method
  , Endpoint -> [(Text, Encoder, Bool)]
_headers :: [(Text, Encoder, Bool)]
  , Endpoint -> Maybe (Expression Void, Encoder)
_body :: Maybe (Expression Void, Encoder)
  , Endpoint -> Maybe (Either NoContent Decoder)
_returnType :: Maybe (Either Servant.NoContent Decoder)
  , Endpoint -> Module
_functionName :: [Text]
  }

data PathSegment e
  = Static Text
  | Capture Text e
  deriving (Int -> PathSegment e -> ShowS
[PathSegment e] -> ShowS
PathSegment e -> [Char]
(Int -> PathSegment e -> ShowS)
-> (PathSegment e -> [Char])
-> ([PathSegment e] -> ShowS)
-> Show (PathSegment e)
forall e. Show e => Int -> PathSegment e -> ShowS
forall e. Show e => [PathSegment e] -> ShowS
forall e. Show e => PathSegment e -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PathSegment e] -> ShowS
$cshowList :: forall e. Show e => [PathSegment e] -> ShowS
show :: PathSegment e -> [Char]
$cshow :: forall e. Show e => PathSegment e -> [Char]
showsPrec :: Int -> PathSegment e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> PathSegment e -> ShowS
Show)

data QueryParamType
  = Required
  | Optional
  | Flag
  | List
  deriving (Int -> QueryParamType -> ShowS
[QueryParamType] -> ShowS
QueryParamType -> [Char]
(Int -> QueryParamType -> ShowS)
-> (QueryParamType -> [Char])
-> ([QueryParamType] -> ShowS)
-> Show QueryParamType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [QueryParamType] -> ShowS
$cshowList :: [QueryParamType] -> ShowS
show :: QueryParamType -> [Char]
$cshow :: QueryParamType -> [Char]
showsPrec :: Int -> QueryParamType -> ShowS
$cshowsPrec :: Int -> QueryParamType -> ShowS
Show)

data URL = URL
  { URL -> [PathSegment Encoder]
_path :: [PathSegment Encoder]
  , URL -> [(Text, QueryParamType, Encoder)]
_queryString :: [(Text, QueryParamType, Encoder)]
  }
  deriving (Int -> URL -> ShowS
[URL] -> ShowS
URL -> [Char]
(Int -> URL -> ShowS)
-> (URL -> [Char]) -> ([URL] -> ShowS) -> Show URL
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [URL] -> ShowS
$cshowList :: [URL] -> ShowS
show :: URL -> [Char]
$cshow :: URL -> [Char]
showsPrec :: Int -> URL -> ShowS
$cshowsPrec :: Int -> URL -> ShowS
Show)

data Encoder = Encoder { Encoder -> Expression Void
_encoder :: Expression Void, Encoder -> Type Void
_encodedType :: Type Void }
  deriving (Int -> Encoder -> ShowS
[Encoder] -> ShowS
Encoder -> [Char]
(Int -> Encoder -> ShowS)
-> (Encoder -> [Char]) -> ([Encoder] -> ShowS) -> Show Encoder
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Encoder] -> ShowS
$cshowList :: [Encoder] -> ShowS
show :: Encoder -> [Char]
$cshow :: Encoder -> [Char]
showsPrec :: Int -> Encoder -> ShowS
$cshowsPrec :: Int -> Encoder -> ShowS
Show)
data Decoder = Decoder { Decoder -> Expression Void
_decoder :: Expression Void, Decoder -> Type Void
_decodedType :: Type Void }
  deriving (Int -> Decoder -> ShowS
[Decoder] -> ShowS
Decoder -> [Char]
(Int -> Decoder -> ShowS)
-> (Decoder -> [Char]) -> ([Decoder] -> ShowS) -> Show Decoder
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Decoder] -> ShowS
$cshowList :: [Decoder] -> ShowS
show :: Decoder -> [Char]
$cshow :: Decoder -> [Char]
showsPrec :: Int -> Decoder -> ShowS
$cshowsPrec :: Int -> Decoder -> ShowS
Show)

makeEncoder :: forall value a. HasElmEncoder value a => Encoder
makeEncoder :: Encoder
makeEncoder = Expression Void -> Type Void -> Encoder
Encoder (forall v. HasElmEncoder value a => Expression v
forall k k1 (value :: k) (a :: k1) v.
HasElmEncoder value a =>
Expression v
elmEncoder @value @a) (forall v. HasElmType a => Type v
forall k (a :: k) v. HasElmType a => Type v
elmType @a)

makeDecoder :: forall value a. HasElmDecoder value a => Decoder
makeDecoder :: Decoder
makeDecoder = Expression Void -> Type Void -> Decoder
Decoder (forall v. HasElmDecoder value a => Expression v
forall k k1 (value :: k) (a :: k1) v.
HasElmDecoder value a =>
Expression v
elmDecoder @value @a) (forall v. HasElmType a => Type v
forall k (a :: k) v. HasElmType a => Type v
elmType @a)

instance HasElmEndpoints Servant.EmptyAPI where
  elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' Endpoint
_ = []

instance (HasElmEndpoints a, HasElmEndpoints b) => HasElmEndpoints (a :<|> b) where
  elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' Endpoint
prefix =
    Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @a Endpoint
prefix [Endpoint] -> [Endpoint] -> [Endpoint]
forall a. Semigroup a => a -> a -> a
<> Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @b Endpoint
prefix

instance (KnownSymbol symbol, HasElmEncoder Text a, HasElmEndpoints api)
  => HasElmEndpoints (Servant.Capture' mods symbol a :> api) where
    elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' Endpoint
prefix =
      Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api Endpoint
prefix
        { $sel:_url:Endpoint :: URL
_url = (Endpoint -> URL
_url Endpoint
prefix)
          { $sel:_path:URL :: [PathSegment Encoder]
_path = URL -> [PathSegment Encoder]
_path (Endpoint -> URL
_url Endpoint
prefix) [PathSegment Encoder]
-> [PathSegment Encoder] -> [PathSegment Encoder]
forall a. Semigroup a => a -> a -> a
<> [Text -> Encoder -> PathSegment Encoder
forall e. Text -> e -> PathSegment e
Capture Text
str (Encoder -> PathSegment Encoder) -> Encoder -> PathSegment Encoder
forall a b. (a -> b) -> a -> b
$ HasElmEncoder Text a => Encoder
forall k k1 (value :: k) (a :: k1).
HasElmEncoder value a =>
Encoder
makeEncoder @Text @a]
          }
        , $sel:_functionName:Endpoint :: Module
_functionName = Endpoint -> Module
_functionName Endpoint
prefix Module -> Module -> Module
forall a. Semigroup a => a -> a -> a
<> [Text
"by", Text
str]
        }
      where
        str :: Text
str =
          [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy symbol -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy symbol -> [Char]) -> Proxy symbol -> [Char]
forall a b. (a -> b) -> a -> b
$ Proxy symbol
forall k (t :: k). Proxy t
Proxy @symbol

instance (KnownSymbol symbol, HasElmEncoder Text a, HasElmEndpoints api)
  => HasElmEndpoints (Servant.CaptureAll symbol a :> api) where
    elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' Endpoint
prefix =
      Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api Endpoint
prefix
        { $sel:_url:Endpoint :: URL
_url = (Endpoint -> URL
_url Endpoint
prefix)
          { $sel:_path:URL :: [PathSegment Encoder]
_path = URL -> [PathSegment Encoder]
_path (Endpoint -> URL
_url Endpoint
prefix) [PathSegment Encoder]
-> [PathSegment Encoder] -> [PathSegment Encoder]
forall a. Semigroup a => a -> a -> a
<> [Text -> Encoder -> PathSegment Encoder
forall e. Text -> e -> PathSegment e
Capture Text
str (Encoder -> PathSegment Encoder) -> Encoder -> PathSegment Encoder
forall a b. (a -> b) -> a -> b
$ HasElmEncoder Text a => Encoder
forall k k1 (value :: k) (a :: k1).
HasElmEncoder value a =>
Encoder
makeEncoder @Text @a]
          }
        , $sel:_functionName:Endpoint :: Module
_functionName = Endpoint -> Module
_functionName Endpoint
prefix Module -> Module -> Module
forall a. Semigroup a => a -> a -> a
<> [Text
"by", Text
str]
        }
      where
        str :: Text
str =
          [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy symbol -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy symbol -> [Char]) -> Proxy symbol -> [Char]
forall a b. (a -> b) -> a -> b
$ Proxy symbol
forall k (t :: k). Proxy t
Proxy @symbol

instance (Servant.ReflectMethod method, HasElmDecoder Aeson.Value a, list ~ '[Servant.JSON])
  => HasElmEndpoints (Servant.Verb method 200 list a) where
    elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' Endpoint
prefix =
      [ Endpoint
prefix
        { $sel:_method:Endpoint :: ByteString
_method = ByteString
method
        , $sel:_returnType:Endpoint :: Maybe (Either NoContent Decoder)
_returnType = Either NoContent Decoder -> Maybe (Either NoContent Decoder)
forall a. a -> Maybe a
Just (Either NoContent Decoder -> Maybe (Either NoContent Decoder))
-> Either NoContent Decoder -> Maybe (Either NoContent Decoder)
forall a b. (a -> b) -> a -> b
$ Decoder -> Either NoContent Decoder
forall a b. b -> Either a b
Right (Decoder -> Either NoContent Decoder)
-> Decoder -> Either NoContent Decoder
forall a b. (a -> b) -> a -> b
$ HasElmDecoder Value a => Decoder
forall k k1 (value :: k) (a :: k1).
HasElmDecoder value a =>
Decoder
makeDecoder @Aeson.Value @a
        , $sel:_functionName:Endpoint :: Module
_functionName = Text -> Text
Text.toLower (ByteString -> Text
Text.decodeUtf8 ByteString
method) Text -> Module -> Module
forall a. a -> [a] -> [a]
: Endpoint -> Module
_functionName Endpoint
prefix
        }
      ]
      where
        method :: ByteString
method =
          Proxy method -> ByteString
forall k (a :: k). ReflectMethod a => Proxy a -> ByteString
Servant.reflectMethod (Proxy method -> ByteString) -> Proxy method -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy method
forall k (t :: k). Proxy t
Proxy @method

instance Servant.ReflectMethod method => HasElmEndpoints (Servant.Verb method 204 list a) where
    elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' Endpoint
prefix =
      [ Endpoint
prefix
        { $sel:_method:Endpoint :: ByteString
_method = ByteString
method
        , $sel:_returnType:Endpoint :: Maybe (Either NoContent Decoder)
_returnType = Either NoContent Decoder -> Maybe (Either NoContent Decoder)
forall a. a -> Maybe a
Just (Either NoContent Decoder -> Maybe (Either NoContent Decoder))
-> Either NoContent Decoder -> Maybe (Either NoContent Decoder)
forall a b. (a -> b) -> a -> b
$ NoContent -> Either NoContent Decoder
forall a b. a -> Either a b
Left NoContent
Servant.NoContent
        , $sel:_functionName:Endpoint :: Module
_functionName = Text -> Text
Text.toLower (ByteString -> Text
Text.decodeUtf8 ByteString
method) Text -> Module -> Module
forall a. a -> [a] -> [a]
: Endpoint -> Module
_functionName Endpoint
prefix
        }
      ]
      where
        method :: ByteString
method =
          Proxy method -> ByteString
forall k (a :: k). ReflectMethod a => Proxy a -> ByteString
Servant.reflectMethod (Proxy method -> ByteString) -> Proxy method -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy method
forall k (t :: k). Proxy t
Proxy @method

instance Servant.ReflectMethod method => HasElmEndpoints (Servant.NoContentVerb method) where
  elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' Endpoint
prefix =
      [ Endpoint
prefix
        { $sel:_method:Endpoint :: ByteString
_method = ByteString
method
        , $sel:_returnType:Endpoint :: Maybe (Either NoContent Decoder)
_returnType = Either NoContent Decoder -> Maybe (Either NoContent Decoder)
forall a. a -> Maybe a
Just (Either NoContent Decoder -> Maybe (Either NoContent Decoder))
-> Either NoContent Decoder -> Maybe (Either NoContent Decoder)
forall a b. (a -> b) -> a -> b
$ NoContent -> Either NoContent Decoder
forall a b. a -> Either a b
Left NoContent
Servant.NoContent
        , $sel:_functionName:Endpoint :: Module
_functionName = Text -> Text
Text.toLower (ByteString -> Text
Text.decodeUtf8 ByteString
method) Text -> Module -> Module
forall a. a -> [a] -> [a]
: Endpoint -> Module
_functionName Endpoint
prefix
        }
      ]
      where
        method :: ByteString
method =
          Proxy method -> ByteString
forall k (a :: k). ReflectMethod a => Proxy a -> ByteString
Servant.reflectMethod (Proxy method -> ByteString) -> Proxy method -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy method
forall k (t :: k). Proxy t
Proxy @method

instance
  ( Servant.SBoolI (Servant.FoldRequired mods)
  , KnownSymbol symbol
  , HasElmEncoder (Servant.RequiredArgument mods Text) (Servant.RequiredArgument mods a)
  , HasElmEndpoints api
  ) => HasElmEndpoints (Servant.Header' mods symbol a :> api) where
    elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' Endpoint
prefix =
      Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api Endpoint
prefix
        { $sel:_headers:Endpoint :: [(Text, Encoder, Bool)]
_headers = Endpoint -> [(Text, Encoder, Bool)]
_headers Endpoint
prefix [(Text, Encoder, Bool)]
-> [(Text, Encoder, Bool)] -> [(Text, Encoder, Bool)]
forall a. Semigroup a => a -> a -> a
<>
          [ ( [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy symbol -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy symbol -> [Char]) -> Proxy symbol -> [Char]
forall a b. (a -> b) -> a -> b
$ Proxy symbol
forall k (t :: k). Proxy t
Proxy @symbol
            , HasElmEncoder
  (RequiredArgument mods Text) (RequiredArgument mods a) =>
Encoder
forall k k1 (value :: k) (a :: k1).
HasElmEncoder value a =>
Encoder
makeEncoder @(Servant.RequiredArgument mods Text) @(Servant.RequiredArgument mods a)
            , case SBoolI (FoldRequired mods) => SBool (FoldRequired mods)
forall (b :: Bool). SBoolI b => SBool b
Servant.sbool @(Servant.FoldRequired mods) of
                SBool (FoldRequired mods)
Servant.STrue ->
                  Bool
True

                SBool (FoldRequired mods)
Servant.SFalse ->
                  Bool
False
            )
          ]
        }

instance
  ( Servant.SBoolI (Servant.FoldRequired mods)
  , KnownSymbol symbol
  , HasElmEncoder (Servant.RequiredArgument mods Text) (Servant.RequiredArgument mods a)
  , HasElmEndpoints api
  ) => HasElmEndpoints (Servant.QueryParam' mods symbol a :> api) where
    elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' Endpoint
prefix =
      Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api Endpoint
prefix
        { $sel:_url:Endpoint :: URL
_url = (Endpoint -> URL
_url Endpoint
prefix)
          { $sel:_queryString:URL :: [(Text, QueryParamType, Encoder)]
_queryString =
            URL -> [(Text, QueryParamType, Encoder)]
_queryString (Endpoint -> URL
_url Endpoint
prefix) [(Text, QueryParamType, Encoder)]
-> [(Text, QueryParamType, Encoder)]
-> [(Text, QueryParamType, Encoder)]
forall a. Semigroup a => a -> a -> a
<>
            [ ( [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy symbol -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy symbol -> [Char]) -> Proxy symbol -> [Char]
forall a b. (a -> b) -> a -> b
$ Proxy symbol
forall k (t :: k). Proxy t
Proxy @symbol
              , case SBoolI (FoldRequired mods) => SBool (FoldRequired mods)
forall (b :: Bool). SBoolI b => SBool b
Servant.sbool @(Servant.FoldRequired mods) of
                  SBool (FoldRequired mods)
Servant.STrue ->
                    QueryParamType
Required

                  SBool (FoldRequired mods)
Servant.SFalse ->
                    QueryParamType
Optional
              , HasElmEncoder
  (RequiredArgument mods Text) (RequiredArgument mods a) =>
Encoder
forall k k1 (value :: k) (a :: k1).
HasElmEncoder value a =>
Encoder
makeEncoder @(Servant.RequiredArgument mods Text) @(Servant.RequiredArgument mods a)
              )
            ]
          }
        }

instance (KnownSymbol symbol, HasElmEncoder Text a, HasElmEndpoints api)
  => HasElmEndpoints (Servant.QueryParams symbol a :> api) where
    elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' Endpoint
prefix =
      Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api Endpoint
prefix
        { $sel:_url:Endpoint :: URL
_url = (Endpoint -> URL
_url Endpoint
prefix)
          { $sel:_queryString:URL :: [(Text, QueryParamType, Encoder)]
_queryString =
            URL -> [(Text, QueryParamType, Encoder)]
_queryString (Endpoint -> URL
_url Endpoint
prefix) [(Text, QueryParamType, Encoder)]
-> [(Text, QueryParamType, Encoder)]
-> [(Text, QueryParamType, Encoder)]
forall a. Semigroup a => a -> a -> a
<>
            [ ( [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy symbol -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy symbol -> [Char]) -> Proxy symbol -> [Char]
forall a b. (a -> b) -> a -> b
$ Proxy symbol
forall k (t :: k). Proxy t
Proxy @symbol
              , QueryParamType
List
              , HasElmEncoder Text a => Encoder
forall k k1 (value :: k) (a :: k1).
HasElmEncoder value a =>
Encoder
makeEncoder @Text @a
              )
            ]
          }
        }

instance (KnownSymbol symbol, HasElmEndpoints api)
  => HasElmEndpoints (Servant.QueryFlag symbol :> api) where
    elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' Endpoint
prefix =
      Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api Endpoint
prefix
        { $sel:_url:Endpoint :: URL
_url = (Endpoint -> URL
_url Endpoint
prefix)
          { $sel:_queryString:URL :: [(Text, QueryParamType, Encoder)]
_queryString =
            URL -> [(Text, QueryParamType, Encoder)]
_queryString (Endpoint -> URL
_url Endpoint
prefix) [(Text, QueryParamType, Encoder)]
-> [(Text, QueryParamType, Encoder)]
-> [(Text, QueryParamType, Encoder)]
forall a. Semigroup a => a -> a -> a
<>
            [ ( [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy symbol -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy symbol -> [Char]) -> Proxy symbol -> [Char]
forall a b. (a -> b) -> a -> b
$ Proxy symbol
forall k (t :: k). Proxy t
Proxy @symbol
              , QueryParamType
Flag
              , Expression Void -> Type Void -> Encoder
Encoder Expression Void
"Basics.identity" Type Void
"Basics.Bool"
              )
            ]
          }
        }

instance (HasElmEncoder Aeson.Value a, HasElmEndpoints api, list ~ '[Servant.JSON])
  => HasElmEndpoints (Servant.ReqBody' mods list a :> api) where
    elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' Endpoint
prefix =
      Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api Endpoint
prefix
        { $sel:_body:Endpoint :: Maybe (Expression Void, Encoder)
_body = (Expression Void, Encoder) -> Maybe (Expression Void, Encoder)
forall a. a -> Maybe a
Just (Expression Void
"Http.jsonBody", HasElmEncoder Value a => Encoder
forall k k1 (value :: k) (a :: k1).
HasElmEncoder value a =>
Encoder
makeEncoder @Aeson.Value @a)
        }

instance (HasElmEncoder (Servant.MultipartData tag) a, HasElmEndpoints api)
  => HasElmEndpoints (Servant.MultipartForm tag a :> api) where
    elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' Endpoint
prefix =
      Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api Endpoint
prefix
        { $sel:_body:Endpoint :: Maybe (Expression Void, Encoder)
_body = (Expression Void, Encoder) -> Maybe (Expression Void, Encoder)
forall a. a -> Maybe a
Just (Expression Void
"Http.multipartBody", HasElmEncoder (MultipartData tag) a => Encoder
forall k k1 (value :: k) (a :: k1).
HasElmEncoder value a =>
Encoder
makeEncoder @(Servant.MultipartData tag) @a)
        }

instance (KnownSymbol path, HasElmEndpoints api) => HasElmEndpoints (path :> api) where
  elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' Endpoint
prefix =
    Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api Endpoint
prefix
      { $sel:_url:Endpoint :: URL
_url = (Endpoint -> URL
_url Endpoint
prefix)
        { $sel:_path:URL :: [PathSegment Encoder]
_path = URL -> [PathSegment Encoder]
_path (Endpoint -> URL
_url Endpoint
prefix) [PathSegment Encoder]
-> [PathSegment Encoder] -> [PathSegment Encoder]
forall a. Semigroup a => a -> a -> a
<> [Text -> PathSegment Encoder
forall e. Text -> PathSegment e
Static Text
path]
        }
      , $sel:_functionName:Endpoint :: Module
_functionName = Endpoint -> Module
_functionName Endpoint
prefix Module -> Module -> Module
forall a. Semigroup a => a -> a -> a
<> [Text
path]
      }
    where
      path :: Text
path =
        [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy path -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy path -> [Char]) -> Proxy path -> [Char]
forall a b. (a -> b) -> a -> b
$ Proxy path
forall k (t :: k). Proxy t
Proxy @path

instance HasElmEndpoints api => HasElmEndpoints (Servant.RemoteHost :> api) where
  elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' = HasElmEndpoints api => Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api

instance HasElmEndpoints api => HasElmEndpoints (Servant.IsSecure :> api) where
  elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' = HasElmEndpoints api => Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api

instance HasElmEndpoints api => HasElmEndpoints (Servant.Vault :> api) where
  elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' = HasElmEndpoints api => Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api

instance HasElmEndpoints api => HasElmEndpoints (Servant.WithNamedContext name context api) where
  elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' = HasElmEndpoints api => Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api

instance HasElmEndpoints api => HasElmEndpoints (Servant.HttpVersion :> api) where
  elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' = HasElmEndpoints api => Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api

instance HasElmEndpoints api => HasElmEndpoints (Servant.Summary summary :> api) where
  elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' = HasElmEndpoints api => Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api

instance HasElmEndpoints api => HasElmEndpoints (Servant.Description description :> api) where
  elmEndpoints' :: Endpoint -> [Endpoint]
elmEndpoints' = HasElmEndpoints api => Endpoint -> [Endpoint]
forall k (api :: k). HasElmEndpoints api => Endpoint -> [Endpoint]
elmEndpoints' @api

-------------------------------------------------------------------------------
-- Orphans

instance HasElmType (Servant.MultipartData tag) where
  elmType :: Type v
elmType =
    Type v -> Type v -> Type v
forall v. Type v -> Type v -> Type v
Type.App Type v
"List.List" Type v
"Http.Part"

instance HasElmEncoder (Servant.MultipartData tag) (Servant.MultipartData tag) where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"Basics.identity"

-------------------------------------------------------------------------------
-- * Internal

elmHeaders :: Endpoint -> Expression Text
elmHeaders :: Endpoint -> Expression Text
elmHeaders Endpoint
endpoint =
  let
    headerDecoder :: Int -> Text -> Encoder -> Expression Text
headerDecoder Int
i Text
name Encoder
arg  =
      Expression Text -> [Expression Text] -> Expression Text
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps
        Expression Text
"Http.header"
        [ Text -> Expression Text
forall v. Text -> Expression v
Expression.String Text
name
        , Expression Text -> Expression Text -> Expression Text
forall v. Expression v -> Expression v -> Expression v
Expression.App
          (Expression Void -> Expression Text
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Expression Void -> Expression Text)
-> Expression Void -> Expression Text
forall a b. (a -> b) -> a -> b
$ Encoder -> Expression Void
_encoder Encoder
arg)
          (Text -> Expression Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Expression Text) -> Text -> Expression Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
headerArgName Int
i)
        ]

    optionalHeaderDecoder :: Int -> Text -> Encoder -> Expression Text
optionalHeaderDecoder Int
i Text
name Encoder
arg =
      Expression Text -> [Expression Text] -> Expression Text
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps
        Expression Text
"Maybe.map"
        [ Expression Text -> Expression Text -> Expression Text
forall v. Expression v -> Expression v -> Expression v
Expression.App
          Expression Text
"Http.header"
          (Text -> Expression Text
forall v. Text -> Expression v
Expression.String Text
name)
        , Expression Text -> Expression Text -> Expression Text
forall v. Expression v -> Expression v -> Expression v
Expression.App
          (Expression Void -> Expression Text
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Expression Void -> Expression Text)
-> Expression Void -> Expression Text
forall a b. (a -> b) -> a -> b
$ Encoder -> Expression Void
_encoder Encoder
arg)
          (Text -> Expression Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Expression Text) -> Text -> Expression Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
headerArgName Int
i)
        ]
  in
  case Endpoint -> [(Text, Encoder, Bool)]
_headers Endpoint
endpoint of
    [] ->
      [Expression Text] -> Expression Text
forall v. [Expression v] -> Expression v
Expression.List []

    [(Text, Encoder, Bool)]
_
      | ((Text, Encoder, Bool) -> Bool) -> [(Text, Encoder, Bool)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Text
_, Encoder
_, Bool
required) -> Bool
required) (Endpoint -> [(Text, Encoder, Bool)]
_headers Endpoint
endpoint) ->
      [Expression Text] -> Expression Text
forall v. [Expression v] -> Expression v
Expression.List
        [ Int -> Text -> Encoder -> Expression Text
headerDecoder Int
i Text
name Encoder
arg
        | (Int
i, (Text
name, Encoder
arg, Bool
_)) <- [Int] -> [(Text, Encoder, Bool)] -> [(Int, (Text, Encoder, Bool))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([(Text, Encoder, Bool)] -> [(Int, (Text, Encoder, Bool))])
-> [(Text, Encoder, Bool)] -> [(Int, (Text, Encoder, Bool))]
forall a b. (a -> b) -> a -> b
$ Endpoint -> [(Text, Encoder, Bool)]
_headers Endpoint
endpoint
        ]

    [(Text, Encoder, Bool)]
_ ->
      Expression Text -> [Expression Text] -> Expression Text
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression Text
"List.filterMap"
      [ Expression Text
"Basics.identity"
      , [Expression Text] -> Expression Text
forall v. [Expression v] -> Expression v
Expression.List
          [ if Bool
required then
              Expression Text -> Expression Text -> Expression Text
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression Text
"Maybe.Just" (Expression Text -> Expression Text)
-> Expression Text -> Expression Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Encoder -> Expression Text
headerDecoder Int
i Text
name Encoder
arg

            else
              Int -> Text -> Encoder -> Expression Text
optionalHeaderDecoder Int
i Text
name Encoder
arg
          | (Int
i, (Text
name, Encoder
arg, Bool
required)) <- [Int] -> [(Text, Encoder, Bool)] -> [(Int, (Text, Encoder, Bool))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([(Text, Encoder, Bool)] -> [(Int, (Text, Encoder, Bool))])
-> [(Text, Encoder, Bool)] -> [(Int, (Text, Encoder, Bool))]
forall a b. (a -> b) -> a -> b
$ Endpoint -> [(Text, Encoder, Bool)]
_headers Endpoint
endpoint
          ]
      ]

headerArgName :: Int -> Text
headerArgName :: Int -> Text
headerArgName Int
i =
  Text
"header" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
forall a. IsString a => [Char] -> a
fromString (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)

numberedPathSegments :: Endpoint -> [PathSegment (Int, Encoder)]
numberedPathSegments :: Endpoint -> [PathSegment (Int, Encoder)]
numberedPathSegments Endpoint
endpoint =
  Int -> [PathSegment Encoder] -> [PathSegment (Int, Encoder)]
forall a b. Num a => a -> [PathSegment b] -> [PathSegment (a, b)]
go Int
0 ([PathSegment Encoder] -> [PathSegment (Int, Encoder)])
-> [PathSegment Encoder] -> [PathSegment (Int, Encoder)]
forall a b. (a -> b) -> a -> b
$ URL -> [PathSegment Encoder]
_path (URL -> [PathSegment Encoder]) -> URL -> [PathSegment Encoder]
forall a b. (a -> b) -> a -> b
$ Endpoint -> URL
_url Endpoint
endpoint
  where
    go :: a -> [PathSegment b] -> [PathSegment (a, b)]
go !a
i [PathSegment b]
segments =
      case [PathSegment b]
segments of
        [] ->
          []

        Static Text
p:[PathSegment b]
segments' ->
          Text -> PathSegment (a, b)
forall e. Text -> PathSegment e
Static Text
p PathSegment (a, b) -> [PathSegment (a, b)] -> [PathSegment (a, b)]
forall a. a -> [a] -> [a]
: a -> [PathSegment b] -> [PathSegment (a, b)]
go a
i [PathSegment b]
segments'

        Capture Text
str b
arg:[PathSegment b]
segments' ->
          Text -> (a, b) -> PathSegment (a, b)
forall e. Text -> e -> PathSegment e
Capture Text
str (a
i, b
arg) PathSegment (a, b) -> [PathSegment (a, b)] -> [PathSegment (a, b)]
forall a. a -> [a] -> [a]
: a -> [PathSegment b] -> [PathSegment (a, b)]
go (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) [PathSegment b]
segments'

elmParams :: Endpoint -> [Expression Text]
elmParams :: Endpoint -> [Expression Text]
elmParams Endpoint
endpoint =
  [ case QueryParamType
type_ of
    QueryParamType
Required ->
      [Expression Text] -> Expression Text
forall v. [Expression v] -> Expression v
Expression.List
        [ Expression Text -> [Expression Text] -> Expression Text
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression Text
"Url.Builder.string"
          [ Text -> Expression Text
forall v. Text -> Expression v
Expression.String Text
name, Expression Text -> Expression Text
encode (Text -> Expression Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Expression Text) -> Text -> Expression Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
paramArgName Int
i) ]
        ]

    QueryParamType
Optional ->
      Expression Text -> [Expression Text] -> Expression Text
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps
        Expression Text
"Maybe.withDefault"
        [ [Expression Text] -> Expression Text
forall v. [Expression v] -> Expression v
Expression.List []
        , Expression Text -> [Expression Text] -> Expression Text
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression Text
"Maybe.map"
          [ Expression Text
"List.singleton" Expression Text -> Expression Text -> Expression Text
forall v. Expression v -> Expression v -> Expression v
Expression.<<
              Expression Text -> Expression Text -> Expression Text
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression Text
"Url.Builder.string" (Text -> Expression Text
forall v. Text -> Expression v
Expression.String Text
name)
          , Expression Text -> Expression Text
encode (Expression Text -> Expression Text)
-> Expression Text -> Expression Text
forall a b. (a -> b) -> a -> b
$ Text -> Expression Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Expression Text) -> Text -> Expression Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
paramArgName Int
i
          ]
        ]

    QueryParamType
Flag ->
      Expression Text
-> Expression Text -> Expression Text -> Expression Text
forall v.
Expression v -> Expression v -> Expression v -> Expression v
Expression.if_
        (Text -> Expression Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Expression Text) -> Text -> Expression Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
paramArgName Int
i)
        ([Expression Text] -> Expression Text
forall v. [Expression v] -> Expression v
Expression.List
         [ Expression Text -> [Expression Text] -> Expression Text
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression Text
"Url.Builder.string"
           [ Text -> Expression Text
forall v. Text -> Expression v
Expression.String Text
name
           , Text -> Expression Text
forall v. Text -> Expression v
Expression.String Text
"true"
           ]
         ]
        )
        ([Expression Text] -> Expression Text
forall v. [Expression v] -> Expression v
Expression.List [])

    QueryParamType
List ->
      Expression Text -> [Expression Text] -> Expression Text
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps
        Expression Text
"List.map"
        [ Expression Text -> Expression Text -> Expression Text
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression Text
"Url.Builder.string" (Text -> Expression Text
forall v. Text -> Expression v
Expression.String Text
name) Expression Text -> Expression Text -> Expression Text
forall v. Expression v -> Expression v -> Expression v
Expression.<< Expression Text
encoder
        , Text -> Expression Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Expression Text) -> Text -> Expression Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
paramArgName Int
i
        ]
  | (Int
i, (Text
name, QueryParamType
type_, Encoder
arg)) <- [Int]
-> [(Text, QueryParamType, Encoder)]
-> [(Int, (Text, QueryParamType, Encoder))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([(Text, QueryParamType, Encoder)]
 -> [(Int, (Text, QueryParamType, Encoder))])
-> [(Text, QueryParamType, Encoder)]
-> [(Int, (Text, QueryParamType, Encoder))]
forall a b. (a -> b) -> a -> b
$ URL -> [(Text, QueryParamType, Encoder)]
_queryString (URL -> [(Text, QueryParamType, Encoder)])
-> URL -> [(Text, QueryParamType, Encoder)]
forall a b. (a -> b) -> a -> b
$ Endpoint -> URL
_url Endpoint
endpoint
  , let
      encoder :: Expression Text
encoder =
        Expression Void -> Expression Text
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Expression Void -> Expression Text)
-> Expression Void -> Expression Text
forall a b. (a -> b) -> a -> b
$ Encoder -> Expression Void
_encoder Encoder
arg

      encode :: Expression Text -> Expression Text
encode =
        Expression Text -> Expression Text -> Expression Text
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression Text
encoder
  ]

paramArgName :: Int -> Text
paramArgName :: Int -> Text
paramArgName Int
i =
  Text
"param" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
forall a. IsString a => [Char] -> a
fromString (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)

elmPathSegment :: PathSegment (Int, Encoder) -> Expression Text
elmPathSegment :: PathSegment (Int, Encoder) -> Expression Text
elmPathSegment PathSegment (Int, Encoder)
pathSegment =
  case PathSegment (Int, Encoder)
pathSegment of
    Static Text
s ->
      Text -> Expression Text
forall v. Text -> Expression v
Expression.String Text
s

    Capture Text
_ (Int
i, Encoder
arg) ->
      Expression Text -> Expression Text -> Expression Text
forall v. Expression v -> Expression v -> Expression v
Expression.App
        (Expression Void -> Expression Text
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Expression Void -> Expression Text)
-> Expression Void -> Expression Text
forall a b. (a -> b) -> a -> b
$ Encoder -> Expression Void
_encoder Encoder
arg)
        (Text -> Expression Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Expression Text) -> Text -> Expression Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
capturedArgName Int
i)

capturedArgName :: Int -> Text
capturedArgName :: Int -> Text
capturedArgName Int
i =
  Text
"capture" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
forall a. IsString a => [Char] -> a
fromString (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)

elmBody :: Endpoint -> Expression Text
elmBody :: Endpoint -> Expression Text
elmBody Endpoint
endpoint =
  case Endpoint -> Maybe (Expression Void, Encoder)
_body Endpoint
endpoint of
    Maybe (Expression Void, Encoder)
Nothing ->
      Expression Text
"Http.emptyBody"

    Just (Expression Void
bodyType, Encoder
body) ->
      Expression Text -> Expression Text -> Expression Text
forall v. Expression v -> Expression v -> Expression v
Expression.App
        (Expression Void -> Expression Text
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous Expression Void
bodyType)
        (Expression Text -> Expression Text -> Expression Text
forall v. Expression v -> Expression v -> Expression v
Expression.App (Expression Void -> Expression Text
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Expression Void -> Expression Text)
-> Expression Void -> Expression Text
forall a b. (a -> b) -> a -> b
$ Encoder -> Expression Void
_encoder Encoder
body) (Expression Text -> Expression Text)
-> Expression Text -> Expression Text
forall a b. (a -> b) -> a -> b
$ Text -> Expression Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
bodyArgName)

elmExpect :: Endpoint -> Expression a
elmExpect :: Endpoint -> Expression a
elmExpect Endpoint
endpoint =
  Expression a -> [Expression a] -> Expression a
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps
    Expression a
"Http.expectStringResponse"
    [ Expression a
"Basics.identity"
    , Scope () Expression a -> Expression a
forall v. Scope () Expression v -> Expression v
Expression.Lam (Scope () Expression a -> Expression a)
-> Scope () Expression a -> Expression a
forall a b. (a -> b) -> a -> b
$ Expression (Var () a) -> Scope () Expression a
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var () a) -> Scope () Expression a)
-> Expression (Var () a) -> Scope () Expression a
forall a b. (a -> b) -> a -> b
$
        Expression (Var () a)
-> [(Pattern Int, Scope Int Expression (Var () a))]
-> Expression (Var () a)
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expression.Case (Var () a -> Expression (Var () a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var () a -> Expression (Var () a))
-> Var () a -> Expression (Var () a)
forall a b. (a -> b) -> a -> b
$ () -> Var () a
forall b a. b -> Var b a
Bound.B ())
        [ ( Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con Qualified
"Http.BadUrl_" [Int -> Pattern Int
forall v. v -> Pattern v
Pattern.Var Int
0]
          , Expression (Var Int (Var () a)) -> Scope Int Expression (Var () a)
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int (Var () a))
 -> Scope Int Expression (Var () a))
-> Expression (Var Int (Var () a))
-> Scope Int Expression (Var () a)
forall a b. (a -> b) -> a -> b
$
            Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () a))
"Result.Err" (Expression (Var Int (Var () a))
 -> Expression (Var Int (Var () a)))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$
            Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.tuple (Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () a))
"Http.BadUrl" (Expression (Var Int (Var () a))
 -> Expression (Var Int (Var () a)))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ Var Int (Var () a) -> Expression (Var Int (Var () a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Var Int (Var () a)
forall b a. b -> Var b a
Bound.B Int
0)) Expression (Var Int (Var () a))
"Maybe.Nothing"
          )
        , ( Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con Qualified
"Http.Timeout_" []
          , Expression (Var Int (Var () a)) -> Scope Int Expression (Var () a)
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int (Var () a))
 -> Scope Int Expression (Var () a))
-> Expression (Var Int (Var () a))
-> Scope Int Expression (Var () a)
forall a b. (a -> b) -> a -> b
$
            Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () a))
"Result.Err" (Expression (Var Int (Var () a))
 -> Expression (Var Int (Var () a)))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$
            Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.tuple Expression (Var Int (Var () a))
"Http.Timeout" Expression (Var Int (Var () a))
"Maybe.Nothing"
          )
        , ( Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con Qualified
"Http.NetworkError_" []
          , Expression (Var Int (Var () a)) -> Scope Int Expression (Var () a)
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int (Var () a))
 -> Scope Int Expression (Var () a))
-> Expression (Var Int (Var () a))
-> Scope Int Expression (Var () a)
forall a b. (a -> b) -> a -> b
$
            Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () a))
"Result.Err" (Expression (Var Int (Var () a))
 -> Expression (Var Int (Var () a)))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$
            Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.tuple Expression (Var Int (Var () a))
"Http.NetworkError" Expression (Var Int (Var () a))
"Maybe.Nothing"
          )
        , ( Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con Qualified
"Http.BadStatus_" [Int -> Pattern Int
forall v. v -> Pattern v
Pattern.Var Int
0, Int -> Pattern Int
forall v. v -> Pattern v
Pattern.Var Int
1]
          , Expression (Var Int (Var () a)) -> Scope Int Expression (Var () a)
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int (Var () a))
 -> Scope Int Expression (Var () a))
-> Expression (Var Int (Var () a))
-> Scope Int Expression (Var () a)
forall a b. (a -> b) -> a -> b
$
            Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () a))
"Result.Err" (Expression (Var Int (Var () a))
 -> Expression (Var Int (Var () a)))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$
            Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.tuple
              (Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () a))
"Http.BadStatus" (Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.App (Field -> Expression (Var Int (Var () a))
forall v. Field -> Expression v
Expression.Proj Field
"statusCode") (Expression (Var Int (Var () a))
 -> Expression (Var Int (Var () a)))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ Var Int (Var () a) -> Expression (Var Int (Var () a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int (Var () a) -> Expression (Var Int (Var () a)))
-> Var Int (Var () a) -> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ Int -> Var Int (Var () a)
forall b a. b -> Var b a
Bound.B Int
0))
              (Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () a))
"Maybe.Just" (Expression (Var Int (Var () a))
 -> Expression (Var Int (Var () a)))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ [(Field, Expression (Var Int (Var () a)))]
-> Expression (Var Int (Var () a))
forall v. [(Field, Expression v)] -> Expression v
Expression.Record [(Field
"metadata", Var Int (Var () a) -> Expression (Var Int (Var () a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int (Var () a) -> Expression (Var Int (Var () a)))
-> Var Int (Var () a) -> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ Int -> Var Int (Var () a)
forall b a. b -> Var b a
Bound.B Int
0), (Field
"body", Var Int (Var () a) -> Expression (Var Int (Var () a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int (Var () a) -> Expression (Var Int (Var () a)))
-> Var Int (Var () a) -> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ Int -> Var Int (Var () a)
forall b a. b -> Var b a
Bound.B Int
1)])
          )
        , ( Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con Qualified
"Http.GoodStatus_" [Int -> Pattern Int
forall v. v -> Pattern v
Pattern.Var Int
0, Int -> Pattern Int
forall v. v -> Pattern v
Pattern.Var Int
1]
          , Expression (Var Int (Var () a)) -> Scope Int Expression (Var () a)
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int (Var () a))
 -> Scope Int Expression (Var () a))
-> Expression (Var Int (Var () a))
-> Scope Int Expression (Var () a)
forall a b. (a -> b) -> a -> b
$
            case Endpoint -> Maybe (Either NoContent Decoder)
_returnType Endpoint
endpoint of
              Maybe (Either NoContent Decoder)
Nothing ->
                [Char] -> Expression (Var Int (Var () a))
forall a. HasCallStack => [Char] -> a
error [Char]
"elmRequest: No return type" -- TODO?

              Just (Left NoContent
Servant.NoContent) ->
                Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v.
Expression v -> Expression v -> Expression v -> Expression v
Expression.if_ (Expression (Var Int (Var () a))
-> [Expression (Var Int (Var () a))]
-> Expression (Var Int (Var () a))
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps (Expression (Var Int (Var () a))
"Basics.==") [Var Int (Var () a) -> Expression (Var Int (Var () a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int (Var () a) -> Expression (Var Int (Var () a)))
-> Var Int (Var () a) -> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ Int -> Var Int (Var () a)
forall b a. b -> Var b a
Bound.B Int
1, Text -> Expression (Var Int (Var () a))
forall v. Text -> Expression v
Expression.String Text
""])
                  (Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () a))
"Result.Ok" Expression (Var Int (Var () a))
"Basics.()")
                  (Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () a))
"Result.Err" (Expression (Var Int (Var () a))
 -> Expression (Var Int (Var () a)))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$
                    Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.tuple
                      (Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () a))
"Http.BadBody" (Expression (Var Int (Var () a))
 -> Expression (Var Int (Var () a)))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ Text -> Expression (Var Int (Var () a))
forall v. Text -> Expression v
Expression.String Text
"Expected the response body to be empty")
                      (Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () a))
"Maybe.Just" (Expression (Var Int (Var () a))
 -> Expression (Var Int (Var () a)))
-> Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ [(Field, Expression (Var Int (Var () a)))]
-> Expression (Var Int (Var () a))
forall v. [(Field, Expression v)] -> Expression v
Expression.Record [(Field
"metadata", Var Int (Var () a) -> Expression (Var Int (Var () a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int (Var () a) -> Expression (Var Int (Var () a)))
-> Var Int (Var () a) -> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ Int -> Var Int (Var () a)
forall b a. b -> Var b a
Bound.B Int
0), (Field
"body", Var Int (Var () a) -> Expression (Var Int (Var () a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int (Var () a) -> Expression (Var Int (Var () a)))
-> Var Int (Var () a) -> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ Int -> Var Int (Var () a)
forall b a. b -> Var b a
Bound.B Int
1)])
                  )

              Just (Right Decoder
elmReturnDecoder) ->
                Expression (Var Int (Var () a))
-> [Expression (Var Int (Var () a))]
-> Expression (Var Int (Var () a))
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression (Var Int (Var () a))
"Result.mapError"
                  [ Scope () Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall v. Scope () Expression v -> Expression v
Expression.Lam (Scope () Expression (Var Int (Var () a))
 -> Expression (Var Int (Var () a)))
-> Scope () Expression (Var Int (Var () a))
-> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ Expression (Var () (Var Int (Var () a)))
-> Scope () Expression (Var Int (Var () a))
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var () (Var Int (Var () a)))
 -> Scope () Expression (Var Int (Var () a)))
-> Expression (Var () (Var Int (Var () a)))
-> Scope () Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$
                    Expression (Var () (Var Int (Var () a)))
-> Expression (Var () (Var Int (Var () a)))
-> Expression (Var () (Var Int (Var () a)))
forall v. Expression v -> Expression v -> Expression v
Expression.tuple
                      (Expression (Var () (Var Int (Var () a)))
-> Expression (Var () (Var Int (Var () a)))
-> Expression (Var () (Var Int (Var () a)))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var () (Var Int (Var () a)))
"Http.BadBody" (Expression (Var () (Var Int (Var () a)))
 -> Expression (Var () (Var Int (Var () a))))
-> Expression (Var () (Var Int (Var () a)))
-> Expression (Var () (Var Int (Var () a)))
forall a b. (a -> b) -> a -> b
$
                        Expression (Var () (Var Int (Var () a)))
-> Expression (Var () (Var Int (Var () a)))
-> Expression (Var () (Var Int (Var () a)))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var () (Var Int (Var () a)))
"Json.Decode.errorToString" (Expression (Var () (Var Int (Var () a)))
 -> Expression (Var () (Var Int (Var () a))))
-> Expression (Var () (Var Int (Var () a)))
-> Expression (Var () (Var Int (Var () a)))
forall a b. (a -> b) -> a -> b
$
                        Var () (Var Int (Var () a))
-> Expression (Var () (Var Int (Var () a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var () (Var Int (Var () a))
 -> Expression (Var () (Var Int (Var () a))))
-> Var () (Var Int (Var () a))
-> Expression (Var () (Var Int (Var () a)))
forall a b. (a -> b) -> a -> b
$ () -> Var () (Var Int (Var () a))
forall b a. b -> Var b a
Bound.B ()
                      )
                      (Expression (Var () (Var Int (Var () a)))
-> Expression (Var () (Var Int (Var () a)))
-> Expression (Var () (Var Int (Var () a)))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var () (Var Int (Var () a)))
"Maybe.Just" (Expression (Var () (Var Int (Var () a)))
 -> Expression (Var () (Var Int (Var () a))))
-> Expression (Var () (Var Int (Var () a)))
-> Expression (Var () (Var Int (Var () a)))
forall a b. (a -> b) -> a -> b
$ [(Field, Expression (Var () (Var Int (Var () a))))]
-> Expression (Var () (Var Int (Var () a)))
forall v. [(Field, Expression v)] -> Expression v
Expression.Record [(Field
"metadata", Var () (Var Int (Var () a))
-> Expression (Var () (Var Int (Var () a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var () (Var Int (Var () a))
 -> Expression (Var () (Var Int (Var () a))))
-> Var () (Var Int (Var () a))
-> Expression (Var () (Var Int (Var () a)))
forall a b. (a -> b) -> a -> b
$ Var Int (Var () a) -> Var () (Var Int (Var () a))
forall b a. a -> Var b a
Bound.F (Var Int (Var () a) -> Var () (Var Int (Var () a)))
-> Var Int (Var () a) -> Var () (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ Int -> Var Int (Var () a)
forall b a. b -> Var b a
Bound.B Int
0), (Field
"body", Var () (Var Int (Var () a))
-> Expression (Var () (Var Int (Var () a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var () (Var Int (Var () a))
 -> Expression (Var () (Var Int (Var () a))))
-> Var () (Var Int (Var () a))
-> Expression (Var () (Var Int (Var () a)))
forall a b. (a -> b) -> a -> b
$ Var Int (Var () a) -> Var () (Var Int (Var () a))
forall b a. a -> Var b a
Bound.F (Var Int (Var () a) -> Var () (Var Int (Var () a)))
-> Var Int (Var () a) -> Var () (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ Int -> Var Int (Var () a)
forall b a. b -> Var b a
Bound.B Int
1)])
                  , Expression (Var Int (Var () a))
-> [Expression (Var Int (Var () a))]
-> Expression (Var Int (Var () a))
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression (Var Int (Var () a))
"Json.Decode.decodeString" [Expression Void -> Expression (Var Int (Var () a))
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (Expression Void -> Expression (Var Int (Var () a)))
-> Expression Void -> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ Decoder -> Expression Void
_decoder Decoder
elmReturnDecoder, Var Int (Var () a) -> Expression (Var Int (Var () a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int (Var () a) -> Expression (Var Int (Var () a)))
-> Var Int (Var () a) -> Expression (Var Int (Var () a))
forall a b. (a -> b) -> a -> b
$ Int -> Var Int (Var () a)
forall b a. b -> Var b a
Bound.B Int
1]
                  ]
          )
        ]
    ]

bodyArgName :: Text
bodyArgName :: Text
bodyArgName =
  Text
"body"

lambdaArgs :: [Text] -> Expression Text -> Expression Text
lambdaArgs :: Module -> Expression Text -> Expression Text
lambdaArgs Module
args Expression Text
rhs =
  case Module
args of
    [] ->
      Expression Text
rhs

    Text
arg:Module
args' ->
      Scope () Expression Text -> Expression Text
forall v. Scope () Expression v -> Expression v
Expression.Lam (Scope () Expression Text -> Expression Text)
-> Scope () Expression Text -> Expression Text
forall a b. (a -> b) -> a -> b
$ Text -> Expression Text -> Scope () Expression Text
forall (f :: * -> *) a. (Monad f, Eq a) => a -> f a -> Scope () f a
Bound.abstract1 Text
arg (Expression Text -> Scope () Expression Text)
-> Expression Text -> Scope () Expression Text
forall a b. (a -> b) -> a -> b
$ Module -> Expression Text -> Expression Text
lambdaArgs Module
args' Expression Text
rhs

argNames :: Endpoint -> [Text]
argNames :: Endpoint -> Module
argNames Endpoint
endpoint =
  [Module] -> Module
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ Int -> Text
headerArgName Int
i
    | (Int
i, (Text, Encoder, Bool)
_) <- [Int] -> [(Text, Encoder, Bool)] -> [(Int, (Text, Encoder, Bool))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([(Text, Encoder, Bool)] -> [(Int, (Text, Encoder, Bool))])
-> [(Text, Encoder, Bool)] -> [(Int, (Text, Encoder, Bool))]
forall a b. (a -> b) -> a -> b
$ Endpoint -> [(Text, Encoder, Bool)]
_headers Endpoint
endpoint
    ]
  , [ Int -> Text
capturedArgName Int
i
    | Capture Text
_ (Int
i, Encoder
_) <- Endpoint -> [PathSegment (Int, Encoder)]
numberedPathSegments Endpoint
endpoint
    ]
  , [ Int -> Text
paramArgName Int
i
    | (Int
i, (Text, QueryParamType, Encoder)
_) <- [Int]
-> [(Text, QueryParamType, Encoder)]
-> [(Int, (Text, QueryParamType, Encoder))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([(Text, QueryParamType, Encoder)]
 -> [(Int, (Text, QueryParamType, Encoder))])
-> [(Text, QueryParamType, Encoder)]
-> [(Int, (Text, QueryParamType, Encoder))]
forall a b. (a -> b) -> a -> b
$ URL -> [(Text, QueryParamType, Encoder)]
_queryString (URL -> [(Text, QueryParamType, Encoder)])
-> URL -> [(Text, QueryParamType, Encoder)]
forall a b. (a -> b) -> a -> b
$ Endpoint -> URL
_url Endpoint
endpoint
    ]
  , [ Text
bodyArgName
    | Just (Expression Void, Encoder)
_ <- [Endpoint -> Maybe (Expression Void, Encoder)
_body Endpoint
endpoint]
    ]
  ]

functionName :: Endpoint -> Text
functionName :: Endpoint -> Text
functionName Endpoint
endpoint =
  case (Char -> Bool) -> Text -> Text
Text.filter Char -> Bool
Char.isAlphaNum (Text -> Text) -> Module -> Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endpoint -> Module
_functionName Endpoint
endpoint of
    [] ->
      Text
""

    Text
firstPart:Module
rest ->
      Text
firstPart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Module -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Text
capitalise Module
rest
  where
    capitalise :: Text -> Text
capitalise Text
s =
      case Text -> Maybe (Char, Text)
Text.uncons Text
s of
        Maybe (Char, Text)
Nothing ->
          Text
""

        Just (Char
c, Text
s') ->
          Char -> Text -> Text
Text.cons (Char -> Char
Char.toUpper Char
c) Text
s'