module Bricks.Expression
(
Expression (..)
, expression'source
, expression'discardSource
, Var (..)
, var'text
, var'to'str'static
, var'to'str'dynamic
, var'discardSource
, Str'Static (..)
, str'static'append
, str'static'discardSource
, str'static'to'dynamic
, Str'Dynamic (..)
, Str'1 (..)
, str'1'discardSource
, str'dynamic'append
, str'dynamic'normalize
, str'dynamic'discardSource
, str'dynamic'to'static
, InStr (..)
, inStr'to'strDynamic
, inStr'level
, inStr'dedent
, inStr'trim
, inStr'toList
, inStr'discardSource
, InStr'1 (..)
, inStr'1'toStrParts
, inStr'1'discardSource
, List (..)
, list'discardSource
, Dict (..)
, dict'discardSource
, DictBinding (..)
, dictBinding'discardSource
, Dot (..)
, expression'applyDots
, dot'discardSource
, Lambda (..)
, lambda'discardSource
, Param (..)
, param'discardSource
, DictPattern (..)
, dictPattern'discardSource
, DictPattern'1 (..)
, dictPattern'1'discardSource
, Apply (..)
, expression'applyArgs
, apply'discardSource
, Let (..)
, let'discardSource
, LetBinding (..)
, letBinding'discardSource
) where
import Bricks.Source
import Bricks.UnquotedString
import Bricks.Internal.List as List
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)
data Expression
= Expr'Var Var
| Expr'Str Str'Dynamic
| Expr'Str'Indented InStr
| Expr'List List
| Expr'Dict Dict
| Expr'Dot Dot
| Expr'Lambda Lambda
| Expr'Apply Apply
| Expr'Let Let
expression'source :: Expression -> Maybe SourceRange
expression'source =
\case
Expr'Var x -> var'source x
Expr'Str x -> strDynamic'source x
Expr'Str'Indented x -> inStr'source x
Expr'List x -> list'source x
Expr'Dict x -> dict'source x
Expr'Dot x -> dot'source x
Expr'Lambda x -> lambda'source x
Expr'Apply x -> apply'source x
Expr'Let x -> let'source x
expression'discardSource :: Expression -> Expression
expression'discardSource =
\case
Expr'Var x -> Expr'Var $ var'discardSource x
Expr'Str x -> Expr'Str $ str'dynamic'discardSource x
Expr'Str'Indented x -> Expr'Str'Indented $ inStr'discardSource x
Expr'List x -> Expr'List $ list'discardSource x
Expr'Dict x -> Expr'Dict $ dict'discardSource x
Expr'Dot x -> Expr'Dot $ dot'discardSource x
Expr'Lambda x -> Expr'Lambda $ lambda'discardSource x
Expr'Apply x -> Expr'Apply $ apply'discardSource x
Expr'Let x -> Expr'Let $ let'discardSource x
data Var =
Var
{ var'str :: UnquotedString
, var'source :: Maybe SourceRange
}
var'text :: Var -> Text
var'text (Var x _) = unquotedString'text x
var'to'str'static :: Var -> Str'Static
var'to'str'static x =
Str'Static (var'text x) (var'source x)
var'to'str'dynamic :: Var -> Str'Dynamic
var'to'str'dynamic =
str'static'to'dynamic . var'to'str'static
var'discardSource :: Var -> Var
var'discardSource x =
Var
{ var'str = var'str x
, var'source = Nothing
}
data Str'Static =
Str'Static
{ str'static'text :: Text
, str'static'source :: Maybe SourceRange
}
str'static'append :: Str'Static -> Str'Static -> Str'Static
str'static'append (Str'Static t1 s1) (Str'Static t2 s2) =
Str'Static (Text.append t1 t2) (sourceRangeMaybe'join s1 s2)
instance Semigroup Str'Static where (<>) = str'static'append
str'static'discardSource :: Str'Static -> Str'Static
str'static'discardSource x =
Str'Static
{ str'static'text = str'static'text x
, str'static'source = Nothing
}
data Str'Dynamic =
Str'Dynamic
{ strDynamic'toSeq :: Seq Str'1
, strDynamic'source :: Maybe SourceRange
}
str'dynamic'discardSource :: Str'Dynamic -> Str'Dynamic
str'dynamic'discardSource x =
Str'Dynamic
{ strDynamic'source = Nothing
, strDynamic'toSeq = fmap str'1'discardSource (strDynamic'toSeq x)
}
str'dynamic'append :: Str'Dynamic -> Str'Dynamic -> Str'Dynamic
str'dynamic'append (Str'Dynamic x1 y1) (Str'Dynamic x2 y2) =
Str'Dynamic (Seq.append x1 x2) (sourceRangeMaybe'join y1 y2)
instance Semigroup Str'Dynamic where (<>) = str'dynamic'append
data Str'1
= Str'1'Literal Str'Static
| Str'1'Antiquote Expression
str'1'discardSource :: Str'1 -> Str'1
str'1'discardSource =
\case
Str'1'Literal x -> Str'1'Literal (str'static'discardSource x)
Str'1'Antiquote x -> Str'1'Antiquote (expression'discardSource x)
str'dynamic'normalize :: Str'Dynamic -> Str'Dynamic
str'dynamic'normalize s =
s{ strDynamic'toSeq = f (strDynamic'toSeq s) }
where
f = Seq.fromList
. List.concat
. List.map (\case
Right xs -> [Str'1'Literal (List.foldr1 str'static'append xs)]
Left xs -> xs
)
. List.groupEither
. List.map (\case
Str'1'Literal x -> Right x
x -> Left x
)
. Seq.toList
data InStr =
InStr
{ inStr'toSeq :: Seq InStr'1
, inStr'source :: Maybe SourceRange
}
inStr'toList :: InStr -> [InStr'1]
inStr'toList =
Seq.toList . inStr'toSeq
inStr'discardSource :: InStr -> InStr
inStr'discardSource x =
InStr
{ inStr'toSeq = fmap inStr'1'discardSource (inStr'toSeq x)
, inStr'source = Nothing
}
data InStr'1 =
InStr'1
{ inStr'1'level :: Natural
, inStr'1'indentSource :: Maybe SourceRange
, inStr'1'str :: Seq Str'1
, inStr'1'lineBreak :: Maybe Str'Static
}
inStr'1'discardSource :: InStr'1 -> InStr'1
inStr'1'discardSource x =
InStr'1
{ inStr'1'level = inStr'1'level x
, inStr'1'indentSource = Nothing
, inStr'1'str = fmap str'1'discardSource (inStr'1'str x)
, inStr'1'lineBreak = fmap str'static'discardSource (inStr'1'lineBreak x)
}
inStr'1'toStrParts :: InStr'1 -> Seq Str'1
inStr'1'toStrParts x =
indent <> inStr'1'str x <> end
where
indent :: Seq Str'1
indent =
case inStr'1'level x of
0 -> Seq.empty
level ->
Seq.singleton . Str'1'Literal $
Str'Static
(Text.replicate (fromIntegral level) " ")
(inStr'1'indentSource x)
end :: Seq Str'1
end =
maybe Seq.empty (Seq.singleton . Str'1'Literal) $
inStr'1'lineBreak x
inStr'level :: InStr -> Natural
inStr'level =
maybe 0 id
. List.minimum
. catMaybes
. List.map (\x ->
if Seq.null (inStr'1'str x)
then Nothing
else Just (inStr'1'level x)
)
. inStr'toList
inStr'dedent :: InStr -> InStr
inStr'dedent x =
let
b = inStr'level x
in
x { inStr'toSeq = inStr'toSeq x <&>
(\l ->
l { inStr'1'level = let a = inStr'1'level l
in if a >= b then a b else 0
})
}
inStr'to'strDynamic :: InStr -> Str'Dynamic
inStr'to'strDynamic =
inStr'trim >>>
inStr'dedent >>>
(\inStr ->
Str'Dynamic
(Seq.concatMap inStr'1'toStrParts (inStr'toSeq inStr))
(inStr'source inStr)
) >>>
str'dynamic'normalize
inStr'trim :: InStr -> InStr
inStr'trim x =
x { inStr'toSeq = inStr'toSeq x
& Seq.trimWhile (Seq.null . inStr'1'str)
& Seq.adjustLast (\y -> y { inStr'1'lineBreak = Nothing })
}
str'dynamic'to'static :: Str'Dynamic -> Maybe Str'Static
str'dynamic'to'static x =
case Seq.toList (strDynamic'toSeq x) of
[] -> Just (Str'Static "" (strDynamic'source x))
[Str'1'Literal a] -> Just (a{ str'static'source = strDynamic'source x })
_ -> Nothing
str'static'to'dynamic :: Str'Static -> Str'Dynamic
str'static'to'dynamic x =
Str'Dynamic (Seq.singleton (Str'1'Literal x)) (str'static'source x)
data Lambda =
Lambda
{ lambda'head :: Param
, lambda'body :: Expression
, lambda'source :: Maybe SourceRange
}
lambda'discardSource :: Lambda -> Lambda
lambda'discardSource x =
Lambda
{ lambda'head = param'discardSource (lambda'head x)
, lambda'body = expression'discardSource (lambda'body x)
, lambda'source = Nothing
}
data Apply =
Apply
{ apply'func :: Expression
, apply'arg :: Expression
, apply'source :: Maybe SourceRange
}
expression'applyArgs
:: Expression
-> [Expression]
-> Expression
expression'applyArgs =
foldl f
where
f acc b =
Expr'Apply (Apply acc b src)
where
src =
sourceRangeMaybe'join
(expression'source acc)
(expression'source b)
apply'discardSource :: Apply -> Apply
apply'discardSource x =
Apply
{ apply'func = expression'discardSource (apply'func x)
, apply'arg = expression'discardSource (apply'arg x)
, apply'source = Nothing
}
data Param
= Param'Name Var
| Param'DictPattern DictPattern
| Param'Both Var DictPattern
param'discardSource :: Param -> Param
param'discardSource =
\case
Param'Name x ->
Param'Name (var'discardSource x)
Param'DictPattern x ->
Param'DictPattern (dictPattern'discardSource x)
Param'Both x y ->
Param'Both (var'discardSource x) (dictPattern'discardSource y)
data DictPattern =
DictPattern
{ dictPattern'items :: Seq DictPattern'1
, dictPattern'ellipsis :: Bool
}
dictPattern'discardSource :: DictPattern -> DictPattern
dictPattern'discardSource x =
DictPattern
{ dictPattern'items = fmap dictPattern'1'discardSource (dictPattern'items x)
, dictPattern'ellipsis = dictPattern'ellipsis x
}
data DictPattern'1 =
DictPattern'1
{ dictPattern'1'name :: Var
, dictPattern'1'default :: Maybe Expression
}
dictPattern'1'discardSource :: DictPattern'1 -> DictPattern'1
dictPattern'1'discardSource x =
DictPattern'1
{ dictPattern'1'name = var'discardSource (dictPattern'1'name x)
, dictPattern'1'default =
fmap expression'discardSource (dictPattern'1'default x)
}
data List =
List
{ list'expressions :: Seq Expression
, list'source :: Maybe SourceRange
}
list'discardSource :: List -> List
list'discardSource x =
List
{ list'expressions = fmap expression'discardSource (list'expressions x)
, list'source = Nothing
}
data Dict =
Dict
{ dict'rec :: Bool
, dict'bindings :: Seq DictBinding
, dict'source :: Maybe SourceRange
}
dict'discardSource :: Dict -> Dict
dict'discardSource x =
Dict
{ dict'rec = dict'rec x
, dict'bindings = fmap dictBinding'discardSource (dict'bindings x)
, dict'source = Nothing
}
data DictBinding
= DictBinding'Eq Expression Expression
| DictBinding'Inherit'Dict Expression (Seq Str'Static)
| DictBinding'Inherit'Var (Seq Var)
dictBinding'discardSource :: DictBinding -> DictBinding
dictBinding'discardSource =
\case
DictBinding'Eq a b ->
DictBinding'Eq
(expression'discardSource a)
(expression'discardSource b)
DictBinding'Inherit'Dict a xs ->
DictBinding'Inherit'Dict
(expression'discardSource a)
(fmap str'static'discardSource xs)
DictBinding'Inherit'Var xs ->
DictBinding'Inherit'Var
(fmap var'discardSource xs)
data Dot =
Dot
{ dot'dict :: Expression
, dot'key :: Expression
, dot'source :: Maybe SourceRange
}
expression'applyDots
:: Expression
-> [Expression]
-> Expression
expression'applyDots =
foldl f
where
f acc b =
Expr'Dot (Dot acc b src)
where
src =
sourceRangeMaybe'join
(expression'source acc)
(expression'source b)
dot'discardSource :: Dot -> Dot
dot'discardSource x =
Dot
{ dot'dict = expression'discardSource (dot'dict x)
, dot'key = expression'discardSource (dot'key x)
, dot'source = Nothing
}
data Let =
Let
{ let'bindings :: Seq LetBinding
, let'value :: Expression
, let'source :: Maybe SourceRange
}
let'discardSource :: Let -> Let
let'discardSource x =
Let
{ let'bindings = fmap letBinding'discardSource (let'bindings x)
, let'value = expression'discardSource (let'value x)
, let'source = Nothing
}
data LetBinding
= LetBinding'Eq Var Expression
| LetBinding'Inherit Expression (Seq Var)
letBinding'discardSource :: LetBinding -> LetBinding
letBinding'discardSource =
\case
LetBinding'Eq a b ->
LetBinding'Eq
(var'discardSource a)
(expression'discardSource b)
LetBinding'Inherit a b ->
LetBinding'Inherit
(expression'discardSource a)
(fmap var'discardSource b)
instance Show Expression where show = Text.unpack . show'expression
instance Show Var where show = Text.unpack . show'var
instance Show Str'Static where show = Text.unpack . show'str'static
instance Show Str'Dynamic where show = Text.unpack . show'str'dynamic
instance Show Str'1 where show = Text.unpack . show'str'1
instance Show InStr where show = Text.unpack . show'str'indented
instance Show InStr'1 where show = Text.unpack . show'str'indented'1
instance Show List where show = Text.unpack . show'list
instance Show Dict where show = Text.unpack . show'dict
instance Show DictBinding where show = Text.unpack . show'dictBinding
instance Show Dot where show = Text.unpack . show'dot
instance Show Lambda where show = Text.unpack . show'lambda
instance Show Param where show = Text.unpack . show'param
instance Show DictPattern where show = Text.unpack . show'dictPattern
instance Show DictPattern'1 where show = Text.unpack . show'dictPattern'1
instance Show Apply where show = Text.unpack . show'apply
instance Show Let where show = Text.unpack . show'let
instance Show LetBinding where show = Text.unpack . show'letBinding
show'expression :: Expression -> Text
show'expression =
\case
Expr'Var x -> show'var x
Expr'Str x -> show'str'dynamic x
Expr'Str'Indented x -> show'str'indented x
Expr'List x -> show'list x
Expr'Dict x -> show'dict x
Expr'Dot x -> show'dot x
Expr'Lambda x -> show'lambda x
Expr'Apply x -> show'apply x
Expr'Let x -> show'let x
source'comment :: Maybe SourceRange -> Maybe Text
source'comment =
fmap $ \x -> "{- " <> show'sourceRange x <> " -}"
show'var :: Var -> Text
show'var (Var x s) =
maybe "" (<> " ") (source'comment s) <>
"var " <> (Text.show @Text . unquotedString'text) x
show'str'static :: Str'Static -> Text
show'str'static (Str'Static x s) =
maybe "" (<> " ") (source'comment s) <>
Text.show @Text x
show'str'dynamic :: Str'Dynamic -> Text
show'str'dynamic (Str'Dynamic xs s) =
maybe "" (<> " ") (source'comment s) <>
"str [" <> Text.intercalateMap ", " show'str'1 xs <> "]"
show'str'1 :: Str'1 -> Text
show'str'1 =
\case
Str'1'Literal (Str'Static x s) ->
maybe "" (<> " ") (source'comment s) <> Text.show @Text x
Str'1'Antiquote x ->
"antiquote (" <> show'expression x <> ")"
show'str'indented :: InStr -> Text
show'str'indented x =
maybe "" (<> " ") (source'comment (inStr'source x)) <>
"str'indented [" <>
Text.intercalateMap ", " show'str'indented'1 (inStr'toSeq x) <>
"]"
show'str'indented'1 :: InStr'1 -> Text
show'str'indented'1 x =
"indent " <>
maybe "" (<> " ") (source'comment (inStr'1'indentSource x)) <>
Text.show @Natural (inStr'1'level x) <>
" [" <>
Text.intercalateMap ", " (Text.show @Str'1) (Seq.toList (inStr'1'str x)) <>
"] " <>
case inStr'1'lineBreak x of
Nothing -> "Nothing"
Just a -> "(Just " <> Text.show @Str'Static a <> ")"
show'list :: List -> Text
show'list (List xs s) =
maybe "" (<> " ") (source'comment s) <>
"list [" <> Text.intercalateMap ", " show'expression xs <> "]"
show'dict :: Dict -> Text
show'dict (Dict r bs s) =
maybe "" (<> " ") (source'comment s) <>
(if r then "rec'dict [" else "dict [") <>
Text.intercalateMap ", " show'dictBinding bs <> "]"
show'dictBinding :: DictBinding -> Text
show'dictBinding =
\case
DictBinding'Eq a b ->
"dict'eq (" <> show'expression a <> ") (" <> show'expression b <> ")"
DictBinding'Inherit'Var xs ->
"dict'inherit [" <>
Text.intercalateMap ", " (Text.show @Text . var'text) xs <> "]"
DictBinding'Inherit'Dict from xs ->
"dict'inherit'from (" <> show'expression from <> ") [" <>
Text.intercalateMap ", " show'str'static xs <> "]"
show'dot :: Dot -> Text
show'dot (Dot a b s) =
maybe "" (<> " ") (source'comment s) <>
"dot (" <> show'expression a <> ") (" <> show'expression b <> ")"
show'lambda :: Lambda -> Text
show'lambda (Lambda a b s) =
maybe "" (<> " ") (source'comment s) <>
"lambda (" <> show'param a <> ") (" <> show'expression b <> ")"
show'param :: Param -> Text
show'param =
\case
Param'Name a -> "param " <> Text.show @Text (var'text a)
Param'DictPattern b -> show'dictPattern b
Param'Both a b -> "param " <> Text.show @Text (var'text a) <>
" <> " <> show'dictPattern b
show'dictPattern :: DictPattern -> Text
show'dictPattern (DictPattern xs e) =
"pattern [" <> Text.intercalateMap ", " show'dictPattern'1 xs <> "]" <>
(if e then " <> ellipsis" else "")
show'dictPattern'1 :: DictPattern'1 -> Text
show'dictPattern'1 (DictPattern'1 a mb) =
"dict'param " <> Text.show @Text (var'text a) <>
maybe "" (\b -> " & def (" <> show'expression b <> ")") mb
show'apply :: Apply -> Text
show'apply (Apply a b s) =
maybe "" (<> " ") (source'comment s) <>
"apply (" <> show'expression a <> ") (" <> show'expression b <> ")"
show'let :: Let -> Text
show'let (Let xs y s) =
maybe "" (<> " ") (source'comment s) <>
"let'in [" <> Text.intercalateMap ", " show'letBinding xs <> "] (" <>
show'expression y <> ")"
show'letBinding :: LetBinding -> Text
show'letBinding =
\case
LetBinding'Eq a b ->
"let'eq " <> Text.show @Text (var'text a) <>
" (" <> show'expression b <> ")"
LetBinding'Inherit from xs ->
"let'inherit'from (" <> show'expression from <> ") [" <>
Text.intercalateMap ", " (Text.show @Text . var'text) xs <> "]"