    {- |
    This module implements a generator for JSON serialisers and parsers of arbitrary elm types.

    It is highly recommended to either only use the functions of "Elm.Module", or to use the functions in this module
    after having modified the 'ETypeDef' arguments with functions such as 'defaultAlterations'.

    The reason is that Elm types might have an equivalent on the Haskell side and should be converted (ie. 'Text' -> 'String', 'Vector' -> 'List').
    -}
    module Elm.Json
        ( jsonParserForDef
        , jsonSerForDef
        , jsonParserForType
        , jsonSerForType
        , stringSerForSimpleAdt
        , stringParserForSimpleAdt
        )
    where

    import           Data.Aeson.Types (SumEncoding (..))
    import           Data.List
    import           Elm.TyRep
    import           Elm.Utils

    data MaybeHandling = Root | Leaf
                       deriving MaybeHandling -> MaybeHandling -> Bool
    (MaybeHandling -> MaybeHandling -> Bool)
    -> (MaybeHandling -> MaybeHandling -> Bool) -> Eq MaybeHandling
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: MaybeHandling -> MaybeHandling -> Bool
    == :: MaybeHandling -> MaybeHandling -> Bool
    $c/= :: MaybeHandling -> MaybeHandling -> Bool
    /= :: MaybeHandling -> MaybeHandling -> Bool
    Eq

    -- | Compile a JSON parser for an Elm type
    jsonParserForType :: EType -> String
    jsonParserForType :: EType -> String
    jsonParserForType = MaybeHandling -> EType -> String
    jsonParserForType' MaybeHandling
    Leaf

    isOption :: EType -> Bool
    isOption :: EType -> Bool
    isOption (ETyApp (ETyCon (ETCon String
    "Maybe")) EType
    _) = Bool
    True
    isOption EType
    _                                   = Bool
    False

    jsonParserForType' :: MaybeHandling -> EType -> String
    jsonParserForType' :: MaybeHandling -> EType -> String
    jsonParserForType' MaybeHandling
    mh EType
    ty =
        case EType
    ty of
          ETyVar (ETVar String
    v) -> String
    "localDecoder_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    v
          ETyCon (ETCon String
    "Int") -> String
    "Json.Decode.int"
          ETyCon (ETCon String
    "Float") -> String
    "Json.Decode.float"
          ETyCon (ETCon String
    "String") -> String
    "Json.Decode.string"
          ETyCon (ETCon String
    "Bool") -> String
    "Json.Decode.bool"
          ETyCon (ETCon String
    c) -> String
    "jsonDec" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    c
          ETyApp (ETyCon (ETCon String
    "List")) EType
    t' -> String
    "Json.Decode.list (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    jsonParserForType EType
    t' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
          ETyApp (ETyCon (ETCon String
    "Maybe")) EType
    t' -> if MaybeHandling
    mh MaybeHandling -> MaybeHandling -> Bool
    forall a. Eq a => a -> a -> Bool
    == MaybeHandling
    Root
                                                    then EType -> String
    jsonParserForType EType
    t'
                                                    else String
    "Json.Decode.maybe (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    jsonParserForType EType
    t' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
          ETyApp (ETyCon (ETCon String
    "Set")) EType
    t' -> String
    "decodeSet (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    jsonParserForType EType
    t' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
          ETyApp (ETyApp (ETyCon (ETCon String
    "Dict")) (ETyCon (ETCon String
    "String")) ) EType
    value -> String
    "Json.Decode.dict (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    jsonParserForType EType
    value String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
          ETyApp (ETyApp (ETyCon (ETCon String
    "Dict")) EType
    key) EType
    value -> String
    "decodeMap (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    jsonParserForType EType
    key String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ") (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    jsonParserForType EType
    value String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
          EType
    _ ->
              case EType -> [EType]
    unpackTupleType EType
    ty of
                [] -> String -> String
    forall a. HasCallStack => String -> a
    error (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    "This should never happen. Failed to unpackTupleType: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    forall a. Show a => a -> String
    show EType
    ty
                [EType
    x] ->
                    case EType -> [EType]
    unpackToplevelConstr EType
    x of
                      (EType
    y : [EType]
    ys) ->
                          EType -> String
    jsonParserForType EType
    y String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " "
                          String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords ((EType -> String) -> [EType] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\EType
    t' -> String
    "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    jsonParserForType EType
    t' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")" ) [EType]
    ys)
                      [EType]
    _ -> String -> String
    forall a. HasCallStack => String -> a
    error (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    "Do suitable json parser found for " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    forall a. Show a => a -> String
    show EType
    ty
                [EType]
    xs ->
                    let tupleLen :: Int
    tupleLen = [EType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [EType]
    xs
                    in String
    "Json.Decode.map" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    tupleLen String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " tuple" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    tupleLen String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " "
                        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords ((Int -> EType -> String) -> [Int] -> [EType] -> [String]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Int
    i EType
    t' -> String
    "(Json.Decode.index " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Int
    i :: Int) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    jsonParserForType EType
    t' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "))") [Int
    0..] [EType]
    xs)

    parseRecords :: Maybe ETypeName -> Bool -> [(String, EType)] -> [String]
    parseRecords :: Maybe ETypeName -> Bool -> [(String, EType)] -> [String]
    parseRecords Maybe ETypeName
    newtyped Bool
    unwrap [(String, EType)]
    fields =
          case [(String, EType)]
    fields of
            [(String
    _, EType
    ftype)] | Bool
    unwrap -> [ String
    succeed String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " |> custom (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ MaybeHandling -> EType -> String
    jsonParserForType' (EType -> MaybeHandling
    o EType
    ftype) EType
    ftype String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")" ]
            [(String, EType)]
    _ -> String
    succeed String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : ((String, EType) -> String) -> [(String, EType)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, EType) -> String
    forall {a}. Show a => (a, EType) -> String
    mkField [(String, EType)]
    fields
        where
            succeed :: String
    succeed = String
    "   Json.Decode.succeed (\\" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords (((String, EType) -> String) -> [(String, EType)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ( (Char
    'p'Char -> String -> String
    forall a. a -> [a] -> [a]
    :) (String -> String)
    -> ((String, EType) -> String) -> (String, EType) -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, EType) -> String
    forall a b. (a, b) -> a
    fst ) [(String, EType)]
    fields) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " -> " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    mkNewtype (String
    "{" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " (((String, EType) -> String) -> [(String, EType)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(String
    fldName, EType
    _) -> String -> String
    fixReserved String
    fldName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " = p" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    fldName) [(String, EType)]
    fields) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "}") String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
            mkNewtype :: String -> String
    mkNewtype String
    x = case Maybe ETypeName
    newtyped of
                              Maybe ETypeName
    Nothing -> String
    x
                              Just ETypeName
    nm -> String
    "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETypeName -> String
    et_name ETypeName
    nm String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
            o :: EType -> MaybeHandling
    o EType
    fldType = if EType -> Bool
    isOption EType
    fldType
                          then MaybeHandling
    Root
                          else MaybeHandling
    Leaf
            mkField :: (a, EType) -> String
    mkField (a
    fldName, EType
    fldType) =
               String
    "   |> " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (if EType -> Bool
    isOption EType
    fldType then String
    "fnullable " else String
    "required ")
                        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    fldName
                        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ MaybeHandling -> EType -> String
    jsonParserForType' (EType -> MaybeHandling
    o EType
    fldType) EType
    fldType String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"

    -- | Checks that all the arguments to the ESum are unary values
    allUnaries :: Bool -> [SumTypeConstructor] -> Maybe [(String, String)]
    allUnaries :: Bool -> [SumTypeConstructor] -> Maybe [(String, String)]
    allUnaries Bool
    False = Maybe [(String, String)]
    -> [SumTypeConstructor] -> Maybe [(String, String)]
    forall a b. a -> b -> a
    const Maybe [(String, String)]
    forall a. Maybe a
    Nothing
    allUnaries Bool
    True  = (SumTypeConstructor -> Maybe (String, String))
    -> [SumTypeConstructor] -> Maybe [(String, String)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM SumTypeConstructor -> Maybe (String, String)
    isUnary
        where
            isUnary :: SumTypeConstructor -> Maybe (String, String)
    isUnary (STC String
    o String
    c (Anonymous [EType]
    args)) = if [EType] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [EType]
    args then (String, String) -> Maybe (String, String)
    forall a. a -> Maybe a
    Just (String
    o,String
    c) else Maybe (String, String)
    forall a. Maybe a
    Nothing
            isUnary SumTypeConstructor
    _ = Maybe (String, String)
    forall a. Maybe a
    Nothing

    -- | Compile a JSON parser for an Elm type definition
    jsonParserForDef :: ETypeDef -> String
    jsonParserForDef :: ETypeDef -> String
    jsonParserForDef ETypeDef
    etd =
        case ETypeDef
    etd of
          ETypePrimAlias (EPrimAlias ETypeName
    name EType
    ty) -> [String] -> String
    unlines
              [ ETypeName -> String
    decoderType ETypeName
    name
              , ETypeName -> String
    makeName ETypeName
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  String
    " ="
              , String
    "    " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    jsonParserForType EType
    ty
              ]
          ETypeAlias (EAlias ETypeName
    name [(String, EType)]
    fields Bool
    _ Bool
    newtyping Bool
    unwrap) -> [String] -> String
    unlines
              ( ETypeName -> String
    decoderType ETypeName
    name
              String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (ETypeName -> String
    makeName ETypeName
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " =")
              String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : Maybe ETypeName -> Bool -> [(String, EType)] -> [String]
    parseRecords (if Bool
    newtyping then ETypeName -> Maybe ETypeName
    forall a. a -> Maybe a
    Just ETypeName
    name else Maybe ETypeName
    forall a. Maybe a
    Nothing) Bool
    unwrap [(String, EType)]
    fields
              )
          ETypeSum (ESum ETypeName
    name [SumTypeConstructor]
    opts (SumEncoding' SumEncoding
    encodingType) Bool
    _ Bool
    unarystring) ->
                ETypeName -> String
    decoderType ETypeName
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                ETypeName -> String
    makeName ETypeName
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " =" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                    case Bool -> [SumTypeConstructor] -> Maybe [(String, String)]
    allUnaries Bool
    unarystring [SumTypeConstructor]
    opts of
                        Just [(String, String)]
    names -> String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [(String, String)] -> String
    forall {a}. Show a => [(String, a)] -> String
    deriveUnaries [(String, String)]
    names
                        Maybe [(String, String)]
    Nothing    -> String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [SumTypeConstructor] -> String
    encodingDictionary [SumTypeConstructor]
    opts String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    isObjectSet String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [SumTypeConstructor] -> String
    forall {a}. [a] -> String
    declLine [SumTypeConstructor]
    opts String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
              where
                tab :: Int -> String -> String
    tab Int
    n String
    s = Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    n Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s
                typename :: String
    typename = ETypeName -> String
    et_name ETypeName
    name
                declLine :: [a] -> String
    declLine [a
    _] = String
    ""
                declLine [a]
    _   = String
    "    in  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ case SumEncoding
    encodingType of
                               SumEncoding
    ObjectWithSingleField -> [String] -> String
    unwords [ String
    "decodeSumObjectWithSingleField ", String -> String
    forall a. Show a => a -> String
    show String
    typename, String
    dictName]
                               SumEncoding
    TwoElemArray          -> [String] -> String
    unwords [ String
    "decodeSumTwoElemArray ", String -> String
    forall a. Show a => a -> String
    show String
    typename, String
    dictName ]
                               TaggedObject String
    tg String
    el    -> [String] -> String
    unwords [ String
    "decodeSumTaggedObject", String -> String
    forall a. Show a => a -> String
    show String
    typename, String -> String
    forall a. Show a => a -> String
    show String
    tg, String -> String
    forall a. Show a => a -> String
    show String
    el, String
    dictName, String
    isObjectSetName ]
                               SumEncoding
    UntaggedValue         -> String
    "Json.Decode.oneOf (Dict.values " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    dictName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
                dictName :: String
    dictName = String
    "jsonDecDict" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    typename
                isObjectSetName :: String
    isObjectSetName = String
    "jsonDecObjectSet" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    typename
                deriveUnaries :: [(String, a)] -> String
    deriveUnaries [(String, a)]
    strs = [String] -> String
    unlines
                    [ String
    ""
                    , String
    "    let " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    dictName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " = Dict.fromList [" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " (((String, a) -> String) -> [(String, a)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(String
    o, a
    s) -> String
    "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    o String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")") [(String, a)]
    strs ) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "]"
                    , String
    "    in  decodeSumUnaries " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    typename String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    dictName
                    ]
                encodingDictionary :: [SumTypeConstructor] -> String
    encodingDictionary [STC String
    cname String
    _ SumTypeFields
    args] = String
    "    " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> SumTypeFields -> String
    mkDecoder String
    cname SumTypeFields
    args
                encodingDictionary [SumTypeConstructor]
    os = Int -> String -> String
    tab Int
    4 String
    "let " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    dictName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " = Dict.fromList\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    tab Int
    12 String
    "[ " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate (String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    12 Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", ") ((SumTypeConstructor -> String) -> [SumTypeConstructor] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map SumTypeConstructor -> String
    dictEntry [SumTypeConstructor]
    os) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    tab Int
    12 String
    "]"
                isObjectSet :: String
    isObjectSet = case SumEncoding
    encodingType of
                                  TaggedObject String
    _ String
    _
                                    | [SumTypeConstructor] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [SumTypeConstructor]
    opts Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1 ->
                                      String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    tab Int
    8 (String
    isObjectSetName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Set.fromList [" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " [String]
    objectSet String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "]")
                                    where objectSet :: [String]
    objectSet =
                                            ((SumTypeConstructor -> String) -> [SumTypeConstructor] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String
    forall a. Show a => a -> String
    show (String -> String)
    -> (SumTypeConstructor -> String) -> SumTypeConstructor -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SumTypeConstructor -> String
    _stcName) ([SumTypeConstructor] -> [String])
    -> [SumTypeConstructor] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (SumTypeConstructor -> Bool)
    -> [SumTypeConstructor] -> [SumTypeConstructor]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (SumTypeFields -> Bool
    isNamed (SumTypeFields -> Bool)
    -> (SumTypeConstructor -> SumTypeFields)
    -> SumTypeConstructor
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SumTypeConstructor -> SumTypeFields
    _stcFields) [SumTypeConstructor]
    opts) [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
                                            -- if field is empty, it do not have content, so add to objectSet.
                                            ((SumTypeConstructor -> String) -> [SumTypeConstructor] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String
    forall a. Show a => a -> String
    show (String -> String)
    -> (SumTypeConstructor -> String) -> SumTypeConstructor -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SumTypeConstructor -> String
    _stcName) ([SumTypeConstructor] -> [String])
    -> [SumTypeConstructor] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (SumTypeConstructor -> Bool)
    -> [SumTypeConstructor] -> [SumTypeConstructor]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (SumTypeFields -> Bool
    isEmpty (SumTypeFields -> Bool)
    -> (SumTypeConstructor -> SumTypeFields)
    -> SumTypeConstructor
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SumTypeConstructor -> SumTypeFields
    _stcFields) [SumTypeConstructor]
    opts)
                                  SumEncoding
    _ -> String
    ""
                dictEntry :: SumTypeConstructor -> String
    dictEntry (STC String
    cname String
    oname SumTypeFields
    args) = String
    "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    oname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> SumTypeFields -> String
    mkDecoder String
    cname SumTypeFields
    args String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
                mkDecoder :: String -> SumTypeFields -> String
    mkDecoder String
    cname (Named [(String, EType)]
    args)  =  String -> String
    lazy (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    "Json.Decode.map "
                                             String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cname
                                             String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " ("
                                             String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords (Maybe ETypeName -> Bool -> [(String, EType)] -> [String]
    parseRecords Maybe ETypeName
    forall a. Maybe a
    Nothing Bool
    False [(String, EType)]
    args)
                                             String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"

                mkDecoder String
    cname (Anonymous [EType]
    args) = String -> String
    lazy (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unwords ( String
    decodeFunction
                                                       String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String
    cname
                                                       String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (EType -> Int -> String) -> [EType] -> [Int] -> [String]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\EType
    t' Int
    i -> String
    "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> Int -> String
    jsonParserForIndexedType EType
    t' Int
    i String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")") [EType]
    args [Int
    0..]
                                                       )
                    where decodeFunction :: String
    decodeFunction = case [EType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [EType]
    args of
                                               Int
    0 -> String
    "Json.Decode.succeed"
                                               Int
    1 -> String
    "Json.Decode.map"
                                               Int
    n -> String
    "Json.Decode.map" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    n
                          jsonParserForIndexedType :: EType -> Int -> String
                          jsonParserForIndexedType :: EType -> Int -> String
    jsonParserForIndexedType EType
    t' Int
    i | [EType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [EType]
    args Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    1 = EType -> String
    jsonParserForType EType
    t'
                                                        | Bool
    otherwise = String
    "Json.Decode.index " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    i String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    jsonParserForType EType
    t' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
        where
          funcname :: ETypeName -> String
    funcname ETypeName
    name = String
    "jsonDec" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETypeName -> String
    et_name ETypeName
    name
          prependTypes :: String -> ETypeName -> [String]
    prependTypes String
    str = (ETVar -> String) -> [ETVar] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ETVar
    tv -> String
    str String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETVar -> String
    tv_name ETVar
    tv) ([ETVar] -> [String])
    -> (ETypeName -> [ETVar]) -> ETypeName -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ETypeName -> [ETVar]
    et_args
          decoderType :: ETypeName -> String
    decoderType ETypeName
    name = ETypeName -> String
    funcname ETypeName
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " : " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    " -> " (String -> ETypeName -> [String]
    prependTypes String
    "Json.Decode.Decoder " ETypeName
    name [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ETypeName -> String
    decoderTypeEnd ETypeName
    name])
          decoderTypeEnd :: ETypeName -> String
    decoderTypeEnd ETypeName
    name = [String] -> String
    unwords (String
    "Json.Decode.Decoder" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String
    "(" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : ETypeName -> String
    et_name ETypeName
    name String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (ETVar -> String) -> [ETVar] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ETVar -> String
    tv_name (ETypeName -> [ETVar]
    et_args ETypeName
    name) [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    ")"])
          makeName :: ETypeName -> String
    makeName ETypeName
    name = [String] -> String
    unwords (ETypeName -> String
    funcname ETypeName
    name String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String -> ETypeName -> [String]
    prependTypes String
    "localDecoder_" ETypeName
    name)
          lazy :: String -> String
    lazy String
    decoder = String
    "Json.Decode.lazy (\\_ -> " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    decoder String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"

    {-| Compile a JSON serializer for an Elm type.

    The 'omitNothingFields' option is currently not implemented!
    -}
    jsonSerForType :: EType -> String
    jsonSerForType :: EType -> String
    jsonSerForType = Bool -> [Int] -> EType -> String
    jsonSerForType' Bool
    False [Int
    1..]

    jsonSerForType' :: Bool -> [Int] -> EType -> String
    jsonSerForType' :: Bool -> [Int] -> EType -> String
    jsonSerForType' Bool
    omitnull [Int]
    ns EType
    ty =
        case EType
    ty of
          ETyVar (ETVar String
    v) -> String
    "localEncoder_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    v
          ETyCon (ETCon String
    "Int") -> String
    "Json.Encode.int"
          ETyCon (ETCon String
    "Float") -> String
    "Json.Encode.float"
          ETyCon (ETCon String
    "String") -> String
    "Json.Encode.string"
          ETyCon (ETCon String
    "Bool") -> String
    "Json.Encode.bool"
          ETyCon (ETCon String
    c) -> String
    "jsonEnc" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    c
          ETyApp (ETyCon (ETCon String
    "List")) EType
    t' -> String
    "(Json.Encode.list " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Bool -> [Int] -> EType -> String
    jsonSerForType' Bool
    omitnull [Int]
    ns EType
    t' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
          ETyApp (ETyCon (ETCon String
    "Maybe")) EType
    t' -> if Bool
    omitnull
                                                    then Bool -> [Int] -> EType -> String
    jsonSerForType' Bool
    omitnull [Int]
    ns EType
    t'
                                                    else String
    "(maybeEncode (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Bool -> [Int] -> EType -> String
    jsonSerForType' Bool
    omitnull [Int]
    ns EType
    t' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "))"
          ETyApp (ETyCon (ETCon String
    "Set")) EType
    t' -> String
    "(encodeSet " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Bool -> [Int] -> EType -> String
    jsonSerForType' Bool
    omitnull [Int]
    ns EType
    t' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
          ETyApp (ETyApp (ETyCon (ETCon String
    "Dict")) (ETyCon (ETCon String
    "String"))) EType
    value -> String
    "(Json.Encode.dict identity (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Bool -> [Int] -> EType -> String
    jsonSerForType' Bool
    omitnull [Int]
    ns EType
    value String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "))"
          ETyApp (ETyApp (ETyCon (ETCon String
    "Dict")) EType
    key) EType
    value -> String
    "(encodeMap (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Bool -> [Int] -> EType -> String
    jsonSerForType' Bool
    omitnull [Int]
    ns EType
    key String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ") (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Bool -> [Int] -> EType -> String
    jsonSerForType' Bool
    omitnull [Int]
    ns EType
    value String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "))"
          EType
    _ ->
              case EType -> [EType]
    unpackTupleType EType
    ty of
                [] -> String -> String
    forall a. HasCallStack => String -> a
    error (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    "This should never happen. Failed to unpackTupleType: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    forall a. Show a => a -> String
    show EType
    ty
                [EType
    x] ->
                    case EType -> [EType]
    unpackToplevelConstr EType
    x of
                      (EType
    y : [EType]
    ys) ->
                          String
    "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Bool -> [Int] -> EType -> String
    jsonSerForType' Bool
    omitnull [Int]
    ns EType
    y String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " "
                          String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords ((EType -> String) -> [EType] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\EType
    t' -> String
    "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Bool -> [Int] -> EType -> String
    jsonSerForType' Bool
    omitnull [Int]
    ns EType
    t' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")") [EType]
    ys)
                          String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
                      [EType]
    _ -> String -> String
    forall a. HasCallStack => String -> a
    error (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    "Do suitable json serialiser found for " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    forall a. Show a => a -> String
    show EType
    ty
                [EType]
    xs ->
                    let ([Int]
    ns', [Int]
    rest) = Int -> [Int] -> ([Int], [Int])
    forall a. Int -> [a] -> ([a], [a])
    splitAt ([EType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [EType]
    xs) [Int]
    ns
                        tupleArgsV :: [(EType, Int)]
    tupleArgsV = [EType] -> [Int] -> [(EType, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [EType]
    xs [Int]
    ns'
                        tupleArgs :: String
    tupleArgs =
                            String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "," ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ ((EType, Int) -> String) -> [(EType, Int)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(EType
    _, Int
    v) -> String
    "t" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    v) [(EType, Int)]
    tupleArgsV
                    in String
    "(\\(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    tupleArgs String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ") -> Json.Encode.list identity [" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "," (((EType, Int) -> String) -> [(EType, Int)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(EType
    t', Int
    idx) -> String
    "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Bool -> [Int] -> EType -> String
    jsonSerForType' Bool
    omitnull [Int]
    rest EType
    t' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ") t" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    idx) [(EType, Int)]
    tupleArgsV) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "])"

    -- | Compile a JSON serializer for an Elm type definition
    jsonSerForDef :: ETypeDef -> String
    jsonSerForDef :: ETypeDef -> String
    jsonSerForDef ETypeDef
    etd =
        case ETypeDef
    etd of
          ETypePrimAlias (EPrimAlias ETypeName
    name EType
    ty) ->
              ETypeName -> Bool -> String
    makeName ETypeName
    name Bool
    False String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  String
    " = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    jsonSerForType EType
    ty String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " val\n"
          ETypeAlias (EAlias ETypeName
    name [(String
    fldName, EType
    fldType)] Bool
    _ Bool
    newtyping Bool
    True) ->
              ETypeName -> Bool -> String
    makeName ETypeName
    name Bool
    newtyping String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " =\n   " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    jsonSerForType EType
    fldType String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " val." String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    fixReserved String
    fldName
          ETypeAlias (EAlias ETypeName
    name [(String, EType)]
    fields Bool
    _ Bool
    newtyping Bool
    _) ->
              ETypeName -> Bool -> String
    makeName ETypeName
    name Bool
    newtyping String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " =\n   Json.Encode.object\n   ["
              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n   ," (((String, EType) -> String) -> [(String, EType)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(String
    fldName, EType
    fldType) -> String
    " (\"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    fldName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\", " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    jsonSerForType EType
    fldType String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " val." String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    fixReserved String
    fldName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")") [(String, EType)]
    fields)
              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n   ]\n"
          ETypeSum (ESum ETypeName
    name [SumTypeConstructor]
    opts (SumEncoding' SumEncoding
    se) Bool
    _ Bool
    unarystring) ->
            case Bool -> [SumTypeConstructor] -> Maybe [(String, String)]
    allUnaries Bool
    unarystring [SumTypeConstructor]
    opts of
                Maybe [(String, String)]
    Nothing   -> [SumTypeConstructor] -> String
    defaultEncoding [SumTypeConstructor]
    opts
                Just [(String, String)]
    strs -> [(String, String)] -> String
    forall {a}. Show a => [(String, a)] -> String
    unaryEncoding [(String, String)]
    strs
              where
                  encodeFunction :: String
    encodeFunction = case SumEncoding
    se of
                                       SumEncoding
    ObjectWithSingleField -> String
    "encodeSumObjectWithSingleField"
                                       SumEncoding
    TwoElemArray -> String
    "encodeSumTwoElementArray"
                                       TaggedObject String
    k String
    c -> [String] -> String
    unwords [String
    "encodeSumTaggedObject", String -> String
    forall a. Show a => a -> String
    show String
    k, String -> String
    forall a. Show a => a -> String
    show String
    c]
                                       SumEncoding
    UntaggedValue -> String
    "encodeSumUntagged"
                  defaultEncoding :: [SumTypeConstructor] -> String
    defaultEncoding [STC String
    _ String
    oname (Anonymous [EType]
    args)] = [String] -> String
    unlines
                    [ ETypeName -> String
    makeType ETypeName
    name
                    , ETypeName -> String
    fname ETypeName
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " "
                        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords ((ETVar -> String) -> [ETVar] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ETVar
    tv -> String
    "localEncoder_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETVar -> String
    tv_name ETVar
    tv) ([ETVar] -> [String]) -> [ETVar] -> [String]
    forall a b. (a -> b) -> a -> b
    $ ETypeName -> [ETVar]
    et_args ETypeName
    name)
                        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    cap String
    oname  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [EType] -> String
    forall {t :: * -> *} {a}. Foldable t => t a -> String
    argList [EType]
    args String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ") ="
                    , String
    "    " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [EType] -> String
    mkEncodeList [EType]
    args
                    ]
                  defaultEncoding [SumTypeConstructor]
    os = [String] -> String
    unlines (
                    ( ETypeName -> Bool -> String
    makeName ETypeName
    name Bool
    False String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " =")
                    String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String
    "    let keyval v = case v of"
                    String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (SumTypeConstructor -> String) -> [SumTypeConstructor] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    12 Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String)
    -> (SumTypeConstructor -> String) -> SumTypeConstructor -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SumTypeConstructor -> String
    mkcase) [SumTypeConstructor]
    os
                    [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ String
    "    " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords [String
    "in", String
    encodeFunction, String
    "keyval", String
    "val"] ]
                    )
                  unaryEncoding :: [(String, a)] -> String
    unaryEncoding [(String, a)]
    names = [String] -> String
    unlines (
                    [ ETypeName -> Bool -> String
    makeName ETypeName
    name Bool
    False String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " ="
                    , String
    "    case val of"
                    ] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ ((String, a) -> String) -> [(String, a)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(String
    o, a
    n) -> Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    8 Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    o String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " -> Json.Encode.string " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    n) [(String, a)]
    names
                    )
                  mkcase :: SumTypeConstructor -> String
                  mkcase :: SumTypeConstructor -> String
    mkcase (STC String
    cname String
    oname (Anonymous [EType]
    args)) = Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    8 Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    cap String
    cname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [EType] -> String
    forall {t :: * -> *} {a}. Foldable t => t a -> String
    argList [EType]
    args String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " -> (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    oname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", encodeValue (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [EType] -> String
    mkEncodeList [EType]
    args String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "))"
                  mkcase (STC String
    cname String
    oname (Named [(String, EType)]
    args)) = Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    8 Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    cap String
    cname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " vs -> (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    oname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [(String, EType)] -> String
    mkEncodeObject [(String, EType)]
    args String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
                  argList :: t a -> String
    argList t a
    a = [String] -> String
    unwords ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (Int -> String) -> [Int] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Int
    i -> String
    "v" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    i ) [Int
    1 .. t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    a]
                  numargs :: (a -> String) -> [a] -> String
                  numargs :: forall a. (a -> String) -> [a] -> String
    numargs a -> String
    f = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " ([String] -> String) -> ([a] -> [String]) -> [a] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> a -> String) -> [Int] -> [a] -> [String]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Int
    n a
    a -> a -> String
    f a
    a String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " v" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    n)  ([Int
    1..] :: [Int])
                  mkEncodeObject :: [(String, EType)] -> String
    mkEncodeObject [(String, EType)]
    args = String
    "encodeObject [" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " (((String, EType) -> String) -> [(String, EType)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(String
    n,EType
    t) -> String
    "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EType -> String
    jsonSerForType EType
    t String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " vs." String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    fixReserved String
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")") [(String, EType)]
    args) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "]"
                  mkEncodeList :: [EType] -> String
    mkEncodeList [EType
    arg] = EType -> String
    jsonSerForType EType
    arg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " v1"
                  mkEncodeList [EType]
    args =  String
    "Json.Encode.list identity [" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (EType -> String) -> [EType] -> String
    forall a. (a -> String) -> [a] -> String
    numargs EType -> String
    jsonSerForType [EType]
    args String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "]"
        where
          fname :: ETypeName -> String
    fname ETypeName
    name = String
    "jsonEnc" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETypeName -> String
    et_name ETypeName
    name
          makeType :: ETypeName -> String
    makeType ETypeName
    name = ETypeName -> String
    fname ETypeName
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " : " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    " -> " ((ETVar -> String) -> [ETVar] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String
    mkLocalEncoder (String -> String) -> (ETVar -> String) -> ETVar -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ETVar -> String
    tv_name) (ETypeName -> [ETVar]
    et_args ETypeName
    name) [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [[String] -> String
    unwords (ETypeName -> String
    et_name ETypeName
    name String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (ETVar -> String) -> [ETVar] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ETVar -> String
    tv_name (ETypeName -> [ETVar]
    et_args ETypeName
    name)) , String
    "Value"])
          mkLocalEncoder :: String -> String
    mkLocalEncoder String
    n = String
    "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " -> Value)"
          makeName :: ETypeName -> Bool -> String
    makeName ETypeName
    name Bool
    newtyping =
               ETypeName -> String
    makeType ETypeName
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
               String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETypeName -> String
    fname ETypeName
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " "
               String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords ((ETVar -> String) -> [ETVar] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ETVar
    tv -> String
    "localEncoder_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETVar -> String
    tv_name ETVar
    tv) ([ETVar] -> [String]) -> [ETVar] -> [String]
    forall a b. (a -> b) -> a -> b
    $ ETypeName -> [ETVar]
    et_args ETypeName
    name)
               String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ if Bool
    newtyping
                      then String
    " (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETypeName -> String
    et_name ETypeName
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " val)"
                      else String
    " val"

    -- | Serialize a type like 'type Color = Red | Green | Blue' in a function like
    --
    -- > stringEncColor : Color -> String
    -- > stringEncColor x =
    -- >   case x of
    -- >     Red -> "red"
    -- >     ...
    --
    -- This is mainly useful for types which are used as part of query parameters and url captures.
    stringSerForSimpleAdt :: ETypeDef -> String
    stringSerForSimpleAdt :: ETypeDef -> String
    stringSerForSimpleAdt ETypeDef
    etd =
      case ETypeDef
    etd of
        ETypeSum (ESum ETypeName
    name [SumTypeConstructor]
    opts (SumEncoding' SumEncoding
    _se) Bool
    _ Bool
    _unarystring) ->
          [SumTypeConstructor] -> String
    defaultEncoding [SumTypeConstructor]
    opts
          where
            defaultEncoding :: [SumTypeConstructor] -> String
    defaultEncoding [SumTypeConstructor]
    os =
              [String] -> String
    unlines
                ((ETypeName -> Bool -> String
    makeName ETypeName
    name Bool
    False String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " =") String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String
    "    case val of" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (SumTypeConstructor -> String) -> [SumTypeConstructor] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map SumTypeConstructor -> String
    mkcase [SumTypeConstructor]
    os)
            mkcase :: SumTypeConstructor -> String
            mkcase :: SumTypeConstructor -> String
    mkcase (STC String
    cname String
    oname (Anonymous [EType]
    args)) =
              Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    8 Char
    ' '
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    cap String
    cname
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " "
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [EType] -> String
    forall {t :: * -> *} {a}. Foldable t => t a -> String
    argList [EType]
    args
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " -> "
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    oname
            mkcase SumTypeConstructor
    _ =
              String -> String
    forall a. HasCallStack => String -> a
    error String
    "stringSerForSimpleAdt.mkcase: Expecting an Anonymous case"
            argList :: t a -> String
    argList t a
    a = [String] -> String
    unwords ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (Int -> String) -> [Int] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Int
    i -> String
    "v" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    i) [Int
    1 .. t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    a]
        ETypeDef
    _ -> String -> String
    forall a. HasCallStack => String -> a
    error String
    "stringSerForSimpleAdt only works with ETypeSum"
      where
        fname :: ETypeName -> String
    fname ETypeName
    name = String
    "stringEnc" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETypeName -> String
    et_name ETypeName
    name
        makeType :: ETypeName -> String
    makeType ETypeName
    name =
          ETypeName -> String
    fname ETypeName
    name
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " : "
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate
              String
    " -> "
              ([[String] -> String
    unwords (ETypeName -> String
    et_name ETypeName
    name String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (ETVar -> String) -> [ETVar] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ETVar -> String
    tv_name (ETypeName -> [ETVar]
    et_args ETypeName
    name))] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    "String"])
        makeName :: ETypeName -> Bool -> String
    makeName ETypeName
    name Bool
    newtyping =
          ETypeName -> String
    makeType ETypeName
    name
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETypeName -> String
    fname ETypeName
    name
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " "
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords ((ETVar -> String) -> [ETVar] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ETVar
    tv -> String
    "localEncoder_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETVar -> String
    tv_name ETVar
    tv) ([ETVar] -> [String]) -> [ETVar] -> [String]
    forall a b. (a -> b) -> a -> b
    $ ETypeName -> [ETVar]
    et_args ETypeName
    name)
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ if Bool
    newtyping
              then String
    " (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETypeName -> String
    et_name ETypeName
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " val)"
              else String
    " val"

    -- | Parse a String into a maybe-value for simple ADT types. See 'stringSerForSimpleAdt' for motivation
    stringParserForSimpleAdt :: ETypeDef -> String
    stringParserForSimpleAdt :: ETypeDef -> String
    stringParserForSimpleAdt ETypeDef
    etd =
      case ETypeDef
    etd of
        ETypeSum (ESum ETypeName
    name [SumTypeConstructor]
    opts (SumEncoding' SumEncoding
    _encodingType) Bool
    _ Bool
    _unarystring) ->
          ETypeName -> String
    decoderType ETypeName
    name
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETypeName -> String
    makeName ETypeName
    name
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " s =\n"
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [SumTypeConstructor] -> String
    encodingDictionary [SumTypeConstructor]
    opts
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
          where
            tab :: Int -> String -> String
    tab Int
    n String
    s = Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    n Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s
            encodingDictionary :: [SumTypeConstructor] -> String
    encodingDictionary [STC String
    cname String
    _ SumTypeFields
    args] =
              String
    "    " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> SumTypeFields -> String
    forall {p} {p} {a}. p -> p -> a
    mkDecoder String
    cname SumTypeFields
    args
            encodingDictionary [SumTypeConstructor]
    os =
              String
    "    case s of\n"
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    tab Int
    8 String
    ""
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate (String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    8 Char
    ' ') ((SumTypeConstructor -> String) -> [SumTypeConstructor] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map SumTypeConstructor -> String
    dictEntry [SumTypeConstructor]
    os)
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    tab Int
    8 String
    "_ -> Nothing"
            dictEntry :: SumTypeConstructor -> String
    dictEntry (STC String
    cname String
    oname SumTypeFields
    _args) =
              String -> String
    forall a. Show a => a -> String
    show String
    oname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " -> Just " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cname
            mkDecoder :: p -> p -> a
    mkDecoder p
    _cname p
    _ = String -> a
    forall a. HasCallStack => String -> a
    error String
    "impossible!"
        ETypeDef
    _ -> String -> String
    forall a. HasCallStack => String -> a
    error String
    "impossible"
      where
        funcname :: ETypeName -> String
    funcname ETypeName
    name = String
    "stringDec" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETypeName -> String
    et_name ETypeName
    name
        prependTypes :: String -> ETypeName -> [String]
    prependTypes String
    str = (ETVar -> String) -> [ETVar] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ETVar
    tv -> String
    str String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ETVar -> String
    tv_name ETVar
    tv) ([ETVar] -> [String])
    -> (ETypeName -> [ETVar]) -> ETypeName -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ETypeName -> [ETVar]
    et_args
        decoderType :: ETypeName -> String
    decoderType ETypeName
    name =
          ETypeName -> String
    funcname ETypeName
    name
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " : "
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    " -> " ([String
    "String"] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ETypeName -> String
    decoderTypeEnd ETypeName
    name])
        decoderTypeEnd :: ETypeName -> String
    decoderTypeEnd ETypeName
    name =
          [String] -> String
    unwords (String
    "Maybe" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : ETypeName -> String
    et_name ETypeName
    name String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (ETVar -> String) -> [ETVar] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ETVar -> String
    tv_name (ETypeName -> [ETVar]
    et_args ETypeName
    name))
        makeName :: ETypeName -> String
    makeName ETypeName
    name = [String] -> String
    unwords (ETypeName -> String
    funcname ETypeName
    name String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String -> ETypeName -> [String]
    prependTypes String
    "localDecoder_" ETypeName
    name)