module Bricks.Rendering
(
Render
, RenderContext (..)
, renderContext'default
, renderContext'terse
, render'expression
, render'expression'listContext
, render'expression'dotLeftContext
, render'expression'applyLeftContext
, render'expression'applyRightContext
, render'expression'inParens
, render'expression'dictKey
, render'var
, str'escape
, render'strStatic'unquotedIfPossible
, render'strStatic'quoted
, render'strDynamic'unquotedIfPossible
, render'strDynamic'quoted
, render'str'1
, render'str'indented
, render'str'indented'1
, render'list
, render'dict
, render'dictBinding
, render'dot
, render'lambda
, render'param
, render'dictPattern
, render'dictPattern'1
, render'apply
, render'let
, render'letBinding
) where
import Bricks.Expression
import Bricks.Keyword
import Bricks.UnquotedString
import Bricks.Internal.Prelude
import Bricks.Internal.Seq (Seq)
import qualified Bricks.Internal.Seq as Seq
import Bricks.Internal.Text (Text)
import qualified Bricks.Internal.Text as Text
import Prelude (Num (..), fromIntegral)
type Render a = RenderContext -> a -> Text
data RenderContext =
RenderContext
{ renderContext'indentStart :: Natural
, renderContext'indentStep :: Natural
, renderContext'lineBreaks :: Bool
}
renderContext'default :: RenderContext
renderContext'default =
RenderContext
{ renderContext'indentStart = 0
, renderContext'indentStep = 2
, renderContext'lineBreaks = True
}
renderContext'terse :: RenderContext
renderContext'terse =
renderContext'default
{ renderContext'lineBreaks = False
}
indentMore :: RenderContext -> RenderContext
indentMore x =
x{ renderContext'indentStart = renderContext'indentStart x +
renderContext'indentStep x }
indentation :: Natural -> Text
indentation n = Text.replicate (fromIntegral n) " "
str'escape :: Text -> Text
str'escape =
Text.replace "\"" "\\\"" .
Text.replace "${" "\\${" .
Text.replace "\n" "\\n" .
Text.replace "\r" "\\r" .
Text.replace "\t" "\\t" .
Text.replace "\\" "\\\\"
render'var :: Render Var
render'var _cx v = var'text v
render'strStatic'unquotedIfPossible :: Render Str'Static
render'strStatic'unquotedIfPossible _cx s =
let
x = str'static'text s
in
if text'canBeUnquoted x
then x
else render'strStatic'quoted _cx s
render'strStatic'quoted :: Render Str'Static
render'strStatic'quoted _cx x =
"\"" <> (str'escape . str'static'text) x <> "\""
render'strDynamic'unquotedIfPossible :: Render Str'Dynamic
render'strDynamic'unquotedIfPossible cx d =
case str'dynamic'to'static d of
Just s -> render'strStatic'unquotedIfPossible cx s
Nothing -> render'strDynamic'quoted cx d
render'strDynamic'quoted :: Render Str'Dynamic
render'strDynamic'quoted cx xs =
"\"" <> foldMap (render'str'1 cx) (strDynamic'toSeq xs) <> "\""
render'str'1 :: Render Str'1
render'str'1 cx =
\case
Str'1'Literal x -> (str'escape . str'static'text) x
Str'1'Antiquote x ->
let cx' = cx{ renderContext'lineBreaks = False }
in "${" <> render'expression cx' x <> "}"
render'str'indented :: Render InStr
render'str'indented cx (inStr'dedent . inStr'trim -> (InStr xs _)) =
"''\n" <>
Text.concatMap (render'str'indented'1 (indentMore cx)) xs <>
indentation (renderContext'indentStart cx) <> "''"
render'str'indented'1 :: Render InStr'1
render'str'indented'1 cx x =
indentation (inStr'1'level x + renderContext'indentStart cx) <>
Text.concatMap (render'str'1 cx) (inStr'1'str x) <>
"\n"
render'param :: Render Param
render'param cx =
\case
Param'Name a -> render'var cx a
Param'DictPattern b -> render'dictPattern cx b
Param'Both a b -> render'var cx a <> "@" <>
render'dictPattern cx b
render'dictPattern :: Render DictPattern
render'dictPattern cx (DictPattern bs e) =
if Seq.null xs
then "{ }"
else "{ " <> Text.intercalate ", " xs <> " }"
where
xs :: Seq Text
xs =
Seq.map (render'dictPattern'1 cx) bs <>
if e then Seq.singleton "..." else Seq.empty
render'dictPattern'1 :: Render DictPattern'1
render'dictPattern'1 cx =
\case
DictPattern'1 a Nothing -> render'var cx a
DictPattern'1 a (Just b) -> render'var cx a <> " ? " <>
render'expression cx b
render'lambda :: Render Lambda
render'lambda cx x =
render'param cx (lambda'head x) <> ":" <> sp <>
render'expression cx' (lambda'body x)
where
sp = if lbr
then "\n" <> indentation (renderContext'indentStart cx)
else " "
lbr = renderContext'lineBreaks cx
cx' = indentMore cx
render'apply :: Render Apply
render'apply cx x =
render'expression'applyLeftContext cx (apply'func x) <> " " <>
render'expression'applyRightContext cx (apply'arg x)
render'list :: Render List
render'list cx x =
if Seq.null (list'expressions x)
then "[ ]"
else "[" <> sp <> r (list'expressions x) <> "]"
where
r = Text.concat . fmap
(\y ->
(if lbr then indentation (renderContext'indentStart cx') else "") <>
render'expression'listContext cx' y <> sp
)
sp = if lbr then "\n" else " "
cx' = indentMore cx
lbr = renderContext'lineBreaks cx
render'dict :: Render Dict
render'dict cx x =
(if dict'rec x then keywordText keyword'rec <> " " else "") <>
if Seq.null (dict'bindings x)
then "{ }"
else "{" <> sp <> r (dict'bindings x) <>
(if lbr then indentation (renderContext'indentStart cx) else "") <> "}"
where
r = Text.concat . fmap
(\b ->
(if lbr then indentation (renderContext'indentStart cx') else "") <>
render'dictBinding cx' b <> sp
)
sp = if lbr then "\n" else " "
cx' = indentMore cx
lbr = renderContext'lineBreaks cx
render'dictBinding :: Render DictBinding
render'dictBinding cx =
\case
DictBinding'Eq a b ->
render'expression'dictKey cx a <> " = " <>
render'expression cx' b <> ";"
DictBinding'Inherit'Dict a b ->
"inherit " <> render'expression'inParens cx a <>
Text.concatMap
(\x ->
" " <> render'strStatic'unquotedIfPossible cx x
) b <>
";"
DictBinding'Inherit'Var a ->
"inherit" <> Text.concatMap (\x -> " " <> render'var cx x) a <> ";"
where
cx' = indentMore cx
render'dot :: Render Dot
render'dot cx x =
render'expression'dotLeftContext cx (dot'dict x) <> "." <>
render'expression'dictKey cx (dot'key x)
render'let :: Render Let
render'let cx x =
keywordText keyword'let <> sp <> r (let'bindings x) <>
(if lbr then indentation (renderContext'indentStart cx) else "") <>
keywordText keyword'in <> sp <>
(if lbr then indentation (renderContext'indentStart cx') else "") <>
render'expression cx' (let'value x)
where
r = Text.concat . fmap
(\b ->
(if lbr then indentation (renderContext'indentStart cx') else "") <>
render'letBinding cx' b <> sp
)
cx' = indentMore cx
sp = if lbr then "\n" else " "
lbr = renderContext'lineBreaks cx
render'letBinding :: Render LetBinding
render'letBinding cx =
\case
LetBinding'Eq a b ->
render'var cx a <> " = " <> render'expression cx' b <> ";"
LetBinding'Inherit a b ->
"inherit " <> render'expression'inParens cx a <>
Text.concatMap (\x -> " " <> render'var cx x) b <> ";"
where
cx' = indentMore cx
render'expression :: Render Expression
render'expression cx =
\case
Expr'Str x -> render'strDynamic'quoted cx x
Expr'Str'Indented x -> render'str'indented cx x
Expr'Dict x -> render'dict cx x
Expr'List x -> render'list cx x
Expr'Var x -> render'var cx x
Expr'Dot x -> render'dot cx x
Expr'Lambda x -> render'lambda cx x
Expr'Apply x -> render'apply cx x
Expr'Let x -> render'let cx x
render'expression'listContext :: Render Expression
render'expression'listContext cx x =
case x of
Expr'Lambda _ -> render'expression'inParens cx x
Expr'Apply _ -> render'expression'inParens cx x
Expr'Let _ -> render'expression'inParens cx x
_ -> render'expression cx x
render'expression'dotLeftContext :: Render Expression
render'expression'dotLeftContext = render'expression'listContext
render'expression'applyLeftContext :: Render Expression
render'expression'applyLeftContext cx x =
case x of
Expr'Lambda _ -> render'expression'inParens cx x
Expr'Let _ -> render'expression'inParens cx x
_ -> render'expression cx x
render'expression'applyRightContext :: Render Expression
render'expression'applyRightContext cx x =
case x of
Expr'Apply _ -> render'expression'inParens cx x
Expr'Let _ -> render'expression'inParens cx x
_ -> render'expression cx x
render'expression'inParens :: Render Expression
render'expression'inParens cx x =
"(" <> render'expression cx x <> ")"
render'expression'dictKey :: Render Expression
render'expression'dictKey cx = \case
Expr'Str x -> render'strDynamic'unquotedIfPossible cx x
x -> "${" <> render'expression cx x <> "}"