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

{-|
  This module provide a way to generate Elm types, encoders, and
  decoders for [json-spec](https://hackage.haskell.org/package/json-spec)
  [Specification](https://hackage.haskell.org/package/json-spec/docs/Data-JsonSpec.html#t:Specification)s

  Generally you will probably want `elmDefs`, but sometimes you might
  want to directly use the methods of `HasType`.

  Since not every part of a 'Specification' may have a name, we can
  generate encoders and decoders for anonymous Elm types like records,
  as well as named Elm types and type aliases. This package figures out
  how to name things given the following rules:

  * If a name appears in a 'JsonLet' binding, then it gets a name in Elm as a
    type or type alias.

  * If a second 'JsonLet' binding, with exactly one definition, of the
    form @JsonLet '[ '(name, def) ] (JsonRef name)@ appears as the RHS of
    a 'JsonLet'binding, then that is interpreted as a constructor name,
    and the generated Elm definition will be a regular type instead of a
    type alias. See 'Named' for an easy shorthand way to spell @JsonLet '[
    '(name, def) ] (JsonRef name)@

  * For any 'Named' leaf of a tree of 'JsonEither's, the name is interpreted as
    a data constructor name, otherwise a data constructor name is
    auto-generated.

    == Examples:

    === Type alias

    The specification

    > Named "MyType" JsonString

    will produce the Elm type

    > type alias MyType = String

    === Type with a constructor

    The specification

    > Named "MyType" (Named "MyDataConstructor" JsonString)

    will produce the Elm type

    > type MyType = MyDataConstructor String

    === Sum Type

    Note that the /root/ of a tree of 'JsonEither's /must/ be named, because
    Elm has no way to represent anonymous sum types.

    The specification

    > Named "MySumType"
    >   ( JsonEither
    >       (Named "AnInt" JsonInt)
    >       ( JsonEither
    >           JsonFloat -- note the omitted name
    >           ( Named "AString" JsonString)
    >       )
    >   )

    will produce the Elm type

    > type MySumType
    >   = AnInt Int
    >   | MySumType_2 Float -- auto-generated constructor name.
    >   | AString String

    == Producing actual Elm code

    This package gets you as far as having a collection of
    'Definition's in hand, which come from the 'elm-syntax'
    package. You will need to use the pretty printing
    features of that package to actually produce code. See
    https://hackage.haskell.org/package/elm-syntax/docs/Language-Elm-Pretty.html,
    or you can look at the source code for the tests in this package.
-}
module Data.JsonSpec.Elm (
  elmDefs,
  Definitions,
  HasType(..),
  Named,
) where


import Bound (Scope(Scope), Var(B), abstract1, closed, toScope)
import Control.Monad.Writer (MonadTrans(lift), MonadWriter(tell),
  Writer, execWriter)
import Data.JsonSpec (FieldSpec(Optional, Required),
  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, if_)
import Language.Elm.Name (Constructor, Qualified)
import Language.Elm.Type (Type)
import Prelude (Applicative(pure), Bool(False, True), Foldable(foldl,
  foldr), Functor(fmap), Maybe(Just, Nothing), Monad((>>)),
  Semigroup((<>)), Show(show), ($), (++), (.), (<$>), Int, error, 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


{-|
  Generate Elm type, encoder, and decoder 'Definition's for all /named/
  types in a 'Specification'. Note that this will not produce any types,
  decoders, or encoders for anonymous parts of the 'Specification',
  since we wouldn't know what to names to give those things in Elm.
-}
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


{-| Describes how a field in a record should be encoded in Elm. -}
data FieldEncoding = FieldEncoding
  {   FieldEncoding -> Bool
required :: Bool
                  {-^
                    'True' if the fields presence is required in the JSON
                    object, 'False' if it is not (which implies that the
                    field is a @Maybe something@, though that information
                    is not tracked here.
                  -}
  ,  FieldEncoding -> Text
jsonField :: Text {-^ The name of the encoded JSON field.  -}
  ,   FieldEncoding -> Field
elmField :: Name.Field {-^ The name of the Elm record field.  -}
  , FieldEncoding -> Expression Void
encoderFun :: Expression Void
                  {-^
                    The Elm function which can decode field value. The
                    expression will be a lambda expression that accepts
                    an Elm value and produces Elm's representation of a
                    JSON value (i.e.  @Json.Encode.Value@)
                  -}
  }


{-| Describes how a field in a record should be decoded.  -}
data FieldDecoding = FieldDecoding
  { FieldDecoding -> Text
jsonField :: Text {-^ The name of the decoded field in JSON -}
  ,   FieldDecoding -> Expression Void
decoder :: Expression Void
                 {-^
                   An Elm expression containing the decoder for the
                   field value. I.e. of the Elm type @Json.Decode.Decoder
                   something@.
                 -}
  }

{-|
  How to define, encode, and decode an Elm record from a list of JSON
  object field specifications.
-}
class Record (spec :: [FieldSpec]) where
  recordDefs :: forall v. Definitions [(Name.Field, Type v)]
  recordEncoders :: Definitions [FieldEncoding]
  recordDecoders :: Definitions [FieldDecoding]
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 [FieldEncoding]
recordEncoders = [FieldEncoding] -> Definitions [FieldEncoding]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  recordDecoders :: Definitions [FieldDecoding]
recordDecoders = [FieldDecoding] -> Definitions [FieldDecoding]
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 ( Required 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 :: [FieldSpec]) 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
$ (Text -> Field
fieldName (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name), Type v
type_) (Field, Type v) -> [(Field, Type v)] -> [(Field, Type v)]
forall a. a -> [a] -> [a]
: [(Field, Type v)]
moreFields
    recordEncoders :: Definitions [FieldEncoding]
recordEncoders = do
      Expression Void
encoder <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
encoderOf @spec
      [FieldEncoding]
moreFields <- forall (spec :: [FieldSpec]).
Record spec =>
Definitions [FieldEncoding]
recordEncoders @more
      [FieldEncoding] -> Definitions [FieldEncoding]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldEncoding] -> Definitions [FieldEncoding])
-> [FieldEncoding] -> Definitions [FieldEncoding]
forall a b. (a -> b) -> a -> b
$
        FieldEncoding
          { required :: Bool
required = Bool
True
          , jsonField :: Text
jsonField = forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name
          , elmField :: Field
elmField = Text -> Field
fieldName (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name)
          , encoderFun :: Expression Void
encoderFun = Expression Void
encoder
          }
        FieldEncoding -> [FieldEncoding] -> [FieldEncoding]
forall a. a -> [a] -> [a]
: [FieldEncoding]
moreFields
    recordDecoders :: Definitions [FieldDecoding]
recordDecoders = do
      Expression Void
dec <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
decoderOf @spec
      [FieldDecoding]
more <- forall (spec :: [FieldSpec]).
Record spec =>
Definitions [FieldDecoding]
recordDecoders @more
      [FieldDecoding] -> Definitions [FieldDecoding]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldDecoding] -> Definitions [FieldDecoding])
