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

module Data.JsonSpec.Elm.Servant (
  servantDefs,
) 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,
  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


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)
"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 -> 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
                                        (
                                          Expression (Var Int (Var () (Var () Void)))
-> [Expression (Var Int (Var () (Var () Void)))]
-> Expression (Var Int (Var () (Var () Void)))
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expr.apps
                                            Expression (Var Int (Var () (Var () Void)))
"Json.Decode.decodeString"
                                            [ 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"
                                            , 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 () (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
"Result.Err" [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.Err"
                                              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
<| Expression (Var Int (Var Int (Var () (Var () Void))))
"Http.BadBody"
                                              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
<| Expression (Var Int (Var Int (Var () (Var () Void))))
"Json.Decode.errorToString"
                                              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
<| 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
"Result.Ok" [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
<| Int -> Expression (Var Int (Var Int (Var () (Var () Void))))
forall a. Int -> Expression (Var Int a)
patVar Int
0
                                        ]
                                    )
                                ]
                        )
                  ]

        )
    ]


class Elmable e where
  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
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))
            (Qualified -> Expression Void
forall any. Qualified -> Expression any
g Qualified
"Json.Decode.succeed" 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 ()


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
typ <- 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
$ Type Void -> Expression Void -> Param
BodyEncoder Type Void
typ 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))


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
segment
            PathParam (Capture Text
name) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
            Param
_ -> Maybe Text
forall a. Maybe a
Nothing
          )
          [Param]
params


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
              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
forall v. [Expression v] -> Expression v
Expr.List []
        ]

    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
  | BodyEncoder (Type Void) (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 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)