{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.JsonSpec.Elm (
  elmDefs,
  Definitions,
  HasType(..),
) where


import Bound (Scope(Scope), Var(B, F), toScope)
import Control.Monad.Writer (MonadWriter(tell), Writer, execWriter)
import Data.JsonSpec (Specification(JsonArray, JsonBool, JsonDateTime,
  JsonEither, JsonInt, JsonLet, JsonNullable, JsonNum, JsonObject,
  JsonRef, JsonString, JsonTag))
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 (ErrorMessage((:$$:), (:<>:)), KnownSymbol, Symbol,
  TypeError, symbolVal)
import Language.Elm.Definition (Definition)
import Language.Elm.Expression ((|>), Expression, bind, if_)
import Language.Elm.Name (Constructor, Qualified)
import Language.Elm.Type (Type)
import Prelude (Applicative(pure), Foldable(foldl), Functor(fmap),
  Maybe(Just, Nothing), Monad((>>)), Semigroup((<>)), Show(show), ($),
  (++), (.), (<$>), Int, error, reverse, zip)
import qualified Data.Char as Char
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified GHC.TypeLits as Lits
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


elmDefs
  :: forall spec. (HasType spec)
  => Proxy (spec :: Specification)
  -> Set Definition
elmDefs :: forall (spec :: Specification).
HasType spec =>
Proxy spec -> Set Definition
elmDefs Proxy spec
_ =
  Writer (Set Definition) (Expression Void) -> Set Definition
forall w a. Writer w a -> w
execWriter (Writer (Set Definition) (Expression Void) -> Set Definition)
-> Writer (Set Definition) (Expression Void) -> Set Definition
forall a b. (a -> b) -> a -> b
$ forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @spec Definitions (Type Any)
-> Writer (Set Definition) (Expression Void)
-> Writer (Set Definition) (Expression Void)
forall a b.
WriterT (Set Definition) Identity a
-> WriterT (Set Definition) Identity b
-> WriterT (Set Definition) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
decoderOf @spec


class Record (spec :: [(Symbol, Specification)]) where
  recordDefs :: forall v. Definitions [(Name.Field, Type v)]
  recordEncoders :: Definitions [(Text, Name.Field, Expression Void)]
instance Record '[] where
  recordDefs :: forall v. Definitions [(Field, Type v)]
recordDefs = [(Field, Type v)]
-> WriterT (Set Definition) Identity [(Field, Type v)]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  recordEncoders :: Definitions [(Text, Field, Expression Void)]
recordEncoders = [(Text, Field, Expression Void)]
-> Definitions [(Text, Field, Expression Void)]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
instance
    ( HasType spec
    , KnownSymbol name
    , Record more
    )
  =>
    Record ( '(name, spec) : more )
  where
    recordDefs :: forall v. Definitions [(Field, Type v)]
recordDefs = do
      Type v
type_ <- forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @spec
      [(Field, Type v)]
moreFields <- forall (spec :: [(Symbol, Specification)]) v.
Record spec =>
Definitions [(Field, Type v)]
recordDefs @more
      [(Field, Type v)] -> Definitions [(Field, Type v)]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Field, Type v)] -> Definitions [(Field, Type v)])
-> [(Field, Type v)] -> Definitions [(Field, Type v)]
forall a b. (a -> b) -> a -> b
$ (forall (name :: Symbol). KnownSymbol name => Field
fieldName @name, Type v
type_) (Field, Type v) -> [(Field, Type v)] -> [(Field, Type v)]
forall a. a -> [a] -> [a]
: [(Field, Type v)]
moreFields
    recordEncoders :: Definitions [(Text, Field, Expression Void)]
recordEncoders = do
      Expression Void
encoder <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
encoderOf @spec
      [(Text, Field, Expression Void)]
moreFields <- forall (spec :: [(Symbol, Specification)]).
Record spec =>
Definitions [(Text, Field, Expression Void)]
recordEncoders @more
      [(Text, Field, Expression Void)]
-> Definitions [(Text, Field, Expression Void)]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, Field, Expression Void)]
 -> Definitions [(Text, Field, Expression Void)])
-> [(Text, Field, Expression Void)]
-> Definitions [(Text, Field, Expression Void)]
forall a b. (a -> b) -> a -> b
$ (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name, forall (name :: Symbol). KnownSymbol name => Field
fieldName @name, Expression Void
encoder) (Text, Field, Expression Void)
-> [(Text, Field, Expression Void)]
-> [(Text, Field, Expression Void)]
forall a. a -> [a] -> [a]
: [(Text, Field, Expression Void)]
moreFields


class HasType (spec :: Specification) where
  typeOf :: forall v. Definitions (Type v)
  decoderOf :: Definitions (Expression Void)
  encoderOf :: Definitions (Expression Void)
instance HasType JsonString where
  typeOf :: forall v. Definitions (Type v)
typeOf = Type v -> WriterT (Set Definition) Identity (Type v)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type v
"String.String"
  decoderOf :: Writer (Set Definition) (Expression Void)
decoderOf = Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression Void
"Json.Decode.string"
  encoderOf :: Writer (Set Definition) (Expression Void)
encoderOf = Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression Void
"Json.Encode.string"
instance HasType JsonNum where
  typeOf :: forall v. Definitions (Type v)
typeOf = Type v -> WriterT (Set Definition) Identity (Type v)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type v
"Basics.Float"
  decoderOf :: Writer (Set Definition) (Expression Void)
decoderOf = Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression Void
"Json.Decode.float"
  encoderOf :: Writer (Set Definition) (Expression Void)
encoderOf = Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression Void
"Json.Encode.float"
instance HasType JsonInt where
  typeOf :: forall v. Definitions (Type v)
typeOf = Type v -> WriterT (Set Definition) Identity (Type v)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type v
"Basics.Int"
  decoderOf :: Writer (Set Definition) (Expression Void)