-> [FieldDecoding] -> Definitions [FieldDecoding]
forall a b. (a -> b) -> a -> b
$
        FieldDecoding
          { jsonField :: Text
jsonField = forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name
          , decoder :: Expression Void
decoder = Expression Void
"Json.Decode.field" Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`a` Text -> Expression Void
forall v. Text -> Expression v
Expr.String (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name) Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`a` Expression Void
dec
          }
        FieldDecoding -> [FieldDecoding] -> [FieldDecoding]
forall a. a -> [a] -> [a]
: [FieldDecoding]
more
instance
    ( HasType spec
    , KnownSymbol name
    , Record more
    )
  =>
    Record ( Optional name spec : more )
  where
    recordDefs :: forall v. Definitions [(Field, Type v)]
recordDefs = do
      Type v
type_ <- Type v -> Type v -> Type v
forall v. Type v -> Type v -> Type v
ta Type v
"Maybe.Maybe" (Type v -> Type v)
-> WriterT (Set Definition) Identity (Type v)
-> WriterT (Set Definition) Identity (Type v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @spec
      [(Field, Type v)]
moreFields <- forall (spec :: [FieldSpec]) 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
$ (Text -> Field
fieldName (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name), Type v
type_) (Field, Type v) -> [(Field, Type v)] -> [(Field, Type v)]
forall a. a -> [a] -> [a]
: [(Field, Type v)]
moreFields
    recordEncoders :: Definitions [FieldEncoding]
recordEncoders = do
      Expression Void
encoder <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
encoderOf @spec
      [FieldEncoding]
moreFields <- forall (spec :: [FieldSpec]).
Record spec =>
Definitions [FieldEncoding]
recordEncoders @more
      [FieldEncoding] -> Definitions [FieldEncoding]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldEncoding] -> Definitions [FieldEncoding])
