module Bricks.Rendering
(
Render
, render'expression
, render'expression'listContext
, render'expression'dotLeftContext
, render'expression'applyLeftContext
, render'expression'applyRightContext
, render'expression'inParens
, render'expression'dictKey
, str'escape
, render'strUnquoted
, render'strStatic'unquotedIfPossible
, render'strStatic'quoted
, render'strDynamic'unquotedIfPossible
, render'strDynamic'quoted
, render'inStr'1
, render'list
, render'dict
, render'dictBinding
, render'dot
, render'lambda
, render'param
, render'dictPattern
, render'dictPattern'1
, render'apply
, render'let
, render'letBinding
, render'with
, render'inherit
) where
import Bricks.Expression
import Bricks.IndentedString
import Bricks.Keyword
import Bricks.UnquotedString
import Bricks.Internal.Prelude
import qualified Bricks.Internal.Seq as Seq
import Bricks.Internal.Text (Text)
import qualified Bricks.Internal.Text as Text
import Prelude (fromIntegral)
type Render a = a -> Text
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'strUnquoted :: Render Str'Unquoted
render'strUnquoted = str'unquotedToStatic
render'strStatic'unquotedIfPossible :: Render Str'Static
render'strStatic'unquotedIfPossible x =
if str'canRenderUnquoted x then x else render'strStatic'quoted x
render'strStatic'quoted :: Render Str'Static
render'strStatic'quoted x =
"\"" <> str'escape x <> "\""
render'strDynamic'unquotedIfPossible :: Render Str'Dynamic
render'strDynamic'unquotedIfPossible d =
case str'dynamicToStatic d of
Just s -> render'strStatic'unquotedIfPossible s
Nothing -> render'strDynamic'quoted d
render'strDynamic'quoted :: Render Str'Dynamic
render'strDynamic'quoted xs =
"\"" <> foldMap r (strDynamic'toSeq xs) <> "\""
where
r = \case
Str'1'Literal x -> str'escape x
Str'1'Antiquote x -> "${" <> render'expression x <> "}"
render'inStr'1 :: Render InStr'1
render'inStr'1 (InStr'1 n xs) =
Text.replicate (fromIntegral n) " " <> foldMap r (strDynamic'toSeq xs)
where
r = \case
Str'1'Literal x -> x
Str'1'Antiquote x -> "${" <> render'expression x <> "}"
render'param :: Render Param
render'param =
\case
Param'Name a -> render'strUnquoted a
Param'DictPattern b -> render'dictPattern b
Param'Both a b -> render'strUnquoted a <> "@" <>
render'dictPattern b
render'dictPattern :: Render DictPattern
render'dictPattern (DictPattern bs e) =
if Seq.null xs
then "{ }"
else "{ " <> Text.intercalate ", " xs <> " }"
where
xs =
Seq.map render'dictPattern'1 bs <>
if e then Seq.singleton "..." else Seq.empty
render'dictPattern'1 :: Render DictPattern'1
render'dictPattern'1 =
\case
DictPattern'1 a Nothing -> render'strUnquoted a
DictPattern'1 a (Just b) -> render'strUnquoted a <> " ? " <> render'expression b
render'lambda :: Render Lambda
render'lambda (Lambda a b) =
render'param a <> ": " <> render'expression b
render'apply :: Render Apply
render'apply (Apply a b) =
render'expression'applyLeftContext a <> " " <>
render'expression'applyRightContext b
render'list :: Render List
render'list (List xs) =
"[ " <> r xs <> "]"
where
r = Text.concat . fmap (\x -> render'expression'listContext x <> " ")
render'dict :: Render Dict
render'dict =
\case
Dict False bs -> "{ " <> r bs <> "}"
Dict True bs -> "rec { " <> r bs <> "}"
where
r = Text.concat . fmap (\b -> render'dictBinding b <> "; ")
render'dictBinding :: Render DictBinding
render'dictBinding =
\case
DictBinding'Eq a b ->
render'expression'dictKey a <> " = " <> render'expression b
DictBinding'Inherit x ->
render'inherit x
render'dot :: Render Dot
render'dot (Dot a b) =
render'expression'dotLeftContext a <> "." <> render'expression'dictKey b
render'let :: Render Let
render'let (Let bs x) =
"let " <> r bs <> "in " <> render'expression x
where
r = Text.concat . fmap (\b -> render'letBinding b <> "; ")
render'letBinding :: Render LetBinding
render'letBinding =
\case
LetBinding'Eq a b ->
render'strStatic'unquotedIfPossible a <> " = " <> render'expression b
LetBinding'Inherit x ->
render'inherit x
render'inherit :: Render Inherit
render'inherit =
\case
Inherit Nothing xs -> "inherit" <> r xs
Inherit (Just a) xs -> "inherit (" <> render'expression a <> ")" <> r xs
where
r = foldMap (\x -> " " <> render'strStatic'unquotedIfPossible x)
render'with :: Render With
render'with (With a b) =
keywordText keyword'with <> " " <>
render'expression a <> "; " <>
render'expression b
render'expression :: Render Expression
render'expression =
\case
Expr'Str x -> render'strDynamic'quoted x
Expr'Dict x -> render'dict x
Expr'List x -> render'list x
Expr'Var x -> render'strUnquoted x
Expr'Dot x -> render'dot x
Expr'Lambda x -> render'lambda x
Expr'Apply x -> render'apply x
Expr'Let x -> render'let x
Expr'With x -> render'with x
render'expression'listContext :: Render Expression
render'expression'listContext x =
case x of
Expr'Lambda _ -> render'expression'inParens x
Expr'Apply _ -> render'expression'inParens x
Expr'Let _ -> render'expression'inParens x
Expr'With _ -> render'expression'inParens x
_ -> render'expression x
render'expression'dotLeftContext :: Render Expression
render'expression'dotLeftContext = render'expression'listContext
render'expression'applyLeftContext :: Render Expression
render'expression'applyLeftContext x =
case x of
Expr'Lambda _ -> render'expression'inParens x
Expr'Let _ -> render'expression'inParens x
Expr'With _ -> render'expression'inParens x
_ -> render'expression x
render'expression'applyRightContext :: Render Expression
render'expression'applyRightContext x =
case x of
Expr'Apply _ -> render'expression'inParens x
Expr'Let _ -> render'expression'inParens x
Expr'With _ -> render'expression'inParens x
_ -> render'expression x
render'expression'inParens :: Render Expression
render'expression'inParens x =
"(" <> render'expression x <> ")"
render'expression'dictKey :: Render Expression
render'expression'dictKey = \case
Expr'Str x -> render'strDynamic'unquotedIfPossible x
x -> "${" <> render'expression x <> "}"