decoderOf = Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression Void
"Json.Decode.int"
  encoderOf :: Writer (Set Definition) (Expression Void)
encoderOf = Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression Void
"Json.Encode.int"
instance {- HasType (JsonObject fields) -}
    ( Record fields
    , BaseFields (Reverse fields)
    , Lambda (LambdaDepth (Reverse fields))
    , Decoders fields
    )
  =>
    HasType (JsonObject fields)
  where
    typeOf :: forall v. Definitions (Type v)
typeOf = [(Field, Type v)] -> Type v
forall v. [(Field, Type v)] -> Type v
Type.Record ([(Field, Type v)] -> Type v)
-> WriterT (Set Definition) Identity [(Field, Type v)]
-> WriterT (Set Definition) Identity (Type v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (spec :: [(Symbol, Specification)]) v.
Record spec =>
Definitions [(Field, Type v)]
recordDefs @fields
    decoderOf :: Writer (Set Definition) (Expression Void)
decoderOf = do
        [(Text, Expression Void)]
decoders <- forall (spec :: [(Symbol, Specification)]).
Decoders spec =>
Definitions [(Text, Expression Void)]
fieldDecoders @fields
        Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression Void -> Writer (Set Definition) (Expression Void))
-> Expression Void -> Writer (Set Definition) (Expression Void)
forall a b. (a -> b) -> a -> b
$
          (Expression Void -> (Text, Expression Void) -> Expression Void)
-> Expression Void -> [(Text, Expression Void)] -> Expression Void
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
            (\Expression Void
expr (Text
_, Expression Void
decoder) ->
              Expression Void
expr Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
|> (Expression Void
"Json.Decode.andThen" Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`Expr.App`
                Scope () Expression Void -> Expression Void
forall v. Scope () Expression v -> Expression v
Expr.Lam (Expression (Var () Void) -> Scope () Expression Void
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope (
                  Expression (Var () Void)
"Json.Decode.map"
                    Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Var () Void -> Expression (Var () Void)
forall v. v -> Expression v
Expr.Var (() -> Var () Void
forall b a. b -> Var b a
B ())
                    Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
`Expr.App` (Qualified -> Expression (Var () Void))
-> (Void -> Expression (Var () Void))
-> Expression Void
-> Expression (Var () Void)
forall v v'.
(Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
bind Qualified -> Expression (Var () Void)
forall v. Qualified -> Expression v
Expr.Global Void -> Expression (Var () Void)
forall a. Void -> a
absurd Expression Void
decoder
                ))
              )
            )
            (Expression Void
"Json.Decode.succeed" Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Expression Void
lambda)
            [(Text, Expression Void)]
decoders
      where
        lambda :: Expression Void
lambda =
          Expression (LambdaDepth (Reverse fields)) -> Expression Void
forall depth. Lambda depth => Expression depth -> Expression Void
lam (Expression (LambdaDepth (Reverse fields)) -> Expression Void)
-> ([(Field, Expression (LambdaDepth (Reverse fields)))]
    -> Expression (LambdaDepth (Reverse fields)))
-> [(Field, Expression (LambdaDepth (Reverse fields)))]
-> Expression Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Field, Expression (LambdaDepth (Reverse fields)))]
-> Expression (LambdaDepth (Reverse fields))
forall v. [(Field, Expression v)] -> Expression v
Expr.Record ([(Field, Expression (LambdaDepth (Reverse fields)))]
 -> Expression (LambdaDepth (Reverse fields)))
-> ([(Field, Expression (LambdaDepth (Reverse fields)))]
    -> [(Field, Expression (LambdaDepth (Reverse fields)))])
-> [(Field, Expression (LambdaDepth (Reverse fields)))]
-> Expression (LambdaDepth (Reverse fields))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Field, Expression (LambdaDepth (Reverse fields)))]
-> [(Field, Expression (LambdaDepth (Reverse fields)))]
forall a. [a] -> [a]
reverse ([(Field, Expression (LambdaDepth (Reverse fields)))]
 -> Expression Void)
-> [(Field, Expression (LambdaDepth (Reverse fields)))]
-> Expression Void
forall a b. (a -> b) -> a -> b
$
            [ (Field
name, Expression (LambdaDepth (Reverse fields))
var)
            | (Field
name, Expression (LambdaDepth (Reverse fields))
var) <- forall (record :: [(Symbol, Specification)]).
BaseFields record =>
[(Field, Expression (LambdaDepth record))]
baseFields @(Reverse fields)
            ]
    encoderOf :: Writer (Set Definition) (Expression Void)
encoderOf = do
        [(Text, Field, Expression Void)]
fields <- forall (spec :: [(Symbol, Specification)]).
Record spec =>
Definitions [(Text, Field, Expression Void)]
recordEncoders @fields
        Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression Void -> Writer (Set Definition) (Expression Void))
-> Expression Void -> Writer (Set Definition) (Expression Void)
forall a b. (a -> b) -> a -> b
$
          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
$
            Expression (Var () Void)
"Json.Encode.object"
            Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
`Expr.App`
            [Expression (Var () Void)] -> Expression (Var () Void)
