{-# language AllowAmbiguousTypes #-}
{-# language DataKinds #-}
{-# language DefaultSignatures #-}
{-# language DuplicateRecordFields #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language MultiParamTypeClasses #-}
{-# language OverloadedStrings #-}
{-# language PartialTypeSignatures #-}
{-# language PolyKinds #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language TypeOperators #-}
{-# language UndecidableInstances #-}
module Language.Haskell.To.Elm where

import qualified Bound
import qualified Data.Aeson as Aeson
import Data.Bifunctor (first, second)
import Data.Foldable
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HashMap
import qualified Data.Int as Int
import qualified Data.Kind
import Data.Maybe (catMaybes)
import Data.Proxy
import Data.String
import Data.Text (Text)
import Data.Time
import Data.Vector (Vector)
import Data.Void
import qualified Data.Word as Word
import qualified Generics.SOP as SOP
import GHC.TypeLits

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

-------------------------------------------------------------------------------
-- * Classes

-- | Represents that the corresponding Elm type for the Haskell type @a@ is @'elmType' \@a@.
class HasElmType a where
  elmType :: Type v
  default elmType :: Type v
  elmType =
    Qualified -> Type v
forall v. Qualified -> Type v
Type.Global (Qualified -> Type v) -> Qualified -> Type v
forall a b. (a -> b) -> a -> b
$
      Qualified
-> (Definition -> Qualified) -> Maybe Definition -> Qualified
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        ([Char] -> Qualified
forall a. HasCallStack => [Char] -> a
error [Char]
"default-implemented 'elmType' without a definition")
        Definition -> Qualified
Definition.name (Maybe Definition -> Qualified) -> Maybe Definition -> Qualified
forall a b. (a -> b) -> a -> b
$
          HasElmType a => Maybe Definition
forall k (a :: k). HasElmType a => Maybe Definition
elmDefinition @a

  -- | When 'Just', this represents that we can generate the definition for the
  -- Elm type that corresponds to @a@ using @'elmDefinition' \@a@.
  --
  -- See 'deriveElmTypeDefinition' for a way to automatically derive 'elmDefinition'.
  --
  -- When 'Nothing', it means that the type is an already existing Elm type
  -- that does not need to be generated.
  elmDefinition :: Maybe Definition
  elmDefinition =
    Maybe Definition
forall a. Maybe a
Nothing

  {-# minimal elmType | elmDefinition #-}

-- | Represents that the Elm type that corresponds to @a@ has a decoder from
-- @value@, namely @'elmDecoder' \@value \@a@.
class HasElmType a => HasElmDecoder value a where
  elmDecoder :: Expression v
  default elmDecoder :: Expression v
  elmDecoder =
    Qualified -> Expression v
forall v. Qualified -> Expression v
Expression.Global (Qualified -> Expression v) -> Qualified -> Expression v
forall a b. (a -> b) -> a -> b
$
      Qualified
-> (Definition -> Qualified) -> Maybe Definition -> Qualified
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        ([Char] -> Qualified
forall a. HasCallStack => [Char] -> a
error [Char]
"default-implemented 'elmDecoder' without a definition")
        Definition -> Qualified
Definition.name (Maybe Definition -> Qualified) -> Maybe Definition -> Qualified
forall a b. (a -> b) -> a -> b
$
          HasElmDecoder value a => Maybe Definition
forall k k (value :: k) (a :: k).
HasElmDecoder value a =>
Maybe Definition
elmDecoderDefinition @value @a

  -- | When 'Just', this represents that we can generate the Elm decoder definition
  -- from @value@ for the Elm type that corresponds to @a@.
  --
  -- See 'deriveElmJSONDecoder' for a way to automatically derive
  -- 'elmDecoderDefinition' when @value = 'Aeson.Value'@.
  elmDecoderDefinition :: Maybe Definition
  elmDecoderDefinition =
    Maybe Definition
forall a. Maybe a
Nothing

  {-# minimal elmDecoder | elmDecoderDefinition #-}

-- | Represents that the Elm type that corresponds to @a@ has an encoder into
-- @value@, namely @'elmEncoder' \@value \@a@.
--
-- This class has a default instance for types that satisfy
-- 'HasElmEncoderDefinition', which refers to the name of that definition.
class HasElmType a => HasElmEncoder value a where
  elmEncoder :: Expression v
  default elmEncoder :: Expression v
  elmEncoder =
    Qualified -> Expression v
forall v. Qualified -> Expression v
Expression.Global (Qualified -> Expression v) -> Qualified -> Expression v
forall a b. (a -> b) -> a -> b
$
      Qualified
-> (Definition -> Qualified) -> Maybe Definition -> Qualified
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        ([Char] -> Qualified
forall a. HasCallStack => [Char] -> a
error [Char]
"default-implemented 'elmEncoder' without a definition")
        Definition -> Qualified
Definition.name (Maybe Definition -> Qualified) -> Maybe Definition -> Qualified
forall a b. (a -> b) -> a -> b
$
          HasElmEncoder value a => Maybe Definition
forall k k (value :: k) (a :: k).
HasElmEncoder value a =>
Maybe Definition
elmEncoderDefinition @value @a

  -- | When 'Just', this represents that we can generate the Elm encoder
  -- definition into @value@ for the Elm type that corresponds to @a@.
  --
  -- See 'deriveElmJSONEncoder' for a way to automatically derive
  -- 'elmEncoderDefinition' when @value = 'Aeson.Value'@.
  elmEncoderDefinition :: Maybe Definition
  elmEncoderDefinition =
    Maybe Definition
forall a. Maybe a
Nothing

  {-# minimal elmEncoder | elmEncoderDefinition #-}

-------------------------------------------------------------------------------
-- * Derivers

-- | Elm code generation options
newtype Options = Options
  { Options -> [Char] -> [Char]
fieldLabelModifier :: String -> String -- ^ Use this function to go from Haskell record field name to Elm record field name.
  }

defaultOptions :: Options
defaultOptions :: Options
defaultOptions =
  Options :: ([Char] -> [Char]) -> Options
Options
    { $sel:fieldLabelModifier:Options :: [Char] -> [Char]
fieldLabelModifier = [Char] -> [Char]
forall a. a -> a
id
    }

-- ** Type definitions

-- | Automatically create an Elm definition given a Haskell type.
--
-- This is suitable for use as the 'elmDefinition' in a 'HasElmType' instance:
--
-- @
-- instance 'HasElmType' MyType where
--   'elmDefinition' =
--     'Just' $ 'deriveElmTypeDefinition' \@MyType 'defaultOptions' \"Api.MyType.MyType\"
-- @
deriveElmTypeDefinition
  :: forall a
  . DeriveParameterisedElmTypeDefinition 0 a
  => Options
  -> Name.Qualified
  -> Definition
deriveElmTypeDefinition :: Options -> Qualified -> Definition
deriveElmTypeDefinition =
  DeriveParameterisedElmTypeDefinition 0 a =>
Options -> Qualified -> Definition
forall k k (numParams :: k) (a :: k).
DeriveParameterisedElmTypeDefinition numParams a =>
Options -> Qualified -> Definition
deriveParameterisedElmTypeDefinition @0 @a

class DeriveParameterisedElmTypeDefinition numParams a where
  deriveParameterisedElmTypeDefinition :: Options -> Name.Qualified -> Definition

data Parameter (n :: Nat)

parameterName :: Int -> Name.Qualified
parameterName :: Int -> Qualified
parameterName Int
i =
  Module -> Text -> Qualified
Name.Qualified [Text
"Haskell", Text
"To", Text
"Elm"] (Text
"Parameter" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
forall a. IsString a => [Char] -> a
fromString (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i))

instance KnownNat n => HasElmType (Parameter n) where
  elmType :: Type v
elmType =
    Qualified -> Type v
forall v. Qualified -> Type v
Type.Global (Qualified -> Type v) -> Qualified -> Type v
forall a b. (a -> b) -> a -> b
$ Int -> Qualified
parameterName (Int -> Qualified) -> Int -> Qualified
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n -> Integer) -> Proxy n -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy n
forall k (t :: k). Proxy t
Proxy @n

instance (DeriveParameterisedElmTypeDefinition (numParams + 1) (f (Parameter numParams))) => DeriveParameterisedElmTypeDefinition numParams (f :: Data.Kind.Type -> b) where
  deriveParameterisedElmTypeDefinition :: Options -> Qualified -> Definition
deriveParameterisedElmTypeDefinition =
    DeriveParameterisedElmTypeDefinition
  (numParams + 1) (f (Parameter numParams)) =>
Options -> Qualified -> Definition
forall k k (numParams :: k) (a :: k).
DeriveParameterisedElmTypeDefinition numParams a =>
Options -> Qualified -> Definition
deriveParameterisedElmTypeDefinition @(numParams + 1) @(f (Parameter numParams))

instance (KnownNat numParams, SOP.HasDatatypeInfo a, SOP.All2 HasElmType (SOP.Code a)) => DeriveParameterisedElmTypeDefinition numParams (a :: Data.Kind.Type) where
  deriveParameterisedElmTypeDefinition :: Options -> Qualified -> Definition
deriveParameterisedElmTypeDefinition Options
options Qualified
name =
    case forall typ (constraint :: * -> Constraint) a.
(All2 constraint (Code typ), HasDatatypeInfo typ) =>
ConstraintFun constraint a -> DataShape a
forall (constraint :: * -> Constraint) a.
(All2 constraint (Code a), HasDatatypeInfo a) =>
ConstraintFun constraint a -> DataShape a
dataShape @a (ConstraintFun HasElmType (Type Void) -> DataShape (Type Void))
-> ConstraintFun HasElmType (Type Void) -> DataShape (Type Void)
forall a b. (a -> b) -> a -> b
$ (forall t. Dict (HasElmType t) -> Type Void)
-> ConstraintFun HasElmType (Type Void)
forall (constraint :: * -> Constraint) a.
(forall t. Dict (constraint t) -> a) -> ConstraintFun constraint a
ConstraintFun forall t. Dict (HasElmType t) -> Type Void
forall k v (t :: k). Dict (HasElmType t) -> Type v
constraintFun of
      [([Char]
_cname, RecordConstructorShape [([Char], Type Void)]
fields)] ->
        Qualified -> Int -> Scope Int Type Void -> Definition
Definition.Alias Qualified
name Int
numParams (Type Void -> Scope Int Type Void
forall v. Type v -> Scope Int Type v
bindTypeParameters (Type Void -> Scope Int Type Void)
-> Type Void -> Scope Int Type Void
forall a b. (a -> b) -> a -> b
$ [(Field, Type Void)] -> Type Void
forall v. [(Field, Type v)] -> Type v
Type.Record ([(Field, Type Void)] -> Type Void)
-> [(Field, Type Void)] -> Type Void
forall a b. (a -> b) -> a -> b
$ ([Char] -> Field) -> ([Char], Type Void) -> (Field, Type Void)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Char] -> Field
fieldName (([Char], Type Void) -> (Field, Type Void))
-> [([Char], Type Void)] -> [(Field, Type Void)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], Type Void)]
fields)

      DataShape (Type Void)
cs ->
        Qualified
-> Int -> [(Constructor, [Scope Int Type Void])] -> Definition
Definition.Type Qualified
name Int
numParams (([Type Void] -> [Scope Int Type Void])
-> (Constructor, [Type Void])
-> (Constructor, [Scope Int Type Void])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Type Void -> Scope Int Type Void)
-> [Type Void] -> [Scope Int Type Void]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type Void -> Scope Int Type Void
forall v. Type v -> Scope Int Type v
bindTypeParameters) ((Constructor, [Type Void])
 -> (Constructor, [Scope Int Type Void]))
-> [(Constructor, [Type Void])]
-> [(Constructor, [Scope Int Type Void])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Char], ConstructorShape (Type Void))
 -> (Constructor, [Type Void]))
-> DataShape (Type Void) -> [(Constructor, [Type Void])]
forall a b. (a -> b) -> [a] -> [b]
map (([Char]
 -> ConstructorShape (Type Void) -> (Constructor, [Type Void]))
-> ([Char], ConstructorShape (Type Void))
-> (Constructor, [Type Void])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char]
-> ConstructorShape (Type Void) -> (Constructor, [Type Void])
forall v.
[Char] -> ConstructorShape (Type v) -> (Constructor, [Type v])
constructor) DataShape (Type Void)
cs)
    where
      constraintFun :: forall v t. Dict (HasElmType t) -> Type v
      constraintFun :: Dict (HasElmType t) -> Type v
constraintFun Dict (HasElmType t)
Dict =
        forall v. HasElmType t => Type v
forall k (a :: k) v. HasElmType a => Type v
elmType @t

      typeParameterMap :: HashMap Name.Qualified Int
      typeParameterMap :: HashMap Qualified Int
typeParameterMap =
        [(Qualified, Int)] -> HashMap Qualified Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Int -> Qualified
parameterName Int
i, Int
i) | Int
i <- [Int
0..Int
numParams Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

      bindTypeParameters
        :: Type v
        -> Bound.Scope Int Type v
      bindTypeParameters :: Type v -> Scope Int Type v
bindTypeParameters =
        Type (Var Int (Type v)) -> Scope Int Type v
forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Bound.Scope (Type (Var Int (Type v)) -> Scope Int Type v)
-> (Type v -> Type (Var Int (Type v)))
-> Type v
-> Scope Int Type v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (Qualified -> Type (Var Int (Type v)))
-> (v -> Type (Var Int (Type v)))
-> Type v
-> Type (Var Int (Type v))
forall v' v.
(Qualified -> Type v') -> (v -> Type v') -> Type v -> Type v'
Type.bind
          (\Qualified
n -> Type (Var Int (Type v))
-> (Int -> Type (Var Int (Type v)))
-> Maybe Int
-> Type (Var Int (Type v))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Qualified -> Type (Var Int (Type v))
forall v. Qualified -> Type v
Type.Global Qualified
n) (Var Int (Type v) -> Type (Var Int (Type v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int (Type v) -> Type (Var Int (Type v)))
-> (Int -> Var Int (Type v)) -> Int -> Type (Var Int (Type v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Var Int (Type v)
forall b a. b -> Var b a
Bound.B) (Qualified -> HashMap Qualified Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Qualified
n HashMap Qualified Int
typeParameterMap))
          (Var Int (Type v) -> Type (Var Int (Type v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int (Type v) -> Type (Var Int (Type v)))
-> (v -> Var Int (Type v)) -> v -> Type (Var Int (Type v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type v -> Var Int (Type v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type v -> Var Int (Type v))
-> (v -> Type v) -> v -> Var Int (Type v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Type v
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

      numParams :: Int
numParams =
        Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy numParams -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy numParams -> Integer) -> Proxy numParams -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy numParams
forall k (t :: k). Proxy t
Proxy @numParams

      constructor :: String -> ConstructorShape (Type v) -> (Name.Constructor, [Type v])
      constructor :: [Char] -> ConstructorShape (Type v) -> (Constructor, [Type v])
constructor [Char]
cname ConstructorShape (Type v)
shape =
        ( [Char] -> Constructor
forall a. IsString a => [Char] -> a
fromString [Char]
cname
        , case ConstructorShape (Type v)
shape of
          ConstructorShape [Type v]
fields ->
            [Type v]
fields

          RecordConstructorShape [([Char], Type v)]
fs ->
            [[(Field, Type v)] -> Type v
forall v. [(Field, Type v)] -> Type v
Type.Record ([(Field, Type v)] -> Type v) -> [(Field, Type v)] -> Type v
forall a b. (a -> b) -> a -> b
$ ([Char] -> Field) -> ([Char], Type v) -> (Field, Type v)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Char] -> Field
fieldName (([Char], Type v) -> (Field, Type v))
-> [([Char], Type v)] -> [(Field, Type v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], Type v)]
fs]
        )

      fieldName :: String -> Name.Field
      fieldName :: [Char] -> Field
fieldName =
        [Char] -> Field
forall a. IsString a => [Char] -> a
fromString ([Char] -> Field) -> ([Char] -> [Char]) -> [Char] -> Field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> [Char] -> [Char]
fieldLabelModifier Options
options

-- ** JSON decoders

-- | Automatically create an Elm JSON decoder definition given a Haskell type.
--
-- This is suitable for use as the 'elmDecoderDefinition' in a
-- @'HasElmDecoder' 'Aeson.Value'@ instance:
--
-- @
-- instance 'HasElmDecoder' 'Aeson.Value' MyType where
--   'elmDecoderDefinition' =
--     Just $ 'deriveElmJSONDecoder' \@MyType 'defaultOptions' 'Aeson.defaultOptions' "Api.MyType.decoder"
-- @
--
-- Uses the given 'Aeson.Options' to match the JSON format of derived
-- 'Aeson.FromJSON' and 'Aeson.ToJSON' instances.
deriveElmJSONDecoder
  :: forall a
  . DeriveParameterisedElmDecoderDefinition 0 Aeson.Value a
  => Options
  -> Aeson.Options
  -> Name.Qualified
  -> Definition
deriveElmJSONDecoder :: Options -> Options -> Qualified -> Definition
deriveElmJSONDecoder =
  DeriveParameterisedElmDecoderDefinition 0 Value a =>
Options -> Options -> Qualified -> Definition
forall k k k (numParams :: k) (value :: k) (a :: k).
DeriveParameterisedElmDecoderDefinition numParams value a =>
Options -> Options -> Qualified -> Definition
deriveParameterisedElmDecoderDefinition @0 @Aeson.Value @a

class DeriveParameterisedElmDecoderDefinition numParams value a where
  deriveParameterisedElmDecoderDefinition :: Options -> Aeson.Options -> Name.Qualified -> Definition

instance KnownNat n => HasElmDecoder value (Parameter n) where
  elmDecoder :: Expression v
elmDecoder =
    Qualified -> Expression v
forall v. Qualified -> Expression v
Expression.Global (Qualified -> Expression v) -> Qualified -> Expression v
forall a b. (a -> b) -> a -> b
$
      Int -> Qualified
parameterName (Int -> Qualified) -> Int -> Qualified
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n -> Integer) -> Proxy n -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy n
forall k (t :: k). Proxy t
Proxy @n

instance (DeriveParameterisedElmDecoderDefinition (numParams + 1) value (f (Parameter numParams))) => DeriveParameterisedElmDecoderDefinition numParams value (f :: Data.Kind.Type -> b) where
  deriveParameterisedElmDecoderDefinition :: Options -> Options -> Qualified -> Definition
deriveParameterisedElmDecoderDefinition =
    DeriveParameterisedElmDecoderDefinition
  (numParams + 1) value (f (Parameter numParams)) =>
Options -> Options -> Qualified -> Definition
forall k k k (numParams :: k) (value :: k) (a :: k).
DeriveParameterisedElmDecoderDefinition numParams value a =>
Options -> Options -> Qualified -> Definition
deriveParameterisedElmDecoderDefinition @(numParams + 1) @value @(f (Parameter numParams))

instance (HasElmType a, KnownNat numParams, SOP.HasDatatypeInfo a, SOP.All2 (HasElmDecoder Aeson.Value) (SOP.Code a))
  => DeriveParameterisedElmDecoderDefinition numParams Aeson.Value (a :: Data.Kind.Type) where
  deriveParameterisedElmDecoderDefinition :: Options -> Options -> Qualified -> Definition
deriveParameterisedElmDecoderDefinition Options
options Options
aesonOptions Qualified
decoderName =
    Qualified
-> Int -> Scope Int Type Void -> Expression Void -> Definition
Definition.Constant Qualified
decoderName Int
numParams Scope Int Type Void
forall v. Scope Int Type v
parameterisedType (Expression Void -> Definition) -> Expression Void -> Definition
forall a b. (a -> b) -> a -> b
$
      Expression Void -> Expression Void
forall v. Expression v -> Expression v
parameteriseBody (Expression Void -> Expression Void)
-> Expression Void -> Expression Void
forall a b. (a -> b) -> a -> b
$
        case forall typ (constraint :: * -> Constraint) a.
(All2 constraint (Code typ), HasDatatypeInfo typ) =>
ConstraintFun constraint a -> DataShape a
forall (constraint :: * -> Constraint) a.
(All2 constraint (Code a), HasDatatypeInfo a) =>
ConstraintFun constraint a -> DataShape a
dataShape @a (ConstraintFun (HasElmDecoder Value) (Type Void, Expression Void)
 -> DataShape (Type Void, Expression Void))
-> ConstraintFun (HasElmDecoder Value) (Type Void, Expression Void)
-> DataShape (Type Void, Expression Void)
forall a b. (a -> b) -> a -> b
$ (forall t.
 Dict (HasElmDecoder Value t) -> (Type Void, Expression Void))
-> ConstraintFun (HasElmDecoder Value) (Type Void, Expression Void)
forall (constraint :: * -> Constraint) a.
(forall t. Dict (constraint t) -> a) -> ConstraintFun constraint a
ConstraintFun forall t.
Dict (HasElmDecoder Value t) -> (Type Void, Expression Void)
forall k v (t :: k).
Dict (HasElmDecoder Value t) -> (Type Void, Expression v)
constraintFun of
          [([Char]
_cname, RecordConstructorShape [([Char], (Type Void, Expression Void))]
fields)] ->
            [([Char], (Type Void, Expression Void))]
-> Expression Void -> Expression Void
forall v.
[([Char], (Type Void, Expression v))]
-> Expression v -> Expression v
decodeRecordFields [([Char], (Type Void, Expression Void))]
fields (Expression Void -> Expression Void)
-> Expression Void -> Expression Void
forall a b. (a -> b) -> a -> b
$
            Expression Void -> Expression Void -> Expression Void
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression Void
"Json.Decode.succeed" (Expression Void -> Expression Void)
-> Expression Void -> Expression Void
forall a b. (a -> b) -> a -> b
$
            case Type Any -> (Type Any, [Type Any])
forall v. Type v -> (Type v, [Type v])
Type.appsView (forall v. HasElmType a => Type v
forall k (a :: k) v. HasElmType a => Type v
elmType @a) of
              (Type.Record [(Field, Type Any)]
fieldTypes, [Type Any]
_) ->
                [Field] -> Expression Void
forall v. [Field] -> Expression v
explicitRecordConstructor ([Field] -> Expression Void) -> [Field] -> Expression Void
forall a b. (a -> b) -> a -> b
$ (Field, Type Any) -> Field
forall a b. (a, b) -> a
fst ((Field, Type Any) -> Field) -> [(Field, Type Any)] -> [Field]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Field, Type Any)]
fieldTypes

              (Type Any, [Type Any])
_ ->
                Qualified -> Expression Void
forall v. Qualified -> Expression v
Expression.Global Qualified
typeName

          DataShape (Type Void, Expression Void)
cs ->
            DataShape (Type Void, Expression Void) -> Expression Void
forall v.
[([Char], ConstructorShape (Type Void, Expression v))]
-> Expression v
decodeConstructors DataShape (Type Void, Expression Void)
cs
    where
      constraintFun :: forall v t. Dict (HasElmDecoder Aeson.Value t) -> (Type Void, Expression v)
      constraintFun :: Dict (HasElmDecoder Value t) -> (Type Void, Expression v)
constraintFun Dict (HasElmDecoder Value t)
Dict =
        (forall v. HasElmType t => Type v
forall k (a :: k) v. HasElmType a => Type v
elmType @t, forall v. HasElmDecoder Value t => Expression v
forall k k (value :: k) (a :: k) v.
HasElmDecoder value a =>
Expression v
elmDecoder @Aeson.Value @t)

      numParams :: Int
numParams =
        Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy numParams -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy numParams -> Integer) -> Proxy numParams -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy numParams
forall k (t :: k). Proxy t
Proxy @numParams

      parameterisedType :: Bound.Scope Int Type v
      parameterisedType :: Scope Int Type v
parameterisedType =
        (Int -> Scope Int Type v -> Scope Int Type v)
-> Scope Int Type v -> [Int] -> Scope Int Type v
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
          (\Int
i (Bound.Scope Type (Var Int (Type v))
rest) ->
            Type (Var Int (Type v)) -> Scope Int Type v
forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Bound.Scope (Type (Var Int (Type v)) -> Scope Int Type v)
-> Type (Var Int (Type v)) -> Scope Int Type v
forall a b. (a -> b) -> a -> b
$ Type (Var Int (Type v))
-> Type (Var Int (Type v)) -> Type (Var Int (Type v))
forall v. Type v -> Type v -> Type v
Type.Fun (Type (Var Int (Type v))
-> Type (Var Int (Type v)) -> Type (Var Int (Type v))
forall v. Type v -> Type v -> Type v
Type.App Type (Var Int (Type v))
"Json.Decode.Decoder" (Type (Var Int (Type v)) -> Type (Var Int (Type v)))
-> Type (Var Int (Type v)) -> Type (Var Int (Type v))
forall a b. (a -> b) -> a -> b
$ Var Int (Type v) -> Type (Var Int (Type v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int (Type v) -> Type (Var Int (Type v)))
-> Var Int (Type v) -> Type (Var Int (Type v))
forall a b. (a -> b) -> a -> b
$ Int -> Var Int (Type v)
forall b a. b -> Var b a
Bound.B Int
i) Type (Var Int (Type v))
rest
          )
          (Type (Var Int (Type v)) -> Scope Int Type v
forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Bound.Scope (Type (Var Int (Type v)) -> Scope Int Type v)
-> Type (Var Int (Type v)) -> Scope Int Type v
forall a b. (a -> b) -> a -> b
$ Type (Var Int (Type v))
-> Type (Var Int (Type v)) -> Type (Var Int (Type v))
forall v. Type v -> Type v -> Type v
Type.App Type (Var Int (Type v))
"Json.Decode.Decoder" (Type (Var Int (Type v)) -> Type (Var Int (Type v)))
-> Type (Var Int (Type v)) -> Type (Var Int (Type v))
forall a b. (a -> b) -> a -> b
$ Type (Type v) -> Type (Var Int (Type v))
forall v. Type v -> Type (Var Int v)
bindTypeParameters (Type (Type v) -> Type (Var Int (Type v)))
-> Type (Type v) -> Type (Var Int (Type v))
forall a b. (a -> b) -> a -> b
$ forall v. HasElmType a => Type v
forall k (a :: k) v. HasElmType a => Type v
elmType @a)
          [Int
0..Int
numParams Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

      typeParameterMap :: HashMap Name.Qualified Int
      typeParameterMap :: HashMap Qualified Int
typeParameterMap =
        [(Qualified, Int)] -> HashMap Qualified Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Int -> Qualified
parameterName Int
i, Int
i) | Int
i <- [Int
0..Int
numParams Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

      bindTypeParameters :: Type v -> Type (Bound.Var Int v)
      bindTypeParameters :: Type v -> Type (Var Int v)
bindTypeParameters =
        (Qualified -> Type (Var Int v))
-> (v -> Type (Var Int v)) -> Type v -> Type (Var Int v)
forall v' v.
(Qualified -> Type v') -> (v -> Type v') -> Type v -> Type v'
Type.bind
          (\Qualified
n -> Type (Var Int v)
-> (Int -> Type (Var Int v)) -> Maybe Int -> Type (Var Int v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Qualified -> Type (Var Int v)
forall v. Qualified -> Type v
Type.Global Qualified
n) (Var Int v -> Type (Var Int v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int v -> Type (Var Int v))
-> (Int -> Var Int v) -> Int -> Type (Var Int v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Var Int v
forall b a. b -> Var b a
Bound.B) (Qualified -> HashMap Qualified Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Qualified
n HashMap Qualified Int
typeParameterMap))
          (Var Int v -> Type (Var Int v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int v -> Type (Var Int v))
-> (v -> Var Int v) -> v -> Type (Var Int v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Var Int v
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

      parameteriseBody :: Expression v -> Expression v
      parameteriseBody :: Expression v -> Expression v
parameteriseBody Expression v
body =
        (Int -> Expression v -> Expression v)
-> Expression v -> [Int] -> Expression v
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
          (\Int
i ->
            Scope () Expression v -> Expression v
forall v. Scope () Expression v -> Expression v
Expression.Lam (Scope () Expression v -> Expression v)
-> (Expression v -> Scope () Expression v)
-> Expression 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
Bound.toScope (Expression (Var () v) -> Scope () Expression v)
-> (Expression v -> Expression (Var () v))
-> Expression v
-> Scope () Expression v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              (Qualified -> Expression (Var () v))
-> (v -> Expression (Var () v))
-> Expression v
-> Expression (Var () v)
forall v v'.
(Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
Expression.bind
                (\Qualified
global ->
                  if Qualified
global Qualified -> Qualified -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Qualified
parameterName Int
i then
                    Var () v -> Expression (Var () v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var () v -> Expression (Var () v))
-> Var () v -> Expression (Var () v)
forall a b. (a -> b) -> a -> b
$ () -> Var () v
forall b a. b -> Var b a
Bound.B ()

                  else
                    Qualified -> Expression (Var () v)
forall v. Qualified -> Expression v
Expression.Global Qualified
global
                )
                (Var () v -> Expression (Var () v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var () v -> Expression (Var () v))
-> (v -> Var () v) -> v -> Expression (Var () v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Var () v
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
          )
          Expression v
body
          [Int
0..Int
numParams Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

      typeName :: Qualified
typeName@(Name.Qualified Module
moduleName_ Text
_) =
        case Type Any -> (Type Any, [Type Any])
forall v. Type v -> (Type v, [Type v])
Type.appsView (forall v. HasElmType a => Type v
forall k (a :: k) v. HasElmType a => Type v
elmType @a) of
          (Type.Global Qualified
tname, [Type Any]
_) -> Qualified
tname

          (Type Any, [Type Any])
_ ->
            [Char] -> Qualified
forall a. HasCallStack => [Char] -> a
error [Char]
"Can't automatically derive JSON decoder for an anonymous Elm type"

      explicitRecordConstructor :: [Name.Field] -> Expression v
      explicitRecordConstructor :: [Field] -> Expression v
explicitRecordConstructor [Field]
names =
        HashMap Field v -> [Field] -> Expression v
forall v. HashMap Field v -> [Field] -> Expression v
go HashMap Field v
forall a. Monoid a => a
mempty [Field]
names
        where
          go :: HashMap Name.Field v -> [Name.Field] -> Expression v
          go :: HashMap Field v -> [Field] -> Expression v
go HashMap Field v
locals [Field]
fnames =
            case [Field]
fnames of
              [] ->
                [(Field, Expression v)] -> Expression v
forall v. [(Field, Expression v)] -> Expression v
Expression.Record [(Field
name, v -> Expression v
forall v. v -> Expression v
Expression.Var (v -> Expression v) -> v -> Expression v
forall a b. (a -> b) -> a -> b
$ HashMap Field v
locals HashMap Field v -> Field -> v
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! Field
name) | Field
name <- [Field]
names]

              Field
fname:[Field]
fnames' ->
                Scope () Expression v -> Expression v
forall v. Scope () Expression v -> Expression v
Expression.Lam (Scope () Expression v -> Expression v)
-> Scope () Expression v -> Expression v
forall a b. (a -> b) -> a -> b
$ Expression (Var () v) -> Scope () Expression v
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var () v) -> Scope () Expression v)
-> Expression (Var () v) -> Scope () Expression v
forall a b. (a -> b) -> a -> b
$ HashMap Field (Var () v) -> [Field] -> Expression (Var () v)
forall v. HashMap Field v -> [Field] -> Expression v
go (Field
-> Var () v -> HashMap Field (Var () v) -> HashMap Field (Var () v)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Field
fname (() -> Var () v
forall b a. b -> Var b a
Bound.B ()) (HashMap Field (Var () v) -> HashMap Field (Var () v))
-> HashMap Field (Var () v) -> HashMap Field (Var () v)
forall a b. (a -> b) -> a -> b
$ v -> Var () v
forall b a. a -> Var b a
Bound.F (v -> Var () v) -> HashMap Field v -> HashMap Field (Var () v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Field v
locals) [Field]
fnames'

      decodeRecordFields :: [(String, (Type Void, Expression v))] -> Expression v -> Expression v
      decodeRecordFields :: [([Char], (Type Void, Expression v))]
-> Expression v -> Expression v
decodeRecordFields [([Char]
_, (Type Void
_, Expression v
decoder))] Expression v
e
        | Options -> Bool
Aeson.unwrapUnaryRecords Options
aesonOptions =
          Expression v
e Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.|> Expression v
decoder
      decodeRecordFields [([Char], (Type Void, Expression v))]
fs Expression v
e =
        (Expression v -> Expression v -> Expression v)
-> Expression v -> [Expression v] -> Expression v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
(Expression.|>) Expression v
e ([Expression v] -> Expression v) -> [Expression v] -> Expression v
forall a b. (a -> b) -> a -> b
$ ([Char], (Type Void, Expression v)) -> Expression v
forall v. ([Char], (Type Void, Expression v)) -> Expression v
decodeRecordField (([Char], (Type Void, Expression v)) -> Expression v)
-> [([Char], (Type Void, Expression v))] -> [Expression v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], (Type Void, Expression v))]
fs

      decodeRecordField :: (String, (Type Void, Expression v)) -> Expression v
      decodeRecordField :: ([Char], (Type Void, Expression v)) -> Expression v
decodeRecordField ([Char]
fname, (Type Void
type_, Expression v
decoder))
        | Options -> Bool
Aeson.omitNothingFields Options
aesonOptions
        , (Type.Global Qualified
"Maybe.Maybe", [Type Void]
_) <- Type Void -> (Type Void, [Type Void])
forall v. Type v -> (Type v, [Type v])
Type.appsView Type Void
type_ =
          Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps
            Expression v
"Json.Decode.Pipeline.optional"
            [ [Char] -> Expression v
forall v. [Char] -> Expression v
jsonFieldName [Char]
fname
            , Expression v
decoder
            , Expression v
"Maybe.Nothing"
            ]

        | Bool
otherwise =
          Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps
            Expression v
"Json.Decode.Pipeline.required"
            [ [Char] -> Expression v
forall v. [Char] -> Expression v
jsonFieldName [Char]
fname
            , Expression v
decoder
            ]

      constructorJSONName :: String -> Text
      constructorJSONName :: [Char] -> Text
constructorJSONName = [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> ([Char] -> [Char]) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> [Char] -> [Char]
Aeson.constructorTagModifier Options
aesonOptions

      jsonFieldName :: String -> Expression v
      jsonFieldName :: [Char] -> Expression v
jsonFieldName = Text -> Expression v
forall v. Text -> Expression v
Expression.String (Text -> Expression v)
-> ([Char] -> Text) -> [Char] -> Expression v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> ([Char] -> [Char]) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> [Char] -> [Char]
Aeson.fieldLabelModifier Options
aesonOptions

      elmField :: String -> Name.Field
      elmField :: [Char] -> Field
elmField = [Char] -> Field
forall a. IsString a => [Char] -> a
fromString ([Char] -> Field) -> ([Char] -> [Char]) -> [Char] -> Field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> [Char] -> [Char]
fieldLabelModifier Options
options

      decodeConstructor :: String -> Expression v -> ConstructorShape (Type Void, Expression v) -> Expression v
      decodeConstructor :: [Char]
-> Expression v
-> ConstructorShape (Type Void, Expression v)
-> Expression v
decodeConstructor [Char]
_ Expression v
constr (ConstructorShape []) =
        Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"Json.Decode.succeed" Expression v
constr

      decodeConstructor [Char]
contentsName Expression v
constr (ConstructorShape [(Type Void
_, Expression v
fieldDecoder)]) =
        Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"Json.Decode.succeed" Expression v
constr Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.|>
          Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
"Json.Decode.Pipeline.required" [Text -> Expression v
forall v. Text -> Expression v
Expression.String ([Char] -> Text
forall a. IsString a => [Char] -> a
fromString [Char]
contentsName), Expression v
fieldDecoder]

      decodeConstructor [Char]
contentsName Expression v
constr (ConstructorShape [(Type Void, Expression v)]
fields) =
        Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps
          Expression v
"Json.Decode.field"
          [ Text -> Expression v
forall v. Text -> Expression v
Expression.String ([Char] -> Text
forall a. IsString a => [Char] -> a
fromString [Char]
contentsName)
          , (Expression v -> Expression v -> Expression v)
-> Expression v -> [Expression v] -> Expression v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
(Expression.|>)
            (Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"Json.Decode.succeed" Expression v
constr)
            [ Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App
              Expression v
"Json.Decode.Pipeline.custom"
              (Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
"Json.Decode.index" [Integer -> Expression v
forall v. Integer -> Expression v
Expression.Int Integer
index, Expression v
fieldDecoder])
            | (Integer
index, (Type Void
_, Expression v
fieldDecoder)) <- [Integer]
-> [(Type Void, Expression v)]
-> [(Integer, (Type Void, Expression v))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] [(Type Void, Expression v)]
fields
            ]
          ]

      decodeConstructor [Char]
_contentsName Expression v
constr (RecordConstructorShape [([Char], (Type Void, Expression v))]
fields) =
        Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
"Json.Decode.map"
          [ Expression v
constr
          , [([Char], (Type Void, Expression v))]
-> Expression v -> Expression v
forall v.
[([Char], (Type Void, Expression v))]
-> Expression v -> Expression v
decodeRecordFields [([Char], (Type Void, Expression v))]
fields (Expression v -> Expression v) -> Expression v -> Expression v
forall a b. (a -> b) -> a -> b
$
            Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"Json.Decode.succeed" (Expression v -> Expression v) -> Expression v -> Expression v
forall a b. (a -> b) -> a -> b
$
              [Field] -> Expression v
forall v. [Field] -> Expression v
explicitRecordConstructor ([Field] -> Expression v) -> [Field] -> Expression v
forall a b. (a -> b) -> a -> b
$ [Char] -> Field
elmField ([Char] -> Field)
-> (([Char], (Type Void, Expression v)) -> [Char])
-> ([Char], (Type Void, Expression v))
-> Field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], (Type Void, Expression v)) -> [Char]
forall a b. (a, b) -> a
fst (([Char], (Type Void, Expression v)) -> Field)
-> [([Char], (Type Void, Expression v))] -> [Field]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], (Type Void, Expression v))]
fields
          ]

      decodeConstructors :: [(String, ConstructorShape (Type Void, Expression v))] -> Expression v
      decodeConstructors :: [([Char], ConstructorShape (Type Void, Expression v))]
-> Expression v
decodeConstructors [([Char]
constr, ConstructorShape (Type Void, Expression v)
constrShape)]
        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> Bool
Aeson.tagSingleConstructors Options
aesonOptions =
          let
            qualifiedConstr :: Expression v
qualifiedConstr =
              Qualified -> Expression v
forall v. Qualified -> Expression v
Expression.Global (Qualified -> Expression v) -> Qualified -> Expression v
forall a b. (a -> b) -> a -> b
$ Module -> Text -> Qualified
Name.Qualified Module
moduleName_ (Text -> Qualified) -> Text -> Qualified
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
forall a. IsString a => [Char] -> a
fromString [Char]
constr
          in
          case ConstructorShape (Type Void, Expression v)
constrShape of
            ConstructorShape [(Type Void
_, Expression v
fieldDecoder)] ->
              Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
"Json.Decode.map" [Expression v
qualifiedConstr, Expression v
fieldDecoder]

            ConstructorShape [(Type Void, Expression v)]
fields ->
              (Expression v -> Expression v -> Expression v)
-> Expression v -> [Expression v] -> Expression v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
                Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
(Expression.|>)
                (Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"Json.Decode.succeed" Expression v
qualifiedConstr)
                [Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App
                  Expression v
"Json.Decode.Pipeline.custom"
                  (Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
"Json.Decode.index" [Integer -> Expression v
forall v. Integer -> Expression v
Expression.Int Integer
index, Expression v
fieldDecoder])
                | (Integer
index, (Type Void
_, Expression v
fieldDecoder)) <- [Integer]
-> [(Type Void, Expression v)]
-> [(Integer, (Type Void, Expression v))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] [(Type Void, Expression v)]
fields
                ]

            RecordConstructorShape [([Char], (Type Void, Expression v))]
fields ->
              Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
"Json.Decode.map"
                [ Expression v
qualifiedConstr
                , [([Char], (Type Void, Expression v))]
-> Expression v -> Expression v
forall v.
[([Char], (Type Void, Expression v))]
-> Expression v -> Expression v
decodeRecordFields [([Char], (Type Void, Expression v))]
fields (Expression v -> Expression v) -> Expression v -> Expression v
forall a b. (a -> b) -> a -> b
$
                  Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"Json.Decode.succeed" (Expression v -> Expression v) -> Expression v -> Expression v
forall a b. (a -> b) -> a -> b
$
                    [Field] -> Expression v
forall v. [Field] -> Expression v
explicitRecordConstructor ([Field] -> Expression v) -> [Field] -> Expression v
forall a b. (a -> b) -> a -> b
$ [Char] -> Field
elmField ([Char] -> Field)
-> (([Char], (Type Void, Expression v)) -> [Char])
-> ([Char], (Type Void, Expression v))
-> Field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], (Type Void, Expression v)) -> [Char]
forall a b. (a, b) -> a
fst (([Char], (Type Void, Expression v)) -> Field)
-> [([Char], (Type Void, Expression v))] -> [Field]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], (Type Void, Expression v))]
fields
                ]

      decodeConstructors [([Char], ConstructorShape (Type Void, Expression v))]
