{- |
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaybeHandling -> MaybeHandling -> Bool
$c/= :: MaybeHandling -> MaybeHandling -> Bool
== :: MaybeHandling -> MaybeHandling -> Bool
$c== :: 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_" 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" forall a. [a] -> [a] -> [a]
++ String
c
      ETyApp (ETyCon (ETCon String
"List")) EType
t' -> String
"Json.Decode.list (" forall a. [a] -> [a] -> [a]
++ EType -> String
jsonParserForType EType
t' forall a. [a] -> [a] -> [a]
++ String
")"
      ETyApp (ETyCon (ETCon String
"Maybe")) EType
t' -> if MaybeHandling
mh forall a. Eq a => a -> a -> Bool
== MaybeHandling
Root
                                                then EType -> String
jsonParserForType EType
t'
                                                else String
"Json.Decode.maybe (" forall a. [a] -> [a] -> [a]
++ EType -> String
jsonParserForType EType
t' forall a. [a] -> [a] -> [a]
++ String
")"
      ETyApp (ETyCon (ETCon String
"Set")) EType
t' -> String
"decodeSet (" forall a. [a] -> [a] -> [a]
++ EType -> String
jsonParserForType EType
t' forall a. [a] -> [a] -> [a]
++ String
")"
      ETyApp (ETyApp (ETyCon (ETCon String
"Dict")) (ETyCon (ETCon String
"String")) ) EType
value -> String
"Json.Decode.dict (" forall a. [a] -> [a] -> [a]
++ EType -> String
jsonParserForType EType
value forall a. [a] -> [a] -> [a]
++ String
")"
      ETyApp (ETyApp (ETyCon (ETCon String
"Dict")) EType
key) EType
value -> String
"decodeMap (" forall a. [a] -> [a] -> [a]
++ EType -> String
jsonParserForType EType
key forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ EType -> String
jsonParserForType EType
value forall a. [a] -> [a] -> [a]
++ String
")"
      EType
_ ->
          case EType -> [EType]
unpackTupleType EType
ty of
            [] -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"This should never happen. Failed to unpackTupleType: " forall a. [a] -> [a] -> [a]
++ 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 forall a. [a] -> [a] -> [a]
++ String
" "
                      forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map (\EType
t' -> String
"(" forall a. [a] -> [a] -> [a]
++ EType -> String
jsonParserForType EType
t' forall a. [a] -> [a] -> [a]
++ String
")" ) [EType]
ys)
                  [EType]
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Do suitable json parser found for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show EType
ty
            [EType]
xs ->
                let tupleLen :: Int
tupleLen = forall (t :: * -> *) a. Foldable t => t a -> Int
length [EType]
xs
                in String
"Json.Decode.map" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
tupleLen forall a. [a] -> [a] -> [a]
++ String
" tuple" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
tupleLen forall a. [a] -> [a] -> [a]
++ String
" "
                    forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i EType
t' -> String
"(Json.Decode.index " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
i :: Int) forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ EType -> String
jsonParserForType EType
t' 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 forall a. [a] -> [a] -> [a]
++ String
" |> custom (" forall a. [a] -> [a] -> [a]
++ MaybeHandling -> EType -> String
jsonParserForType' (EType -> MaybeHandling
o EType
ftype) EType
ftype forall a. [a] -> [a] -> [a]
++ String
")" ]
        [(String, EType)]
_ -> String
succeed forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (a, EType) -> String
mkField [(String, EType)]
fields
    where
        succeed :: String
succeed = String
"   Json.Decode.succeed (\\" forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map ( (Char
'p'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst ) [(String, EType)]
fields) forall a. [a] -> [a] -> [a]
++ String
" -> " forall a. [a] -> [a] -> [a]
++ String -> String
mkNewtype (String
"{" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map (\(String
fldName, EType
_) -> String -> String
fixReserved String
fldName forall a. [a] -> [a] -> [a]
++ String
" = p" forall a. [a] -> [a] -> [a]
++ String
fldName) [(String, EType)]
fields) forall a. [a] -> [a] -> [a]
++ 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
"(" forall a. [a] -> [a] -> [a]
++ ETypeName -> String
et_name ETypeName
nm forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
x 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
"   |> " forall a. [a] -> [a] -> [a]
++ (if EType -> Bool
isOption EType
fldType then String
"fnullable " else String
"required ")
                    forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