-> [FieldEncoding] -> Definitions [FieldEncoding]
forall a b. (a -> b) -> a -> b
$
        FieldEncoding
          { required :: Bool
required = Bool
False
          , jsonField :: Text
jsonField = forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name
          , elmField :: Field
elmField = Text -> Field
fieldName (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name)
          , encoderFun :: Expression Void
encoderFun = Expression Void
encoder
          }
        FieldEncoding -> [FieldEncoding] -> [FieldEncoding]
forall a. a -> [a] -> [a]
: [FieldEncoding]
moreFields
    recordDecoders :: Definitions [FieldDecoding]
recordDecoders = do
      Expression Void
dec <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
decoderOf @spec
      [FieldDecoding]
more <- forall (spec :: [FieldSpec]).
Record spec =>
Definitions [FieldDecoding]
recordDecoders @more
      [FieldDecoding] -> Definitions [FieldDecoding]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldDecoding] -> Definitions [FieldDecoding])
-> [FieldDecoding] -> Definitions [FieldDecoding]
forall a b. (a -> b) -> a -> b
$
        FieldDecoding
          { jsonField :: Text
jsonField = forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name
          , decoder :: Expression Void
decoder =
              Expression Void
"Json.Decode.maybe"
                Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`a` (Expression Void
"Json.Decode.field" Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`a` Text -> Expression Void
forall v. Text -> Expression v
Expr.String (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name) Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`a` Expression Void
dec)
          }
        FieldDecoding -> [FieldDecoding] -> [FieldDecoding]
forall a. a -> [a] -> [a]
: [FieldDecoding]
more


{-|
  Translates 'Specification's into "anonymous" Elm types (where
  "anonymous" really means the RHS of a definition, which could be truly
  anonymous but might in fact be a reference to something previously named
  'Definition').
-}
class HasType (spec :: Specification) where

  {-|
    Produce the anonymous Elm type for the spec, collecting any necessary
    'Definition's along the way.
  -}
  typeOf :: forall v. Definitions (Type v)

  {-|
    Produce the Elm Decode for the spec, collecting any necessary
    'Definition's along the way
  -}
  decoderOf :: Definitions (Expression Void)


  {-|
    Produce the Elm Encoder for the spec, collecting any necessary
    'Definition's along the way.
  -}
  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 (Record 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 :: [FieldSpec]) v.
Record spec =>
Definitions [(Field, Type v)]
recordDefs @fields
  decoderOf :: Writer (Set Definition) (Expression Void)
decoderOf = do
    [FieldDecoding]
decodings <- forall (spec :: [FieldSpec]).
Record spec =>
Definitions [FieldDecoding]
recordDecoders @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 -> Expression Void -> Expression Void)
-> Expression Void -> [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 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
`a`
                (Expression (Var () Void) -> Expression (Var () Void))
-> Expression Void
forall a v.
(Expression (Var () a) -> Expression (Var () v)) -> Expression v
lam (\Expression (Var () Void)
var -> Expression (Var () Void)
"Json.Decode.map" Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
`a` Expression (Var () Void)
var Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
`a` (Void -> Var () Void
forall a. Void -> a
absurd (Void -> Var () Void)
-> Expression Void -> Expression (Var () Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression Void
decoder))
            )
        )
        (Expression Void
"Json.Decode.succeed" Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`a` [Text] -> Expression Void
forall v. [Text] -> Expression v
recordConstructor ((.jsonField) (FieldDecoding -> Text) -> [FieldDecoding] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldDecoding]
decodings))
        ((.decoder) (FieldDecoding -> Expression Void)
-> [FieldDecoding] -> [Expression Void]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldDecoding]
decodings)
  encoderOf :: Writer (Set Definition) (Expression Void)
encoderOf = do
    [FieldEncoding]
fields <- forall (spec :: [FieldSpec]).
Record spec =>
Definitions [FieldEncoding]
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
$
      (Expression (Var () Void) -> Expression (Var () Void))