constrs
        | Options -> Bool
Aeson.allNullaryToStringTag Options
aesonOptions Bool -> Bool -> Bool
&& (([Char], ConstructorShape (Type Void, Expression v)) -> Bool)
-> [([Char], ConstructorShape (Type Void, Expression v))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ConstructorShape (Type Void, Expression v) -> Bool
forall a. ConstructorShape a -> Bool
nullary (ConstructorShape (Type Void, Expression v) -> Bool)
-> (([Char], ConstructorShape (Type Void, Expression v))
    -> ConstructorShape (Type Void, Expression v))
-> ([Char], ConstructorShape (Type Void, Expression v))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], ConstructorShape (Type Void, Expression v))
-> ConstructorShape (Type Void, Expression v)
forall a b. (a, b) -> b
snd) [([Char], ConstructorShape (Type Void, Expression v))]
constrs =
          Expression v
"Json.Decode.string" Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.|> Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"Json.Decode.andThen" (Scope () Expression v -> Expression v
forall v. Scope () Expression v -> Expression v
Expression.Lam
            (Expression (Var () v) -> Scope () Expression v
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var () v) -> Scope () Expression v)
-> Expression (Var () v) -> Scope () Expression v
forall a b. (a -> b) -> a -> b
$ Expression (Var () v)
-> [(Pattern Int, Scope Int Expression (Var () v))]
-> Expression (Var () v)
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expression.Case (Var () v -> Expression (Var () v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var () v -> Expression (Var () v))
-> Var () v -> Expression (Var () v)
forall a b. (a -> b) -> a -> b
$ () -> Var () v
forall b a. b -> Var b a
Bound.B ()) ([(Pattern Int, Scope Int Expression (Var () v))]
 -> Expression (Var () v))