fldName
                    forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ MaybeHandling -> EType -> String
jsonParserForType' (EType -> MaybeHandling
o EType
fldType) EType
fldType 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 = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
allUnaries Bool
True  = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SumTypeConstructor -> Maybe (String, String)
isUnary
    where
        isUnary :: SumTypeConstructor -> Maybe (String, String)
isUnary (STC String
o String
c (Anonymous [EType]
args)) = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EType]
args then forall a. a -> Maybe a
Just (String
o,String
c) else forall a. Maybe a
Nothing
        isUnary SumTypeConstructor
_ = 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 forall a. [a] -> [a] -> [a]
++  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
          forall a. a -> [a] -> [a]
: (ETypeName -> String
makeName ETypeName
name forall a. [a] -> [a] -> [a]
++ String
" =")
          forall a. a -> [a] -> [a]
: Maybe ETypeName -> Bool -> [(String, EType)] -> [String]
parseRecords (if Bool
newtyping then forall a. a -> Maybe a
Just ETypeName
name else 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 forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++
            ETypeName -> String
makeName ETypeName
name forall a. [a] -> [a] -> [a]
++ String
" =" forall a. [a] -> [a] -> [a]
++
                case Bool -> [SumTypeConstructor] -> Maybe [(String, String)]
allUnaries Bool
unarystring [SumTypeConstructor]
opts of
                    Just [(String, String)]
names -> String
" " forall a. [a] -> [a] -> [a]
++ forall {a}. Show a => [(String, a)] -> String
deriveUnaries [(String, String)]
names
                    Maybe [(String, String)]
Nothing    -> String
"\n" forall a. [a] -> [a] -> [a]
++ [SumTypeConstructor] -> String
encodingDictionary [SumTypeConstructor]
opts forall a. [a] -> [a] -> [a]
++ String
isObjectSet forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ forall {a}. [a] -> String
declLine [SumTypeConstructor]
opts forall a. [a] -> [a] -> [a]
++ String
"\n"
          where
            tab :: Int -> String -> String
tab Int
n String
s = forall a. Int -> a -> [a]
replicate Int
n Char
' ' 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  " forall a. [a] -> [a] -> [a]
++ case SumEncoding
encodingType of
                           SumEncoding
ObjectWithSingleField -> [String] -> String
unwords [ String
"decodeSumObjectWithSingleField ", forall a. Show a => a -> String
show String
typename, String
dictName]
                           SumEncoding
TwoElemArray          -> [String] -> String
unwords [ String
"decodeSumTwoElemArray ", forall a. Show a => a -> String
show String
typename, String
dictName ]
                           TaggedObject String
tg String
el    -> [String] -> String
unwords [ String
"decodeSumTaggedObject", forall a. Show a => a -> String
show String
typename, forall a. Show a => a -> String
show String
tg, forall a. Show a => a -> String
show String
el, String
dictName, String
isObjectSetName ]
                           SumEncoding
UntaggedValue         -> String
"Json.Decode.oneOf (Dict.values " forall a. [a] -> [a] -> [a]
++ String
dictName forall a. [a] -> [a] -> [a]
++ String
")"
            dictName :: String
dictName = String
"jsonDecDict" forall a. [a] -> [a] -> [a]
++ String
typename
            isObjectSetName :: String
isObjectSetName = String
"jsonDecObjectSet" forall a. [a] -> [a] -> [a]
++ String
typename
            deriveUnaries :: [(String, a)] -> String
deriveUnaries [(String, a)]
strs = [String] -> String
unlines
                [ String
""
                , String
"    let " forall a. [a] -> [a] -> [a]
++ String
dictName forall a. [a] -> [a] -> [a]
++ String
" = Dict.fromList [" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map (\(String
o, a
s) -> String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
s forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ String
o forall a. [a] -> [a] -> [a]
++ String
")") [(String, a)]
strs ) forall a. [a] -> [a] -> [a]
++ String
"]"
                , String
"    in  decodeSumUnaries " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
typename forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
dictName
                ]
            encodingDictionary :: [SumTypeConstructor] -> String
