{-# 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
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
elmDefinition :: Maybe Definition
elmDefinition =
Maybe Definition
forall a. Maybe a
Nothing
{-# minimal elmType | elmDefinition #-}
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
elmDecoderDefinition :: Maybe Definition
elmDecoderDefinition =
Maybe Definition
forall a. Maybe a
Nothing
{-# minimal elmDecoder | elmDecoderDefinition #-}
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
elmEncoderDefinition :: Maybe Definition
elmEncoderDefinition =
Maybe Definition
forall a. Maybe a
Nothing
{-# minimal elmEncoder | elmEncoderDefinition #-}
newtype Options = Options
{ Options -> [Char] -> [Char]
fieldLabelModifier :: String -> String
}
defaultOptions :: Options
defaultOptions :: Options
defaultOptions =
Options :: ([Char] -> [Char]) -> Options
Options
{ $sel:fieldLabelModifier:Options :: [Char] -> [Char]
fieldLabelModifier = [Char] -> [Char]
forall a. a -> a
id
}
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
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"
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"
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"
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"
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"
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"
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"
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"
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"
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"
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"
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"
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"
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"
)
]
)
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"
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)
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)
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)
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]
]
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
]