forall v. [Expression v] -> Expression v
Expr.List
              [ Expression (Var () Void)
-> [Expression (Var () Void)] -> Expression (Var () Void)
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expr.apps Expression (Var () Void)
"Basics.," [
                Text -> Expression (Var () Void)
forall v. Text -> Expression v
Expr.String Text
jsonField,
                (Qualified -> Expression (Var () Void))
-> (Void -> Expression (Var () Void))
-> Expression Void
-> Expression (Var () Void)
forall v v'.
(Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
Expr.bind Qualified -> Expression (Var () Void)
forall v. Qualified -> Expression v
Expr.Global Void -> Expression (Var () Void)
forall a. Void -> a
absurd Expression Void
encoder Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
`Expr.App`
                  (Field -> Expression (Var () Void)
forall v. Field -> Expression v
Expr.Proj Field
elmField Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Var () Void -> Expression (Var () Void)
forall v. v -> Expression v
Expr.Var Var () Void
forall a. Var () a
var)
                ]
              | (Text
jsonField, Field
elmField, Expression Void
encoder) <- [(Text, Field, Expression Void)]
fields
              ]
      where
        var :: Bound.Var () a
        var :: forall a. Var () a
var = () -> Var () a
forall b a. b -> Var b a
B ()

instance (HasType spec) => HasType (JsonArray spec) where
  typeOf :: forall v. Definitions (Type v)
typeOf = do
    Type v
elemType <- forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @spec
    Type v -> Definitions (Type v)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type v -> Definitions (Type v)) -> Type v -> Definitions (Type v)
forall a b. (a -> b) -> a -> b
$ Type v -> Type v -> Type v
forall v. Type v -> Type v -> Type v
Type.App Type v
"Basics.List" Type v
elemType
  decoderOf :: Writer (Set Definition) (Expression Void)
decoderOf = do
    Expression Void
dec <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
decoderOf @spec
    Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression Void -> Writer (Set Definition) (Expression Void))
-> Expression Void -> Writer (Set Definition) (Expression Void)
forall a b. (a -> b) -> a -> b
$ Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
Expr.App Expression Void
"Json.Decode.list" Expression Void
dec
  encoderOf :: Writer (Set Definition) (Expression Void)
encoderOf = do
    Expression Void
encoder <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
encoderOf @spec
    Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression Void -> Writer (Set Definition) (Expression Void))
-> Expression Void -> Writer (Set Definition) (Expression Void)
forall a b. (a -> b) -> a -> b
$ Expression Void
"Json.Encode.list" Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Expression Void
encoder
instance HasType JsonBool where
  typeOf :: forall v. Definitions (Type v)
typeOf = Type v -> WriterT (Set Definition) Identity (Type v)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type v
"Basics.Bool"
  decoderOf :: Writer (Set Definition) (Expression Void)
decoderOf = Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression Void
"Json.Decode.bool"
  encoderOf :: Writer (Set Definition) (Expression Void)
encoderOf =
    Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression Void
"Json.Encode.bool"
instance (HasType spec) => HasType (JsonNullable spec) where
  typeOf :: forall v. Definitions (Type v)
typeOf = do
    Type v
type_ <- forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @spec
    Type v -> Definitions (Type v)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type v -> Definitions (Type v)) -> Type v -> Definitions (Type v)
forall a b. (a -> b) -> a -> b
$ Type v -> Type v -> Type v
forall v. Type v -> Type v -> Type v
Type.App Type v
"Maybe.Maybe" Type v
type_
  decoderOf :: Writer (Set Definition) (Expression Void)
decoderOf = do
    Expression Void
dec <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
decoderOf @spec
    Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression Void -> Writer (Set Definition) (Expression Void))
-> Expression Void -> Writer (Set Definition) (Expression Void)
forall a b. (a -> b) -> a -> b
$ Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
Expr.App Expression Void
"Json.Decode.nullable" Expression Void
dec
  encoderOf :: Writer (Set Definition) (Expression Void)
encoderOf = do
    Expression Void
encoder <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
encoderOf @spec
    Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression Void -> Writer (Set Definition) (Expression Void))
-> Expression Void -> Writer (Set Definition) (Expression Void)
forall a b. (a -> b) -> a -> b
$
      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
$
        Expression (Var () Void)
-> [Expression (Var () Void)] -> Expression (Var () Void)
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expr.apps
          Expression (Var () Void)
"Maybe.withDefault"
          [ Expression (Var () Void)
"Json.Decode.null"
          , Expression (Var () Void)
-> [Expression (Var () Void)] -> Expression (Var () Void)
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expr.apps
              Expression (Var () Void)
"Maybe.map"
              [ (Qualified -> Expression (Var () Void))
-> (Void -> Expression (Var () Void))
-> Expression Void
-> Expression (Var () Void)
forall v v'.
(Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
Expr.bind Qualified -> Expression (Var () Void)
forall v. Qualified -> Expression v
Expr.Global Void -> Expression (Var () Void)
forall a. Void -> a
absurd Expression Void
encoder
              , Var () Void -> Expression (Var () Void)
forall v. v -> Expression v
Expr.Var (() -> Var () Void
forall b a. b -> Var b a
B ())
              ]
          ]
instance (KnownSymbol const) => HasType (JsonTag const) where
  typeOf :: forall v. Definitions (Type v)
typeOf = Type v -> WriterT (Set Definition) Identity (Type v)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type v
"Basics.()"
  decoderOf :: Writer (Set Definition) (Expression Void)
decoderOf =
    Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression Void -> Writer (Set Definition) (Expression Void))
-> Expression Void -> Writer (Set Definition) (Expression Void)
forall a b. (a -> b) -> a -> b
$
      Expression Void
"Json.Decode.string"
      Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
|> Expression Void -> [Expression Void] -> Expression Void
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expr.apps Expression Void
"Json.Decode.andThen"
          [ 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
$
              Expression (Var () Void)
-> Expression (Var () Void)
-> Expression (Var () Void)
-> Expression (Var () Void)
forall v.
Expression v -> Expression v -> Expression v -> Expression v
if_
                (
                  Expression (Var () Void)
-> [Expression (Var () Void)] -> Expression (Var () Void)
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expr.apps
                    Expression (Var () Void)
"Basics.=="
                    [ Var () Void -> Expression (Var () Void)
forall v. v -> Expression v
Expr.Var (() -> Var () Void
forall b a. b -> Var b a
B ())
                    , Text -> Expression (Var () Void)
forall v. Text -> Expression v
Expr.String (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @const)
                    ]
                )
                (Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
Expr.App Expression (Var () Void)
"Json.Decode.succeed" Expression (Var () Void)
"Basics.()")
                (Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
Expr.App Expression (Var () Void)
"Json.Decode.fail" (Text -> Expression (Var () Void)
forall v. Text -> Expression v
Expr.String Text
"Tag mismatch"))
          ]
  encoderOf :: Writer (Set Definition) (Expression Void)