encodingDictionary [STC String
cname String
_ SumTypeFields
args] = 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 " forall a. [a] -> [a] -> [a]
++ String
dictName forall a. [a] -> [a] -> [a]
++ String
" = Dict.fromList\n" forall a. [a] -> [a] -> [a]
++ Int -> String -> String
tab Int
12 String
"[ " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate (String
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
12 Char
' ' forall a. [a] -> [a] -> [a]
++ String
", ") (forall a b. (a -> b) -> [a] -> [b]
map SumTypeConstructor -> String
dictEntry [SumTypeConstructor]
os) forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ Int -> String -> String
tab Int
12 String
"]"
            isObjectSet :: String
isObjectSet = case SumEncoding
encodingType of
                              TaggedObject String
_ String
_
                                | forall (t :: * -> *) a. Foldable t => t a -> Int
length [SumTypeConstructor]
opts forall a. Ord a => a -> a -> Bool
> Int
1 ->
                                  String
"\n" forall a. [a] -> [a] -> [a]
++ Int -> String -> String
tab Int
8 (String
isObjectSetName forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ String
"Set.fromList [" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
objectSet forall a. [a] -> [a] -> [a]
++ String
"]")
                                where objectSet :: [String]
objectSet =
                                        (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumTypeConstructor -> String
_stcName) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (SumTypeFields -> Bool
isNamed forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumTypeConstructor -> SumTypeFields
_stcFields) [SumTypeConstructor]
opts) forall a. [a] -> [a] -> [a]
++
                                        -- if field is empty, it do not have content, so add to objectSet.
                                        (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumTypeConstructor -> String
_stcName) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (SumTypeFields -> Bool
isEmpty 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
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
oname forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ String -> SumTypeFields -> String
mkDecoder String
cname SumTypeFields
args forall a. [a] -> [a] -> [a]
++ String
")"
            mkDecoder :: String -> SumTypeFields -> String
mkDecoder String
cname (Named [(String, EType)]
args)  =  String -> String
lazy forall a b. (a -> b) -> a -> b
$ String
"Json.Decode.map "
                                         forall a. [a] -> [a] -> [a]
++ String
cname
                                         forall a. [a] -> [a] -> [a]
++ String
" ("
                                         forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (Maybe ETypeName -> Bool -> [(String, EType)] -> [String]
parseRecords forall a. Maybe a
Nothing Bool
False [(String, EType)]
args)
                                         forall a. [a] -> [a] -> [a]
++ String
")"

            mkDecoder String
cname (Anonymous [EType]
args) = String -> String
lazy forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ( String
decodeFunction
                                                   forall a. a -> [a] -> [a]
: String
cname
                                                   forall a. a -> [a] -> [a]
: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\EType
t' Int
i -> String
"(" forall a. [a] -> [a] -> [a]
++ EType -> Int -> String
jsonParserForIndexedType EType
t' Int
i forall a. [a] -> [a] -> [a]
++ String
")") [EType]
args [Int
0..]
                                                   )
                where decodeFunction :: String
decodeFunction = case 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" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
                      jsonParserForIndexedType :: EType -> Int -> String
                      jsonParserForIndexedType :: EType -> Int -> String
jsonParserForIndexedType EType
t' Int
i | forall (t :: * -> *) a. Foldable t => t a -> Int
length [EType]
args forall a. Ord a => a -> a -> Bool
<= Int
1 = EType -> String
jsonParserForType EType
t'
                                                    | Bool
otherwise = String
"Json.Decode.index " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ EType -> String
jsonParserForType EType
t' forall a. [a] -> [a] -> [a]
++ String
")"
    where
      funcname :: ETypeName -> String
funcname ETypeName
name = String
"jsonDec" forall a. [a] -> [a] -> [a]
++ ETypeName -> String
et_name ETypeName
name
      prependTypes :: String -> ETypeName -> [String]
prependTypes String
str = forall a b. (a -> b) -> [a] -> [b]
map (\ETVar
tv -> String
str forall a. [a] -> [a] -> [a]
++ ETVar -> String
tv_name ETVar
tv) 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 forall a. [a] -> [a] -> [a]
++ String
" : " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
" -> " (String -> ETypeName -> [String]
prependTypes String
"Json.Decode.Decoder " ETypeName
name forall a. [a] -> [a] -> [a]
++ [ETypeName -> String
decoderTypeEnd ETypeName
name])
      decoderTypeEnd :: ETypeName -> String
