{-# 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

-- | Pretty printing for type.
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))

-- | Pretty printing for expression.
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

-- | Pretty printing for core.
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