-> [(Pattern Int, Scope Int Expression (Var () v))]
-> Expression (Var () v)
forall a b. (a -> b) -> a -> b
$
              [ ( Text -> Pattern Int
forall v. Text -> Pattern v
Pattern.String (Text -> Pattern Int) -> Text -> Pattern Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
constructorJSONName [Char]
constr
                , Expression (Var Int (Var () v)) -> Scope Int Expression (Var () v)
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int (Var () v))
 -> Scope Int Expression (Var () v))
-> Expression (Var Int (Var () v))
-> Scope Int Expression (Var () v)
forall a b. (a -> b) -> a -> b
$ Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () v))
"Json.Decode.succeed" Expression (Var Int (Var () v))
qualifiedConstr
                )
              | ([Char]
constr, ConstructorShape (Type Void, Expression v)
_) <- [([Char], ConstructorShape (Type Void, Expression v))]
constrs
              , let
                  qualifiedConstr :: Expression (Var Int (Var () v))
qualifiedConstr =
                    Qualified -> Expression (Var Int (Var () v))
forall v. Qualified -> Expression v
Expression.Global (Qualified -> Expression (Var Int (Var () v)))
-> Qualified -> Expression (Var Int (Var () v))
forall a b. (a -> b) -> a -> b
$ Module -> Text -> Qualified
Name.Qualified Module
moduleName_ (Text -> Qualified) -> Text -> Qualified
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
forall a. IsString a => [Char] -> a
fromString [Char]
constr
              ]
              [(Pattern Int, Scope Int Expression (Var () v))]