decoderTypeEnd ETypeName
name = [String] -> String
unwords (String
"Json.Decode.Decoder" forall a. a -> [a] -> [a]
: String
"(" forall a. a -> [a] -> [a]
: ETypeName -> String
et_name ETypeName
name forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ETVar -> String
tv_name (ETypeName -> [ETVar]
et_args ETypeName
name) forall a. [a] -> [a] -> [a]
++ [String
")"])
      makeName :: ETypeName -> String
makeName ETypeName
name = [String] -> String
unwords (ETypeName -> String
funcname ETypeName
name forall a. a -> [a] -> [a]
: String -> ETypeName -> [String]
prependTypes String
"localDecoder_" ETypeName
name)
      lazy :: String -> String
lazy String
decoder = String
"Json.Decode.lazy (\\_ -> " forall a. [a] -> [a] -> [a]
++ String
decoder 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_" 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" forall a. [a] -> [a] -> [a]
++ String
c
      ETyApp (ETyCon (ETCon String
"List")) EType
t' -> String
"(Json.Encode.list " forall a. [a] -> [a] -> [a]
++ Bool -> [Int] -> EType -> String
jsonSerForType' Bool
omitnull [Int]
ns EType
t' 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 (" forall a. [a] -> [a] -> [a]
++ Bool -> [Int] -> EType -> String
jsonSerForType' Bool
omitnull [Int]
ns EType
t' forall a. [a] -> [a] -> [a]
++ String
"))"
      ETyApp (ETyCon (ETCon String
"Set")) EType
t' -> String
"(encodeSet " forall a. [a] -> [a] -> [a]
++ Bool -> [Int] -> EType -> String
jsonSerForType' Bool
omitnull [Int]
ns EType
t' forall a. [a] -> [a] -> [a]
++ String
")"
      ETyApp (ETyApp (ETyCon (ETCon String
"Dict")) (ETyCon (ETCon String
"String"))) EType
value -> String
"(Json.Encode.dict identity (" forall a. [a] -> [a] -> [a]
++ Bool -> [Int] -> EType -> String
jsonSerForType' Bool
omitnull [Int]
ns EType
value forall a. [a] -> [a] -> [a]
++ String
"))"
      ETyApp (ETyApp (ETyCon (ETCon String
"Dict")) EType
key) EType
value -> String
"(encodeMap (" forall a. [a] -> [a] -> [a]
++ Bool -> [Int] -> EType -> String
jsonSerForType' Bool
omitnull [Int]
ns EType
key forall a. [a] -> [a] -> [a]
++ String
") (" forall a. [a] -> [a] -> [a]
++ Bool -> [Int] -> EType -> String
jsonSerForType' Bool
omitnull [Int]
ns EType
value forall a. [a] -> [a] -> [a]
++ String
"))"
      EType
_ ->
          case EType -> [EType]
unpackTupleType EType
ty of
            [] -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"This should never happen. Failed to unpackTupleType: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show EType
ty
            [EType
x] ->
                case EType -> [EType]
unpackToplevelConstr EType
x of
                  (EType
y : [EType]
ys) ->
                      String
"(" forall a. [a] -> [a] -> [a]
++ Bool -> [Int] -> EType -> String
jsonSerForType' Bool
omitnull [Int]
ns EType
y forall a. [a] -> [a] -> [a]
++ String
" "
                      forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map (\EType
t' -> String
"(" forall a. [a] -> [a] -> [a]
++ Bool -> [Int] -> EType -> String
jsonSerForType' Bool
omitnull [Int]
ns EType
t' forall a. [a] -> [a] -> [a]
++ String
")") [EType]
ys)
                      forall a. [a] -> [a] -> [a]
++ String
")"
                  [EType]
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Do suitable json serialiser found for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show EType
ty
            [EType]
xs ->
                let ([Int]
ns', [Int]
rest) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [EType]
xs) [Int]
ns
                    tupleArgsV :: [(EType, Int)]
tupleArgsV = forall a b. [a] -> [b] -> [(a, b)]
zip [EType]
xs [Int]
ns'
                    tupleArgs :: String
tupleArgs =
                        forall a. [a] -> [[a]] -> [a]
intercalate String
"," forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(EType
_, Int
v) -> String
"t" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
v) [(EType, Int)]
tupleArgsV
                in String
