{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

module Data.JsonSpec.Elm.Servant (
  -- * Generating Elm Clients
  servantDefs,

  -- * Extensions
  {-|
    The symbols in this section are mainly exposed in case you are using
    some extensions to the standard servant types and need to build some
    companion extensions to generate proper Elm types for them. For most
    normal usage you will probably just use 'servantDefs'.
  -}
  Elmable(..),
  IsParam(..),
  Param(..),
  PathParam(..),
  HeaderParam(..),
  QP(..),
) where


import Bound (Var(B, F), Scope, abstract1, closed, toScope)
import Control.Monad.Writer (MonadTrans(lift), MonadWriter(tell),
  execWriter)
import Data.Foldable (Foldable(fold))
import Data.JsonSpec (HasJsonDecodingSpec(DecodingSpec),
  HasJsonEncodingSpec(EncodingSpec))
import Data.JsonSpec.Elm (HasType(decoderOf, encoderOf, typeOf),
  Definitions)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Proxy (Proxy(Proxy))
import Data.Set (Set)
import Data.String (IsString(fromString))
import Data.Text (Text)
import Data.Void (Void, absurd)
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import Language.Elm.Definition (Definition)
import Language.Elm.Expression ((<|), Expression)
import Language.Elm.Type (Type)
import Network.HTTP.Types (Method)
import Prelude (Applicative(pure), Foldable(foldr, length), Maybe(Just,
  Nothing), Semigroup((<>)), ($), (.), (<$>), Eq, Int, error, reverse)
import Servant.API (ReflectMethod(reflectMethod), (:<|>), (:>), Capture,
  Header', Headers, JSON, NamedRoutes, NoContent, NoContentVerb, Optional,
  QueryParam', ReqBody', Required, ToServantApi, Verb)
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.Encoding as TE
import qualified Language.Elm.Definition as Def
import qualified Language.Elm.Expression as Expr
import qualified Language.Elm.Name as Name
import qualified Language.Elm.Pattern as Pat
import qualified Language.Elm.Type as Type


{-|
  This function will traverse the @api@ type, generating elm definitions for:
  * Http requests for each endpoint, including encoders and decoders for
    anonymous elm types.
  * Named Elm types (i.e. Any 'Specification' that is bound to a name using
    'JsonLet'
  * Decoders and Encoders for named elm types.
-}
servantDefs :: forall api. (Elmable api) => Proxy api -> Set Definition
servantDefs :: forall {k} (api :: k). Elmable api => Proxy api -> Set Definition
servantDefs Proxy api
_ =
  Set Definition
builtins
  Set Definition -> Set Definition -> Set Definition
forall a. Semigroup a => a -> a -> a
<> Writer (Set Definition) () -> Set Definition
forall w a. Writer w a -> w
execWriter (forall (e :: k). Elmable e => [Param] -> Writer (Set Definition) ()
forall {k} (e :: k).
Elmable e =>
[Param] -> Writer (Set Definition) ()
endpoints @api [])


builtins :: Set Definition
builtins :: Set Definition
builtins =
  [Definition] -> Set Definition
forall a. Ord a => [a] -> Set a
Set.fromList
    [ Qualified -> Int -> Scope Int Type Void -> Definition
Def.Alias
        Qualified
"Api.Req.Request"
        Int
1
        (
          Type (Var Int Void) -> Scope Int Type Void
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope (Type (Var Int Void) -> Scope Int Type Void)
-> Type (Var Int Void) -> Scope Int Type Void
forall a b. (a -> b) -> a -> b
$
            [(Field, Type (Var Int Void))] -> Type (Var Int Void)
forall v. [(Field, Type v)] -> Type v
Type.Record
              [ (Text -> Field
Name.Field Text
"method", Type (Var Int Void)
"Basics.String")
              , (Text -> Field
Name.Field Text
"headers", Type (Var Int Void)
"Basics.List" Type (Var Int Void) -> Type (Var Int Void) -> Type (Var Int Void)
forall v. Type v -> Type v -> Type v
`Type.App` Type (Var Int Void)
"Http.Header")
              , (Text -> Field
Name.Field Text
"url", Type (Var Int Void)
"Basics.String")
              , (Text -> Field
Name.Field Text
"body", Type (Var Int Void)
"Http.Body")
              , ( Text -> Field
Name.Field Text
"decoder"
                , Type (Var Int Void)
"Api.Req.Either"
                    Type (Var Int Void) -> Type (Var Int Void) -> Type (Var Int Void)
forall v. Type v -> Type v -> Type v
`Type.App` Var Int Void -> Type (Var Int Void)
forall v. v -> Type v
Type.Var (Int -> Var Int Void
forall b a. b -> Var b a
B Int
0)
                    Type (Var Int Void) -> Type (Var Int Void) -> Type (Var Int Void)
forall v. Type v -> Type v -> Type v
`Type.App` (Type (Var Int Void)
"Json.Decode.Decoder" Type (Var Int Void) -> Type (Var Int Void) -> Type (Var Int Void)
forall v. Type v -> Type v -> Type v
`Type.App` Var Int Void -> Type (Var Int Void)
forall v. v -> Type v
Type.Var (Int -> Var Int Void
forall b a. b -> Var b a
B Int
0))
                )
              ]
        )
    , Qualified
-> Int -> [(Constructor, [Scope Int Type Void])] -> Definition
Def.Type
        Qualified
"Api.Req.Either"
        Int
2
        [ ( Text -> Constructor
Name.Constructor Text
"Left"
          , [Type (Var Int Void) -> Scope Int Type Void
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope (Var Int Void -> Type (Var Int Void)
forall v. v -> Type v
Type.Var (Int -> Var Int Void
forall b a. b -> Var b a
B Int
0))]
          )
        , ( Text -> Constructor
Name.Constructor Text
"Right"
          , [Type (Var Int Void) -> Scope Int Type Void
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope (Var Int Void -> Type (Var Int Void)
forall v. v -> Type v
Type.Var (Int -> Var Int Void
forall b a. b -> Var b a
B Int
1))]
          )
        ]
    , Qualified
-> Int -> Scope Int Type Void -> Expression Void -> Definition
Def.Constant
        Qualified
"Api.Req.task"
        Int
1
        (
          Type (Var Int Void) -> Scope Int Type Void
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope (Type (Var Int Void) -> Scope Int Type Void)
-> Type (Var Int Void) -> Scope Int Type Void
forall a b. (a -> b) -> a -> b
$
            let
              var :: Type (Bound.Var Int a)
              var :: forall a. Type (Var Int a)
var = Var Int a -> Type (Var Int a)
forall v. v -> Type v
Type.Var (Int -> Var Int a
forall b a. b -> Var b a
B Int
0)
            in
              Type (Var Int Void) -> Type (Var Int Void) -> Type (Var Int Void)
forall v. Type v -> Type v -> Type v
Type.Fun
                (Type (Var Int Void)
"Api.Req.Request" Type (Var Int Void) -> Type (Var Int Void) -> Type (Var Int Void)
forall v. Type v -> Type v -> Type v
`Type.App` Type (Var Int Void)
forall a. Type (Var Int a)
var)
                (Type (Var Int Void) -> [Type (Var Int Void)] -> Type (Var Int Void)
forall v. Type v -> [Type v] -> Type v
Type.apps Type (Var Int Void)
"Task.Task" [Type (Var Int Void)
"Http.Error", Type (Var Int Void)
forall a. Type (Var Int a)
var])
        )
        (
          Scope () Expression Void -> Expression Void
forall v. Scope () Expression v -> Expression v
Expr.Lam (Scope () Expression Void -> Expression Void)
-> (Expression (Var () Void) -> Scope () Expression Void)
-> Expression (Var () Void)
-> Expression Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression (Var () Void) -> Scope () Expression Void
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope (Expression (Var () Void) -> Expression Void)
-> Expression (Var () Void) -> Expression Void
forall a b. (a -> b) -> a -> b
$
            let
              req :: Expression (Bound.Var () a)
              req :: forall a. Expression (Var () a)
req = Var () a -> Expression (Var () a)
forall v. v -> Expression v
Expr.Var (() -> Var () a
forall b a. b -> Var b a
B ())

              f :: Text -> b -> (Name.Field, b)
              f :: forall b. Text -> b -> (Field, b)
f Text
name b
expr = (Text -> Field
Name.Field Text
name, b
expr)

              p :: Expression v -> Text -> Expression v
              p :: forall v. Expression v -> Text -> Expression v
p Expression v
v Text
name = Field -> Expression v
forall v. Field -> Expression v
Expr.Proj (Text -> Field
Name.Field Text
name) Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Expression v
v
            in
              Expression (Var () Void)
"Http.task" Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
<|
                [(Field, Expression (Var () Void))] -> Expression (Var () Void)
forall v. [(Field, Expression v)] -> Expression v
Expr.Record
                  [ Text
-> Expression (Var () Void) -> (Field, Expression (Var () Void))
forall b. Text -> b -> (Field, b)
f Text
"method"   (Expression (Var () Void) -> (Field, Expression (Var () Void)))
-> Expression (Var () Void) -> (Field, Expression (Var () Void))
forall a b. (a -> b) -> a -> b
$ Expression (Var () Void) -> Text -> Expression (Var () Void)
forall v. Expression v -> Text -> Expression v
p Expression (Var () Void)
forall a. Expression (Var () a)
req Text
"method"
                  , Text
-> Expression (Var () Void) -> (Field, Expression (Var () Void))
forall b. Text -> b -> (Field, b)
f Text
"headers"  (Expression (Var () Void) -> (Field, Expression (Var () Void)))
-> Expression (Var () Void) -> (Field, Expression (Var () Void))
forall a b. (a -> b) -> a -> b
$ Expression (Var () Void) -> Text -> Expression (Var () Void)
forall v. Expression v -> Text -> Expression v
p Expression (Var () Void)
forall a. Expression (Var () a)
req Text
"headers"
                  , Text
-> Expression (Var () Void) -> (Field, Expression (Var () Void))
forall b. Text -> b -> (Field, b)
f Text
"url"      (Expression (Var () Void) -> (Field, Expression (Var () Void)))
-> Expression (Var () Void) -> (Field, Expression (Var () Void))
forall a b. (a -> b) -> a -> b
$ Expression (Var () Void) -> Text -> Expression (Var () Void)
forall v. Expression v -> Text -> Expression v
p Expression (Var () Void)
forall a. Expression (Var () a)
req Text
"url"
                  , Text
-> Expression (Var () Void) -> (Field, Expression (Var () Void))
forall b. Text -> b -> (Field, b)
f Text
"body"     (Expression (Var () Void) -> (Field, Expression (Var () Void)))
-> Expression (Var () Void) -> (Field, Expression (Var () Void))
forall a b. (a -> b) -> a -> b
$ Expression (Var () Void) -> Text -> Expression (Var () Void)
forall v. Expression v -> Text -> Expression v
p Expression (Var () Void)
forall a. Expression (Var () a)
req Text
"body"
                  , Text
-> Expression (Var () Void) -> (Field, Expression (Var () Void))
forall b. Text -> b -> (Field, b)
f Text
"timeout"    Expression (Var () Void)
"Maybe.Nothing"
                  , Text
-> Expression (Var () Void) -> (Field, Expression (Var () Void))
forall b. Text -> b -> (Field, b)
f Text
"resolver" (Expression (Var () Void) -> (Field, Expression (Var () Void)))
-> Expression (Var () Void) -> (Field, Expression (Var () Void))
forall a b. (a -> b) -> a -> b
$
                      Expression (Var () Void)
"Http.stringResolver" Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
`Expr.App`
                        (
                          Scope () Expression (Var () Void) -> Expression (Var () Void)
forall v. Scope () Expression v -> Expression v
Expr.Lam (Scope () Expression (Var () Void) -> Expression (Var () Void))
-> (Expression (Var () (Var () Void))
    -> Scope () Expression (Var () Void))
-> Expression (Var () (Var () Void))
-> Expression (Var () Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression (Var () (Var () Void))
-> Scope () Expression (Var () Void)
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope (Expression (Var () (Var () Void)) -> Expression (Var () Void))
-> Expression (Var () (Var () Void)) -> Expression (Var () Void)
forall a b. (a -> b) -> a -> b
$
                            let
                              var :: Expression (Bound.Var () a)
                              var :: forall a. Expression (Var () a)
var = Var () a -> Expression (Var () a)
forall v. v -> Expression v
Expr.Var (() -> Var () a
forall b a. b -> Var b a
B ())

                              pat
                                :: Name.Qualified
                                -> [Pat.Pattern v]
                                -> Expression (Bound.Var b a)
                                -> (Pat.Pattern v, Scope b Expression a)
                              pat :: forall v b a.
Qualified
-> [Pattern v]
-> Expression (Var b a)
-> (Pattern v, Scope b Expression a)
pat Qualified
con [Pattern v]
vars Expression (Var b a)
expr =
                                (Qualified -> [Pattern v] -> Pattern v
forall v. Qualified -> [Pattern v] -> Pattern v
Pat.Con Qualified
con [Pattern v]
vars, Expression (Var b a) -> Scope b Expression a
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope Expression (Var b a)
expr)

                              patVar :: Int -> Expression (Bound.Var Int a)
                              patVar :: forall a. Int -> Expression (Var Int a)
patVar Int
n = Var Int a -> Expression (Var Int a)
forall v. v -> Expression v
Expr.Var (Int -> Var Int a
forall b a. b -> Var b a
B Int
n)
                            in
                              Expression (Var () (Var () Void))
-> [(Pattern Int, Scope Int Expression (Var () (Var () Void)))]
-> Expression (Var () (Var () Void))
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expr.Case
                                Expression (Var () (Var () Void))
forall a. Expression (Var () a)
var
                                [ Qualified
-> [Pattern Int]
-> Expression (Var Int (Var () (Var () Void)))
-> (Pattern Int, Scope Int Expression (Var () (Var () Void)))
forall v b a.
Qualified
-> [Pattern v]
-> Expression (Var b a)
-> (Pattern v, Scope b Expression a)
pat Qualified
"Http.BadUrl_" [Int -> Pattern Int
forall v. v -> Pattern v
Pat.Var Int
0] (Expression (Var Int (Var () (Var () Void)))
 -> (Pattern Int, Scope Int Expression (Var () (Var () Void))))
-> Expression (Var Int (Var () (Var () Void)))
-> (Pattern Int, Scope Int Expression (Var () (Var () Void)))
forall a b. (a -> b) -> a -> b
$
                                    Expression (Var Int (Var () (Var () Void)))
"Result.Err" Expression (Var Int (Var () (Var () Void)))
-> Expression (Var Int (Var () (Var () Void)))
-> Expression (Var Int (Var () (Var () Void)))
forall v. Expression v -> Expression v -> Expression v
`Expr.App`
                                      (Expression (Var Int (Var () (Var () Void)))
"Http.BadUrl" Expression (Var Int (Var () (Var () Void)))
-> Expression (Var Int (Var () (Var () Void)))
-> Expression (Var Int (Var () (Var () Void)))
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Int -> Expression (Var Int (Var () (Var () Void)))
forall a. Int -> Expression (Var Int a)
patVar Int
0)
                                , Qualified
-> [Pattern Int]
-> Expression (Var Int (Var () (Var () Void)))
-> (Pattern Int, Scope Int Expression (Var () (Var () Void)))
forall v b a.
Qualified
-> [Pattern v]
-> Expression (Var b a)
-> (Pattern v, Scope b Expression a)
pat Qualified
"Http.Timeout_" [] (Expression (Var Int (Var () (Var () Void)))
 -> (Pattern Int, Scope Int Expression (Var () (Var () Void))))
-> Expression (Var Int (Var () (Var () Void)))
-> (Pattern Int, Scope Int Expression (Var () (Var () Void)))
forall a b. (a -> b) -> a -> b
$
                                    Expression (Var Int (Var () (Var () Void)))
"Result.Err" Expression (Var Int (Var () (Var () Void)))
-> Expression (Var Int (Var () (Var () Void)))
-> Expression (Var Int (Var () (Var () Void)))
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Expression (Var Int (Var () (Var () Void)))
"Http.Timeout"
                                , Qualified
-> [Pattern Int]
-> Expression (Var Int (Var () (Var () Void)))
-> (Pattern Int, Scope Int Expression (Var () (Var () Void)))
forall v b a.
Qualified
-> [Pattern v]
-> Expression (Var b a)
-> (Pattern v, Scope b Expression a)
pat Qualified
"Http.NetworkError_" [] (Expression (Var Int (Var () (Var () Void)))
 -> (Pattern Int, Scope Int Expression (Var () (Var () Void))))
-> Expression (Var Int (Var () (Var () Void)))
-> (Pattern Int, Scope Int Expression (Var () (Var () Void)))
forall a b. (a -> b) -> a -> b
$
                                    Expression (Var Int (Var () (Var () Void)))
"Result.Err" Expression (Var Int (Var () (Var () Void)))
-> Expression (Var Int (Var () (Var () Void)))
-> Expression (Var Int (Var () (Var () Void)))
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Expression (Var Int (Var () (Var () Void)))
"Http.NetworkError"
                                , Qualified
-> [Pattern Int]
-> Expression (Var Int (Var () (Var () Void)))
-> (Pattern Int, Scope Int Expression (Var () (Var () Void)))
forall v b a.
Qualified
-> [Pattern v]
-> Expression (Var b a)
-> (Pattern v, Scope b Expression a)
pat Qualified
"Http.BadStatus_" [Int -> Pattern Int
forall v. v -> Pattern v
Pat.Var Int
0, Int -> Pattern Int
forall v. v -> Pattern v
Pat.Var Int
1] (Expression (Var Int (Var () (Var () Void)))
 -> (Pattern Int, Scope Int Expression (Var () (Var () Void))))
-> Expression (Var Int (Var () (Var () Void)))
-> (Pattern Int, Scope Int Expression (Var () (Var () Void)))
forall a b. (a -> b) -> a -> b
$
                                    Expression (Var Int (Var () (Var () Void)))
"Result.Err" Expression (Var Int (Var () (Var () Void)))
-> Expression (Var Int (Var () (Var () Void)))
-> Expression (Var Int (Var () (Var () Void)))
forall v. Expression v -> Expression v -> Expression v
`Expr.App`
                                      (
                                        Expression (Var Int (Var () (Var () Void)))
"Http.BadStatus" Expression (Var Int (Var () (Var () Void)))
-> Expression (Var Int (Var () (Var () Void)))
-> Expression (Var Int (Var () (Var () Void)))
forall v. Expression v -> Expression v -> Expression v
`Expr.App`
                                          Expression (Var Int (Var () (Var () Void)))
-> Text -> Expression (Var Int (Var () (Var () Void)))
forall v. Expression v -> Text -> Expression v
p (Int -> Expression (Var Int (Var () (Var () Void)))
forall a. Int -> Expression (Var Int a)
patVar Int
0) Text
"statusCode"
                                      )
                                , Qualified
-> [Pattern Int]
-> Expression (Var Int (Var () (Var () Void)))
-> (Pattern Int, Scope Int Expression (Var () (Var () Void)))
forall v b a.
Qualified
-> [Pattern v]
-> Expression (Var b a)
-> (Pattern v, Scope b Expression a)
pat
                                    Qualified
"Http.GoodStatus_"
                                    [Int -> Pattern Int
forall v. v -> Pattern v
Pat.Var Int
0, Int -> Pattern Int
forall v. v -> Pattern v
Pat.Var Int
1]
                                    (
                                      Expression (Var Int (Var () (Var () Void)))
-> [(Pattern Int,
     Scope Int Expression (Var Int (Var () (Var () Void))))]
-> Expression (Var Int (Var () (Var () Void)))
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expr.Case
                                        ( Var () (Var () Void) -> Var Int (Var () (Var () Void))
forall b a. a -> Var b a
F (Var () (Var () Void) -> Var Int (Var () (Var () Void)))
-> (Var () Void -> Var () (Var () Void))
-> Var () Void
-> Var Int (Var () (Var () Void))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var () Void -> Var () (Var () Void)
forall b a. a -> Var b a
F (Var () Void -> Var Int (Var () (Var () Void)))
-> Expression (Var () Void)
-> Expression (Var Int (Var () (Var () Void)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression (Var () Void) -> Text -> Expression (Var () Void)
forall v. Expression v -> Text -> Expression v
p Expression (Var () Void)
forall a. Expression (Var () a)
req Text
"decoder")
                                        [ Qualified
-> [Pattern Int]
-> Expression (Var Int (Var Int (Var () (Var () Void))))
-> (Pattern Int,
    Scope Int Expression (Var Int (Var () (Var () Void))))
forall v b a.
Qualified
-> [Pattern v]
-> Expression (Var b a)
-> (Pattern v, Scope b Expression a)
pat Qualified
"Api.Req.Left" [Int -> Pattern Int
forall v. v -> Pattern v
Pat.Var Int
0] (Expression (Var Int (Var Int (Var () (Var () Void))))
 -> (Pattern Int,
     Scope Int Expression (Var Int (Var () (Var () Void)))))
-> Expression (Var Int (Var Int (Var () (Var () Void))))
-> (Pattern Int,
    Scope Int Expression (Var Int (Var () (Var () Void))))
forall a b. (a -> b) -> a -> b
$
                                            Expression (Var Int (Var Int (Var () (Var () Void))))
"Result.Ok" Expression (Var Int (Var Int (Var () (Var () Void))))
-> Expression (Var Int (Var Int (Var () (Var () Void))))
-> Expression (Var Int (Var Int (Var () (Var () Void))))
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Int -> Expression (Var Int (Var Int (Var () (Var () Void))))
forall a. Int -> Expression (Var Int a)
patVar Int
0
                                        , Qualified
-> [Pattern Int]
-> Expression (Var Int (Var Int (Var () (Var () Void))))
-> (Pattern Int,
    Scope Int Expression (Var Int (Var () (Var () Void))))
forall v b a.
Qualified
-> [Pattern v]
-> Expression (Var b a)
-> (Pattern v, Scope b Expression a)
pat Qualified
"Api.Req.Right" [Int -> Pattern Int
forall v. v -> Pattern v
Pat.Var Int
0] (Expression (Var Int (Var Int (Var () (Var () Void))))
 -> (Pattern Int,
     Scope Int Expression (Var Int (Var () (Var () Void)))))
-> Expression (Var Int (Var Int (Var () (Var () Void))))
-> (Pattern Int,
    Scope Int Expression (Var Int (Var () (Var () Void))))
forall a b. (a -> b) -> a -> b
$
                                            Expression (Var Int (Var Int (Var () (Var () Void))))
-> [(Pattern Int,
     Scope Int Expression (Var Int (Var Int (Var () (Var () Void)))))]
-> Expression (Var Int (Var Int (Var () (Var () Void))))
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expr.Case
                                              (
                                                Expression (Var Int (Var Int (Var () (Var () Void))))
-> [Expression (Var Int (Var Int (Var () (Var () Void))))]
-> Expression (Var Int (Var Int (Var () (Var () Void))))
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expr.apps
                                                  Expression (Var Int (Var Int (Var () (Var () Void))))
"Json.Decode.decodeString"
                                                  [ Int -> Expression (Var Int (Var Int (Var () (Var () Void))))
forall a. Int -> Expression (Var Int a)
patVar Int
0
                                                  , Var Int (Var () (Var () Void))
-> Var Int (Var Int (Var () (Var () Void)))
forall b a. a -> Var b a
F (Var Int (Var () (Var () Void))
 -> Var Int (Var Int (Var () (Var () Void))))
-> Expression (Var Int (Var () (Var () Void)))
-> Expression (Var Int (Var Int (Var () (Var () Void))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Expression (Var Int (Var () (Var () Void)))
forall a. Int -> Expression (Var Int a)
patVar Int
1
                                                  ]
                                              )
                                              [ Qualified
-> [Pattern Int]
-> Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
-> (Pattern Int,
    Scope Int Expression (Var Int (Var Int (Var () (Var () Void)))))
forall v b a.
Qualified
-> [Pattern v]
-> Expression (Var b a)
-> (Pattern v, Scope b Expression a)
pat Qualified
"Result.Err" [Int -> Pattern Int
forall v. v -> Pattern v
Pat.Var Int
0] (Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
 -> (Pattern Int,
     Scope Int Expression (Var Int (Var Int (Var () (Var () Void))))))
-> Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
-> (Pattern Int,
    Scope Int Expression (Var Int (Var Int (Var () (Var () Void)))))
forall a b. (a -> b) -> a -> b
$
                                                  Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
"Result.Err"
                                                    Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
-> Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
-> Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
forall v. Expression v -> Expression v -> Expression v
<| Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
"Http.BadBody"
                                                    Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
-> Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
-> Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
forall v. Expression v -> Expression v -> Expression v
<| Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
"Json.Decode.errorToString"
                                                    Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
-> Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
-> Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
forall v. Expression v -> Expression v -> Expression v
<| Int
-> Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
forall a. Int -> Expression (Var Int a)
patVar Int
0
                                              , Qualified
-> [Pattern Int]
-> Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
-> (Pattern Int,
    Scope Int Expression (Var Int (Var Int (Var () (Var () Void)))))
forall v b a.
Qualified
-> [Pattern v]
-> Expression (Var b a)
-> (Pattern v, Scope b Expression a)
pat Qualified
"Result.Ok" [Int -> Pattern Int
forall v. v -> Pattern v
Pat.Var Int
0] (Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
 -> (Pattern Int,
     Scope Int Expression (Var Int (Var Int (Var () (Var () Void))))))
-> Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
-> (Pattern Int,
    Scope Int Expression (Var Int (Var Int (Var () (Var () Void)))))
forall a b. (a -> b) -> a -> b
$
                                                  Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
"Result.Ok" Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
-> Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
-> Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
forall v. Expression v -> Expression v -> Expression v
<| Int
-> Expression (Var Int (Var Int (Var Int (Var () (Var () Void)))))
forall a. Int -> Expression (Var Int a)
patVar Int
0
                                              ]
                                        ]
                                    )
                                ]
                        )
                  ]

        )
    ]


{-| Class of servant APIs for which Elm client code can be generated. -}
class Elmable e where
  {-|
    Collect all the Elm definitions needed to implement a client for
    the API.  This is called recursively on our walk down the API tree,
    and the @['Param']@ argument contains all the request parameters
    (like 'Servant.API.Capture', 'Servant.API.ReqBody'', etc) that have been encountered so far on
    whatever particular branch . It will start out empty at the API root.
  -}
  endpoints :: [Param] -> Definitions ()
instance (Elmable a, Elmable b) => Elmable (a :<|> b) where
  endpoints :: [Param] -> Writer (Set Definition) ()
endpoints [Param]
params = do
    forall e. Elmable e => [Param] -> Writer (Set Definition) ()
forall {k} (e :: k).
Elmable e =>
[Param] -> Writer (Set Definition) ()
endpoints @a [Param]
params
    forall e. Elmable e => [Param] -> Writer (Set Definition) ()
forall {k} (e :: k).
Elmable e =>
[Param] -> Writer (Set Definition) ()
endpoints @b [Param]
params
instance (Elmable (ToServantApi api)) => Elmable (NamedRoutes api) where
  endpoints :: [Param] -> Writer (Set Definition) ()
endpoints = forall e. Elmable e => [Param] -> Writer (Set Definition) ()
forall {k} (e :: k).
Elmable e =>
[Param] -> Writer (Set Definition) ()
endpoints @(ToServantApi api)
instance (IsParam a, Elmable b) => Elmable (a :> b) where
  endpoints :: [Param] -> Writer (Set Definition) ()
endpoints [Param]
params = do
    Param
p <- forall (a :: k). IsParam a => Definitions Param
forall {k} (a :: k). IsParam a => Definitions Param
param @a
    forall e. Elmable e => [Param] -> Writer (Set Definition) ()
forall {k} (e :: k).
Elmable e =>
[Param] -> Writer (Set Definition) ()
endpoints @b (Param
p Param -> [Param] -> [Param]
forall a. a -> [a] -> [a]
: [Param]
params)
instance (Elmable (Verb m c t r)) => Elmable (Verb m c t (Headers h r)) where
  endpoints :: [Param] -> Writer (Set Definition) ()
endpoints = forall e. Elmable e => [Param] -> Writer (Set Definition) ()
forall {k} (e :: k).
Elmable e =>
[Param] -> Writer (Set Definition) ()
endpoints @(Verb m c t r)
instance {- Elmable (Verb m c t NoContent) -}
    (Elmable (NoContentVerb m))
  =>
    Elmable (Verb m c t NoContent)
  where
    endpoints :: [Param] -> Writer (Set Definition) ()
endpoints = forall e. Elmable e => [Param] -> Writer (Set Definition) ()
forall {k} (e :: k).
Elmable e =>
[Param] -> Writer (Set Definition) ()
endpoints @(NoContentVerb m)
instance {- Elmable (Verb method code types response) -}
    {-# overlaps #-}
    ( HasType (EncodingSpec response)
    , ReflectMethod method
    )
  =>
    Elmable (Verb method code types response)
  where
    endpoints :: [Param] -> Writer (Set Definition) ()
endpoints ([Param] -> [Param]
forall a. [a] -> [a]
reverse -> [Param]
params) = do
      Type Void
responseType <- forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @(EncodingSpec response)
      Expression Void
decoder <- forall (spec :: Specification).
HasType spec =>
Definitions (Expression Void)
decoderOf @(EncodingSpec response)
      Set Definition -> Writer (Set Definition) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Set Definition -> Writer (Set Definition) ())
-> (Definition -> Set Definition)
-> Definition
-> Writer (Set Definition) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Definition -> Set Definition
forall a. a -> Set a
Set.singleton (Definition -> Writer (Set Definition) ())
-> Definition -> Writer (Set Definition) ()
forall a b. (a -> b) -> a -> b
$
        Qualified
-> Int -> Scope Int Type Void -> Expression Void -> Definition
Def.Constant
          (forall (method :: k1). ReflectMethod method => [Param] -> Qualified
forall {k} (method :: k).
ReflectMethod method =>
[Param] -> Qualified
requestFunctionName @method [Param]
params)
          ([Param] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Param]
params)
          ([Param] -> Type Void -> Scope Int Type Void
requestFunctionType [Param]
params Type Void
responseType)
          (
            [Param] -> Method -> Expression Void -> Expression Void
requestFunctionBody
              [Param]
params
              (Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (forall (t :: k1). Proxy t
forall {k} (t :: k). Proxy t
Proxy @method))
              (Expression Void
"Api.Req.Right" Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Expression Void
decoder)
          )
      () -> Writer (Set Definition) ()
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance (ReflectMethod method) => Elmable (NoContentVerb method) where
  endpoints :: [Param] -> Writer (Set Definition) ()
endpoints ([Param] -> [Param]
forall a. [a] -> [a]
reverse -> [Param]
params) = do
    Set Definition -> Writer (Set Definition) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Set Definition -> Writer (Set Definition) ())
-> (Definition -> Set Definition)
-> Definition
-> Writer (Set Definition) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Definition -> Set Definition
forall a. a -> Set a
Set.singleton (Definition -> Writer (Set Definition) ())
-> Definition -> Writer (Set Definition) ()
forall a b. (a -> b) -> a -> b
$
      Qualified
-> Int -> Scope Int Type Void -> Expression Void -> Definition
Def.Constant
        (forall (method :: k1). ReflectMethod method => [Param] -> Qualified
forall {k} (method :: k).
ReflectMethod method =>
[Param] -> Qualified
requestFunctionName @method [Param]
params)
        ([Param] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Param]
params)
        ([Param] -> Type Void -> Scope Int Type Void
requestFunctionType [Param]
params Type Void
"Basics.()")
        (
          [Param] -> Method -> Expression Void -> Expression Void
requestFunctionBody
            [Param]
params
            (Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (forall (t :: k1). Proxy t
forall {k} (t :: k). Proxy t
Proxy @method))
            (Expression Void
"Api.Req.Left" Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Expression Void
"Basics.()")
        )
    () -> Writer (Set Definition) ()
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


{-|
  Obtain a value-level request parameter type from the type-level servant
  parameter type.
-}
class IsParam a where
  param :: Definitions Param
instance (KnownSymbol name) => IsParam (Capture name tpy) where
  param :: Definitions Param
param = Param -> Definitions Param
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Param -> Definitions Param) -> Param -> Definitions Param
forall a b. (a -> b) -> a -> b
$ PathParam -> Param
PathParam (Text -> PathParam
Capture (forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym @name))
instance (KnownSymbol name) => IsParam (Header' (Optional : mods) name a) where
  param :: Definitions Param
param = Param -> Definitions Param
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Param -> Definitions Param) -> Param -> Definitions Param
forall a b. (a -> b) -> a -> b
$ HeaderParam -> Param
HeaderParam (Text -> HeaderParam
OptionalHeader (forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym @name))
instance (KnownSymbol name) => IsParam (Header' (Required : mods) name a) where
  param :: Definitions Param
param = Param -> Definitions Param
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Param -> Definitions Param) -> Param -> Definitions Param
forall a b. (a -> b) -> a -> b
$ HeaderParam -> Param
HeaderParam (Text -> HeaderParam
RequiredHeader (forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym @name))
instance {- IsParam (Header' (other : mods) name a) -}
    {-# OVERLAPS #-} (IsParam (Header' mods name a))
  =>
    IsParam (Header' (other : mods) name a)
  where
    param :: Definitions Param
param = forall a. IsParam a => Definitions Param
forall {k} (a :: k). IsParam a => Definitions Param
param @(Header' mods name a)
instance {- IsParam (ReqBody' (Required : mods) (JSON : accept) a) -}
    (HasType (DecodingSpec a))
  =>
    IsParam (ReqBody' (Required : mods) (JSON : accept) a)
  where
    param :: Definitions Param
param = do
      Type Void
elmType <- forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @(DecodingSpec a)
      Expression Void
encoder <- forall (spec :: Specification).
HasType spec =>
Definitions (Expression Void)
encoderOf @(DecodingSpec a)
      Param -> Definitions Param
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Param -> Definitions Param) -> Param -> Definitions Param
forall a b. (a -> b) -> a -> b
$ BodyEncoder {Type Void
elmType :: Type Void
elmType :: Type Void
elmType, Expression Void
encoder :: Expression Void
encoder :: Expression Void
encoder}
instance {- IsParam (ReqBody' (other : mods) (JSON : accept) a) -}
    {-# overlaps #-} (IsParam (ReqBody' mods '[JSON] a))
  =>
    IsParam (ReqBody' (other : mods) (JSON : accept) a)
  where
    param :: Definitions Param
param = forall a. IsParam a => Definitions Param
forall {k} (a :: k). IsParam a => Definitions Param
param @(ReqBody' mods '[JSON] a)
instance {- IsParam (ReqBody' mods (other : accept) a) -}
    {-# overlaps #-} (IsParam (ReqBody' mods accept a))
  =>
    IsParam (ReqBody' mods (other : accept) a)
  where
    param :: Definitions Param
param = forall a. IsParam a => Definitions Param
forall {k} (a :: k). IsParam a => Definitions Param
param @(ReqBody' mods accept a)
instance (KnownSymbol segment) => IsParam (segment :: Symbol) where
  param :: Definitions Param
param = Param -> Definitions Param
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Param -> Definitions Param) -> Param -> Definitions Param
forall a b. (a -> b) -> a -> b
$ PathParam -> Param
PathParam (Text -> PathParam
Static (forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym @segment))
instance {- IsParam (QueryParam' (Optional : more) name typ) -}
    (KnownSymbol name)
  =>
    IsParam (QueryParam' (Optional : more) name typ)
  where
    param :: Definitions Param
param = Param -> Definitions Param
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Param -> Definitions Param) -> Param -> Definitions Param
forall a b. (a -> b) -> a -> b
$ QP -> Param
QueryParam (Text -> QP
OptionalQP (forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym @name))
instance {- IsParam (QueryParam' (Required : more) name typ) -}
    (KnownSymbol name)
  =>
    IsParam (QueryParam' (Required : more) name typ)
  where
    param :: Definitions Param
param = Param -> Definitions Param
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Param -> Definitions Param) -> Param -> Definitions Param
forall a b. (a -> b) -> a -> b
$ QP -> Param
QueryParam (Text -> QP
RequiredQP (forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym @name))
instance {- IsParam (QueryParam' (other : more) name typ) -}
    {-# overlaps #-} (IsParam (QueryParam' more name typ))
  =>
    IsParam (QueryParam' (other : more) name typ)
  where
    param :: Definitions Param
param = forall a. IsParam a => Definitions Param
forall {k} (a :: k). IsParam a => Definitions Param
param @(QueryParam' more name typ)


requestFunctionName
  :: forall method. (ReflectMethod method)
  => [Param]
  -> Name.Qualified
requestFunctionName :: forall {k} (method :: k).
ReflectMethod method =>
[Param] -> Qualified
requestFunctionName [Param]
params =
    Module -> Text -> Qualified
Name.Qualified
      [Text
"Api", Text
"Req"]
      (Module -> Text
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Text
methodName Text -> Module -> Module
forall a. a -> [a] -> [a]
: Module
pathParts))
  where
    methodName :: Text
    methodName :: Text
methodName =
      Text -> Text
Text.toLower
      (Text -> Text) -> (Proxy method -> Text) -> Proxy method -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text
TE.decodeUtf8
      (Method -> Text)
-> (Proxy method -> Method) -> Proxy method -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy method -> Method
forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod
      (Proxy method -> Text) -> Proxy method -> Text
forall a b. (a -> b) -> a -> b
$ forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @method

    pathParts :: [Text]
    pathParts :: Module
pathParts =
      Text -> Text
Text.toTitle (Text -> Text) -> Module -> Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Param -> Maybe Text) -> [Param] -> Module
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
          (\case
            PathParam (Static Text
segment) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Text
munge Text
segment)
            PathParam (Capture Text
name) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Text
munge Text
name)
            Param
_ -> Maybe Text
forall a. Maybe a
Nothing
          )
          [Param]
params

    {-
      Try to generate valid names in the face of common api path
      idioms. It isn't really worth it for this to be complete, but we
      at least want to cover the basics
    -}
    munge :: Text -> Text
    munge :: Text -> Text
munge = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"-" Text
"_"


requestFunctionType
  :: [Param]
  -> Type Void
  -> Scope Int Type Void
requestFunctionType :: [Param] -> Type Void -> Scope Int Type Void
requestFunctionType [Param]
params Type Void
responseType =
    Type Void -> Scope Int Type Void
forall (m :: * -> *) a. Monad m => m a -> Scope Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Type Void
funType
  where
    funType :: Type Void
    funType :: Type Void
funType =
      (Type Void -> Type Void -> Type Void)
-> Type Void -> [Type Void] -> Type Void
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
        Type Void -> Type Void -> Type Void
forall v. Type v -> Type v -> Type v
Type.Fun
        (Type Void
"Api.Req.Request" Type Void -> Type Void -> Type Void
forall v. Type v -> Type v -> Type v
`Type.App` Type Void
responseType)
        (
          (Param -> Maybe (Type Void)) -> [Param] -> [Type Void]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
            (\case
              PathParam (Capture Text
_) -> Type Void -> Maybe (Type Void)
forall a. a -> Maybe a
Just Type Void
"Basics.String"
              PathParam (Static Text
_) -> Maybe (Type Void)
forall a. Maybe a
Nothing
              QueryParam (RequiredQP Text
_) -> Type Void -> Maybe (Type Void)
forall a. a -> Maybe a
Just Type Void
"Basics.String"
              QueryParam (OptionalQP Text
_) ->
                Type Void -> Maybe (Type Void)
forall a. a -> Maybe a
Just (Type Void
"Basics.Maybe" Type Void -> Type Void -> Type Void
forall v. Type v -> Type v -> Type v
`Type.App` Type Void
"Basics.String")
              HeaderParam (RequiredHeader Text
_) -> Type Void -> Maybe (Type Void)
forall a. a -> Maybe a
Just Type Void
"Basics.String"
              HeaderParam (OptionalHeader Text
_) ->
                Type Void -> Maybe (Type Void)
forall a. a -> Maybe a
Just (Type Void
"Basics.Maybe" Type Void -> Type Void -> Type Void
forall v. Type v -> Type v -> Type v
`Type.App` Type Void
"Basics.String")
              BodyEncoder Type Void
typ Expression Void
_ -> Type Void -> Maybe (Type Void)
forall a. a -> Maybe a
Just Type Void
typ
            )
            [Param]
params
        )


requestFunctionBody
  :: [Param]
  -> Method
  -> Expression Void
  -> Expression Void
requestFunctionBody :: [Param] -> Method -> Expression Void -> Expression Void
requestFunctionBody [Param]
params Method
method Expression Void
decoder =
    [Param] -> Expression Param -> Expression Void
buildLambda
      ([Param] -> [Param]
forall a. [a] -> [a]
reverse [Param]
params)
      (
        [(Field, Expression Param)] -> Expression Param
forall v. [(Field, Expression v)] -> Expression v
Expr.Record
          [ (Text -> Field
Name.Field Text
"method", Text -> Expression Param
forall v. Text -> Expression v
Expr.String (Method -> Text
TE.decodeUtf8 Method
method))
          , (Text -> Field
Name.Field Text
"headers", Expression Param
headers)
          , (Text -> Field
Name.Field Text
"url", Expression Param
url)
          , (Text -> Field
Name.Field Text
"body", Expression Param
body)
          , (Text -> Field
Name.Field Text
"decoder", (Qualified -> Expression Param)
-> (Void -> Expression Param)
-> Expression Void
-> Expression Param
forall v v'.
(Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
Expr.bind Qualified -> Expression Param
forall any. Qualified -> Expression any
g Void -> Expression Param
forall a. Void -> a
absurd Expression Void
decoder)
          ]
      )
  where
    headers :: Expression Param
    headers :: Expression Param
headers =
        Expression Param -> [Expression Param] -> Expression Param
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expr.apps
          Expression Param
"List.filterMap"
          [ Expression Param
"Basics.identity"
          , [Expression Param] -> Expression Param
forall v. [Expression v] -> Expression v
Expr.List
              [ HeaderParam -> Expression Param
headerExpr HeaderParam
header
              | HeaderParam HeaderParam
header <- [Param]
params
              ]
          ]
      where
        headerExpr :: HeaderParam -> Expression Param
        headerExpr :: HeaderParam -> Expression Param
headerExpr HeaderParam
header =
            Expression Param -> [Expression Param] -> Expression Param
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expr.apps
              Expression Param
"Maybe.map"
              [ Expression Param
"Http.header" Expression Param -> Expression Param -> Expression Param
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Text -> Expression Param
forall v. Text -> Expression v
Expr.String Text
name
              , case HeaderParam
header of
                  RequiredHeader Text
_ ->
                    Expression Param
"Maybe.Just" Expression Param -> Expression Param -> Expression Param
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Param -> Expression Param
forall v. v -> Expression v
Expr.Var (HeaderParam -> Param
HeaderParam HeaderParam
header)
                  OptionalHeader Text
_ -> Param -> Expression Param
forall v. v -> Expression v
Expr.Var (HeaderParam -> Param
HeaderParam HeaderParam
header)
              ]
          where
            name :: Text
            name :: Text
name =
              case HeaderParam
header of
                  RequiredHeader Text
n -> Text
n
                  OptionalHeader Text
n -> Text
n

    url :: Expression Param
    url :: Expression Param
url =
      Expression Param -> [Expression Param] -> Expression Param
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expr.apps
        Expression Param
"Url.Builder.absolute"
        [
          [Expression Param] -> Expression Param
forall v. [Expression v] -> Expression v
Expr.List
            [ case PathParam
pp of
                Static Text
part -> Text -> Expression Param
forall v. Text -> Expression v
Expr.String Text
part
                Capture Text
_ -> Param -> Expression Param
forall v. v -> Expression v
Expr.Var Param
param_
            | param_ :: Param
param_@(PathParam PathParam
pp) <- [Param]
params
            ]
        , Expression Param -> [Expression Param] -> Expression Param
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expr.apps
            Expression Param
"List.filterMap"
            [ Expression Param
"Basics.identity"
            , [Expression Param] -> Expression Param
forall v. [Expression v] -> Expression v
Expr.List
                [ let
                    name :: Text
                    name :: Text
name  = case QP
qp of { RequiredQP Text
n -> Text
n; OptionalQP Text
n -> Text
n}
                        
                    queryExpr :: Expression Param
                    queryExpr :: Expression Param
queryExpr =
                      Expression Param -> [Expression Param] -> Expression Param
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expr.apps
                        Expression Param
"Maybe.map"
                        [ Expression Param
"Url.Builder.string" Expression Param -> Expression Param -> Expression Param
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Text -> Expression Param
forall v. Text -> Expression v
Expr.String Text
name
                        , case QP
qp of
                            RequiredQP Text
_ ->
                              Expression Param
"Maybe.Just" Expression Param -> Expression Param -> Expression Param
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Param -> Expression Param
forall v. v -> Expression v
Expr.Var Param
param_
                            OptionalQP Text
_ -> Param -> Expression Param
forall v. v -> Expression v
Expr.Var Param
param_
                        ]
                  in
                    Expression Param
queryExpr
                | param_ :: Param
param_@(QueryParam QP
qp) <- [Param]
params
                ]
            ]
        ]

    body :: Expression Param
    body :: Expression Param
body =
      case
        [ Qualified -> Expression Param
forall any. Qualified -> Expression any
g Qualified
"Http.jsonBody" Expression Param -> Expression Param -> Expression Param
forall v. Expression v -> Expression v -> Expression v
`Expr.App`
            ((Void -> Param
forall a. Void -> a
absurd (Void -> Param) -> Expression Void -> Expression Param
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression Void
encoder) Expression Param -> Expression Param -> Expression Param
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Param -> Expression Param
forall v. v -> Expression v
Expr.Var Param
param_)
        | param_ :: Param
param_@(BodyEncoder Type Void
_ Expression Void
encoder) <- [Param]
params
        ]
      of
        [] -> Qualified -> Expression Param
forall any. Qualified -> Expression any
g Qualified
"Http.emptyBody"
        (Expression Param
encoder : [Expression Param]
_) -> Expression Param
encoder

    buildLambda :: [Param] -> Expression Param -> Expression Void
    buildLambda :: [Param] -> Expression Param -> Expression Void
buildLambda = \cases
      [] Expression Param
e ->
        Expression Void -> Maybe (Expression Void) -> Expression Void
forall a. a -> Maybe a -> a
fromMaybe
          ([Char] -> Expression Void
forall a. HasCallStack => [Char] -> a
error [Char]
"Paramaters in expression to not match the parameter list.")
          (Expression Param -> Maybe (Expression Void)
forall (f :: * -> *) a b. Traversable f => f a -> Maybe (f b)
Bound.closed Expression Param
e)
      (PathParam (Static Text
_) : [Param]
more) Expression Param
e ->
        [Param] -> Expression Param -> Expression Void
buildLambda [Param]
more Expression Param
e
      (Param
p : [Param]
more) Expression Param
e ->
        [Param] -> Expression Param -> Expression Void
buildLambda
          [Param]
more
          (Scope () Expression Param -> Expression Param
forall v. Scope () Expression v -> Expression v
Expr.Lam (Param -> Expression Param -> Scope () Expression Param
forall (f :: * -> *) a. (Monad f, Eq a) => a -> f a -> Scope () f a
abstract1 Param
p Expression Param
e))


data Param
  = PathParam PathParam
  | HeaderParam HeaderParam
  | QueryParam QP
  | BodyEncoder
      { Param -> Type Void
elmType :: Type Void
      , Param -> Expression Void
encoder :: Expression Void
      }
  deriving stock (Param -> Param -> Bool
(Param -> Param -> Bool) -> (Param -> Param -> Bool) -> Eq Param
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Param -> Param -> Bool
== :: Param -> Param -> Bool
$c/= :: Param -> Param -> Bool
/= :: Param -> Param -> Bool
Eq)


data QP
  = RequiredQP Text
  | OptionalQP Text
  deriving stock (QP -> QP -> Bool
(QP -> QP -> Bool) -> (QP -> QP -> Bool) -> Eq QP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QP -> QP -> Bool
== :: QP -> QP -> Bool
$c/= :: QP -> QP -> Bool
/= :: QP -> QP -> Bool
Eq)


data PathParam
  = Static Text
  | Capture Text
  deriving stock (PathParam -> PathParam -> Bool
(PathParam -> PathParam -> Bool)
-> (PathParam -> PathParam -> Bool) -> Eq PathParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathParam -> PathParam -> Bool
== :: PathParam -> PathParam -> Bool
$c/= :: PathParam -> PathParam -> Bool
/= :: PathParam -> PathParam -> Bool
Eq)


data HeaderParam
  = RequiredHeader Text
  | OptionalHeader Text
  deriving stock (HeaderParam -> HeaderParam -> Bool
(HeaderParam -> HeaderParam -> Bool)
-> (HeaderParam -> HeaderParam -> Bool) -> Eq HeaderParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeaderParam -> HeaderParam -> Bool
== :: HeaderParam -> HeaderParam -> Bool
$c/= :: HeaderParam -> HeaderParam -> Bool
/= :: HeaderParam -> HeaderParam -> Bool
Eq)


g :: Name.Qualified -> Expression any
g :: forall any. Qualified -> Expression any
g = Qualified -> Expression any
forall any. Qualified -> Expression any
Expr.Global


sym
  :: forall a b.
     ( IsString b
     , KnownSymbol a
     )
  => b
sym :: forall (a :: Symbol) b. (IsString b, KnownSymbol a) => b
sym = [Char] -> b
forall a. IsString a => [Char] -> a
fromString ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$ Proxy a -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @a)