-> Expression Void
forall a v.
(Expression (Var () a) -> Expression (Var () v)) -> Expression v
lam (\Expression (Var () Void)
var ->
        Expression (Var () Void)
"Json.Encode.object" Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
`a`
          (
            Expression (Var () Void)
"List.filterMap"
            Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
`a` Expression (Var () Void)
"Basics.identity"
            Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
`a` [Expression (Var () Void)] -> Expression (Var () Void)
forall v. [Expression v] -> Expression v
Expr.List
                  [ if Bool
required then
                      Expression (Var () Void)
"Maybe.Just" Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
`a`
                        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,
                            (Void -> Var () Void)
-> Expression Void -> Expression (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 () Void
forall a. Void -> a
absurd Expression Void
encoderFun Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
`a`
                              (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
`a` Expression (Var () Void)
var)
                          ]
                    else
                      Expression (Var () Void)
"Maybe.map"
                      Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
`a` (Expression (Var () (Var () Void))
 -> Expression (Var () (Var () Void)))
-> Expression (Var () Void)
forall a v.
(Expression (Var () a) -> Expression (Var () v)) -> Expression v
lam (\Expression (Var () (Var () Void))
inner ->
                            Expression (Var () (Var () Void))
-> [Expression (Var () (Var () Void))]
-> Expression (Var () (Var () Void))
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expr.apps Expression (Var () (Var () Void))
"Basics.,"
                              [
                                Text -> Expression (Var () (Var () Void))
forall v. Text -> Expression v
Expr.String Text
jsonField,
                                (Void -> Var () (Var () Void))
-> Expression Void -> Expression (Var () (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 () (Var () Void)
forall a. Void -> a
absurd Expression Void
encoderFun Expression (Var () (Var () Void))
-> Expression (Var () (Var () Void))
-> Expression (Var () (Var () Void))
forall v. Expression v -> Expression v -> Expression v
`a` Expression (Var () (Var () Void))
inner
                              ]
                          )
                      Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
`a` (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
`a` Expression (Var () Void)
var)
                  | FieldEncoding {Bool
required :: FieldEncoding -> Bool
required :: Bool
required, Text
jsonField :: FieldEncoding -> Text
jsonField :: Text
jsonField, Field
elmField :: FieldEncoding -> Field
elmField :: Field
elmField, Expression Void
encoderFun :: FieldEncoding -> Expression Void
encoderFun :: Expression Void
encoderFun}
                      <- [FieldEncoding]
fields

                  ]
          )
      )
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
"Basics.List" Type v -> Type v -> Type v
forall v. Type v -> Type v -> Type v
`ta` 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
"Json.Decode.list" Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`a` 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
`a` 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
"Maybe.Maybe" Type v -> Type v -> Type v
forall v. Type v -> Type v -> Type v
`ta` 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
a 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.Encode.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"
              [ (Void -> Var () Void)
-> Expression Void -> Expression (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 () 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
a 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
a 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
`a`
        (Expression Void
"Json.Encode.string" Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`a` 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) -}
    ( HasDef def
    , HasType (JsonLet more spec)
    )
  =>
    HasType (JsonLet ( def : more ) spec)
  where
    typeOf :: forall v. Definitions (Type v)
typeOf = do
      forall (def :: (Symbol, Specification)).
HasDef 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)).
HasDef 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)).
HasDef def =>
Definitions ()
defs @def
      forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
encoderOf @(JsonLet more spec)
instance {- HasType (JsonEither left right) -}
    (TypeError AnonSumTypeError)
  =>
    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)


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 HasDef (def :: (Symbol, Specification)) where
  defs :: Definitions ()
