{- |
  TODO: Use real pretty printer library
-}
{-# LANGUAGE OverloadedStrings #-}
module LambdaCube.STLC.PrettyPrinter
  ( prettyUnnamedTerm
  , prettyShowUnnamedTerm
  , prettyUnnamedType
  , prettyShowUnnamedType
  ) where

import           Data.Text                       (Text)
import qualified Data.Text                       as Text
import           LambdaCube.Common.PrettyPrinter
import           LambdaCube.STLC.Ast

prettyUnnamedTerm :: LCTerm -> Text
prettyUnnamedTerm :: LCTerm -> Text
prettyUnnamedTerm = Int -> LCTerm -> Text
prettyUnnamedTermPrec Int
0

prettyShowUnnamedTerm :: LCTerm -> String
prettyShowUnnamedTerm :: LCTerm -> String
prettyShowUnnamedTerm = Text -> String
Text.unpack (Text -> String) -> (LCTerm -> Text) -> LCTerm -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LCTerm -> Text
prettyUnnamedTerm

prettyUnnamedType :: LCType -> Text
prettyUnnamedType :: LCType -> Text
prettyUnnamedType = Int -> LCType -> Text
prettyUnnamedTypePrec Int
0

prettyShowUnnamedType :: LCType -> String
prettyShowUnnamedType :: LCType -> String
prettyShowUnnamedType = Text -> String
Text.unpack (Text -> String) -> (LCType -> Text) -> LCType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LCType -> Text
prettyUnnamedType

prettyUnnamedTermPrec :: Int -> LCTerm -> Text
prettyUnnamedTermPrec :: Int -> LCTerm -> Text
prettyUnnamedTermPrec = Int -> LCTerm -> Text
forall t. (Ord t, Num t) => t -> LCTerm -> Text
go
  where
    pTP :: Int -> LCType -> Text
pTP = Int -> LCType -> Text
prettyUnnamedTypePrec

    go :: t -> LCTerm -> Text
go t
_ (LCVar Int
x)   = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
x
    go t
p (LCLam LCType
t LCTerm
b) = Bool -> [Text] -> Text
wrapIfSpaced (t
p t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0) [Text
"\\ :", Int -> LCType -> Text
pTP Int
0 LCType
t, Text
".", t -> LCTerm -> Text
go t
0 LCTerm
b]
    go t
p (LCApp LCTerm
f LCTerm
a) = Bool -> [Text] -> Text
wrapIfSpaced (t
p t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
1) [t -> LCTerm -> Text
go t
1 LCTerm
f, t -> LCTerm -> Text
go t
2 LCTerm
a]

prettyUnnamedTypePrec :: Int -> LCType -> Text
prettyUnnamedTypePrec :: Int -> LCType -> Text
prettyUnnamedTypePrec = Int -> LCType -> Text
forall t. (Ord t, Num t) => t -> LCType -> Text
go
  where
    go :: t -> LCType -> Text
go t
_ LCType
LCBase      = Text
"#"
    go t
p (LCArr LCType
a LCType
b) = Bool -> [Text] -> Text
wrapIfSpaced (t
p t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0) [t -> LCType -> Text
go t
1 LCType
a, Text
"->", t -> LCType -> Text
go t
0 LCType
b]