{-# LANGUAGE OverloadedStrings #-}

module Elminator.ELM.Render where

import Control.Monad.State.Lazy
import qualified Data.List as DL
import Data.String
import Data.Text as T hiding (foldr)

type CurrentPos = Int

type CurrentIndent = Int

type RenderM = State (CurrentIndent, CurrentPos, Text)

renderElm :: ElmSrc -> Text
renderElm :: ElmSrc -> Text
renderElm (ElmSrc [EDec]
decs) =
  let (CurrentIndent
_, CurrentIndent
_, Text
srcs) =
        forall s a. State s a -> s -> s
execState
          (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
             (\EDec
x -> do
                EDec -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderElmDec EDec
x
                StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderNL
                StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderNL
                StateT (CurrentIndent, CurrentIndent, Text) Identity ()
resetIndent)
             [EDec]
decs)
          (CurrentIndent
0, CurrentIndent
0, Text
"")
   in Text
srcs

renderText :: Text -> RenderM ()
renderText :: Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
t = do
  (CurrentIndent
ci, CurrentIndent
cp, Text
ct) <- forall s (m :: * -> *). MonadState s m => m s
get
  forall s (m :: * -> *). MonadState s m => s -> m ()
put (CurrentIndent
ci, CurrentIndent
cp forall a. Num a => a -> a -> a
+ Text -> CurrentIndent
T.length Text
t, [Text] -> Text
T.concat [Text
ct, Text
t])

renderIC :: RenderM () -> [a] -> (a -> RenderM ()) -> RenderM ()
renderIC :: forall a.
StateT (CurrentIndent, CurrentIndent, Text) Identity ()
-> [a]
-> (a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ())
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderIC StateT (CurrentIndent, CurrentIndent, Text) Identity ()
_ [] a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
renderIC StateT (CurrentIndent, CurrentIndent, Text) Identity ()
_ [a
t] a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
fn = a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
fn a
t
renderIC StateT (CurrentIndent, CurrentIndent, Text) Identity ()
s (a
t:[a]
tx) a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
fn = do
  a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
fn a
t
  forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall a b. (a -> b) -> a -> b
$
    (\a
x -> do
       StateT (CurrentIndent, CurrentIndent, Text) Identity ()
s
       a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
fn a
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [a]
tx

renderNL :: RenderM ()
renderNL :: StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderNL = do
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"\n"
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\(CurrentIndent
i, CurrentIndent
_, Text
t) -> (CurrentIndent
i, CurrentIndent
0, Text
t))

getCI :: RenderM Int
getCI :: RenderM CurrentIndent
getCI = do
  (CurrentIndent
i, CurrentIndent
_, Text
_) <- forall s (m :: * -> *). MonadState s m => m s
get
  forall (f :: * -> *) a. Applicative f => a -> f a
pure CurrentIndent
i

getCP :: RenderM Int
getCP :: RenderM CurrentIndent
getCP = do
  (CurrentIndent
_, CurrentIndent
p, Text
_) <- forall s (m :: * -> *). MonadState s m => m s
get
  forall (f :: * -> *) a. Applicative f => a -> f a
pure CurrentIndent
p

setCI :: Int -> RenderM ()
setCI :: CurrentIndent
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
setCI CurrentIndent
i = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\(CurrentIndent
_, CurrentIndent
p, Text
t) -> (CurrentIndent
i, CurrentIndent
p, Text
t))

resetIndent :: RenderM ()
resetIndent :: StateT (CurrentIndent, CurrentIndent, Text) Identity ()
resetIndent = CurrentIndent
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
setCI CurrentIndent
0

incIndent :: RenderM ()
incIndent :: StateT (CurrentIndent, CurrentIndent, Text) Identity ()
incIndent = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\(CurrentIndent
i, CurrentIndent
p, Text
t) -> (CurrentIndent
i forall a. Num a => a -> a -> a
+ CurrentIndent
1, CurrentIndent
p, Text
t))

renderCI :: RenderM ()
renderCI :: StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderCI = do
  CurrentIndent
i <- RenderM CurrentIndent
getCI
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText forall a b. (a -> b) -> a -> b
$ CurrentIndent -> Text
getIntend CurrentIndent
i

renderSpace :: RenderM ()
renderSpace :: StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace = Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
" "