"(\\(" forall a. [a] -> [a] -> [a]
++ String
tupleArgs forall a. [a] -> [a] -> [a]
++ String
") -> Json.Encode.list identity [" forall a. [a] -> [a] -> [a]
++  forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall a b. (a -> b) -> [a] -> [b]
map (\(EType
t', Int
idx) -> String
"(" forall a. [a] -> [a] -> [a]
++ Bool -> [Int] -> EType -> String
jsonSerForType' Bool
omitnull [Int]
rest EType
t' forall a. [a] -> [a] -> [a]
++ String
") t" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
idx) [(EType, Int)]
tupleArgsV) 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 forall a. [a] -> [a] -> [a]
++  String
" = " forall a. [a] -> [a] -> [a]
++ EType -> String
jsonSerForType EType
ty 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 forall a. [a] -> [a] -> [a]
++ String
" =\n   " forall a. [a] -> [a] -> [a]
++ EType -> String
jsonSerForType EType
fldType forall a. [a] -> [a] -> [a]
++ String
" val." 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 forall a. [a] -> [a] -> [a]
++ String
" =\n   Json.Encode.object\n   ["
          forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n   ," (forall a b. (a -> b) -> [a] -> [b]
map (\(String
fldName, EType
fldType) -> String
" (\"" forall a. [a] -> [a] -> [a]
++ String
fldName forall a. [a] -> [a] -> [a]
++ String
"\", " forall a. [a] -> [a] -> [a]
++ EType -> String
jsonSerForType EType
fldType forall a. [a] -> [a] -> [a]
++ String
" val." forall a. [a] -> [a] -> [a]
++ String -> String
fixReserved String
fldName forall a. [a] -> [a] -> [a]
++ String
")") [(String, EType)]
fields)
          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 -> 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", forall a. Show a => a -> String
show String
k, 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 forall a. [a] -> [a] -> [a]
++ String
" "
                    forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map (\ETVar
tv -> String
"localEncoder_" forall a. [a] -> [a] -> [a]
++ ETVar -> String
tv_name ETVar
tv) forall a b. (a -> b) -> a -> b
$ ETypeName -> [ETVar]
et_args ETypeName
name)
                    forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ String -> String
cap String
oname  forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall {t :: * -> *} {a}. Foldable t => t a -> String
argList [EType]
args forall a. [a] -> [a] -> [a]
++ 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 forall a. [a] -> [a] -> [a]
++ String
" =")
                forall a. a -> [a] -> [a]
: String
"    let keyval v = case v of"
                forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Int -> a -> [a]
replicate Int
12 Char
' ' forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SumTypeConstructor -> String
mkcase) [SumTypeConstructor]
os
                forall a. [a] -> [a] -> [a]
++ [ 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 forall a. [a] -> [a] -> [a]
++ String
" ="
                , String
"    case val of"
                ] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\(String
o, a
n) -> forall a. Int -> a -> [a]
replicate Int
8 Char
' ' forall a. [a] -> [a] -> [a]
++ String
o forall a. [a] -> [a] -> [a]
++ String
" -> Json.Encode.string " forall a. [a] -> [a] -> [a]
++ 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)) = forall a. Int -> a -> [a]
replicate Int
8 Char
' ' forall a. [a] -> [a] -> [a]
++ String -> String
cap String
cname forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall {t :: * -> *} {a}. Foldable t => t a -> String
argList [EType]
args forall a. [a] -> [a] -> [a]
++ String
" -> (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
oname forall a. [a] -> [a] -> [a]
++ String
", encodeValue (" forall a. [a] -> [a] -> [a]
++ [EType] -> String
mkEncodeList [EType]
args forall a. [a] -> [a] -> [a]
++ String
"))"
              mkcase (STC String
cname String
oname (Named [(String, EType)]
args)) = forall a. Int -> a -> [a]
replicate Int
8 Char
' ' forall a. [a] -> [a] -> [a]
++ String -> String
cap String
cname forall a. [a] -> [a] -> [a]
++ String
" vs -> (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
oname forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ [(String, EType)] -> String
mkEncodeObject [(String, EType)]
args forall a. [a] -> [a] -> [a]
++ String
")"
              argList :: t a -> String
argList t a
a = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> String
"v" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i ) [Int
1 .. 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 = forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
n a
a -> a -> String
f a
a forall a. [a] -> [a] -> [a]
++ String
" v" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n)  ([Int
1..] :: [Int])
              mkEncodeObject :: [(String, EType)] -> String
