{-| This module should not usually be imported. -}
module Elm.TyRender where

import           Elm.TyRep
import           Elm.Utils

import           Data.List

class ElmRenderable a where
    renderElm :: a -> String

instance ElmRenderable ETypeDef where
    renderElm :: ETypeDef -> String
renderElm ETypeDef
td =
        case ETypeDef
td of
          ETypeAlias EAlias
alias  -> forall a. ElmRenderable a => a -> String
renderElm EAlias
alias
          ETypeSum ESum
s        -> forall a. ElmRenderable a => a -> String
renderElm ESum
s
          ETypePrimAlias EPrimAlias
pa -> forall a. ElmRenderable a => a -> String
renderElm EPrimAlias
pa

instance ElmRenderable EType where
    renderElm :: EType -> String
renderElm EType
ty =
        case EType -> [EType]
unpackTupleType EType
ty of
          [EType
t] -> EType -> String
renderSingleTy EType
t
          [EType]
xs  -> String
"(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. ElmRenderable a => a -> String
renderElm [EType]
xs) forall a. [a] -> [a] -> [a]
++ String
")"
        where
          renderApp :: EType -> String
renderApp (ETyApp EType
l EType
r) = EType -> String
renderApp EType
l forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. ElmRenderable a => a -> String
renderElm EType
r
          renderApp EType
x            = forall a. ElmRenderable a => a -> String
renderElm EType
x
          renderSingleTy :: EType -> String
renderSingleTy EType
typ =
              case EType
typ of
                ETyVar ETVar
v   -> forall a. ElmRenderable a => a -> String
renderElm ETVar
v
                ETyCon ETCon
c   -> forall a. ElmRenderable a => a -> String
renderElm ETCon
c
                ETyTuple Int
_ -> forall a. HasCallStack => String -> a
error String
"Library Bug: This should never happen!"
                ETyApp EType
l EType
r -> String
"(" forall a. [a] -> [a] -> [a]
++ EType -> String
renderApp EType
l forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. ElmRenderable a => a -> String
renderElm EType
r forall a. [a] -> [a] -> [a]
++ String
")"

instance ElmRenderable ETCon where
    renderElm :: ETCon -> String
renderElm = ETCon -> String
tc_name

instance ElmRenderable ETVar where
    renderElm :: ETVar -> String
renderElm = ETVar -> String
tv_name

instance ElmRenderable ETypeName where
    renderElm :: ETypeName -> String
renderElm ETypeName
tyName =
        ETypeName -> String
et_name ETypeName
tyName forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a. ElmRenderable a => a -> String
renderElm forall a b. (a -> b) -> a -> b
$ ETypeName -> [ETVar]
et_args ETypeName
tyName)

instance ElmRenderable EAlias where
    renderElm :: EAlias -> String
renderElm EAlias
alias = (if EAlias -> Bool
ea_newtype EAlias
alias then String
withnewtype else String
nonewtype) forall a. [a] -> [a] -> [a]
++ String
body
        where
            withnewtype :: String
withnewtype = String
"type " forall a. [a] -> [a] -> [a]
++ forall a. ElmRenderable a => a -> String
renderElm (EAlias -> ETypeName
ea_name EAlias
alias) forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ ETypeName -> String
et_name (EAlias -> ETypeName
ea_name EAlias
alias)
            nonewtype :: String
nonewtype = String
"type alias " forall a. [a] -> [a] -> [a]
++ forall a. ElmRenderable a => a -> String
renderElm (EAlias -> ETypeName
ea_name EAlias
alias) forall a. [a] -> [a] -> [a]
++ String
" ="
            body :: String
body = String
"\n   { "
                forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n   , " (forall a b. (a -> b) -> [a] -> [b]
map (\(String
fld, EType
ty) -> String -> String
fixReserved String
fld forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. ElmRenderable a => a -> String
renderElm EType
ty) (EAlias -> [(String, EType)]
ea_fields EAlias
alias))
                forall a. [a] -> [a] -> [a]
++ String
"\n   }\n"

instance ElmRenderable ESum where
    renderElm :: ESum -> String
renderElm ESum
s =
        String
"type " forall a. [a] -> [a] -> [a]
++ forall a. ElmRenderable a => a -> String
renderElm (ESum -> ETypeName
es_name ESum
s) forall a. [a] -> [a] -> [a]
++ String
" =\n    "
        forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n    | " (forall a b. (a -> b) -> [a] -> [b]
map SumTypeConstructor -> String
mkOpt (ESum -> [SumTypeConstructor]
es_constructors ESum
s))
        forall a. [a] -> [a] -> [a]
++ String
"\n"
        where
          mkOpt :: SumTypeConstructor -> String
mkOpt (STC String
name String
_ (Named [(String, EType)]
types)) = String -> String
cap String
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
fld, EType
ty) -> String -> String
fixReserved String
fld forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. ElmRenderable a => a -> String
renderElm EType
ty) [(String, EType)]
types) forall a. [a] -> [a] -> [a]
++ String
"}"
          mkOpt (STC String
name String
_ (Anonymous [EType]
types)) =
              String -> String
cap String
name forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a. ElmRenderable a => a -> String
renderElm [EType]
types)

instance ElmRenderable EPrimAlias where
    renderElm :: EPrimAlias -> String
renderElm EPrimAlias
pa =
        String
"type alias " forall a. [a] -> [a] -> [a]
++ forall a. ElmRenderable a => a -> String
renderElm (EPrimAlias -> ETypeName
epa_name EPrimAlias
pa) forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ forall a. ElmRenderable a => a -> String
renderElm (EPrimAlias -> EType
epa_type EPrimAlias
pa) forall a. [a] -> [a] -> [a]
++ String
"\n"