encoderOf =
    Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression Void -> Writer (Set Definition) (Expression Void))
-> Expression Void -> Writer (Set Definition) (Expression Void)
forall a b. (a -> b) -> a -> b
$
      Expression Void
"Basics.always" Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`Expr.App`
        (Expression Void
"Json.Encode.string" Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Text -> Expression Void
forall v. Text -> Expression v
Expr.String (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @const))
instance HasType JsonDateTime where
  typeOf :: forall v. Definitions (Type v)
typeOf = Type v -> WriterT (Set Definition) Identity (Type v)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type v
"Time.Posix"
  decoderOf :: Writer (Set Definition) (Expression Void)
decoderOf = Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression Void
"Iso8601.decoder"
  encoderOf :: Writer (Set Definition) (Expression Void)
encoderOf = Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression Void
"Iso8601.encode"
instance (KnownSymbol name) => HasType (JsonRef name) where
  typeOf :: forall v. Definitions (Type v)
typeOf =
    Type v -> WriterT (Set Definition) Identity (Type v)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Type v -> WriterT (Set Definition) Identity (Type v))
-> (Text -> Type v)
-> Text
-> WriterT (Set Definition) Identity (Type v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified -> Type v
forall v. Qualified -> Type v
Type.Global
    (Qualified -> Type v) -> (Text -> Qualified) -> Text -> Type v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Qualified
localName
    (Text -> WriterT (Set Definition) Identity (Type v))
-> Text -> WriterT (Set Definition) Identity (Type v)
forall a b. (a -> b) -> a -> b
$ forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name
  decoderOf :: Writer (Set Definition) (Expression Void)
decoderOf =
    Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression Void -> Writer (Set Definition) (Expression Void))
-> (Qualified -> Expression Void)
-> Qualified
-> Writer (Set Definition) (Expression Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified -> Expression Void
forall v. Qualified -> Expression v
Expr.Global (Qualified -> Writer (Set Definition) (Expression Void))
-> Qualified -> Writer (Set Definition) (Expression Void)
forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol). KnownSymbol name => Qualified
decoderName @name
  encoderOf :: Writer (Set Definition) (Expression Void)