-> [(Pattern Int, Scope Int Expression (Var () v))]
-> [(Pattern Int, Scope Int Expression (Var () v))]
forall a. [a] -> [a] -> [a]
++
              [ ( Pattern Int
forall v. Pattern v
Pattern.Wildcard
                , Expression (Var Int (Var () v)) -> Scope Int Expression (Var () v)
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int (Var () v))
 -> Scope Int Expression (Var () v))
-> Expression (Var Int (Var () v))
-> Scope Int Expression (Var () v)
forall a b. (a -> b) -> a -> b
$ Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () v))
"Json.Decode.fail" (Expression (Var Int (Var () v))
 -> Expression (Var Int (Var () v)))
-> Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
forall a b. (a -> b) -> a -> b
$ Text -> Expression (Var Int (Var () v))
forall v. Text -> Expression v
Expression.String Text
"No matching constructor"
                )
              ]
            ))

      decodeConstructors [([Char], ConstructorShape (Type Void, Expression v))]
constrs =
        case Options -> SumEncoding
Aeson.sumEncoding Options
aesonOptions of
          Aeson.TaggedObject [Char]
tagName [Char]
contentsName ->
            Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
"Json.Decode.field" [Text -> Expression v
forall v. Text -> Expression v
Expression.String (Text -> Expression v) -> Text -> Expression v
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
forall a. IsString a => [Char] -> a
fromString [Char]
tagName, Expression v
"Json.Decode.string"] Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.|>
              Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"Json.Decode.andThen" (Scope () Expression v -> Expression v
forall v. Scope () Expression v -> Expression v
Expression.Lam
                (Expression (Var () v) -> Scope () Expression v
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var () v) -> Scope () Expression v)
-> Expression (Var () v) -> Scope () Expression v
forall a b. (a -> b) -> a -> b
$ Expression (Var () v)
-> [(Pattern Int, Scope Int Expression (Var () v))]
-> Expression (Var () v)
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expression.Case (Var () v -> Expression (Var () v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var () v -> Expression (Var () v))
-> Var () v -> Expression (Var () v)
forall a b. (a -> b) -> a -> b
$ () -> Var () v
forall b a. b -> Var b a
Bound.B ()) ([(Pattern Int, Scope Int Expression (Var () v))]
 -> Expression (Var () v))
-> [(Pattern Int, Scope Int Expression (Var () v))]
-> Expression (Var () v)
forall a b. (a -> b) -> a -> b
$
                  [ ( Text -> Pattern Int
forall v. Text -> Pattern v
Pattern.String (Text -> Pattern Int) -> Text -> Pattern Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
constructorJSONName [Char]
constr
                    , Expression (Var Int (Var () v)) -> Scope Int Expression (Var () v)
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int (Var () v))
 -> Scope Int Expression (Var () v))
-> Expression (Var Int (Var () v))
-> Scope Int Expression (Var () v)
forall a b. (a -> b) -> a -> b
$
                      [Char]
-> Expression (Var Int (Var () v))
-> ConstructorShape (Type Void, Expression (Var Int (Var () v)))
-> Expression (Var Int (Var () v))
forall v.
[Char]
-> Expression v
-> ConstructorShape (Type Void, Expression v)
-> Expression v
decodeConstructor [Char]
contentsName Expression (Var Int (Var () v))
qualifiedConstr (ConstructorShape (Type Void, Expression (Var Int (Var () v)))
 -> Expression (Var Int (Var () v)))
-> ConstructorShape (Type Void, Expression (Var Int (Var () v)))
-> Expression (Var Int (Var () v))
forall a b. (a -> b) -> a -> b
$
                      (Expression v -> Expression (Var Int (Var () v)))
-> (Type Void, Expression v)
-> (Type Void, Expression (Var Int (Var () v)))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((v -> Var Int (Var () v))
-> Expression v -> Expression (Var Int (Var () v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((v -> Var Int (Var () v))
 -> Expression v -> Expression (Var Int (Var () v)))
-> (v -> Var Int (Var () v))
-> Expression v
-> Expression (Var Int (Var () v))
forall a b. (a -> b) -> a -> b
$ Var () v -> Var Int (Var () v)
forall b a. a -> Var b a
Bound.F (Var () v -> Var Int (Var () v))
-> (v -> Var () v) -> v -> Var Int (Var () v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Var () v
forall b a. a -> Var b a
Bound.F) ((Type Void, Expression v)
 -> (Type Void, Expression (Var Int (Var () v))))
-> ConstructorShape (Type Void, Expression v)
-> ConstructorShape (Type Void, Expression (Var Int (Var () v)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConstructorShape (Type Void, Expression v)
shape
                    )
                | ([Char]
constr, ConstructorShape (Type Void, Expression v)
shape) <- [([Char], ConstructorShape (Type Void, Expression v))]
constrs
                , let
                    qualifiedConstr :: Expression (Var Int (Var () v))
qualifiedConstr =
                      Qualified -> Expression (Var Int (Var () v))
forall v. Qualified -> Expression v
Expression.Global (Qualified -> Expression (Var Int (Var () v)))
-> Qualified -> Expression (Var Int (Var () v))
forall a b. (a -> b) -> a -> b
$ Module -> Text -> Qualified
Name.Qualified Module
moduleName_ (Text -> Qualified) -> Text -> Qualified
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
forall a. IsString a => [Char] -> a
fromString [Char]
constr
                ]
                [(Pattern Int, Scope Int Expression (Var () v))]
-> [(Pattern Int, Scope Int Expression (Var () v))]
-> [(Pattern Int, Scope Int Expression (Var () v))]
forall a. [a] -> [a] -> [a]
++
                [ ( Pattern Int
forall v. Pattern v
Pattern.Wildcard
                  , Expression (Var Int (Var () v)) -> Scope Int Expression (Var () v)
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int (Var () v))
 -> Scope Int Expression (Var () v))
-> Expression (Var Int (Var () v))
-> Scope Int Expression (Var () v)
forall a b. (a -> b) -> a -> b
$ Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () v))
"Json.Decode.fail" (Expression (Var Int (Var () v))
 -> Expression (Var Int (Var () v)))
-> Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
forall a b. (a -> b) -> a -> b
$ Text -> Expression (Var Int (Var () v))
forall v. Text -> Expression v
Expression.String Text
"No matching constructor"
                  )
                ]
              ))

          SumEncoding
_ -> [Char] -> Expression v
forall a. HasCallStack => [Char] -> a
error [Char]
"Only the DataAeson.TaggedObject sumEncoding is currently supported"

-- ** JSON encoders

-- | Automatically create an Elm JSON encoder definition given a Haskell type.
--
-- This is suitable for use as the 'elmEncoderDefinition' in a @'HasElmEncoder 'Aeson.Value'@ instance:
--
-- @
-- instance 'HasElmEncoder' 'Aeson.Value' MyType where
--   'elmEncoderDefinition' =
--     'Just' $ 'deriveElmJSONEncoder' \@MyType 'defaultOptions' 'Aeson.defaultOptions' "Api.MyType.encoder"
-- @
--
-- Uses the given 'Aeson.Options' to match the JSON format of derived
-- 'Aeson.FromJSON' and 'Aeson.ToJSON' instances.
deriveElmJSONEncoder
  :: forall a
  . DeriveParameterisedElmEncoderDefinition 0 Aeson.Value a
  => Options
  -> Aeson.Options
  -> Name.Qualified
  -> Definition
deriveElmJSONEncoder :: Options -> Options -> Qualified -> Definition
deriveElmJSONEncoder =
  DeriveParameterisedElmEncoderDefinition 0 Value a =>
Options -> Options -> Qualified -> Definition
forall k k k (numParams :: k) (value :: k) (a :: k).
DeriveParameterisedElmEncoderDefinition numParams value a =>
Options -> Options -> Qualified -> Definition
deriveParameterisedElmEncoderDefinition @0 @Aeson.Value @a

