{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
module JL.Printer where
import qualified Data.HashMap.Strict as HM
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import JL.Types
prettyType :: Type -> Text
prettyType :: Type -> Text
prettyType = Type -> Text
render
where
render :: Type -> Text
render = Type -> Text
go
where
go :: Type -> Text
go Type
t =
case Type
t of
Type
JSONType -> Text
"JSON"
VariableType (TypeVariable Int
n) -> [Text]
nameStream [Text] -> Int -> Text
forall a. [a] -> Int -> a
!! Int
n
FunctionType Type
a Type
b ->
(case Type
a of
FunctionType {} -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
go Type
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
Type
_ -> Type -> Text
go Type
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
" → " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Type -> Text
go Type
b
nameStream :: [Text]
nameStream = Char -> Integer -> [Text]
forall t. (Eq t, Num t, Show t) => Char -> t -> [Text]
go Char
'a' (Integer
0 :: Integer)
where
go :: Char -> t -> [Text]
go Char
c t
n =
(String -> Text
T.pack
(Char
c Char -> String -> String
forall a. a -> [a] -> [a]
:
if t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0
then String
""
else t -> String
forall a. Show a => a -> String
show t
n)) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
(Char -> t -> [Text]
go
(Int -> Char
forall a. Enum a => Int -> a
toEnum (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
26)))
(if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'z'
then t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1
else t
n))
prettyExp :: Expression -> Text
prettyExp :: Expression -> Text
prettyExp = Expression -> Text
go
where
go :: Expression -> Text
go Expression
t =
case Expression
t of
VariableExpression (Variable Text
name) -> Text
name
LambdaExpression (Variable Text
n) Expression
e ->
Text
"(\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" -> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
go Expression
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
ApplicationExpression Expression
f Expression
x -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
go Expression
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
go Expression
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"))"
InfixExpression Expression
l Variable
o Expression
r ->
Expression -> Text
prettyExp Expression
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Variable -> Text
prettyVariable Variable
o Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
prettyExp Expression
r
IfExpression Expression
a Expression
b Expression
c ->
Text
"if " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
prettyExp Expression
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" then " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
prettyExp Expression
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" else " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Expression -> Text
prettyExp Expression
c
RecordExpression HashMap Text Expression
hm ->
Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> [Text] -> Text
T.intercalate
Text
", "
(((Text, Expression) -> Text) -> [(Text, Expression)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, Expression
v) -> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
prettyExp Expression
v) (HashMap Text Expression -> [(Text, Expression)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text Expression
hm)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"}"
SubscriptExpression Subscripted
o [Subscript]
ks ->
(case Subscripted
o of
Subscripted
WildcardSubscripted -> Text
"_"
ExpressionSubscripted Expression
e -> Expression -> Text
go Expression
e) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ((Subscript -> Text) -> [Subscript] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Subscript -> Text
prettySubcript [Subscript]
ks)
ArrayExpression Vector Expression
as ->
Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " ((Expression -> Text) -> [Expression] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Expression -> Text
prettyExp (Vector Expression -> [Expression]
forall a. Vector a -> [a]
V.toList Vector Expression
as)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
ConstantExpression Constant
c -> Constant -> Text
prettyConstant Constant
c
prettyCore :: Core -> Text
prettyCore :: Core -> Text
prettyCore = Core -> Text
go
where
go :: Core -> Text
go Core
t =
case Core
t of
VariableCore (Variable Text
name) -> Text
name
LambdaCore (Variable Text
n) Core
e -> Text
"(\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" -> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Core -> Text
go Core
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
ApplicationCore Core
f Core
x -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Core -> Text
go Core
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Core -> Text
go Core
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"))"
IfCore Core
a Core
b Core
c ->
Text
"if " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Core -> Text
prettyCore Core
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" then " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Core -> Text
prettyCore Core
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" else " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Core -> Text
prettyCore Core
c
RecordCore HashMap Text Core
hm ->
Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> [Text] -> Text
T.intercalate
Text
", "
(((Text, Core) -> Text) -> [(Text, Core)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, Core
v) -> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Core -> Text
prettyCore Core
v) (HashMap Text Core -> [(Text, Core)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text Core
hm)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"}"
EvalCore Core -> Core
_ -> Text
"<internal>"
ArrayCore Vector Core
as ->
Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " ((Core -> Text) -> [Core] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Core -> Text
prettyCore (Vector Core -> [Core]
forall a. Vector a -> [a]
V.toList Vector Core
as)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
ConstantCore Constant
c -> Constant -> Text
prettyConstant Constant
c
prettyConstant :: Constant -> Text
prettyConstant :: Constant -> Text
prettyConstant =
\case
NumberConstant Scientific
s -> String -> Text
T.pack (Scientific -> String
forall a. Show a => a -> String
show Scientific
s)
StringConstant Text
t -> String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
t)
BoolConstant Bool
b ->
if Bool
b
then Text
"true"
else Text
"false"
Constant
NullConstant -> Text
"null"
prettySubcript :: Subscript -> Text
prettySubcript :: Subscript -> Text
prettySubcript =
\case
ExpressionSubscript Expression
e -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expression -> Text
prettyExp Expression
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
PropertySubscript Text
p -> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p
prettyVariable :: Variable -> Text
prettyVariable :: Variable -> Text
prettyVariable (Variable Text
t) = Text
t