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"