class DeriveParameterisedElmEncoderDefinition numParams value a where
  deriveParameterisedElmEncoderDefinition :: Options -> Aeson.Options -> Name.Qualified -> Definition

instance KnownNat n => HasElmEncoder value (Parameter n) where
  elmEncoder :: Expression v
elmEncoder =
    Qualified -> Expression v
forall v. Qualified -> Expression v
Expression.Global (Qualified -> Expression v) -> Qualified -> Expression v
forall a b. (a -> b) -> a -> b
$
      Int -> Qualified
parameterName (Int -> Qualified) -> Int -> Qualified
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n -> Integer) -> Proxy n -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy n
forall k (t :: k). Proxy t
Proxy @n

instance (DeriveParameterisedElmEncoderDefinition (numParams + 1) value (f (Parameter numParams))) => DeriveParameterisedElmEncoderDefinition numParams value (f :: Data.Kind.Type -> b) where
  deriveParameterisedElmEncoderDefinition :: Options -> Options -> Qualified -> Definition
deriveParameterisedElmEncoderDefinition =
    DeriveParameterisedElmEncoderDefinition
  (numParams + 1) value (f (Parameter numParams)) =>
Options -> Options -> Qualified -> Definition
forall k k k (numParams :: k) (value :: k) (a :: k).
DeriveParameterisedElmEncoderDefinition numParams value a =>
Options -> Options -> Qualified -> Definition
deriveParameterisedElmEncoderDefinition @(numParams + 1) @value @(f (Parameter numParams))

instance (HasElmType a, KnownNat numParams, SOP.HasDatatypeInfo a, SOP.All2 (HasElmEncoder Aeson.Value) (SOP.Code a))
  => DeriveParameterisedElmEncoderDefinition numParams Aeson.Value (a :: Data.Kind.Type) where
  deriveParameterisedElmEncoderDefinition :: Options -> Options -> Qualified -> Definition
deriveParameterisedElmEncoderDefinition Options
options Options
aesonOptions Qualified
encoderName =
    Qualified
-> Int -> Scope Int Type Void -> Expression Void -> Definition
Definition.Constant Qualified
encoderName Int
numParams Scope Int Type Void
forall v. Scope Int Type v
parameterisedType (Expression Void -> Definition) -> Expression Void -> Definition
forall a b. (a -> b) -> a -> b
$
      Expression Void -> Expression Void
forall v. Expression v -> Expression v
parameteriseBody (Expression Void -> Expression Void)
-> Expression Void -> Expression Void
forall a b. (a -> b) -> a -> b
$
        Scope () Expression Void -> Expression Void
forall v. Scope () Expression v -> Expression v
Expression.Lam (Scope () Expression Void -> Expression Void)
-> Scope () Expression Void -> Expression Void
forall a b. (a -> b) -> a -> b
$ Expression (Var () Void) -> Scope () Expression Void
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var () Void) -> Scope () Expression Void)
-> Expression (Var () Void) -> Scope () Expression Void
forall a b. (a -> b) -> a -> b
$
          case forall typ (constraint :: * -> Constraint) a.
(All2 constraint (Code typ), HasDatatypeInfo typ) =>
ConstraintFun constraint a -> DataShape a
forall (constraint :: * -> Constraint) a.
(All2 constraint (Code a), HasDatatypeInfo a) =>
ConstraintFun constraint a -> DataShape a
dataShape @a (ConstraintFun
   (HasElmEncoder Value) (Type Void, Expression (Var () Void))
 -> DataShape (Type Void, Expression (Var () Void)))
-> ConstraintFun
     (HasElmEncoder Value) (Type Void, Expression (Var () Void))
-> DataShape (Type Void, Expression (Var () Void))
forall a b. (a -> b) -> a -> b
$ (forall t.
 Dict (HasElmEncoder Value t)
 -> (Type Void, Expression (Var () Void)))
-> ConstraintFun
     (HasElmEncoder Value) (Type Void, Expression (Var () Void))
forall (constraint :: * -> Constraint) a.
(forall t. Dict (constraint t) -> a) -> ConstraintFun constraint a
ConstraintFun forall t.
Dict (HasElmEncoder Value t)
-> (Type Void, Expression (Var () Void))
forall k v (t :: k).
Dict (HasElmEncoder Value t) -> (Type Void, Expression v)
constraintFun of
            [([Char]
_cname, RecordConstructorShape [([Char], (Type Void, Expression (Var () Void)))]
fields)] ->
              Expression (Var () Void)
-> Expression (Var () Void) -> Expression (Var () Void)
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var () Void)
"Json.Encode.object" (Expression (Var () Void) -> Expression (Var () Void))
-> Expression (Var () Void) -> Expression (Var () Void)
forall a b. (a -> b) -> a -> b
$
              [([Char], (Type Void, Expression (Var () Void)))]
-> Expression (Var () Void) -> Expression (Var () Void)
forall v.
[([Char], (Type Void, Expression v))]
-> Expression v -> Expression v
encodedRecordFieldList [([Char], (Type Void, Expression (Var () Void)))]
fields (Expression (Var () Void) -> Expression (Var () Void))
-> Expression (Var () Void) -> Expression (Var () Void)
forall a b. (a -> b) -> a -> b
$ Var () Void -> Expression (Var () Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var () Void -> Expression (Var () Void))
-> Var () Void -> Expression (Var () Void)
forall a b. (a -> b) -> a -> b
$ () -> Var () Void
forall b a. b -> Var b a
Bound.B ()

            DataShape (Type Void, Expression (Var () Void))
cs ->
              DataShape (Type Void, Expression (Var () Void))
-> Expression (Var () Void) -> Expression (Var () Void)
forall v.
[([Char], ConstructorShape (Type Void, Expression v))]
-> Expression v -> Expression v
encodeConstructors DataShape (Type Void, Expression (Var () Void))
cs (Var () Void -> Expression (Var () Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var () Void -> Expression (Var () Void))
-> Var () Void -> Expression (Var () Void)
forall a b. (a -> b) -> a -> b
$ () -> Var () Void
forall b a. b -> Var b a
Bound.B ())
    where
      constraintFun :: forall v t. Dict (HasElmEncoder Aeson.Value t) -> (Type Void, Expression v)
      constraintFun :: Dict (HasElmEncoder Value t) -> (Type Void, Expression v)
constraintFun Dict (HasElmEncoder Value t)
Dict =
        (forall v. HasElmType t => Type v
forall k (a :: k) v. HasElmType a => Type v
elmType @t, forall v. HasElmEncoder Value t => Expression v
forall k k (value :: k) (a :: k) v.
HasElmEncoder value a =>
Expression v
elmEncoder @Aeson.Value @t)

      numParams :: Int
numParams =
        Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy numParams -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy numParams -> Integer) -> Proxy numParams -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy numParams
forall k (t :: k). Proxy t
Proxy @numParams

      parameterisedType :: Bound.Scope Int Type v
      parameterisedType :: Scope Int Type v
parameterisedType =
        (Int -> Scope Int Type v -> Scope Int Type v)