mkEncodeObject [(String, EType)]
args = String
"encodeObject [" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map (\(String
n,EType
t) -> String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
n forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ EType -> String
jsonSerForType EType
t forall a. [a] -> [a] -> [a]
++ String
" vs." forall a. [a] -> [a] -> [a]
++ String -> String
fixReserved String
n forall a. [a] -> [a] -> [a]
++ String
")") [(String, EType)]
args) forall a. [a] -> [a] -> [a]
++ String
"]"
              mkEncodeList :: [EType] -> String
mkEncodeList [EType
arg] = EType -> String
jsonSerForType EType
arg forall a. [a] -> [a] -> [a]
++ String
" v1"
              mkEncodeList [EType]
args =  String
"Json.Encode.list identity [" forall a. [a] -> [a] -> [a]
++ forall a. (a -> String) -> [a] -> String
numargs EType -> String
jsonSerForType [EType]
args forall a. [a] -> [a] -> [a]
++ String
"]"
    where
      fname :: ETypeName -> String
fname ETypeName
name = String
"jsonEnc" forall a. [a] -> [a] -> [a]
++ ETypeName -> String
et_name ETypeName
name
      makeType :: ETypeName -> String
makeType ETypeName
name = ETypeName -> String
fname ETypeName
name forall a. [a] -> [a] -> [a]
++ String
" : " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
" -> " (forall a b. (a -> b) -> [a] -> [b]
map (String -> String
mkLocalEncoder forall b c a. (b -> c) -> (a -> b) -> a -> c
. ETVar -> String
tv_name) (ETypeName -> [ETVar]
et_args ETypeName
name) forall a. [a] -> [a] -> [a]
++ [[String] -> String
unwords (ETypeName -> String
et_name ETypeName
name forall a. a -> [a] -> [a]
: 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
"(" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
" -> Value)"
      makeName :: ETypeName -> Bool -> String
makeName ETypeName
name Bool
newtyping =
           ETypeName -> String
makeType ETypeName
name forall a. [a] -> [a] -> [a]
++ String
"\n"
           forall a. [a] -> [a] -> [a]
++ ETypeName -> String
fname ETypeName
name forall a. [a] -> [a] -> [a]
++ String
" "
           forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map (\ETVar
tv -> String
"localEncoder_" forall a. [a] -> [a] -> [a]
++ ETVar -> String
tv_name ETVar
tv) forall a b. (a -> b) -> a -> b
$ ETypeName -> [ETVar]
et_args ETypeName
name)
           forall a. [a] -> [a] -> [a]
++ if Bool
newtyping
                  then String
" (" forall a. [a] -> [a] -> [a]
++ ETypeName -> String
et_name ETypeName
name 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 forall a. [a] -> [a] -> [a]
++ String
" =") forall a. a -> [a] -> [a]
: String
"    case val of" forall a. a -> [a] -> [a]
: 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)) =
          forall a. Int -> a -> [a]
replicate Int
8 Char
' '
            forall a. [a] -> [a] -> [a]
++ String -> String
cap String
cname
            forall a. [a] -> [a] -> [a]
++ String
" "
            forall a. [a] -> [a] -> [a]
++ forall {t :: * -> *} {a}. Foldable t => t a -> String
argList [EType]
args
            forall a. [a] -> [a] -> [a]
++ String
" -> "
            forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
oname
        mkcase SumTypeConstructor
_ =
          forall a. HasCallStack => String -> a
error String
"stringSerForSimpleAdt.mkcase: Expecting an Anonymous case"
        argList :: t a -> String
argList t a
a = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> String
"v" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i) [Int
1 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
a]
    ETypeDef
_ -> forall a. HasCallStack => String -> a
error String
"stringSerForSimpleAdt only works with ETypeSum"
  where
    fname :: ETypeName -> String
fname ETypeName
name = String
"stringEnc" forall a. [a] -> [a] -> [a]
++ ETypeName -> String
et_name ETypeName
name
    makeType :: ETypeName -> String
makeType ETypeName
name =
      ETypeName -> String
fname ETypeName
name
        forall a. [a] -> [a] -> [a]
++ String
" : "
        forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate
          String