encoderOf =
    Expression Void -> Writer (Set Definition) (Expression Void)
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression Void -> Writer (Set Definition) (Expression Void))
-> (Qualified -> Expression Void)
-> Qualified
-> Writer (Set Definition) (Expression Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified -> Expression Void
forall v. Qualified -> Expression v
Expr.Global (Qualified -> Writer (Set Definition) (Expression Void))
-> Qualified -> Writer (Set Definition) (Expression Void)
forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol). KnownSymbol name => Qualified
encoderName @name
instance (HasType spec) => HasType (JsonLet '[] spec) where
  typeOf :: forall v. Definitions (Type v)
typeOf = forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @spec
  decoderOf :: Writer (Set Definition) (Expression Void)
decoderOf = forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
decoderOf @spec
  encoderOf :: Writer (Set Definition) (Expression Void)
encoderOf = forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
encoderOf @spec
instance {- HasType (JsonLet ( def : more ) spec) -}
    ( ElmDef def
    , HasType (JsonLet more spec)
    )
  =>
    HasType (JsonLet ( def : more ) spec)
  where
    typeOf :: forall v. Definitions (Type v)
typeOf = do
      forall (def :: (Symbol, Specification)).
ElmDef def =>
Definitions ()
defs @def
      forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @(JsonLet more spec)
    decoderOf :: Writer (Set Definition) (Expression Void)
decoderOf = do
      forall (def :: (Symbol, Specification)).
ElmDef def =>
Definitions ()
defs @def
      forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
decoderOf @(JsonLet more spec)
    encoderOf :: Writer (Set Definition) (Expression Void)
encoderOf = do
      forall (def :: (Symbol, Specification)).
ElmDef def =>
Definitions ()
defs @def
      forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
encoderOf @(JsonLet more spec)
instance {- HasType (JsonEither left right) -}
    ( TypeError
        ( Lits.Text "Elm doesn't support anonymous sum types, so if you "
          :<>: Lits.Text "want to use (possibly nested) `JsonEither` "
          :<>: Lits.Text "you must give it a name using `JsonLet`, e.g:"
          :$$: Lits.Text ""
          :$$: Lits.Text "> JsonLet"
          :$$: Lits.Text ">   '[ '( \"MySum\""
          :$$: Lits.Text ">       , JsonEither"
          :$$: Lits.Text ">           ( JsonEither"
          :$$: Lits.Text ">               JsonInt"
          :$$: Lits.Text ">               JsonString"
          :$$: Lits.Text ">           )"
          :$$: Lits.Text ">           ( JsonEither"
          :$$: Lits.Text ">               JsonFloat"
          :$$: Lits.Text ">               JsonBool"
          :$$: Lits.Text ">           )"
          :$$: Lits.Text ">       )"
          :$$: Lits.Text ">    ]"
          :$$: Lits.Text ">    (JsonRef \"MySum\")"
          :$$: Lits.Text ""
          :$$: Lits.Text "This will produce the Elm type"
          :$$: Lits.Text ""
          :$$: Lits.Text "> type MySum"
          :$$: Lits.Text ">   = MySum_1 Int"
          :$$: Lits.Text ">   | MySum_2 String"
          :$$: Lits.Text ">   | MySum_3 Float"
          :$$: Lits.Text ">   | MySum_4 Bool"
          :$$: Lits.Text ""

        )
    )
  =>
    HasType (JsonEither left right)
  where
    typeOf :: forall v. Definitions (Type v)
typeOf = [Char] -> Definitions (Type v)
forall a. HasCallStack => [Char] -> a
error [Char]
"undefinable"
    decoderOf :: Writer (Set Definition) (Expression Void)
decoderOf = [Char] -> Writer (Set Definition) (Expression Void)
forall a. HasCallStack => [Char] -> a
error [Char]
"undefinable"
    encoderOf :: Writer (Set Definition) (Expression Void)
encoderOf = [Char] -> Writer (Set Definition) (Expression Void)
forall a. HasCallStack => [Char] -> a
error [Char]
"undefinable"


type family LambdaDepth (record :: [k]) where
  LambdaDepth '[] = Void
  LambdaDepth (a : more) =
    Bound.Var () (LambdaDepth more)


class Lambda depth where
  lam :: Expression depth -> Expression Void
instance {-# OVERLAPS #-} Lambda (Bound.Var () Void) where
  lam :: Expression (Var () Void) -> Expression Void
lam Expression (Var () Void)
e = Scope () Expression Void -> Expression Void
forall v. Scope () Expression v -> Expression v
Expr.Lam (Expression (Var () Void) -> Scope () Expression Void
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope Expression (Var () Void)
e)
instance (Lambda deeper) => Lambda (Bound.Var () deeper) where
  lam :: Expression (Var () deeper) -> Expression Void
lam Expression (Var () deeper)
e = Expression deeper -> Expression Void
forall depth. Lambda depth => Expression depth -> Expression Void
lam (Scope () Expression deeper -> Expression deeper
forall v. Scope () Expression v -> Expression v
Expr.Lam (Expression (Var () deeper) -> Scope () Expression deeper
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope Expression (Var () deeper)
e))


class BaseFields (record :: [(Symbol, Specification)]) where
  baseFields :: [(Name.Field, Expression (LambdaDepth record))]
instance BaseFields '[] where
  baseFields :: [(Field, Expression (LambdaDepth '[]))]
baseFields = []
instance {- BaseFields ('(name, spec) : more) -}
    (BaseFields more, KnownSymbol name)
  =>
    BaseFields ('(name, spec) : more)
  where
    baseFields :: [(Field, Expression (LambdaDepth ('(name, spec) : more)))]
baseFields =
        (forall (name :: Symbol). KnownSymbol name => Field
fieldName @name, Var () (LambdaDepth more) -> Expression (Var () (LambdaDepth more))
forall v. v -> Expression v
Expr.Var (() -> Var () (LambdaDepth more)
forall b a. b -> Var b a
B ())) (Field, Expression (Var () (LambdaDepth more)))
-> [(Field, Expression (Var () (LambdaDepth more)))]
-> [(Field, Expression (Var () (LambdaDepth more)))]
forall a. a -> [a] -> [a]
:
        [ (Field
name, Expression (LambdaDepth more)
-> Expression (Var () (LambdaDepth more))
forall {v} {b}. Expression v -> Expression (Var b v)
b Expression (LambdaDepth more)
var)
        | (Field
name, Expression (LambdaDepth more)
var) <- forall (record :: [(Symbol, Specification)]).
BaseFields record =>
[(Field, Expression (LambdaDepth record))]
baseFields @more
        ]
      where
        b :: Expression v -> Expression (Var b v)
b = (Qualified -> Expression (Var b v))
-> (v -> Expression (Var b v))
-> Expression v
-> Expression (Var b v)
forall v v'.
(Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
bind Qualified -> Expression (Var b v)
forall v. Qualified -> Expression v
Expr.Global (Var b v -> Expression (Var b v)
forall v. v -> Expression v
Expr.Var (Var b v -> Expression (Var b v))
-> (v -> Var b v) -> v -> Expression (Var b v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Var b v
forall b a. a -> Var b a
F)


type family Reverse (l :: [k]) where
  Reverse '[] = '[]
  Reverse (a : more) = Concat (Reverse more) '[a]


type family Concat (a :: [k]) (b :: [k]) where
  Concat '[] b = b
  Concat (a : more) b =
    a : Concat more b


class Decoders (spec :: [(Symbol, Specification)]) where
  fieldDecoders :: Definitions [(Text, Expression Void)]
instance Decoders '[] where
  fieldDecoders :: Definitions [(Text, Expression Void)]
fieldDecoders = [(Text, Expression Void)] -> Definitions [(Text, Expression Void)]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
instance {- Decoders ('(name, spec) : more) -}
    (HasType spec, Decoders more, KnownSymbol name)
  =>
    Decoders ('(name, spec) : more)
  where
    fieldDecoders :: Definitions [(Text, Expression Void)]
fieldDecoders = do
      Expression Void
dec <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
decoderOf @spec
      [(Text, Expression Void)]
more <- forall (spec :: [(Symbol, Specification)]).
Decoders spec =>
Definitions [(Text, Expression Void)]
fieldDecoders @more
      [(Text, Expression Void)] -> Definitions [(Text, Expression Void)]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, Expression Void)]
 -> Definitions [(Text, Expression Void)])
-> [(Text, Expression Void)]
-> Definitions [(Text, Expression Void)]
forall a b. (a -> b) -> a -> b
$ ( forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name , Expression Void
dec) (Text, Expression Void)
-> [(Text, Expression Void)] -> [(Text, Expression Void)]
forall a. a -> [a] -> [a]
: [(Text, Expression Void)]
more


class ElmDef (def :: (Symbol, Specification)) where
  defs :: Definitions ()
instance {-# OVERLAPS #-}
    ( KnownSymbol name
    , SumDef (JsonEither left right)
    )
  =>
    ElmDef '(name, JsonEither left right)
  where
    defs :: Definitions ()
defs = do
        [Type (Var Int (Type Void))]
branches <- forall (spec :: Specification) v.
SumDef spec =>
Definitions [Type v]
sumDef @(JsonEither left right)
        let
          constructors :: [(Constructor, [Scope Int Type Void])]
          constructors :: [(Constructor, [Scope Int Type Void])]
constructors =
            [ ( Text -> Constructor
Name.Constructor (Int -> Text
constructorName Int
n)
              , [Type (Var Int (Type Void)) -> Scope Int Type Void
forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope Type (Var Int (Type Void))
type_]
              )
            | (Int
n, Type (Var Int (Type Void))
type_) <- [Int]
-> [Type (Var Int (Type Void))]
-> [(Int, Type (Var Int (Type Void)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int) ..] [Type (Var Int (Type Void))]
branches
            ]
        [Expression Void]
decoders <- forall (spec :: Specification).
SumDef spec =>
Definitions [Expression Void]
sumDecoders @(JsonEither left right)
        [Expression Void]
encoders <- forall (spec :: Specification).
SumDef spec =>
Definitions [Expression Void]
sumEncoders @(JsonEither left right)
        Set Definition -> Definitions ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Set Definition -> Definitions ())
-> ([Definition] -> Set Definition)
-> [Definition]
-> Definitions ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Definition] -> Set Definition
forall a. Ord a => [a] -> Set a
Set.fromList ([Definition] -> Definitions ()) -> [Definition] -> Definitions ()
forall a b. (a -> b) -> a -> b
$
          [ Qualified
-> Int -> [(Constructor, [Scope Int Type Void])] -> Definition
Def.Type (Text -> Qualified
localName Text
name) Int
0 [(Constructor, [Scope Int Type Void])]
constructors
          , Qualified
-> Int -> Scope Int Type Void -> Expression Void -> Definition
Def.Constant
              (forall (name :: Symbol). KnownSymbol name => Qualified
decoderName @name)
              Int
0
              ( Type (Var Int (Type Void)) -> Scope Int Type Void
forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope
                  ( Type (Var Int (Type Void))
"Json.Decode.Decoder"
                    Type (Var Int (Type Void))
-> Type (Var Int (Type Void)) -> Type (Var Int (Type Void))
forall v. Type v -> Type v -> Type v
`Type.App`
                    Qualified -> Type (Var Int (Type Void))
forall v. Qualified -> Type v
Type.Global (Text -> Qualified
localName Text
name)
                  )
              )
              (
                Expression Void
"Json.Decode.oneOf"
                Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`Expr.App`
                [Expression Void] -> Expression Void
forall v. [Expression v] -> Expression v
Expr.List
                  [ Expression Void
"Json.Decode.map"
                    Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Qualified -> Expression Void
forall v. Qualified -> Expression v
Expr.Global (Text -> Qualified
localName (Int -> Text
constructorName Int
n))
                    Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`Expr.App` Expression Void
dec
                  | (Int
n, Expression Void
dec) <-  [Int] -> [Expression Void] -> [(Int, Expression Void)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int) ..] [Expression Void]
decoders
                  ]
              )
          , Qualified
-> Int -> Scope Int Type Void -> Expression Void -> Definition
Def.Constant
              (forall (name :: Symbol). KnownSymbol name => Qualified
encoderName @name)
              Int
0
              (
                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
$
                  Type (Var Int Void) -> Type (Var Int Void) -> Type (Var Int Void)
forall v. Type v -> Type v -> Type v
Type.Fun
                    (Qualified -> Type (Var Int Void)
forall v. Qualified -> Type v
Type.Global (Text -> Qualified
localName Text
name))
                    Type (Var Int Void)
"Json.Encode.Value"
              )
              (
                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
$
                  Expression (Var () Void)
-> [(Pattern Int, Scope Int Expression (Var () Void))]
-> Expression (Var () Void)
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expr.Case
                    (Var () Void -> Expression (Var () Void)
forall v. v -> Expression v
Expr.Var (() -> Var () Void
forall b a. b -> Var b a
B ()))
                    [ ( Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pat.Con (Text -> Qualified
localName (Int -> Text
constructorName Int
n)) [Int -> Pattern Int
forall v. v -> Pattern v
Pat.Var Int
0]
                      , Expression (Var Int (Var () Void))
-> Scope Int Expression (Var () Void)
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope (Expression (Var Int (Var () Void))
 -> Scope Int Expression (Var () Void))
-> Expression (Var Int (Var () Void))
-> Scope Int Expression (Var () Void)
forall a b. (a -> b) -> a -> b
$
                        (Void -> Var Int (Var () Void))
-> Expression Void -> Expression (Var Int (Var () Void))
forall a b. (a -> b) -> Expression a -> Expression b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Void -> Var Int (Var () Void)
forall a. Void -> a
absurd Expression Void
encoder Expression (Var Int (Var () Void))
-> Expression (Var Int (Var () Void))
-> Expression (Var Int (Var () Void))
forall v. Expression v -> Expression v -> Expression v
`Expr.App`
                          Var Int (Var () Void) -> Expression (Var Int (Var () Void))
forall v. v -> Expression v
Expr.Var (Int -> Var Int (Var () Void)
forall b a. b -> Var b a
B (Int
0 :: Int))
                      )
                    | (Int
n, Expression Void
encoder) <- [Int] -> [Expression Void] -> [(Int, Expression Void)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Expression Void]
encoders
                    ]
              )
          ]
      where
        constructorName :: Int -> Text
        constructorName :: Int -> Text
constructorName Int
n = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, IsString b) => a -> b
showt Int
n

        name :: Text
        name :: Text
name = forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name
instance (HasType spec, KnownSymbol name) => ElmDef '(name, spec) where
  defs :: Definitions ()
defs = do
    Type (Var Int (Type Void))
type_ <- forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @spec
    Expression Void
dec <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
decoderOf @spec
    Expression Void
enc <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
encoderOf @spec
    Set Definition -> Definitions ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Set Definition -> Definitions ())
-> ([Definition] -> Set Definition)
-> [Definition]
-> Definitions ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Definition] -> Set Definition
forall a. Ord a => [a] -> Set a
Set.fromList ([Definition] -> Definitions ()) -> [Definition] -> Definitions ()
forall a b. (a -> b) -> a -> b
$
      [ Qualified -> Int -> Scope Int Type Void -> Definition
Def.Alias
          (Text -> Qualified
localName (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name))
          Int
0
          (Type (Var Int (Type Void)) -> Scope Int Type Void
forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope Type (Var Int (Type Void))
type_)
      , Qualified
-> Int -> Scope Int Type Void -> Expression Void -> Definition
Def.Constant
          (forall (name :: Symbol). KnownSymbol name => Qualified
decoderName @name)
          Int
0
          ( Type (Var Int (Type Void)) -> Scope Int Type Void
forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope
              ( Type (Var Int (Type Void))
-> Type (Var Int (Type Void)) -> Type (Var Int (Type Void))
forall v. Type v -> Type v -> Type v
Type.App
                  Type (Var Int (Type Void))
"Json.Decode.Decoder"
                  (Qualified -> Type (Var Int (Type Void))
forall v. Qualified -> Type v
Type.Global (Qualified -> Type (Var Int (Type Void)))
-> Qualified -> Type (Var Int (Type Void))
forall a b. (a -> b) -> a -> b
$ Text -> Qualified
localName (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name))
              )
          )
          Expression Void
dec
      , Qualified
-> Int -> Scope Int Type Void -> Expression Void -> Definition
Def.Constant
          (forall (name :: Symbol). KnownSymbol name => Qualified
encoderName @name)
          Int
0
          ( Type (Var Int (Type Void)) -> Scope Int Type Void
forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope
              ( Type (Var Int (Type Void))
-> Type (Var Int (Type Void)) -> Type (Var Int (Type Void))
forall v. Type v -> Type v -> Type v
Type.Fun
                  (Qualified -> Type (Var Int (Type Void))
forall v. Qualified -> Type v
Type.Global (Qualified -> Type (Var Int (Type Void)))
-> Qualified -> Type (Var Int (Type Void))
forall a b. (a -> b) -> a -> b
$ Text -> Qualified
localName (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name))
                  Type (Var Int (Type Void))
"Json.Encode.Value"
              )
          )
          Expression Void
enc
      ]


class SumDef (spec :: Specification) where
  sumDef :: forall v. Definitions [Type v]
  sumDecoders :: Definitions [Expression Void]
  sumEncoders :: Definitions [Expression Void]
instance {-# OVERLAPS #-}
    (SumDef (JsonEither a b), SumDef (JsonEither c d))
  =>
    SumDef (JsonEither (JsonEither a b) (JsonEither c d))
  where
    sumDef :: forall v. Definitions [Type v]
sumDef = do
      [Type v]
left <- forall (spec :: Specification) v.
SumDef spec =>
Definitions [Type v]
sumDef @(JsonEither a b)
      [Type v]
right <- forall (spec :: Specification) v.
SumDef spec =>
Definitions [Type v]
sumDef @(JsonEither c d)
      [Type v] -> Definitions [Type v]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Type v] -> Definitions [Type v])
-> [Type v] -> Definitions [Type v]
forall a b. (a -> b) -> a -> b
$ [Type v]
left [Type v] -> [Type v] -> [Type v]
forall a. [a] -> [a] -> [a]
++ [Type v]
right
    sumDecoders :: Definitions [Expression Void]
sumDecoders = do
      [Expression Void]
left <- forall (spec :: Specification).
SumDef spec =>
Definitions [Expression Void]
sumDecoders @(JsonEither a b)
      [Expression Void]
right <- forall (spec :: Specification).
SumDef spec =>
Definitions [Expression Void]
sumDecoders @(JsonEither c d)
      [Expression Void] -> Definitions [Expression Void]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expression Void]
left [Expression Void] -> [Expression Void] -> [Expression Void]
forall a. [a] -> [a] -> [a]
++ [Expression Void]
right)
    sumEncoders :: Definitions [Expression Void]
sumEncoders = do
      [Expression Void]
left <- forall (spec :: Specification).
SumDef spec =>
Definitions [Expression Void]
sumEncoders @(JsonEither a b)
      [Expression Void]
right <- forall (spec :: Specification).
SumDef spec =>
Definitions [Expression Void]
sumEncoders @(JsonEither c d)
      [Expression Void] -> Definitions [Expression Void]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expression Void]
left [Expression Void] -> [Expression Void] -> [Expression Void]
forall a. [a] -> [a] -> [a]
++ [Expression Void]
right)
instance {-# OVERLAPS #-}
    (SumDef (JsonEither a b), HasType right)
  =>
    SumDef (JsonEither (JsonEither a b) right)
  where
    sumDef :: forall v. Definitions [Type v]
sumDef = do
      [Type v]
left <- forall (spec :: Specification) v.
SumDef spec =>
Definitions [Type v]
sumDef @(JsonEither a b)
      Type v
right <- forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @right
      [Type v] -> Definitions [Type v]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Type v] -> Definitions [Type v])
-> [Type v] -> Definitions [Type v]
forall a b. (a -> b) -> a -> b
$ [Type v]
left [Type v] -> [Type v] -> [Type v]
forall a. [a] -> [a] -> [a]
++ [Type v
right]
    sumDecoders :: Definitions [Expression Void]
sumDecoders = do
      [Expression Void]
left <- forall (spec :: Specification).
SumDef spec =>
Definitions [Expression Void]
sumDecoders @(JsonEither a b)
      Expression Void
right <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
decoderOf @right
      [Expression Void] -> Definitions [Expression Void]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expression Void] -> Definitions [Expression Void])
-> [Expression Void] -> Definitions [Expression Void]
forall a b. (a -> b) -> a -> b
$ [Expression Void]
left [Expression Void] -> [Expression Void] -> [Expression Void]
forall a. [a] -> [a] -> [a]
++ [Expression Void
right]
    sumEncoders :: Definitions [Expression Void]
sumEncoders = do
      [Expression Void]
left <- forall (spec :: Specification).
SumDef spec =>
Definitions [Expression Void]
sumEncoders @(JsonEither a b)
      Expression Void
right <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
encoderOf @right
      [Expression Void] -> Definitions [Expression Void]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expression Void] -> Definitions [Expression Void])