renderElmDec :: EDec -> RenderM ()
renderElmDec :: EDec -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderElmDec (EType Text
name [Text]
targs ECons
cons_) = do
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderCI
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"type"
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
name
  if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
DL.null [Text]
targs)
    then StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  forall a.
StateT (CurrentIndent, CurrentIndent, Text) Identity ()
-> [a]
-> (a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ())
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderIC StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace [Text]
targs Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText
  case ECons
cons_ of
    ECons
EEmpty -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ECons
_ -> do
      StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace
      Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"="
      StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace
      ECons -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderCon ECons
cons_
      StateT (CurrentIndent, CurrentIndent, Text) Identity ()
resetIndent
renderElmDec (EFunc Text
name FSig
sig [Text]
fargs EExpr
expr) = do
  case FSig
sig of
    Just Text
s -> Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
name, Text
" : ", Text
s]
    FSig
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderNL
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderCI
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
name
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace
  forall a.
StateT (CurrentIndent, CurrentIndent, Text) Identity ()
-> [a]
-> (a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ())
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderIC StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace [Text]
fargs Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
" = "
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderNL
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
incIndent
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderCI
  EExpr -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderExp EExpr
expr
renderElmDec (EBinding EPattern
patt EExpr
expr) = do
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderNL
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderCI
  EPattern -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderPattern EPattern
patt
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
" = "
  EExpr -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderExp EExpr
expr

renderExp :: EExpr -> RenderM ()
renderExp :: EExpr -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderExp (ERec [EField]
fields) = do
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"{"
  forall a.
StateT (CurrentIndent, CurrentIndent, Text) Identity ()
-> [a]
-> (a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ())
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderIC (Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
", ") [EField]
fields EField -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderField
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"}"
  where
    renderField :: EField -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderField (Text
fname, EExpr
exp_) = do
      Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
fname
      Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
" = "
      EExpr -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderExp EExpr
exp_
renderExp (ELet [EDec]
decs EExpr
exp_) = do
  CurrentIndent
i0 <- RenderM CurrentIndent
getCI
  CurrentIndent
p <- RenderM CurrentIndent
getCP
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"let"
  CurrentIndent
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
setCI forall a b. (a -> b) -> a -> b
$ CurrentIndent
p forall a. Num a => a -> a -> a
+ CurrentIndent
1
  CurrentIndent
i <- RenderM CurrentIndent
getCI
  forall a.
StateT (CurrentIndent, CurrentIndent, Text) Identity ()
-> [a]
-> (a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ())
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderIC
    (do StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderNL
        StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderCI)
    [EDec]
decs
    EDec -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderElmDec
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderNL
  CurrentIndent
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
setCI (CurrentIndent
i forall a. Num a => a -> a -> a
- CurrentIndent
1)
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderCI
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"in"
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace
  EExpr -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderExp EExpr
exp_
  CurrentIndent
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
setCI CurrentIndent
i0
renderExp (ECase EExpr
expr [ECaseBranch]
branches) = do
  CurrentIndent
si <- RenderM CurrentIndent
getCI
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"case"
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace
  EExpr -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderExp EExpr
expr
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"of"
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderNL
  CurrentIndent
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
setCI (CurrentIndent
si forall a. Num a => a -> a -> a
+ CurrentIndent
1)
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderCI
  forall a.
StateT (CurrentIndent, CurrentIndent, Text) Identity ()
-> [a]
-> (a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ())
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderIC
    (do StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderNL
        StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderCI)
    [ECaseBranch]
branches
    ECaseBranch
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderCaseBranch
renderExp (EFuncApp EExpr
expr1 EExpr
expr2) = do
  EExpr -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderExp EExpr
expr1
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"("
  EExpr -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderExp EExpr
expr2
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
")"
renderExp (EInlineApp EExpr
op EExpr
expr1 EExpr
expr2) = do
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"("
  EExpr -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderExp EExpr
expr1
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
")"
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace
  EExpr -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderExp EExpr
op
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"("
  EExpr -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderExp EExpr
expr2
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
")"
renderExp (EName Text
n) = Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
n
renderExp (EList [EExpr]
l) = do
  CurrentIndent
i <- RenderM CurrentIndent
getCI
  CurrentIndent
p <- RenderM CurrentIndent
getCP
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"[ "
  forall a.