" -> "
          ([[String] -> String
unwords (ETypeName -> String
et_name ETypeName
name forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ETVar -> String
tv_name (ETypeName -> [ETVar]
et_args ETypeName
name))] forall a. [a] -> [a] -> [a]
++ [String
"String"])
    makeName :: ETypeName -> Bool -> String
makeName ETypeName
name Bool
newtyping =
      ETypeName -> String
makeType ETypeName
name
        forall a. [a] -> [a] -> [a]
++ String
"\n"
        forall a. [a] -> [a] -> [a]
++ ETypeName -> String
fname ETypeName
name
        forall a. [a] -> [a] -> [a]
++ String
" "
        forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map (\ETVar
tv -> String
"localEncoder_" forall a. [a] -> [a] -> [a]
++ ETVar -> String
tv_name ETVar
tv) forall a b. (a -> b) -> a -> b
$ ETypeName -> [ETVar]
et_args ETypeName
name)
        forall a. [a] -> [a] -> [a]
++ if Bool
newtyping
          then String
" (" forall a. [a] -> [a] -> [a]
++ ETypeName -> String
et_name ETypeName
name 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
        forall a. [a] -> [a] -> [a]
++ String
"\n"
        forall a. [a] -> [a] -> [a]
++ ETypeName -> String
makeName ETypeName
name
        forall a. [a] -> [a] -> [a]
++ String
" s =\n"
        forall a. [a] -> [a] -> [a]
++ [SumTypeConstructor] -> String
encodingDictionary [SumTypeConstructor]
opts
        forall a. [a] -> [a] -> [a]
++ String
"\n"
      where
        tab :: Int -> String -> String
tab Int
n String
s = forall a. Int -> a -> [a]
replicate Int
n Char
' ' forall a. [a] -> [a] -> [a]
++ String
s
        encodingDictionary :: [SumTypeConstructor] -> String
encodingDictionary [STC String
cname String
_ SumTypeFields
args] =
          String
"    " forall a. [a] -> [a] -> [a]
++ forall {p} {p} {a}. p -> p -> a
mkDecoder String
cname SumTypeFields
args
        encodingDictionary [SumTypeConstructor]
os =
          String
"    case s of\n"
            forall a. [a] -> [a] -> [a]
++ Int -> String -> String
tab Int
8 String
""
            forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate (String
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
8 Char
' ') (forall a b. (a -> b) -> [a] -> [b]
map SumTypeConstructor -> String
dictEntry [SumTypeConstructor]
os)
            forall a. [a] -> [a] -> [a]
++ String
"\n"
            forall a. [a] -> [a] -> [a]
++ Int -> String -> String
tab Int
8 String
"_ -> Nothing"
        dictEntry :: SumTypeConstructor -> String
dictEntry (STC String
cname String
oname SumTypeFields
_args) =
          forall a. Show a => a -> String
show String
oname forall a. [a] -> [a] -> [a]
++ String
" -> Just " forall a. [a] -> [a] -> [a]
++ String
cname
        mkDecoder :: p -> p -> a
mkDecoder p
_cname p
_ = forall a. HasCallStack => String -> a
error String
"impossible!"
    ETypeDef
_ -> forall a. HasCallStack => String -> a
error String
"impossible"
  where
    funcname :: ETypeName -> String
funcname ETypeName
name = String
"stringDec" forall a. [a] -> [a] -> [a]
++ ETypeName -> String
et_name ETypeName
name
    prependTypes :: String -> ETypeName -> [String]
prependTypes String
str = forall a b. (a -> b) -> [a] -> [b]
map (\ETVar
tv -> String
str forall a. [a] -> [a] -> [a]
++ ETVar -> String
tv_name ETVar
tv) 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
        forall a. [a] -> [a] -> [a]
++ String
" : "
        forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
" -> " ([String
"String"] forall a. [a] -> [a] -> [a]
++ [ETypeName -> String
decoderTypeEnd ETypeName
name])
    decoderTypeEnd :: ETypeName -> String
decoderTypeEnd ETypeName
name =
      [String] -> String
unwords (String
"Maybe" forall a. a -> [a] -> [a]
: ETypeName -> String
et_name ETypeName
name forall a. a -> [a] -> [a]
: 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 forall a. a -> [a] -> [a]
: String -> ETypeName -> [String]
prependTypes String
"localDecoder_" ETypeName
name)