instance {- HasDef '(name, JsonEither left right) -}
    ( KnownSymbol name
    , SumDef (JsonEither left right)
    )
  =>
    HasDef '(name, JsonEither left right)
  where
    defs :: Definitions ()
defs = do
        [(Maybe Text, Type (Var Int (Type Void)))]
branches <- forall (spec :: Specification) v.
SumDef spec =>
Definitions [(Maybe Text, Type v)]
sumDef @(JsonEither left right)
        let
          constructors :: [(Constructor, [Scope Int Type Void])]
          constructors :: [(Constructor, [Scope Int Type Void])]
constructors =
            [ ( Text -> Constructor
Name.Constructor (Maybe Text -> Int -> Text
constructorName Maybe Text
conName 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, (Maybe Text
conName, Type (Var Int (Type Void))
type_)) <- [Int]
-> [(Maybe Text, Type (Var Int (Type Void)))]
-> [(Int, (Maybe Text, Type (Var Int (Type Void))))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [(Maybe Text, Type (Var Int (Type Void)))]
branches
            ]
        [(Maybe Text, Expression Void)]
decoders <- forall (spec :: Specification).
SumDef spec =>
Definitions [(Maybe Text, Expression Void)]
sumDecoders @(JsonEither left right)
        [(Maybe Text, Expression Void)]
encoders <- forall (spec :: Specification).
SumDef spec =>
Definitions [(Maybe Text, 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
`ta` 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
`a`
                [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
`a` Qualified -> Expression Void
forall v. Qualified -> Expression v
Expr.Global (Text -> Qualified
localName (Maybe Text -> Int -> Text
constructorName Maybe Text
conName Int
n))
                    Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`a` Expression Void
dec
                  | (Int
n, (Maybe Text
conName, Expression Void
dec)) <-  [Int]
-> [(Maybe Text, Expression Void)]
-> [(Int, (Maybe Text, Expression Void))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [(Maybe Text, 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 (Maybe Text -> Int -> Text
constructorName Maybe Text
conName 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
`a`
                            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, (Maybe Text
conName, Expression Void
encoder)) <- [Int]
-> [(Maybe Text, Expression Void)]
-> [(Int, (Maybe Text, Expression Void))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [(Maybe Text, Expression Void)]
encoders
                    ]
              )
          ]
      where
        constructorName :: Maybe Text -> Int -> Text
        constructorName :: Maybe Text -> Int -> Text
constructorName = \cases
          Maybe Text
Nothing 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
          (Just Text
consName) Int
_ -> Text
consName

        name :: Text
        name :: Text
name = forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name
instance {- HasDef '(name, Named consName spec) -}
    ( HasType spec
    , KnownSymbol consName
    , KnownSymbol name
    )
  =>
    HasDef '(name, Named consName spec)
  where
    defs :: Definitions ()
defs = do
      Type Void
typ <- 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 -> [(Constructor, [Scope Int Type Void])] -> Definition
Def.Type (Text -> Qualified
localName (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name)) Int
0
            [ ( Text -> Constructor
Name.Constructor (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @consName)
              , [ 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
typ ]
              )
            ]
        , 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
`ta`
                    Qualified -> Type (Var Int (Type Void))
forall v. Qualified -> Type v
Type.Global (Text -> Qualified
localName (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name))
                )
            )
            ( Expression Void
"Json.Decode.map"
                Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`a` Qualified -> Expression Void
forall v. Qualified -> Expression v
Expr.Global (Text -> Qualified
localName (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @consName))
                Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
`a` 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 (Var () Void) -> Expression (Var () Void))
-> Expression Void
forall a v.
(Expression (Var () a) -> Expression (Var () v)) -> Expression v
lam ((Expression (Var () Void) -> Expression (Var () Void))
 -> Expression Void)
-> (Expression (Var () Void) -> Expression (Var () Void))
-> Expression Void
forall a b. (a -> b) -> a -> b
$ \Expression (Var () Void)
var ->
                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
                  Expression (Var () Void)
var
                  [ (Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pat.Con
                      (Text -> Qualified
localName (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @consName))
                      [ 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)
forall a. Void -> a
absurd (Void -> Var Int (Var () Void))
-> Expression Void -> Expression (Var Int (Var () Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression Void
enc) Expression (Var Int (Var () Void))
-> Expression (Var Int (Var () Void))
-> Expression (Var Int (Var () Void))
forall v. Expression v -> Expression v -> Expression v
`a` 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)
                    )
                  ]
            )
        ]
instance {- HasDef '(name, spec) -}
    {-# overlaps #-} (HasType spec, KnownSymbol name)
  =>
    HasDef '(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))
"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
`ta`
                    Qualified -> Type (Var Int (Type Void))
forall v. Qualified -> Type v
Type.Global (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 [(Maybe Text, Type v)]
  sumDecoders :: Definitions [(Maybe Text, Expression Void)]
  sumEncoders :: Definitions [(Maybe Text, Expression Void)]
instance {- SumDef (JsonEither left right) -}
    (SumDef left, SumDef right)
  =>
    SumDef (JsonEither left right)
  where
    sumDef :: forall v. Definitions [(Maybe Text, Type v)]
sumDef = do
      [(Maybe Text, Type v)]
left <- forall (spec :: Specification) v.
SumDef spec =>
Definitions [(Maybe Text, Type v)]
sumDef @left
      [(Maybe Text, Type v)]
right <- forall (spec :: Specification) v.
SumDef spec =>
Definitions [(Maybe Text, Type v)]
sumDef @right
      [(Maybe Text, Type v)] -> Definitions [(Maybe Text, Type v)]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Maybe Text, Type v)] -> Definitions [(Maybe Text, Type v)])
-> [(Maybe Text, Type v)] -> Definitions [(Maybe Text, Type v)]
forall a b. (a -> b) -> a -> b
$ [(Maybe Text, Type v)]
left [(Maybe Text, Type v)]
-> [(Maybe Text, Type v)] -> [(Maybe Text, Type v)]
forall a. [a] -> [a] -> [a]
++ [(Maybe Text, Type v)]
right
    sumDecoders :: Definitions [(Maybe Text, Expression Void)]
sumDecoders = do
      [(Maybe Text, Expression Void)]
left <- forall (spec :: Specification).
SumDef spec =>
Definitions [(Maybe Text, Expression Void)]
sumDecoders @left
      [(Maybe Text, Expression Void)]
right <- forall (spec :: Specification).
SumDef spec =>
Definitions [(Maybe Text, Expression Void)]
sumDecoders @right
      [(Maybe Text, Expression Void)]
-> Definitions [(Maybe Text, Expression Void)]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Maybe Text, Expression Void)]
left [(Maybe Text, Expression Void)]
-> [(Maybe Text, Expression Void)]
-> [(Maybe Text, Expression Void)]
forall a. [a] -> [a] -> [a]
++ [(Maybe Text, Expression Void)]
right)
    sumEncoders :: Definitions [(Maybe Text, Expression Void)]
sumEncoders = do
      [(Maybe Text, Expression Void)]
left <- forall (spec :: Specification).
SumDef spec =>
Definitions [(Maybe Text, Expression Void)]
sumEncoders @left
      [(Maybe Text, Expression Void)]
right <- forall (spec :: Specification).
SumDef spec =>
Definitions [(Maybe Text, Expression Void)]
sumEncoders @right
      [(Maybe Text, Expression Void)]
-> Definitions [(Maybe Text, Expression Void)]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Maybe Text, Expression Void)]
left [(Maybe Text, Expression Void)]
-> [(Maybe Text, Expression Void)]
-> [(Maybe Text, Expression Void)]
forall a. [a] -> [a] -> [a]
++ [(Maybe Text, Expression Void)]
right)
instance {- SumDef (JsonLet '[ '(name, def) ] (JsonRef name)) -}
    ( HasType def
    , KnownSymbol name
    )
  =>
    SumDef (JsonLet '[ '(name, def) ] (JsonRef name))
  where
    sumDef :: forall v. Definitions [(Maybe Text, Type v)]