-> Scope Int Type v -> [Int] -> Scope Int Type v
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
          (\Int
i (Bound.Scope Type (Var Int (Type v))
rest) ->
            Type (Var Int (Type v)) -> Scope Int Type v
forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Bound.Scope (Type (Var Int (Type v)) -> Scope Int Type v)
-> Type (Var Int (Type v)) -> Scope Int Type v
forall a b. (a -> b) -> a -> b
$ Type (Var Int (Type v))
-> Type (Var Int (Type v)) -> Type (Var Int (Type v))
forall v. Type v -> Type v -> Type v
Type.Fun (Type (Var Int (Type v))
-> Type (Var Int (Type v)) -> Type (Var Int (Type v))
forall v. Type v -> Type v -> Type v
Type.Fun (Var Int (Type v) -> Type (Var Int (Type v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int (Type v) -> Type (Var Int (Type v)))
-> Var Int (Type v) -> Type (Var Int (Type v))
forall a b. (a -> b) -> a -> b
$ Int -> Var Int (Type v)
forall b a. b -> Var b a
Bound.B Int
i) Type (Var Int (Type v))
"Json.Encode.Value") Type (Var Int (Type v))
rest
          )
          (Type (Var Int (Type v)) -> Scope Int Type v
forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Bound.Scope (Type (Var Int (Type v)) -> Scope Int Type v)
-> Type (Var Int (Type v)) -> Scope Int Type v
forall a b. (a -> b) -> a -> b
$ Type (Var Int (Type v))
-> Type (Var Int (Type v)) -> Type (Var Int (Type v))
forall v. Type v -> Type v -> Type v
Type.Fun (Type (Type v) -> Type (Var Int (Type v))
forall v. Type v -> Type (Var Int v)
bindTypeParameters (Type (Type v) -> Type (Var Int (Type v)))
-> Type (Type v) -> Type (Var Int (Type v))
forall a b. (a -> b) -> a -> b
$ forall v. HasElmType a => Type v
forall k (a :: k) v. HasElmType a => Type v
elmType @a) Type (Var Int (Type v))
"Json.Encode.Value")
          [Int
0..Int
numParams Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

      typeParameterMap :: HashMap Name.Qualified Int
      typeParameterMap :: HashMap Qualified Int
typeParameterMap =
        [(Qualified, Int)] -> HashMap Qualified Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Int -> Qualified
parameterName Int
i, Int
i) | Int
i <- [Int
0..Int
numParams Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

      bindTypeParameters :: Type v -> Type (Bound.Var Int v)
      bindTypeParameters :: Type v -> Type (Var Int v)
bindTypeParameters =
        (Qualified -> Type (Var Int v))
-> (v -> Type (Var Int v)) -> Type v -> Type (Var Int v)
forall v' v.
(Qualified -> Type v') -> (v -> Type v') -> Type v -> Type v'
Type.bind
          (\Qualified
n -> Type (Var Int v)
-> (Int -> Type (Var Int v)) -> Maybe Int -> Type (Var Int v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Qualified -> Type (Var Int v)
forall v. Qualified -> Type v
Type.Global Qualified
n) (Var Int v -> Type (Var Int v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int v -> Type (Var Int v))
-> (Int -> Var Int v) -> Int -> Type (Var Int v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Var Int v
forall b a. b -> Var b a
Bound.B) (Qualified -> HashMap Qualified Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Qualified
n HashMap Qualified Int
typeParameterMap))
          (Var Int v -> Type (Var Int v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int v -> Type (Var Int v))
-> (v -> Var Int v) -> v -> Type (Var Int v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Var Int v
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

      parameteriseBody :: Expression v -> Expression v
      parameteriseBody :: Expression v -> Expression v
parameteriseBody Expression v
body =
        (Int -> Expression v -> Expression v)
-> Expression v -> [Int] -> Expression v
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
          (\Int
i ->
            Scope () Expression v -> Expression v
forall v. Scope () Expression v -> Expression v
Expression.Lam (Scope () Expression v -> Expression v)
-> (Expression v -> Scope () Expression v)
-> Expression 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
Bound.toScope (Expression (Var () v) -> Scope () Expression v)
-> (Expression v -> Expression (Var () v))
-> Expression v
-> Scope () Expression v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              (Qualified -> Expression (Var () v))
-> (v -> Expression (Var () v))
-> Expression v
-> Expression (Var () v)
forall v v'.
(Qualified -> Expression v')
-> (v -> Expression v') -> Expression v -> Expression v'
Expression.bind
                (\Qualified
global ->
                  if Qualified
global Qualified -> Qualified -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Qualified
parameterName Int
i then
                    Var () v -> Expression (Var () v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var () v -> Expression (Var () v))
-> Var () v -> Expression (Var () v)
forall a b. (a -> b) -> a -> b
$ () -> Var () v
forall b a. b -> Var b a
Bound.B ()

                  else
                    Qualified -> Expression (Var () v)
forall v. Qualified -> Expression v
Expression.Global Qualified
global
                )
                (Var () v -> Expression (Var () v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var () v -> Expression (Var () v))
-> (v -> Var () v) -> v -> Expression (Var () v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Var () v
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
          )
          Expression v
body
          [Int
0..Int
numParams Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

      (Name.Qualified Module
moduleName_ Text
_) =
        case Type Any -> (Type Any, [Type Any])
forall v. Type v -> (Type v, [Type v])
Type.appsView (forall v. HasElmType a => Type v
forall k (a :: k) v. HasElmType a => Type v
elmType @a) of
          (Type.Global Qualified
tname, [Type Any]
_) -> Qualified
tname

          (Type Any, [Type Any])
_ ->
            [Char] -> Qualified
forall a. HasCallStack => [Char] -> a
error [Char]
"Can't automatically derive JSON encoder for an anonymous Elm type"

      encodedRecordFieldList :: [(String, (Type Void, Expression v))] -> Expression v -> Expression v
      encodedRecordFieldList :: [([Char], (Type Void, Expression v))]
-> Expression v -> Expression v
encodedRecordFieldList [([Char]
_, (Type Void
_, Expression v
encoder))] Expression v
e
        | Options -> Bool
Aeson.unwrapUnaryRecords Options
aesonOptions =
          Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
encoder Expression v
e
      encodedRecordFieldList [([Char], (Type Void, Expression v))]
fs Expression v
e =
        case (([Char], (Type Void, Expression v))
 -> ([Expression v], [Expression v]))
-> [([Char], (Type Void, Expression v))]
-> ([Expression v], [Expression v])
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Expression v
-> ([Char], (Type Void, Expression v))
-> ([Expression v], [Expression v])
forall v.
Expression v
-> ([Char], (Type Void, Expression v))
-> ([Expression v], [Expression v])
recordField Expression v
e) [([Char], (Type Void, Expression v))]
fs of
          ([Expression v]
nonNullable, []) ->
            [Expression v] -> Expression v
forall v. [Expression v] -> Expression v
Expression.List [Expression v]
nonNullable

          ([], [Expression v]
nullable) ->
            Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"List.concat" (Expression v -> Expression v) -> Expression v -> Expression v
forall a b. (a -> b) -> a -> b
$ [Expression v] -> Expression v
forall v. [Expression v] -> Expression v
Expression.List [Expression v]
nullable

          ([Expression v]
nonNullable, [Expression v]
nullable) ->
            Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
"Basics.++"
              [ [Expression v] -> Expression v
forall v. [Expression v] -> Expression v
Expression.List [Expression v]
nonNullable
              , Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"List.concat" (Expression v -> Expression v) -> Expression v -> Expression v
forall a b. (a -> b) -> a -> b
$ [Expression v] -> Expression v
forall v. [Expression v] -> Expression v
Expression.List [Expression v]
nullable
              ]

      recordField
        :: Expression v
        -> (String, (Type Void, Expression v))
        -> ([Expression v], [Expression v])
      recordField :: Expression v
-> ([Char], (Type Void, Expression v))
-> ([Expression v], [Expression v])
recordField Expression v
e ([Char]
fname, (Type Void
type_, Expression v
encoder))
        | Options -> Bool
Aeson.omitNothingFields Options
aesonOptions
        , (Type.Global Qualified
"Maybe.Maybe", [Type Void]
_) <- Type Void -> (Type Void, [Type Void])
forall v. Type v -> (Type v, [Type v])
Type.appsView Type Void
type_ =
          ( []
          , [ Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expression.Case (Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App (Field -> Expression v
forall v. Field -> Expression v
Expression.Proj (Field -> Expression v) -> Field -> Expression v
forall a b. (a -> b) -> a -> b
$ [Char] -> Field
elmField [Char]
fname) Expression v
e)
              [ ( Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con Qualified
"Maybe.Nothing" []
                , Expression (Var Int v) -> Scope Int Expression v
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int v) -> Scope Int Expression v)
-> Expression (Var Int v) -> Scope Int Expression v
forall a b. (a -> b) -> a -> b
$ [Expression (Var Int v)] -> Expression (Var Int v)
forall v. [Expression v] -> Expression v
Expression.List []
                )
              , ( Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con Qualified
"Maybe.Just" [Int -> Pattern Int
forall v. v -> Pattern v
Pattern.Var Int
0]
                , Expression (Var Int v) -> Scope Int Expression v
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int v) -> Scope Int Expression v)
-> Expression (Var Int v) -> Scope Int Expression v
forall a b. (a -> b) -> a -> b
$
                  [Expression (Var Int v)] -> Expression (Var Int v)
forall v. [Expression v] -> Expression v
Expression.List
                  [ v -> Var Int v
forall b a. a -> Var b a
Bound.F (v -> Var Int v) -> Expression v -> Expression (Var Int v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.tuple
                      ([Char] -> Expression v
forall v. [Char] -> Expression v
jsonFieldName [Char]
fname)
                      (Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
encoder (Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App (Field -> Expression v
forall v. Field -> Expression v
Expression.Proj (Field -> Expression v) -> Field -> Expression v
forall a b. (a -> b) -> a -> b
$ [Char] -> Field
elmField [Char]
fname) Expression v
e))
                  ]
                )
              ]
            ]
          )

        | Bool
otherwise =
          ( [ Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.tuple
              ([Char] -> Expression v
forall v. [Char] -> Expression v
jsonFieldName [Char]
fname)
              (Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
encoder (Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App (Field -> Expression v
forall v. Field -> Expression v
Expression.Proj (Field -> Expression v) -> Field -> Expression v
forall a b. (a -> b) -> a -> b
$ [Char] -> Field
elmField [Char]
fname) Expression v
e))
            ]
          , []
          )

      constructorJSONName :: String -> Text
      constructorJSONName :: [Char] -> Text
constructorJSONName = [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> ([Char] -> [Char]) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> [Char] -> [Char]
Aeson.constructorTagModifier Options
aesonOptions

      jsonFieldName :: String -> Expression v
      jsonFieldName :: [Char] -> Expression v
jsonFieldName = Text -> Expression v
forall v. Text -> Expression v
Expression.String (Text -> Expression v)
-> ([Char] -> Text) -> [Char] -> Expression v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> ([Char] -> [Char]) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> [Char] -> [Char]
Aeson.fieldLabelModifier Options
aesonOptions

      elmField :: String -> Name.Field
      elmField :: [Char] -> Field
elmField = [Char] -> Field
forall a. IsString a => [Char] -> a
fromString ([Char] -> Field) -> ([Char] -> [Char]) -> [Char] -> Field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> [Char] -> [Char]
fieldLabelModifier Options
options

      elmConstr :: String -> Name.Qualified
      elmConstr :: [Char] -> Qualified
elmConstr = Module -> Text -> Qualified
Name.Qualified Module
moduleName_ (Text -> Qualified) -> ([Char] -> Text) -> [Char] -> Qualified
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
forall a. IsString a => [Char] -> a
fromString

      encodeConstructorFields :: [(Type Void, Expression v)] -> Expression (Bound.Var Int v)
      encodeConstructorFields :: [(Type Void, Expression v)] -> Expression (Var Int v)
encodeConstructorFields [(Type Void
_, Expression v
encoder)] =
        Expression (Var Int v)
-> Expression (Var Int v) -> Expression (Var Int v)
forall v. Expression v -> Expression v -> Expression v
Expression.App (v -> Var Int v
forall b a. a -> Var b a
Bound.F (v -> Var Int v) -> Expression v -> Expression (Var Int v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression v
encoder) (Var Int v -> Expression (Var Int v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int v -> Expression (Var Int v))
-> Var Int v -> Expression (Var Int v)
forall a b. (a -> b) -> a -> b
$ Int -> Var Int v
forall b a. b -> Var b a
Bound.B Int
0)

      encodeConstructorFields [(Type Void, Expression v)]
constrFields =
        Expression (Var Int v)
-> [Expression (Var Int v)] -> Expression (Var Int v)
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps
          Expression (Var Int v)
"Json.Encode.list"
          [ Expression (Var Int v)
"Basics.identity"
          , [Expression (Var Int v)] -> Expression (Var Int v)
forall v. [Expression v] -> Expression v
Expression.List
            [ Expression (Var Int v)
-> Expression (Var Int v) -> Expression (Var Int v)
forall v. Expression v -> Expression v -> Expression v
Expression.App (v -> Var Int v
forall b a. a -> Var b a
Bound.F (v -> Var Int v) -> Expression v -> Expression (Var Int v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression v
encoder) (Var Int v -> Expression (Var Int v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int v -> Expression (Var Int v))
-> Var Int v -> Expression (Var Int v)
forall a b. (a -> b) -> a -> b
$ Int -> Var Int v
forall b a. b -> Var b a
Bound.B Int
index)
            | (Int
index, (Type Void
_, Expression v
encoder)) <- [Int]
-> [(Type Void, Expression v)]
-> [(Int, (Type Void, Expression v))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(Type Void, Expression v)]
constrFields
            ]
          ]

      encodeConstructors :: [(String, ConstructorShape (Type Void, Expression v))] -> Expression v -> Expression v
      encodeConstructors :: [([Char], ConstructorShape (Type Void, Expression v))]
-> Expression v -> Expression v
encodeConstructors [([Char]
constr, ConstructorShape (Type Void, Expression v)
constrShape)] Expression v
expr
        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> Bool
Aeson.tagSingleConstructors Options
aesonOptions =
          Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expression.Case Expression v
expr
            [ case ConstructorShape (Type Void, Expression v)
constrShape of
                ConstructorShape [(Type Void, Expression v)]
constrFields ->
                  ( Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con ([Char] -> Qualified
elmConstr [Char]
constr) (Int -> Pattern Int
forall v. v -> Pattern v
Pattern.Var (Int -> Pattern Int)
-> ((Int, (Type Void, Expression v)) -> Int)
-> (Int, (Type Void, Expression v))
-> Pattern Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (Type Void, Expression v)) -> Int
forall a b. (a, b) -> a
fst ((Int, (Type Void, Expression v)) -> Pattern Int)
-> [(Int, (Type Void, Expression v))] -> [Pattern Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
-> [(Type Void, Expression v)]
-> [(Int, (Type Void, Expression v))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(Type Void, Expression v)]
constrFields)
                  , Expression (Var Int v) -> Scope Int Expression v
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int v) -> Scope Int Expression v)
-> Expression (Var Int v) -> Scope Int Expression v
forall a b. (a -> b) -> a -> b
$ [(Type Void, Expression v)] -> Expression (Var Int v)
forall v. [(Type Void, Expression v)] -> Expression (Var Int v)
encodeConstructorFields [(Type Void, Expression v)]
constrFields
                  )

                RecordConstructorShape [([Char], (Type Void, Expression v))]
recordFields ->
                  ( Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con ([Char] -> Qualified
elmConstr [Char]
constr) [Int -> Pattern Int
forall v. v -> Pattern v
Pattern.Var Int
0]
                  , Expression (Var Int v) -> Scope Int Expression v
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int v) -> Scope Int Expression v)
-> Expression (Var Int v) -> Scope Int Expression v
forall a b. (a -> b) -> a -> b
$
                    Expression (Var Int v)
-> Expression (Var Int v) -> Expression (Var Int v)
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int v)
"Json.Encode.object" (Expression (Var Int v) -> Expression (Var Int v))
-> Expression (Var Int v) -> Expression (Var Int v)
forall a b. (a -> b) -> a -> b
$
                    [([Char], (Type Void, Expression (Var Int v)))]
-> Expression (Var Int v) -> Expression (Var Int v)
forall v.
[([Char], (Type Void, Expression v))]
-> Expression v -> Expression v
encodedRecordFieldList (((Type Void, Expression v) -> (Type Void, Expression (Var Int v)))
-> ([Char], (Type Void, Expression v))
-> ([Char], (Type Void, Expression (Var Int v)))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Expression v -> Expression (Var Int v))
-> (Type Void, Expression v) -> (Type Void, Expression (Var Int v))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Expression v -> Expression (Var Int v))
 -> (Type Void, Expression v)
 -> (Type Void, Expression (Var Int v)))
-> (Expression v -> Expression (Var Int v))
-> (Type Void, Expression v)
-> (Type Void, Expression (Var Int v))
forall a b. (a -> b) -> a -> b
$ (v -> Var Int v) -> Expression v -> Expression (Var Int v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> Var Int v
forall b a. a -> Var b a
Bound.F) (([Char], (Type Void, Expression v))
 -> ([Char], (Type Void, Expression (Var Int v))))
-> [([Char], (Type Void, Expression v))]
-> [([Char], (Type Void, Expression (Var Int v)))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], (Type Void, Expression v))]
recordFields) (Expression (Var Int v) -> Expression (Var Int v))
-> Expression (Var Int v) -> Expression (Var Int v)
forall a b. (a -> b) -> a -> b
$ Var Int v -> Expression (Var Int v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int v -> Expression (Var Int v))
-> Var Int v -> Expression (Var Int v)
forall a b. (a -> b) -> a -> b
$ Int -> Var Int v
forall b a. b -> Var b a
Bound.B Int
0
                  )
            ]

      encodeConstructors [([Char], ConstructorShape (Type Void, Expression v))]
constrs Expression v
expr
        | Options -> Bool
Aeson.allNullaryToStringTag Options
aesonOptions Bool -> Bool -> Bool
&& (([Char], ConstructorShape (Type Void, Expression v)) -> Bool)
-> [([Char], ConstructorShape (Type Void, Expression v))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ConstructorShape (Type Void, Expression v) -> Bool
forall a. ConstructorShape a -> Bool
nullary (ConstructorShape (Type Void, Expression v) -> Bool)
-> (([Char], ConstructorShape (Type Void, Expression v))
    -> ConstructorShape (Type Void, Expression v))
-> ([Char], ConstructorShape (Type Void, Expression v))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], ConstructorShape (Type Void, Expression v))
-> ConstructorShape (Type Void, Expression v)
forall a b. (a, b) -> b
snd) [([Char], ConstructorShape (Type Void, Expression v))]
constrs =
          Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expression.Case Expression v
expr
            [ ( Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con ([Char] -> Qualified
elmConstr [Char]
constr) []
              , Expression (Var Int v) -> Scope Int Expression v
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int v) -> Scope Int Expression v)
-> Expression (Var Int v) -> Scope Int Expression v
forall a b. (a -> b) -> a -> b
$
                Expression (Var Int v)