StateT (CurrentIndent, CurrentIndent, Text) Identity ()
-> [a]
-> (a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ())
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderIC
    (do StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderNL
        CurrentIndent
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
setCI CurrentIndent
p
        StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderCI
        Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
", ")
    [EExpr]
l
    EExpr -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderExp
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"]"
  CurrentIndent
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
setCI CurrentIndent
i
renderExp (ELiteral ELit
l) = ELit -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderLiteral ELit
l
renderExp (ETuple [EExpr]
l) = do
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"("
  forall a.
StateT (CurrentIndent, CurrentIndent, Text) Identity ()
-> [a]
-> (a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ())
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderIC (Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
", ") [EExpr]
l EExpr -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderExp
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
")"
renderExp (ELambda EExpr
expr) = do
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"(\\_ -> "
  EExpr -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderExp EExpr
expr
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
")"

renderLiteral :: ELit -> RenderM ()
renderLiteral :: ELit -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderLiteral (EStringL String
s) = Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText forall a b. (a -> b) -> a -> b
$ String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show String
s
renderLiteral (EIntL CurrentIndent
x) = Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText forall a b. (a -> b) -> a -> b
$ String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show CurrentIndent
x

renderCaseBranch :: ECaseBranch -> RenderM ()
renderCaseBranch :: ECaseBranch
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderCaseBranch (EPattern
pat, EExpr
expr) = do
  EPattern -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderPattern EPattern
pat
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
" -> "
  EExpr -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderExp EExpr
expr

renderPattern :: EPattern -> RenderM ()
renderPattern :: EPattern -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderPattern (EVarP Text
x) = Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
x
renderPattern (ELitP ELit
x) = ELit -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderLiteral ELit
x
renderPattern EPattern
EWildP = Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"_"
renderPattern (ETupleP [EPattern]
ps) = do
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"("
  forall a.
StateT (CurrentIndent, CurrentIndent, Text) Identity ()
-> [a]
-> (a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ())
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderIC (Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
",") [EPattern]
ps EPattern -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderPattern
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
")"
renderPattern (EListP [EPattern]
ps) = do
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"["
  forall a.
StateT (CurrentIndent, CurrentIndent, Text) Identity ()
-> [a]
-> (a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ())
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderIC (Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
",") [EPattern]
ps EPattern -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderPattern
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
"]"
renderPattern (EConsP Text
name [EPattern]
patterns) = do
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
name
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace
  forall a.
StateT (CurrentIndent, CurrentIndent, Text) Identity ()
-> [a]
-> (a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ())
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderIC StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace [EPattern]
patterns EPattern -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderPattern

getIntend :: Int -> Text
getIntend :: CurrentIndent -> Text
getIntend CurrentIndent
x = CurrentIndent -> Text -> Text
T.replicate CurrentIndent
x Text
" "

renderCon :: ECons -> RenderM ()
renderCon :: ECons -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderCon (ERecord Text
cname [ENamedField]
fds) = do
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
cname
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
" { "
  forall a.
StateT (CurrentIndent, CurrentIndent, Text) Identity ()
-> [a]
-> (a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ())
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderIC (Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
", ") [ENamedField]
fds (Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ENamedField -> Text
renderNamedField)
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
" } "
renderCon (EProduct Text
cname [Text]
fds) = do
  Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
cname
  StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderSpace
  forall a.
StateT (CurrentIndent, CurrentIndent, Text) Identity ()
-> [a]
-> (a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ())
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderIC (Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
" ") [Text]
fds Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText
renderCon (ESum [ECons]
cons_) = forall a.
StateT (CurrentIndent, CurrentIndent, Text) Identity ()
-> [a]
-> (a -> StateT (CurrentIndent, CurrentIndent, Text) Identity ())
-> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderIC (Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
" | ") [ECons]
cons_ ECons -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderCon
renderCon (ENullary Text
con) = Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
con
renderCon ECons
EEmpty = Text -> StateT (CurrentIndent, CurrentIndent, Text) Identity ()
renderText Text
""

renderNamedField :: ENamedField -> Text
renderNamedField :: ENamedField -> Text
renderNamedField (Text
name, Text
td) = [Text] -> Text
T.concat [Text
name, Text
" : ", Text
td]

-- | Elm code gen
type TArg = Text

type FArg = Text

type FSig = Maybe Text

newtype ElmSrc =
  ElmSrc [EDec]