sumDef = do
      Type v
typ <- forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @def
      [(Maybe Text, Type v)] -> Definitions [(Maybe Text, Type v)]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Text -> Maybe Text
forall a. a -> Maybe a
Just (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name), Type v
typ)]
    sumDecoders :: Definitions [(Maybe Text, Expression Void)]
sumDecoders = do
      Expression Void
dec <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
decoderOf @def
      [(Maybe Text, Expression Void)]
-> Definitions [(Maybe Text, Expression Void)]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Text -> Maybe Text
forall a. a -> Maybe a
Just (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name), Expression Void
dec)]
    sumEncoders :: Definitions [(Maybe Text, Expression Void)]
sumEncoders = do
      Expression Void
enc <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
encoderOf @def
      [(Maybe Text, Expression Void)]
-> Definitions [(Maybe Text, Expression Void)]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Text -> Maybe Text
forall a. a -> Maybe a
Just (forall (a :: Symbol) b. (KnownSymbol a, IsString b) => b
sym @name), Expression Void
enc)]
instance {-# overlaps #-} (HasType a) => SumDef a where
  sumDef :: forall v. Definitions [(Maybe Text, Type v)]
sumDef = do
    Type v
typ <- forall (spec :: Specification) v.
HasType spec =>
Definitions (Type v)
typeOf @a
    [(Maybe Text, Type v)] -> Definitions [(Maybe Text, Type v)]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Maybe Text
forall a. Maybe a
Nothing, Type v
typ)]
  sumDecoders :: Definitions [(Maybe Text, Expression Void)]
sumDecoders = do
    Expression Void
dec <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
decoderOf @a
    [(Maybe Text, Expression Void)]
-> Definitions [(Maybe Text, Expression Void)]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Maybe Text
forall a. Maybe a
Nothing, Expression Void
dec)]
  sumEncoders :: Definitions [(Maybe Text, Expression Void)]