-> Expression (Var Int v) -> Expression (Var Int v)
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int v)
"Json.Encode.string" (Expression (Var Int v) -> Expression (Var Int v))
-> Expression (Var Int v) -> Expression (Var Int v)
forall a b. (a -> b) -> a -> b
$ Text -> Expression (Var Int v)
forall v. Text -> Expression v
Expression.String (Text -> Expression (Var Int v)) -> Text -> Expression (Var Int v)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
constructorJSONName [Char]
constr
              )
            | ([Char]
constr, ConstructorShape (Type Void, Expression v)
_) <- [([Char], ConstructorShape (Type Void, Expression v))]
constrs
            ]

      encodeConstructors [([Char], ConstructorShape (Type Void, Expression v))]
constrs Expression v
expr =
        case Options -> SumEncoding
Aeson.sumEncoding Options
aesonOptions of
          Aeson.TaggedObject [Char]
tagName [Char]
contentsName ->
            Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expression.Case Expression v
expr
              [ case ConstructorShape (Type Void, Expression v)
constrShape of
                  ConstructorShape [(Type Void, Expression v)]
constrFields ->
                    ( Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con ([Char] -> Qualified
elmConstr [Char]
constr) (Int -> Pattern Int
forall v. v -> Pattern v
Pattern.Var (Int -> Pattern Int)
-> ((Int, (Type Void, Expression v)) -> Int)
-> (Int, (Type Void, Expression v))
-> Pattern Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (Type Void, Expression v)) -> Int
forall a b. (a, b) -> a
fst ((Int, (Type Void, Expression v)) -> Pattern Int)
-> [(Int, (Type Void, Expression v))] -> [Pattern Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
-> [(Type Void, Expression v)]
-> [(Int, (Type Void, Expression v))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(Type Void, Expression v)]
constrFields)
                    , Expression (Var Int v) -> Scope Int Expression v
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int v) -> Scope Int Expression v)
-> Expression (Var Int v) -> Scope Int Expression v
forall a b. (a -> b) -> a -> b
$
                      Expression (Var Int v)
-> Expression (Var Int v) -> Expression (Var Int v)
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int v)
"Json.Encode.object" (Expression (Var Int v) -> Expression (Var Int v))
-> Expression (Var Int v) -> Expression (Var Int v)
forall a b. (a -> b) -> a -> b
$
                      [Expression (Var Int v)] -> Expression (Var Int v)
forall v. [Expression v] -> Expression v
Expression.List ([Expression (Var Int v)] -> Expression (Var Int v))
-> [Expression (Var Int v)] -> Expression (Var Int v)
forall a b. (a -> b) -> a -> b
$
                        Expression (Var Int v)
tagTuple Expression (Var Int v)
-> [Expression (Var Int v)] -> [Expression (Var Int v)]
forall a. a -> [a] -> [a]
:
                        [ Expression (Var Int v)
-> Expression (Var Int v) -> Expression (Var Int v)
forall v. Expression v -> Expression v -> Expression v
Expression.tuple
                          (Text -> Expression (Var Int v)
forall v. Text -> Expression v
Expression.String ([Char] -> Text
forall a. IsString a => [Char] -> a
fromString [Char]
contentsName))
                          ([(Type Void, Expression v)] -> Expression (Var Int v)
forall v. [(Type Void, Expression v)] -> Expression (Var Int v)
encodeConstructorFields [(Type Void, Expression v)]
constrFields)
                        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Type Void, Expression v)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Type Void, Expression v)]
constrFields
                        ]
                    )
                  RecordConstructorShape [([Char], (Type Void, Expression v))]
recordFields ->
                    ( Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con ([Char] -> Qualified
elmConstr [Char]
constr) [Int -> Pattern Int
forall v. v -> Pattern v
Pattern.Var Int
0]
                    , Expression (Var Int v) -> Scope Int Expression v
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int v) -> Scope Int Expression v)
-> Expression (Var Int v) -> Scope Int Expression v
forall a b. (a -> b) -> a -> b
$
                      Expression (Var Int v)
-> Expression (Var Int v) -> Expression (Var Int v)
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int v)
"Json.Encode.object" (Expression (Var Int v) -> Expression (Var Int v))
-> Expression (Var Int v) -> Expression (Var Int v)
forall a b. (a -> b) -> a -> b
$
                        [Expression (Var Int v)] -> Expression (Var Int v)
forall v. [Expression v] -> Expression v
Expression.List [Expression (Var Int v)
tagTuple] Expression (Var Int v)
-> Expression (Var Int v) -> Expression (Var Int v)
forall v. Expression v -> Expression v -> Expression v
Expression.++
                        [([Char], (Type Void, Expression (Var Int v)))]
-> Expression (Var Int v) -> Expression (Var Int v)
forall v.
[([Char], (Type Void, Expression v))]
-> Expression v -> Expression v
encodedRecordFieldList (((Type Void, Expression v) -> (Type Void, Expression (Var Int v)))
-> ([Char], (Type Void, Expression v))
-> ([Char], (Type Void, Expression (Var Int v)))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Expression v -> Expression (Var Int v))
-> (Type Void, Expression v) -> (Type Void, Expression (Var Int v))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Expression v -> Expression (Var Int v))
 -> (Type Void, Expression v)
 -> (Type Void, Expression (Var Int v)))
-> (Expression v -> Expression (Var Int v))
-> (Type Void, Expression v)
-> (Type Void, Expression (Var Int v))
forall a b. (a -> b) -> a -> b
$ (v -> Var Int v) -> Expression v -> Expression (Var Int v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> Var Int v
forall b a. a -> Var b a
Bound.F) (([Char], (Type Void, Expression v))
 -> ([Char], (Type Void, Expression (Var Int v))))
-> [([Char], (Type Void, Expression v))]
-> [([Char], (Type Void, Expression (Var Int v)))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], (Type Void, Expression v))]
recordFields) (Var Int v -> Expression (Var Int v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int v -> Expression (Var Int v))
-> Var Int v -> Expression (Var Int v)
forall a b. (a -> b) -> a -> b
$ Int -> Var Int v
forall b a. b -> Var b a
Bound.B Int
0)
                    )
              | ([Char]
constr, ConstructorShape (Type Void, Expression v)
constrShape) <- [([Char], ConstructorShape (Type Void, Expression v))]
constrs
              , let
                tagTuple :: Expression (Var Int v)
tagTuple =
                  Expression (Var Int v)
-> Expression (Var Int v) -> Expression (Var Int v)
forall v. Expression v -> Expression v -> Expression v
Expression.tuple
                    (Text -> Expression (Var Int v)
forall v. Text -> Expression v
Expression.String ([Char] -> Text
forall a. IsString a => [Char] -> a
fromString [Char]
tagName))
                    (Expression (Var Int v)
-> Expression (Var Int v) -> Expression (Var Int v)
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int v)
"Json.Encode.string" (Expression (Var Int v) -> Expression (Var Int v))
-> Expression (Var Int v) -> Expression (Var Int v)
forall a b. (a -> b) -> a -> b
$ Text -> Expression (Var Int v)
forall v. Text -> Expression v
Expression.String (Text -> Expression (Var Int v)) -> Text -> Expression (Var Int v)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
constructorJSONName [Char]
constr)
              ]

          SumEncoding
_ -> [Char] -> Expression v
forall a. HasCallStack => [Char] -> a
error [Char]
"Only the DataAeson.TaggedObject sumEncoding is currently supported"

-------------

-- Int

instance HasElmType Int where
  elmType :: Type v
elmType =
    Type v
"Basics.Int"

instance HasElmEncoder Aeson.Value Int where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"Json.Encode.int"

instance HasElmDecoder Aeson.Value Int where
  elmDecoder :: Expression v
elmDecoder =
    Expression v
"Json.Decode.int"

-- Int8

instance HasElmType Int.Int8 where
  elmType :: Type v
elmType =
    Type v
"Basics.Int"

instance HasElmEncoder Aeson.Value Int.Int8 where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"Json.Encode.int"

instance HasElmDecoder Aeson.Value Int.Int8 where
  elmDecoder :: Expression v
elmDecoder =
    Expression v
"Json.Decode.int"

-- Int16

instance HasElmType Int.Int16 where
  elmType :: Type v
elmType =
    Type v
"Basics.Int"

instance HasElmEncoder Aeson.Value Int.Int16 where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"Json.Encode.int"

instance HasElmDecoder Aeson.Value Int.Int16 where
  elmDecoder :: Expression v
elmDecoder =
    Expression v
"Json.Decode.int"

-- Int32

instance HasElmType Int.Int32 where
  elmType :: Type v
elmType =
    Type v
"Basics.Int"

instance HasElmEncoder Aeson.Value Int.Int32 where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"Json.Encode.int"

instance HasElmDecoder Aeson.Value Int.Int32 where
  elmDecoder :: Expression v
elmDecoder =
    Expression v
"Json.Decode.int"

-- Word8

instance HasElmType Word.Word8 where
  elmType :: Type v
elmType =
    Type v
"Basics.Int"

instance HasElmEncoder Aeson.Value Word.Word8 where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"Json.Encode.int"

instance HasElmDecoder Aeson.Value Word.Word8 where
  elmDecoder :: Expression v
elmDecoder =
    Expression v
"Json.Decode.int"

-- Word16

instance HasElmType Word.Word16 where
  elmType :: Type v
elmType =
    Type v
"Basics.Int"

instance HasElmEncoder Aeson.Value Word.Word16 where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"Json.Encode.int"

instance HasElmDecoder Aeson.Value Word.Word16 where
  elmDecoder :: Expression v
elmDecoder =
    Expression v
"Json.Decode.int"

-- Word32

instance HasElmType Word.Word32 where
  elmType :: Type v
elmType =
    Type v
"Basics.Int"

instance HasElmEncoder Aeson.Value Word.Word32 where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"Json.Encode.int"

instance HasElmDecoder Aeson.Value Word.Word32 where
  elmDecoder :: Expression v
elmDecoder =
    Expression v
"Json.Decode.int"

-- Double

instance HasElmType Double where
  elmType :: Type v
elmType =
    Type v
"Basics.Float"

instance HasElmEncoder Aeson.Value Double where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"Json.Encode.float"

instance HasElmDecoder Aeson.Value Double where
  elmDecoder :: Expression v
elmDecoder =
    Expression v
"Json.Decode.float"

-- Float

instance HasElmType Float where
  elmType :: Type v
elmType =
    Type v
"Basics.Float"

instance HasElmEncoder Aeson.Value Float where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"Json.Encode.float"

instance HasElmDecoder Aeson.Value Float where
  elmDecoder :: Expression v
elmDecoder =
    Expression v
"Json.Decode.float"

-- Bool

instance HasElmType Bool where
  elmType :: Type v
elmType =
    Type v
"Basics.Bool"

instance HasElmEncoder Aeson.Value Bool where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"Json.Encode.bool"

instance HasElmDecoder Aeson.Value Bool where
  elmDecoder :: Expression v
elmDecoder =
    Expression v
"Json.Decode.bool"

-- Text

instance HasElmType Text where
  elmType :: Type v
elmType =
    Type v
"String.String"

instance HasElmEncoder Text Text where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"Basics.identity"

instance HasElmDecoder Text Text where
  elmDecoder :: Expression v
elmDecoder =
    Expression v
"Basics.identity"

instance HasElmEncoder Text Char where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"String.fromChar"

instance HasElmEncoder Text Int where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"String.fromInt"

instance HasElmEncoder Text Int.Int8 where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"String.fromInt"

instance HasElmEncoder Text Int.Int16 where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"String.fromInt"

instance HasElmEncoder Text Int.Int32 where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"String.fromInt"

instance HasElmEncoder Text Word.Word8 where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"String.fromInt"

instance HasElmEncoder Text Word.Word16 where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"String.fromInt"

instance HasElmEncoder Text Word.Word32 where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"String.fromInt"

instance HasElmEncoder Text Double where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"String.fromFloat"

instance HasElmEncoder Text Float where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"String.fromFloat"

instance HasElmEncoder Aeson.Value Text where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"Json.Encode.string"

instance HasElmDecoder Aeson.Value Text where
  elmDecoder :: Expression v
elmDecoder =
    Expression v
"Json.Decode.string"

-- Char

instance HasElmType Char where
  elmType :: Type v
elmType =
    Type v
"Char.Char"

instance HasElmEncoder Aeson.Value Char where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"Json.Encode.string" Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.<< Expression v
"String.fromChar"

instance HasElmDecoder Aeson.Value Char where
  elmDecoder :: Expression v
elmDecoder =
    Expression v
"Json.Decode.string" Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.|>
      Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"Json.Decode.andThen"
      (Scope () Expression v -> Expression v
forall v. Scope () Expression v -> Expression v
Expression.Lam (Scope () Expression v -> Expression v)
-> Scope () Expression v -> Expression v
forall a b. (a -> b) -> a -> b
$ Expression (Var () v) -> Scope () Expression v
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var () v) -> Scope () Expression v)
-> Expression (Var () v) -> Scope () Expression v
forall a b. (a -> b) -> a -> b
$
        Expression (Var () v)
