{-| 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  -> EAlias -> String
forall a. ElmRenderable a => a -> String
renderElm EAlias
alias
          ETypeSum ESum
s        -> ESum -> String
forall a. ElmRenderable a => a -> String
renderElm ESum
s
          ETypePrimAlias EPrimAlias
pa -> EPrimAlias -> String
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
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((EType -> String) -> [EType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map EType -> String
forall a. ElmRenderable a => a -> String
renderElm [EType]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
        where
          renderApp :: EType -> String
renderApp (ETyApp EType
l EType
r) = EType -> String
renderApp EType
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ EType -> String
forall a. ElmRenderable a => a -> String
renderElm EType
r
          renderApp EType
x            = EType -> String
forall a. ElmRenderable a => a -> String
renderElm EType
x
          renderSingleTy :: EType -> String
renderSingleTy EType
typ =
              case EType
typ of
                ETyVar ETVar
v   -> ETVar -> String
forall a. ElmRenderable a => a -> String
renderElm ETVar
v
                ETyCon ETCon
c   -> ETCon -> String
forall a. ElmRenderable a => a -> String
renderElm ETCon
c
                ETyTuple Int
_ -> String -> String
forall a. HasCallStack => String -> a
error String
"Library Bug: This should never happen!"
                ETyApp EType
l EType
r -> String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ EType -> String
renderApp EType
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ EType -> String
forall a. ElmRenderable a => a -> String
renderElm EType
r String -> String -> String
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 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 -> String
forall a. ElmRenderable a => a -> String
renderElm ([ETVar] -> [String]) -> [ETVar] -> [String]
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) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
body
        where
            withnewtype :: String
withnewtype = String
"type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ETypeName -> String
forall a. ElmRenderable a => a -> String
renderElm (EAlias -> ETypeName
ea_name EAlias
alias) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ETypeName -> String
et_name (EAlias -> ETypeName
ea_name EAlias
alias)
            nonewtype :: String
nonewtype = String
"type alias " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ETypeName -> String
forall a. ElmRenderable a => a -> String
renderElm (EAlias -> ETypeName
ea_name EAlias
alias) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ="
            body :: String
body = String
"\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
fld, EType
ty) -> String -> String
fixReserved String
fld String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ EType -> String
forall a. ElmRenderable a => a -> String
renderElm EType
ty) (EAlias -> [(String, EType)]
ea_fields EAlias
alias))
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n   }\n"

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

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