-> [Expression Void] -> Definitions [Expression Void]
forall a b. (a -> b) -> a -> b
$ [Expression Void]
left [Expression Void] -> [Expression Void] -> [Expression Void]
forall a. [a] -> [a] -> [a]
++ [Expression Void
right]
instance {-# OVERLAPS #-}
    (SumDef (JsonEither c d), HasType left)
  =>
    SumDef (JsonEither left (JsonEither c d))
  where
    sumDef :: forall v. Definitions [Type v]
sumDef = do
      Type v
left <- forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @left
      [Type v]
right <- forall (spec :: Specification) v.
SumDef spec =>
Definitions [Type v]
sumDef @(JsonEither c d)
      [Type v] -> Definitions [Type v]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Type v] -> Definitions [Type v])
-> [Type v] -> Definitions [Type v]
forall a b. (a -> b) -> a -> b
$ Type v
left Type v -> [Type v] -> [Type v]
forall a. a -> [a] -> [a]
: [Type v]
right
    sumDecoders :: Definitions [Expression Void]
sumDecoders = do
      Expression Void
left <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
decoderOf @left
      [Expression Void]
right <- forall (spec :: Specification).
SumDef spec =>
Definitions [Expression Void]
sumDecoders @(JsonEither c d)
      [Expression Void] -> Definitions [Expression Void]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expression Void] -> Definitions [Expression Void])
