{-# 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) =
        State (CurrentIndent, CurrentIndent, Text) ()
-> (CurrentIndent, CurrentIndent, Text)
-> (CurrentIndent, CurrentIndent, Text)
forall s a. State s a -> s -> s
execState
          ((EDec -> State (CurrentIndent, CurrentIndent, Text) ())
-> [EDec] -> State (CurrentIndent, CurrentIndent, Text) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
             (\EDec
x -> do
                EDec -> State (CurrentIndent, CurrentIndent, Text) ()
renderElmDec EDec
x
                State (CurrentIndent, CurrentIndent, Text) ()
renderNL
                State (CurrentIndent, CurrentIndent, Text) ()
renderNL
                State (CurrentIndent, CurrentIndent, Text) ()
resetIndent)
             [EDec]
decs)
          (CurrentIndent
0, CurrentIndent
0, Text
"")
   in Text
srcs

renderText :: Text -> RenderM ()
renderText :: Text -> State (CurrentIndent, CurrentIndent, Text) ()
renderText Text
t = do
  (CurrentIndent
ci, CurrentIndent
cp, Text
ct) <- StateT
  (CurrentIndent, CurrentIndent, Text)
  Identity
  (CurrentIndent, CurrentIndent, Text)
forall s (m :: * -> *). MonadState s m => m s
get
  (CurrentIndent, CurrentIndent, Text)
-> State (CurrentIndent, CurrentIndent, Text) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (CurrentIndent
ci, CurrentIndent
cp CurrentIndent -> CurrentIndent -> CurrentIndent
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.
State (CurrentIndent, CurrentIndent, Text) ()
-> [a]
-> (a -> State (CurrentIndent, CurrentIndent, Text) ())
-> State (CurrentIndent, CurrentIndent, Text) ()
renderIC State (CurrentIndent, CurrentIndent, Text) ()
_ [] a -> State (CurrentIndent, CurrentIndent, Text) ()
_ = () -> State (CurrentIndent, CurrentIndent, Text) ()
forall a.
a -> StateT (CurrentIndent, CurrentIndent, Text) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
renderIC State (CurrentIndent, CurrentIndent, Text) ()
_ [a
t] a -> State (CurrentIndent, CurrentIndent, Text) ()
fn = a -> State (CurrentIndent, CurrentIndent, Text) ()
fn a
t
renderIC State (CurrentIndent, CurrentIndent, Text) ()
s (a
t:[a]
tx) a -> State (CurrentIndent, CurrentIndent, Text) ()
fn = do
  a -> State (CurrentIndent, CurrentIndent, Text) ()
fn a
t
  [State (CurrentIndent, CurrentIndent, Text) ()]
-> State (CurrentIndent, CurrentIndent, Text) ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([State (CurrentIndent, CurrentIndent, Text) ()]
 -> State (CurrentIndent, CurrentIndent, Text) ())
-> [State (CurrentIndent, CurrentIndent, Text) ()]
-> State (CurrentIndent, CurrentIndent, Text) ()
forall a b. (a -> b) -> a -> b
$
    (\a
x -> do
       State (CurrentIndent, CurrentIndent, Text) ()
s
       a -> State (CurrentIndent, CurrentIndent, Text) ()
fn a
x) (a -> State (CurrentIndent, CurrentIndent, Text) ())
-> [a] -> [State (CurrentIndent, CurrentIndent, Text) ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [a]
tx

renderNL :: RenderM ()
renderNL :: State (CurrentIndent, CurrentIndent, Text) ()
renderNL = do
  Text -> State (CurrentIndent, CurrentIndent, Text) ()
renderText Text
"\n"
  ((CurrentIndent, CurrentIndent, Text)
 -> (CurrentIndent, CurrentIndent, Text))
-> State (CurrentIndent, CurrentIndent, Text) ()
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
_) <- StateT
  (CurrentIndent, CurrentIndent, Text)
  Identity
  (CurrentIndent, CurrentIndent, Text)
forall s (m :: * -> *). MonadState s m => m s
get
  CurrentIndent -> RenderM CurrentIndent
forall a.
a -> StateT (CurrentIndent, CurrentIndent, Text) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CurrentIndent
i

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

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

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

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

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

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

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

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

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

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

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

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

renderCon :: ECons -> RenderM ()
renderCon :: ECons -> State (CurrentIndent, CurrentIndent, Text) ()
renderCon (ERecord Text
cname [ENamedField]
fds) = do
  Text -> State (CurrentIndent, CurrentIndent, Text) ()
renderText Text
cname
  Text -> State (CurrentIndent, CurrentIndent, Text) ()
renderText Text
" { "
  State (CurrentIndent, CurrentIndent, Text) ()
-> [ENamedField]
-> (ENamedField -> State (CurrentIndent, CurrentIndent, Text) ())
-> State (CurrentIndent, CurrentIndent, Text) ()
forall a.
State (CurrentIndent, CurrentIndent, Text) ()
-> [a]
-> (a -> State (CurrentIndent, CurrentIndent, Text) ())
-> State (CurrentIndent, CurrentIndent, Text) ()
renderIC (Text -> State (CurrentIndent, CurrentIndent, Text) ()
renderText Text
", ") [ENamedField]
fds (Text -> State (CurrentIndent, CurrentIndent, Text) ()
renderText (Text -> State (CurrentIndent, CurrentIndent, Text) ())
-> (ENamedField -> Text)
-> ENamedField
-> State (CurrentIndent, CurrentIndent, Text) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ENamedField -> Text
renderNamedField)
  Text -> State (CurrentIndent, CurrentIndent, Text) ()
renderText Text
" } "
renderCon (EProduct Text
cname [Text]
fds) = do
  Text -> State (CurrentIndent, CurrentIndent, Text) ()
renderText Text
cname
  State (CurrentIndent, CurrentIndent, Text) ()
renderSpace
  State (CurrentIndent, CurrentIndent, Text) ()
-> [Text]
-> (Text -> State (CurrentIndent, CurrentIndent, Text) ())
-> State (CurrentIndent, CurrentIndent, Text) ()
forall a.
State (CurrentIndent, CurrentIndent, Text) ()
-> [a]
-> (a -> State (CurrentIndent, CurrentIndent, Text) ())
-> State (CurrentIndent, CurrentIndent, Text) ()
renderIC (Text -> State (CurrentIndent, CurrentIndent, Text) ()
renderText Text
" ") [Text]
fds Text -> State (CurrentIndent, CurrentIndent, Text) ()
renderText
renderCon (ESum [ECons]
cons_) = State (CurrentIndent, CurrentIndent, Text) ()
-> [ECons]
-> (ECons -> State (CurrentIndent, CurrentIndent, Text) ())
-> State (CurrentIndent, CurrentIndent, Text) ()
forall a.
State (CurrentIndent, CurrentIndent, Text) ()
-> [a]
-> (a -> State (CurrentIndent, CurrentIndent, Text) ())
-> State (CurrentIndent, CurrentIndent, Text) ()
renderIC (Text -> State (CurrentIndent, CurrentIndent, Text) ()
renderText Text
" | ") [ECons]
cons_ ECons -> State (CurrentIndent, CurrentIndent, Text) ()
renderCon
renderCon (ENullary Text
con) = Text -> State (CurrentIndent, CurrentIndent, Text) ()
renderText Text
con
renderCon ECons
EEmpty = Text -> State (CurrentIndent, CurrentIndent, Text) ()
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 -> String -> String
[EDec] -> String -> String
EDec -> String
(CurrentIndent -> EDec -> String -> String)
-> (EDec -> String) -> ([EDec] -> String -> String) -> Show EDec
forall a.
(CurrentIndent -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: CurrentIndent -> EDec -> String -> String
showsPrec :: CurrentIndent -> EDec -> String -> String
$cshow :: EDec -> String
show :: EDec -> String
$cshowList :: [EDec] -> String -> String
showList :: [EDec] -> String -> String
Show, EDec -> EDec -> Bool
(EDec -> EDec -> Bool) -> (EDec -> EDec -> Bool) -> Eq EDec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EDec -> EDec -> Bool
== :: EDec -> EDec -> Bool
$c/= :: EDec -> EDec -> Bool
/= :: EDec -> EDec -> Bool
Eq)

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

instance IsString EExpr where
  fromString :: String -> EExpr
fromString = Text -> EExpr
EName (Text -> EExpr) -> (String -> Text) -> String -> EExpr
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
(ELit -> ELit -> Bool) -> (ELit -> ELit -> Bool) -> Eq ELit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ELit -> ELit -> Bool
== :: ELit -> ELit -> Bool
$c/= :: ELit -> ELit -> Bool
/= :: ELit -> ELit -> Bool
Eq, CurrentIndent -> ELit -> String -> String
[ELit] -> String -> String
ELit -> String
(CurrentIndent -> ELit -> String -> String)
-> (ELit -> String) -> ([ELit] -> String -> String) -> Show ELit
forall a.
(CurrentIndent -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: CurrentIndent -> ELit -> String -> String
showsPrec :: CurrentIndent -> ELit -> String -> String
$cshow :: ELit -> String
show :: ELit -> String
$cshowList :: [ELit] -> String -> String
showList :: [ELit] -> String -> String
Show)

type ECaseBranch = (EPattern, EExpr)

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