data EDec
  = EFunc Text FSig [FArg] EExpr
  | EType Text [TArg] ECons
  | EBinding EPattern EExpr
  deriving (CurrentIndent -> EDec -> ShowS
[EDec] -> ShowS
EDec -> String
forall a.
(CurrentIndent -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EDec] -> ShowS
$cshowList :: [EDec] -> ShowS
show :: EDec -> String
$cshow :: EDec -> String
showsPrec :: CurrentIndent -> EDec -> ShowS
$cshowsPrec :: CurrentIndent -> EDec -> ShowS
Show, EDec -> EDec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EDec -> EDec -> Bool
$c/= :: EDec -> EDec -> Bool
== :: EDec -> EDec -> Bool
$c== :: EDec -> EDec -> Bool
Eq)

data ECons
  = ERecord Text [ENamedField]
  | EProduct Text [Text]
  | ESum [ECons]
  | ENullary Text
  | EEmpty
  deriving (CurrentIndent -> ECons -> ShowS
[ECons] -> ShowS
ECons -> String
forall a.
(CurrentIndent -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ECons] -> ShowS
$cshowList :: [ECons] -> ShowS
show :: ECons -> String
$cshow :: ECons -> String
showsPrec :: CurrentIndent -> ECons -> ShowS
$cshowsPrec :: CurrentIndent -> ECons -> ShowS
Show, ECons -> ECons -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ECons -> ECons -> Bool
$c/= :: ECons -> ECons -> Bool
== :: ECons -> ECons -> Bool
$c== :: ECons -> ECons -> Bool
Eq)

type ENamedField = (Text, Text)

data EExpr
  = ECase EExpr [ECaseBranch]
  | EFuncApp EExpr EExpr
  | EInlineApp EExpr EExpr EExpr
  | EName Text
  | EList [EExpr]
  | ELiteral ELit
  | ETuple [EExpr]
  | ELet [EDec] EExpr
  | ERec [EField]
  | ELambda EExpr
  deriving (EExpr -> EExpr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EExpr -> EExpr -> Bool
$c/= :: EExpr -> EExpr -> Bool
== :: EExpr -> EExpr -> Bool
$c== :: EExpr -> EExpr -> Bool
Eq, CurrentIndent -> EExpr -> ShowS
[EExpr] -> ShowS
EExpr -> String
forall a.
(CurrentIndent -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EExpr] -> ShowS
$cshowList :: [EExpr] -> ShowS
show :: EExpr -> String
$cshow :: EExpr -> String
showsPrec :: CurrentIndent -> EExpr -> ShowS
$cshowsPrec :: CurrentIndent -> EExpr -> ShowS
Show)

instance IsString EExpr where
  fromString :: String -> EExpr
fromString = Text -> EExpr
EName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

type EField = (Text, EExpr)

type EBinding = (EPattern, EExpr)

data ELit
  = EStringL String
  | EIntL Int
  deriving (ELit -> ELit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ELit -> ELit -> Bool
$c/= :: ELit -> ELit -> Bool
== :: ELit -> ELit -> Bool
$c== :: ELit -> ELit -> Bool
Eq, CurrentIndent -> ELit -> ShowS
[ELit] -> ShowS
ELit -> String
forall a.
(CurrentIndent -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ELit] -> ShowS
$cshowList :: [ELit] -> ShowS
show :: ELit -> String
$cshow :: ELit -> String
showsPrec :: CurrentIndent -> ELit -> ShowS
$cshowsPrec :: CurrentIndent -> ELit -> ShowS
Show)

type ECaseBranch = (EPattern, EExpr)

data EPattern
  = EVarP Text
  | EConsP Text [EPattern]
  | ELitP ELit
  | ETupleP [EPattern]
  | EListP [EPattern]
  | EWildP
  deriving (EPattern -> EPattern -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EPattern -> EPattern -> Bool
$c/= :: EPattern -> EPattern -> Bool
== :: EPattern -> EPattern -> Bool
$c== :: EPattern -> EPattern -> Bool
Eq, CurrentIndent -> EPattern -> ShowS
[EPattern] -> ShowS
EPattern -> String
forall a.
(CurrentIndent -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EPattern] -> ShowS
$cshowList :: [EPattern] -> ShowS
show :: EPattern -> String
$cshow :: EPattern -> String
showsPrec :: CurrentIndent -> EPattern -> ShowS
$cshowsPrec :: CurrentIndent -> EPattern -> ShowS
Show)