-> [Expression Void] -> Definitions [Expression Void]
forall a b. (a -> b) -> a -> b
$ Expression Void
left Expression Void -> [Expression Void] -> [Expression Void]
forall a. a -> [a] -> [a]
: [Expression Void]
right
    sumEncoders :: Definitions [Expression Void]
sumEncoders = do
      Expression Void
left <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
encoderOf @left
      [Expression Void]
right <- forall (spec :: Specification).
SumDef spec =>
Definitions [Expression Void]
sumEncoders @(JsonEither c d)
      [Expression Void] -> Definitions [Expression Void]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expression Void] -> Definitions [Expression Void])
-> [Expression Void] -> Definitions [Expression Void]
forall a b. (a -> b) -> a -> b
$ Expression Void
left Expression Void -> [Expression Void] -> [Expression Void]
forall a. a -> [a] -> [a]
: [Expression Void]
right
instance
    (HasType left, HasType right)
  =>
    SumDef (JsonEither left right)
  where
    sumDef :: forall v. Definitions [Type v]
sumDef = do
      Type v
left <- forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @left
      Type v
right <- forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @right
      [Type v] -> Definitions [Type v]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Type v
left, Type v
right]
    sumDecoders :: Definitions [Expression Void]
sumDecoders = do
      Expression Void