-> [(Pattern Int, Scope Int Expression (Var () v))]
-> Expression (Var () v)
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expression.Case
          (Expression (Var () v)
-> Expression (Var () v) -> Expression (Var () v)
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var () v)
"String.uncons" (Expression (Var () v) -> Expression (Var () v))
-> Expression (Var () v) -> Expression (Var () v)
forall a b. (a -> b) -> a -> b
$ Var () v -> Expression (Var () v)
forall v. v -> Expression v
Expression.Var (Var () v -> Expression (Var () v))
-> Var () v -> Expression (Var () v)
forall a b. (a -> b) -> a -> b
$ () -> Var () v
forall b a. b -> Var b a
Bound.B ())
          [ ( Qualified -> [Pattern Int] -> Pattern Int
forall v. Qualified -> [Pattern v] -> Pattern v
Pattern.Con Qualified
"Maybe.Just" [Pattern Int -> Pattern Int -> Pattern Int
forall v. Pattern v -> Pattern v -> Pattern v
Pattern.tuple (Int -> Pattern Int
forall v. v -> Pattern v
Pattern.Var Int
0) (Text -> Pattern Int
forall v. Text -> Pattern v
Pattern.String Text
"")]
            , Expression (Var Int (Var () v)) -> Scope Int Expression (Var () v)
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int (Var () v))
 -> Scope Int Expression (Var () v))
-> Expression (Var Int (Var () v))
-> Scope Int Expression (Var () v)
forall a b. (a -> b) -> a -> b
$ Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () v))
"Json.Decode.succeed" (Expression (Var Int (Var () v))
 -> Expression (Var Int (Var () v)))
-> Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
forall a b. (a -> b) -> a -> b
$ Var Int (Var () v) -> Expression (Var Int (Var () v))
forall v. v -> Expression v
Expression.Var (Var Int (Var () v) -> Expression (Var Int (Var () v)))
-> Var Int (Var () v) -> Expression (Var Int (Var () v))
forall a b. (a -> b) -> a -> b
$ Int -> Var Int (Var () v)
forall b a. b -> Var b a
Bound.B Int
0
            )
          , ( Pattern Int
forall v. Pattern v
Pattern.Wildcard
            , Expression (Var Int (Var () v)) -> Scope Int Expression (Var () v)
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int (Var () v))
 -> Scope Int Expression (Var () v))
-> Expression (Var Int (Var () v))
-> Scope Int Expression (Var () v)
forall a b. (a -> b) -> a -> b
$ Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression (Var Int (Var () v))
"Json.Decode.fail" (Expression (Var Int (Var () v))
 -> Expression (Var Int (Var () v)))
-> Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
forall a b. (a -> b) -> a -> b
$ Text -> Expression (Var Int (Var () v))
forall v. Text -> Expression v
Expression.String Text
"Not a char"
            )
          ]
      )

-- UTCTime

instance HasElmType UTCTime where
  elmType :: Type v
elmType =
    Type v
"Time.Posix"

instance HasElmEncoder Aeson.Value UTCTime where
  elmEncoder :: Expression v
elmEncoder =
    Expression v
"Iso8601.encode"

instance HasElmDecoder Aeson.Value UTCTime where
  elmDecoder :: Expression v
elmDecoder =
    Expression v
"Iso8601.decoder"

-- Maybe

instance HasElmEncoder a b => HasElmEncoder (Maybe a) (Maybe b) where
  elmEncoder :: Expression v
elmEncoder = Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"Maybe.map" (forall v. HasElmEncoder a b => Expression v
forall k k (value :: k) (a :: k) v.
HasElmEncoder value a =>
Expression v
elmEncoder @a @b)

instance HasElmType a => HasElmType (Maybe a) where
  elmType :: Type v
elmType =
    Type v -> Type v -> Type v
forall v. Type v -> Type v -> Type v
Type.App Type v
"Maybe.Maybe" (forall v. HasElmType a => Type v
forall k (a :: k) v. HasElmType a => Type v
elmType @a)

instance HasElmEncoder Aeson.Value a => HasElmEncoder Aeson.Value (Maybe a) where
  elmEncoder :: Expression v
elmEncoder =
    Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
"Maybe.Extra.unwrap" [Expression v
"Json.Encode.null", forall v. HasElmEncoder Value a => Expression v
forall k k (value :: k) (a :: k) v.
HasElmEncoder value a =>
Expression v
elmEncoder @Aeson.Value @a]

instance HasElmDecoder Aeson.Value a => HasElmDecoder Aeson.Value (Maybe a) where
  elmDecoder :: Expression v
elmDecoder =
    Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"Json.Decode.nullable" (forall v. HasElmDecoder Value a => Expression v
forall k k (value :: k) (a :: k) v.
HasElmDecoder value a =>
Expression v
elmDecoder @Aeson.Value @a)

-- Vector

instance HasElmType a => HasElmType (Vector a) where
  elmType :: Type v
elmType =
    Type v -> Type v -> Type v
forall v. Type v -> Type v -> Type v
Type.App Type v
"Array.Array" (forall v. HasElmType a => Type v
forall k (a :: k) v. HasElmType a => Type v
elmType @a)

instance HasElmEncoder Aeson.Value a => HasElmEncoder Aeson.Value (Vector a) where
  elmEncoder :: Expression v
elmEncoder =
    Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"Json.Encode.array" (forall v. HasElmEncoder Value a => Expression v
forall k k (value :: k) (a :: k) v.
HasElmEncoder value a =>
Expression v
elmEncoder @Aeson.Value @a)

instance HasElmDecoder Aeson.Value a => HasElmDecoder Aeson.Value (Vector a) where
  elmDecoder :: Expression v
elmDecoder =
    Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"Json.Decode.array" (forall v. HasElmDecoder Value a => Expression v
forall k k (value :: k) (a :: k) v.
HasElmDecoder value a =>
Expression v
elmDecoder @Aeson.Value @a)

-- List

instance HasElmType a => HasElmType [a] where
  elmType :: Type v
elmType =
    Type v -> Type v -> Type v
forall v. Type v -> Type v -> Type v
Type.App Type v
"List.List" (forall v. HasElmType a => Type v
forall k (a :: k) v. HasElmType a => Type v
elmType @a)

instance HasElmEncoder Aeson.Value a => HasElmEncoder Aeson.Value [a] where
  elmEncoder :: Expression v
elmEncoder =
    Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"Json.Encode.list" (forall v. HasElmEncoder Value a => Expression v
forall k k (value :: k) (a :: k) v.
HasElmEncoder value a =>
Expression v
elmEncoder @Aeson.Value @a)

instance HasElmDecoder Aeson.Value a => HasElmDecoder Aeson.Value [a] where
  elmDecoder :: Expression v
elmDecoder =
    Expression v -> Expression v -> Expression v
forall v. Expression v -> Expression v -> Expression v
Expression.App Expression v
"Json.Decode.list" (forall v. HasElmDecoder Value a => Expression v
forall k k (value :: k) (a :: k) v.
HasElmDecoder value a =>
Expression v
elmDecoder @Aeson.Value @a)

-- Tuple

instance (HasElmType a, HasElmType b) => HasElmType (a, b) where
  elmType :: Type v
elmType =
    Type v -> [Type v] -> Type v
forall v. Type v -> [Type v] -> Type v
Type.apps Type v
"Basics.," [forall v. HasElmType a => Type v
forall k (a :: k) v. HasElmType a => Type v
elmType @a, forall v. HasElmType b => Type v
forall k (a :: k) v. HasElmType a => Type v
elmType @b]

instance (HasElmEncoder Aeson.Value a, HasElmEncoder Aeson.Value b) => HasElmEncoder Aeson.Value (a, b) where
  elmEncoder :: Expression v
elmEncoder =
    Scope () Expression v -> Expression v
forall v. Scope () Expression v -> Expression v
Expression.Lam (Scope () Expression v -> Expression v)
-> Scope () Expression v -> Expression v
forall a b. (a -> b) -> a -> b
$ Expression (Var () v) -> Scope () Expression v
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var () v) -> Scope () Expression v)
-> Expression (Var () v) -> Scope () Expression v
forall a b. (a -> b) -> a -> b
$
      Expression (Var () v)
-> [(Pattern Int, Scope Int Expression (Var () v))]
-> Expression (Var () v)
forall v.
Expression v
-> [(Pattern Int, Scope Int Expression v)] -> Expression v
Expression.Case (Var () v -> Expression (Var () v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var () v -> Expression (Var () v))
-> Var () v -> Expression (Var () v)
forall a b. (a -> b) -> a -> b
$ () -> Var () v
forall b a. b -> Var b a
Bound.B ())
        [ ( Pattern Int -> Pattern Int -> Pattern Int
forall v. Pattern v -> Pattern v -> Pattern v
Pattern.tuple (Int -> Pattern Int
forall v. v -> Pattern v
Pattern.Var Int
0) (Int -> Pattern Int
forall v. v -> Pattern v
Pattern.Var Int
1)
          , Expression (Var Int (Var () v)) -> Scope Int Expression (Var () v)
forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
Bound.toScope (Expression (Var Int (Var () v))
 -> Scope Int Expression (Var () v))
-> Expression (Var Int (Var () v))
-> Scope Int Expression (Var () v)
forall a b. (a -> b) -> a -> b
$
            Expression (Var Int (Var () v))
-> [Expression (Var Int (Var () v))]
-> Expression (Var Int (Var () v))
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps
              Expression (Var Int (Var () v))
"Json.Encode.list"
              [ Expression (Var Int (Var () v))
"Basics.identity"
              , [Expression (Var Int (Var () v))]
-> Expression (Var Int (Var () v))
forall v. [Expression v] -> Expression v
Expression.List
                  [ Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
forall v. Expression v -> Expression v -> Expression v
Expression.App (forall v. HasElmEncoder Value a => Expression v
forall k k (value :: k) (a :: k) v.
HasElmEncoder value a =>
Expression v
elmEncoder @Aeson.Value @a) (Expression (Var Int (Var () v))
 -> Expression (Var Int (Var () v)))
-> Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
forall a b. (a -> b) -> a -> b
$ Var Int (Var () v) -> Expression (Var Int (Var () v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int (Var () v) -> Expression (Var Int (Var () v)))
-> Var Int (Var () v) -> Expression (Var Int (Var () v))
forall a b. (a -> b) -> a -> b
$ Int -> Var Int (Var () v)
forall b a. b -> Var b a
Bound.B Int
0
                  , Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
forall v. Expression v -> Expression v -> Expression v
Expression.App (forall v. HasElmEncoder Value b => Expression v
forall k k (value :: k) (a :: k) v.
HasElmEncoder value a =>
Expression v
elmEncoder @Aeson.Value @b) (Expression (Var Int (Var () v))
 -> Expression (Var Int (Var () v)))
-> Expression (Var Int (Var () v))
-> Expression (Var Int (Var () v))
forall a b. (a -> b) -> a -> b
$ Var Int (Var () v) -> Expression (Var Int (Var () v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var Int (Var () v) -> Expression (Var Int (Var () v)))
-> Var Int (Var () v) -> Expression (Var Int (Var () v))
forall a b. (a -> b) -> a -> b
$ Int -> Var Int (Var () v)
forall b a. b -> Var b a
Bound.B Int
1
                  ]
              ]
          )
        ]

instance (HasElmDecoder Aeson.Value a, HasElmDecoder Aeson.Value b) => HasElmDecoder Aeson.Value (a, b) where
  elmDecoder :: Expression v
elmDecoder =
    Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps
      Expression v
"Json.Decode.map2"
      [ Expression v
"Tuple.pair"
      , Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
"Json.Decode.index" [Integer -> Expression v
forall v. Integer -> Expression v
Expression.Int Integer
0, forall v. HasElmDecoder Value a => Expression v
forall k k (value :: k) (a :: k) v.
HasElmDecoder value a =>
Expression v
elmDecoder @Aeson.Value @a]
      , Expression v -> [Expression v] -> Expression v
forall (f :: * -> *) v.
Foldable f =>
Expression v -> f (Expression v) -> Expression v
Expression.apps Expression v
"Json.Decode.index" [Integer -> Expression v
forall v. Integer -> Expression v
Expression.Int Integer
1, forall v. HasElmDecoder Value b => Expression v
forall k k (value :: k) (a :: k) v.
HasElmDecoder value a =>
Expression v
elmDecoder @Aeson.Value @b]
      ]

-- | A shorthand for a list of the type definitions for
-- @'jsonDefinitions' \@MyType@ is a shorthand for creating a list of its
-- 'elmDefinition', @'elmEncoderDefinition' \@'Aeson.Value'@, and
-- @'elmDecoderDefinition' \@'Aeson.Value'@.
jsonDefinitions :: forall t. (HasElmEncoder Aeson.Value t, HasElmDecoder Aeson.Value t) => [Definition]
jsonDefinitions :: [Definition]
jsonDefinitions =
  [Maybe Definition] -> [Definition]
forall a. [Maybe a] -> [a]
catMaybes
  [ HasElmType t => Maybe Definition
forall k (a :: k). HasElmType a => Maybe Definition
elmDefinition @t
  , HasElmEncoder Value t => Maybe Definition
forall k k (value :: k) (a :: k).
HasElmEncoder value a =>
Maybe Definition
elmEncoderDefinition @Aeson.Value @t
  , HasElmDecoder Value t => Maybe Definition
forall k k (value :: k) (a :: k).
HasElmDecoder value a =>
Maybe Definition
elmDecoderDefinition @Aeson.Value @t
  ]