sumEncoders = do
    Expression Void
enc <- forall (spec :: Specification).
HasType spec =>
Writer (Set Definition) (Expression Void)
encoderOf @a
    [(Maybe Text, Expression Void)]
-> Definitions [(Maybe Text, Expression Void)]
forall a. a -> WriterT (Set Definition) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Maybe Text
forall a. Maybe a
Nothing, Expression Void
enc)]


localName :: Text -> Qualified
localName :: Text -> Qualified
localName =
  [Text] -> 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 :: Text -> Name.Field
fieldName :: Text -> Field
fieldName Text
specName =
  Text -> Field
Name.Field (Text -> Field) -> Text -> Field
forall a b. (a -> b) -> a -> b
$
    case Text
specName of
      Text
"type" -> Text
"type_"
      Text
other -> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"-" Text
"_" Text
other


a :: Expression v -> Expression v -> Expression v
a :: forall v. Expression v -> Expression v -> Expression v
a = Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expr.App


ta :: Type v -> Type v -> Type v
ta :: forall v. Type v -> Type v -> Type v
ta = Type v -> Type v -> Type v
forall v. Type v -> Type v -> Type v
Type.App


recordConstructor :: [Text] -> Expression v
recordConstructor :: forall v. [Text] -> Expression v
recordConstructor [Text]
records =
    case
      Expression Text -> Maybe (Expression v)
forall (f :: * -> *) a b. Traversable f => f a -> Maybe (f b)
closed (Expression Text -> Maybe (Expression v))
-> Expression Text -> Maybe (Expression v)
forall a b. (a -> b) -> a -> b
$
        (Text -> Expression Text -> Expression Text)
-> Expression Text -> [Text] -> Expression Text
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
          (\Text
field Expression Text
expr ->
            Scope () Expression Text -> Expression Text
forall v. Scope () Expression v -> Expression v
Expr.Lam (Scope () Expression Text -> Expression Text)
-> Scope () Expression Text -> Expression Text
forall a b. (a -> b) -> a -> b
$ Text -> Expression Text -> Scope () Expression Text
forall (f :: * -> *) a. (Monad f, Eq a) => a -> f a -> Scope () f a
abstract1 Text
field Expression Text
expr
          )
          Expression Text
unboundRecord
          [Text]
records
    of
      Maybe (Expression v)
Nothing -> [Char] -> Expression v
forall a. HasCallStack => [Char] -> a
error [Char]
"can't happen"
      Just Expression v
expr -> Expression v
expr
  where
    unboundRecord :: Expression Text
    unboundRecord :: Expression Text
unboundRecord =
      [(Field, Expression Text)] -> Expression Text
forall v. [(Field, Expression v)] -> Expression v
Expr.Record
        [ (Text -> Field
fieldName Text
field, Text -> Expression Text
forall v. v -> Expression v
Expr.Var Text
field)
        | Text
field <- [Text]
records
        ]


{-|
  Produce lambda in Elm out of a haskell function.

  > lam (\var ->
  >   "elmFunction" `a` var
  > )

  produces an Elm lambda expression of the form

  > (\var -> elmFunction var)
-}
lam
  :: (Expression (Var () a) -> Expression (Var () v))
  -> Expression v
lam :: forall a v.
(Expression (Var () a) -> Expression (Var () v)) -> Expression v
lam Expression (Var () a) -> Expression (Var () v)
f =
  Scope () Expression v -> Expression v
forall v. Scope () Expression v -> Expression v
Expr.Lam (Scope () Expression v -> Expression v)
-> (Expression (Var () v) -> Scope () Expression v)
-> Expression (Var () v)
-> Expression v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression (Var () v) -> Scope () Expression v
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope (Expression (Var () v) -> Expression v)
-> Expression (Var () v) -> Expression v
forall a b. (a -> b) -> a -> b
$ Expression (Var () a) -> Expression (Var () v)
f (Var () a -> Expression (Var () a)
forall v. v -> Expression v
Expr.Var (() -> Var () a
forall b a. b -> Var b a
B ()))


{-|
  Helper for giving a specification a name. This is especially useful for
  making sure sum type data constructors have meaningful names.
-}
type Named name def = JsonLet '[ '(name, def) ] (JsonRef name)


type AnonSumTypeError =
  ( 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 ""
  )