left <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
decoderOf @left
      Expression Void
right <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
decoderOf @right
      [Expression Void] -> Definitions [Expression Void]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Expression Void
left, Expression Void
right]
    sumEncoders :: Definitions [Expression Void]
sumEncoders = do
      Expression Void
left <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
encoderOf @left
      Expression Void
right <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
encoderOf @right
      [Expression Void] -> Definitions [Expression Void]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Expression Void
left, Expression Void
right]


localName :: Text -> Qualified
localName :: Text -> Qualified
localName =
  Module -> Text -> Qualified
Name.Qualified [Text
"Api", Text
"Data"]


type Definitions = Writer (Set Definition)


sym :: forall a b. (KnownSymbol a, IsString b) => b
sym :: forall (a :: Symbol) b. (KnownSymbol a, IsString b) => 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)


showt :: (Show a, IsString b) => a -> b
showt :: forall a b. (Show a, IsString b) => a -> b
showt = [Char] -> b
forall a. IsString a => [Char] -> a
fromString ([Char] -> b) -> (a -> [Char]) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show


lower :: Text -> Text
lower :: Text -> Text
lower Text
txt =
  case Text -> Maybe (Char, Text)
Text.uncons Text
txt of
    Maybe (Char, Text)
Nothing -> Text
txt
    Just (Char
c, Text
more) -> Char -> Text -> Text
Text.cons (Char -> Char
Char.toLower Char
c) Text
more


decoderName :: forall name. (KnownSymbol name) => Qualified
decoderName :: forall (name :: Symbol). KnownSymbol name => Qualified
decoderName = Text -> Qualified
localName (Text -> Text
lower (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Decoder")

encoderName :: forall name. (KnownSymbol name) => Qualified
encoderName :: forall (name :: Symbol). KnownSymbol name => Qualified
encoderName = Text -> Qualified
localName (Text -> Text
lower (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Encoder")


fieldName :: forall name. (KnownSymbol name) => Name.Field
fieldName :: forall (name :: Symbol). KnownSymbol name => Field
fieldName =
  Text -> Field
Name.Field (Text -> Field) -> Text -> Field
forall a b. (a -> b) -> a -> b
$
    case forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name of
      Text
"type" -> Text
"type_"
      Text
other -> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"-" Text
"_" Text
other