{-# LANGUAGE FlexibleInstances #-}

-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com
-- SPDX-License-Identifier: MIT

module Pretty
  ( prettyExpression,
    prettyProgram,
    prettyProgram',
    prettyAttribute,
    prettySubsts,
    prettySubsts',
    prettyBinding,
    PrintMode (SWEET, SALTY),
  )
where

import Ast
import qualified Data.Map.Strict as Map
import Matcher
import Prettyprinter
import Prettyprinter.Render.String (renderString)
import Misc

data PrintMode = SWEET | SALTY
  deriving (PrintMode -> PrintMode -> Bool
(PrintMode -> PrintMode -> Bool)
-> (PrintMode -> PrintMode -> Bool) -> Eq PrintMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrintMode -> PrintMode -> Bool
== :: PrintMode -> PrintMode -> Bool
$c/= :: PrintMode -> PrintMode -> Bool
/= :: PrintMode -> PrintMode -> Bool
Eq)

instance Show PrintMode where
  show :: PrintMode -> String
show PrintMode
SWEET = String
"sweet"
  show PrintMode
SALTY = String
"salty"

newtype Formatted a = Formatted {forall a. Formatted a -> (PrintMode, a)
unFormatted :: (PrintMode, a)}

prettyMeta :: String -> Doc ann
prettyMeta :: forall ann. String -> Doc ann
prettyMeta String
meta = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"!" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
meta

prettyArrow :: Doc ann
prettyArrow :: forall ann. Doc ann
prettyArrow = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"↦"

prettyLsb :: Doc ann
prettyLsb :: forall ann. Doc ann
prettyLsb = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"⟦"

prettyRsb :: Doc ann
prettyRsb :: forall ann. Doc ann
prettyRsb = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"⟧"

prettyDashedArrow :: Doc ann
prettyDashedArrow :: forall ann. Doc ann
prettyDashedArrow = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"⤍"

instance Pretty Attribute where
  pretty :: forall ann. Attribute -> Doc ann
pretty (AtLabel String
name) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
name
  pretty (AtAlpha Integer
index) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"α" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
index
  pretty Attribute
AtRho = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"ρ"
  pretty Attribute
AtPhi = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"φ"
  pretty (AtMeta String
meta) = String -> Doc ann
forall ann. String -> Doc ann
prettyMeta String
meta

instance Pretty (Formatted Binding) where
  pretty :: forall ann. Formatted Binding -> Doc ann
pretty (Formatted (PrintMode
SWEET, BiTau Attribute
attr (ExFormation [Binding]
bindings))) =
    let voids' :: [Attribute]
voids' = [Binding] -> [Attribute]
voids [Binding]
bindings
     in if [Attribute] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Attribute]
voids'
          then Attribute -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Attribute -> Doc ann
pretty Attribute
attr Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
prettyArrow Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Formatted Expression -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Expression -> Doc ann
pretty ((PrintMode, Expression) -> Formatted Expression
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SWEET, [Binding] -> Expression
ExFormation [Binding]
bindings))
          else
            if [Attribute] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Attribute]
voids' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Binding] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Binding]
bindings Bool -> Bool -> Bool
&& [Attribute] -> Attribute
forall a. HasCallStack => [a] -> a
last [Attribute]
voids' Attribute -> Attribute -> Bool
forall a. Eq a => a -> a -> Bool
== Attribute
AtRho
              then [Attribute] -> Doc ann
forall ann. [Attribute] -> Doc ann
inlineVoids ([Attribute] -> [Attribute]
forall a. HasCallStack => [a] -> [a]
init [Attribute]
voids') Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
prettyLsb Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
prettyRsb
              else [Attribute] -> Doc ann
forall ann. [Attribute] -> Doc ann
inlineVoids [Attribute]
voids' Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Formatted Expression -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Expression -> Doc ann
pretty ((PrintMode, Expression) -> Formatted Expression
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SWEET, [Binding] -> Expression
ExFormation (Int -> [Binding] -> [Binding]
forall a. Int -> [a] -> [a]
drop ([Attribute] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Attribute]
voids') [Binding]
bindings)))
    where
      voids :: [Binding] -> [Attribute]
      voids :: [Binding] -> [Attribute]
voids [] = []
      voids (Binding
bd : [Binding]
bds) = case Binding
bd of
        BiVoid Attribute
attr -> Attribute
attr Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
: [Binding] -> [Attribute]
voids [Binding]
bds
        Binding
_ -> []
      inlineVoids :: [Attribute] -> Doc ann
      inlineVoids :: forall ann. [Attribute] -> Doc ann
inlineVoids [Attribute]
voids' = Attribute -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Attribute -> Doc ann
pretty Attribute
attr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
lparen Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Attribute -> Doc ann) -> [Attribute] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Attribute -> Doc ann
pretty [Attribute]
voids')) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
rparen Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
prettyArrow
  pretty (Formatted (PrintMode
mode, BiTau Attribute
attr Expression
expr)) = Attribute -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Attribute -> Doc ann
pretty Attribute
attr Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
prettyArrow Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Formatted Expression -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Expression -> Doc ann
pretty ((PrintMode, Expression) -> Formatted Expression
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
mode, Expression
expr))
  pretty (Formatted (PrintMode
_, BiMeta String
meta)) = String -> Doc ann
forall ann. String -> Doc ann
prettyMeta String
meta
  pretty (Formatted (PrintMode
_, BiDelta String
bytes)) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Δ" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
prettyDashedArrow Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
bytes
  pretty (Formatted (PrintMode
_, BiMetaLambda String
meta)) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"λ" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
prettyDashedArrow Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
prettyMeta String
meta
  pretty (Formatted (PrintMode
_, BiMetaDelta String
meta)) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Δ" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
prettyDashedArrow Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
prettyMeta String
meta
  pretty (Formatted (PrintMode
_, BiVoid Attribute
attr)) = Attribute -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Attribute -> Doc ann
pretty Attribute
attr Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
prettyArrow Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"∅"
  pretty (Formatted (PrintMode
_, BiLambda String
func)) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"λ" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
prettyDashedArrow Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
func

instance {-# OVERLAPPING #-} Pretty (Formatted [Binding]) where
  pretty :: forall ann. Formatted [Binding] -> Doc ann
pretty (Formatted (PrintMode
SWEET, [Binding]
bds)) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Binding -> Doc ann) -> [Doc ann] -> [Binding] -> [Doc ann]
forall ann.
(Binding -> Doc ann) -> [Doc ann] -> [Binding] -> [Doc ann]
excludeVoidRho (\Binding
bd -> Formatted Binding -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Binding -> Doc ann
pretty ((PrintMode, Binding) -> Formatted Binding
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SWEET, Binding
bd))) [] [Binding]
bds))
    where
      excludeVoidRho :: (Binding -> Doc ann) -> [Doc ann] -> [Binding] -> [Doc ann]
      excludeVoidRho :: forall ann.
(Binding -> Doc ann) -> [Doc ann] -> [Binding] -> [Doc ann]
excludeVoidRho Binding -> Doc ann
func [Doc ann]
acc [Binding
bd] = case Binding
bd of
        BiVoid Attribute
AtRho -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a]
reverse [Doc ann]
acc
        Binding
_ -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a]
reverse (Binding -> Doc ann
func Binding
bd Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
acc)
      excludeVoidRho Binding -> Doc ann
func [Doc ann]
acc (Binding
x : [Binding]
xs) = (Binding -> Doc ann) -> [Doc ann] -> [Binding] -> [Doc ann]
forall ann.
(Binding -> Doc ann) -> [Doc ann] -> [Binding] -> [Doc ann]
excludeVoidRho Binding -> Doc ann
func (Binding -> Doc ann
func Binding
x Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
acc) [Binding]
xs
      excludeVoidRho Binding -> Doc ann
func [Doc ann]
acc [] = [Doc ann] -> [Doc ann]
forall a. [a] -> [a]
reverse [Doc ann]
acc
  pretty (Formatted (PrintMode
SALTY, [Binding]
bds)) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Binding -> Doc ann) -> [Binding] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (\Binding
bd -> Formatted Binding -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Binding -> Doc ann
pretty ((PrintMode, Binding) -> Formatted Binding
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SALTY, Binding
bd))) [Binding]
bds))

complexApplication :: Expression -> (Expression, [Binding], [Expression])
complexApplication :: Expression -> (Expression, [Binding], [Expression])
complexApplication (ExApplication (ExApplication Expression
expr Binding
tau) Binding
tau') =
  let (Expression
before, [Binding]
taus, [Expression]
exprs) = Expression -> (Expression, [Binding], [Expression])
complexApplication (Expression -> Binding -> Expression
ExApplication Expression
expr Binding
tau)
      taus' :: [Binding]
taus' = Binding
tau' Binding -> [Binding] -> [Binding]
forall a. a -> [a] -> [a]
: [Binding]
taus
   in if [Expression] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expression]
exprs
        then (Expression
before, [Binding]
taus', [])
        else case Binding
tau' of
          BiTau (AtAlpha Integer
idx) Expression
expr' ->
            if Integer
idx Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Expression] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expression]
exprs)
              then (Expression
before, [Binding]
taus', Expression
expr' Expression -> [Expression] -> [Expression]
forall a. a -> [a] -> [a]
: [Expression]
exprs)
              else (Expression
before, [Binding]
taus', [])
          Binding
_ -> (Expression
before, [Binding]
taus', [])
complexApplication (ExApplication Expression
expr (BiTau (AtAlpha Integer
0) Expression
expr')) = (Expression
expr, [Attribute -> Expression -> Binding
BiTau (Integer -> Attribute
AtAlpha Integer
0) Expression
expr'], [Expression
expr'])
complexApplication (ExApplication Expression
expr Binding
tau) = (Expression
expr, [Binding
tau], [])

instance Pretty (Formatted Expression) where
  pretty :: forall ann. Formatted Expression -> Doc ann
pretty (Formatted (PrintMode
SWEET, ExDispatch (ExDispatch Expression
ExGlobal (AtLabel String
"org")) (AtLabel String
"eolang"))) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Φ̇"
  pretty (Formatted (PrintMode
SWEET, DataObject String
"string" String
bytes)) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"\"" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ShowS
hexToStr String
bytes) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"\""
  pretty (Formatted (PrintMode
SWEET, DataObject String
"number" String
bytes)) = (Integer -> Doc ann)
-> (Double -> Doc ann) -> Either Integer Double -> Doc ann
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Double -> Doc ann
forall ann. Double -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Either Integer Double
hexToNum String
bytes)
  pretty (Formatted (PrintMode
SWEET, DataObject String
other String
bytes)) = Formatted Expression -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Expression -> Doc ann
pretty ((PrintMode, Expression) -> Formatted Expression
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SALTY, String -> String -> Expression
DataObject String
other String
bytes))
  pretty (Formatted (PrintMode
mode, ExFormation [Binding
binding])) = case Binding
binding of
    BiTau Attribute
_ Expression
_ -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"⟦", Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Formatted Binding -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Binding -> Doc ann
pretty ((PrintMode, Binding) -> Formatted Binding
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
mode, Binding
binding))), String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"⟧"]
    Binding
_ -> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"⟦" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Formatted Binding -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Binding -> Doc ann
pretty ((PrintMode, Binding) -> Formatted Binding
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
mode, Binding
binding)) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"⟧"
  pretty (Formatted (PrintMode
_, ExFormation [])) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"⟦⟧"
  pretty (Formatted (PrintMode
mode, ExFormation [Binding]
bindings)) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"⟦", Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Formatted [Binding] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted [Binding] -> Doc ann
pretty ((PrintMode, [Binding]) -> Formatted [Binding]
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
mode, [Binding]
bindings))), String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"⟧"]
  pretty (Formatted (PrintMode
_, Expression
ExThis)) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"ξ"
  pretty (Formatted (PrintMode
_, Expression
ExGlobal)) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Φ"
  pretty (Formatted (PrintMode
_, Expression
ExTermination)) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"⊥"
  pretty (Formatted (PrintMode
_, ExMeta String
meta)) = String -> Doc ann
forall ann. String -> Doc ann
prettyMeta String
meta
  pretty (Formatted (PrintMode
SWEET, ExApplication (ExApplication Expression
expr Binding
tau) Binding
tau')) =
    let (Expression
expr', [Binding]
taus, [Expression]
exprs) = Expression -> (Expression, [Binding], [Expression])
complexApplication (Expression -> Binding -> Expression
ExApplication (Expression -> Binding -> Expression
ExApplication Expression
expr Binding
tau) Binding
tau')
        args :: Doc ann
args =
          if [Expression] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expression]
exprs
            then Formatted [Binding] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted [Binding] -> Doc ann
pretty ((PrintMode, [Binding]) -> Formatted [Binding]
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SWEET, [Binding] -> [Binding]
forall a. [a] -> [a]
reverse [Binding]
taus))
            else [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Expression -> Doc ann) -> [Expression] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (\Expression
exp -> Formatted Expression -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Expression -> Doc ann
pretty ((PrintMode, Expression) -> Formatted Expression
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SWEET, Expression
exp))) ([Expression] -> [Expression]
forall a. [a] -> [a]
reverse [Expression]
exprs)))
     in Formatted Expression -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Expression -> Doc ann
pretty ((PrintMode, Expression) -> Formatted Expression
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SWEET, Expression
expr')) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
forall ann. Doc ann
lparen, Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 Doc ann
forall ann. Doc ann
args, Doc ann
forall ann. Doc ann
rparen]
  pretty (Formatted (PrintMode
SWEET, ExApplication Expression
expr Binding
tau)) =
    let arg :: Doc ann
arg = case Binding
tau of
          BiTau (AtAlpha Integer
0) Expression
expr' -> Formatted Expression -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Expression -> Doc ann
pretty ((PrintMode, Expression) -> Formatted Expression
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SWEET, Expression
expr'))
          Binding
_ -> Formatted Binding -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Binding -> Doc ann
pretty ((PrintMode, Binding) -> Formatted Binding
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SWEET, Binding
tau))
     in Formatted Expression -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Expression -> Doc ann
pretty ((PrintMode, Expression) -> Formatted Expression
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SWEET, Expression
expr)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
forall ann. Doc ann
lparen, Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 Doc ann
forall ann. Doc ann
arg, Doc ann
forall ann. Doc ann
rparen]
  pretty (Formatted (PrintMode
mode, ExApplication Expression
expr Binding
tau)) = Formatted Expression -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Expression -> Doc ann
pretty ((PrintMode, Expression) -> Formatted Expression
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
mode, Expression
expr)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
forall ann. Doc ann
lparen, Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Formatted Binding -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Binding -> Doc ann
pretty ((PrintMode, Binding) -> Formatted Binding
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
mode, Binding
tau))), Doc ann
forall ann. Doc ann
rparen]
  pretty (Formatted (PrintMode
mode, ExDispatch Expression
expr Attribute
attr)) = Formatted Expression -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Expression -> Doc ann
pretty ((PrintMode, Expression) -> Formatted Expression
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
mode, Expression
expr)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Attribute -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Attribute -> Doc ann
pretty Attribute
attr
  pretty (Formatted (PrintMode
mode, ExMetaTail Expression
expr String
meta)) = Formatted Expression -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Expression -> Doc ann
pretty ((PrintMode, Expression) -> Formatted Expression
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
mode, Expression
expr)) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"*" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
prettyMeta String
meta

instance Pretty (Formatted Program) where
  pretty :: forall ann. Formatted Program -> Doc ann
pretty (Formatted (PrintMode
SALTY, Program Expression
expr)) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"Φ" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
prettyArrow Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Formatted Expression -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Expression -> Doc ann
pretty ((PrintMode, Expression) -> Formatted Expression
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SALTY, Expression
expr))
  pretty (Formatted (PrintMode
SWEET, Program Expression
expr)) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"{" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Formatted Expression -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Expression -> Doc ann
pretty ((PrintMode, Expression) -> Formatted Expression
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SWEET, Expression
expr)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"}"

instance Pretty Tail where
  pretty :: forall ann. Tail -> Doc ann
pretty (TaApplication Binding
tau) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
forall ann. Doc ann
lparen, Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Formatted Binding -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Binding -> Doc ann
pretty ((PrintMode, Binding) -> Formatted Binding
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SALTY, Binding
tau))), Doc ann
forall ann. Doc ann
rparen]
  pretty (TaDispatch Attribute
attr) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Attribute -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Attribute -> Doc ann
pretty Attribute
attr

instance Pretty MetaValue where
  pretty :: forall ann. MetaValue -> Doc ann
pretty (MvAttribute Attribute
attr) = Attribute -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Attribute -> Doc ann
pretty Attribute
attr
  pretty (MvBytes String
bytes) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
bytes
  pretty (MvBindings []) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"[]"
  pretty (MvBindings [Binding]
bindings) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"[", Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Formatted [Binding] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted [Binding] -> Doc ann
pretty ((PrintMode, [Binding]) -> Formatted [Binding]
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SALTY, [Binding]
bindings))), String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"]"]
  pretty (MvFunction String
func) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
func
  pretty (MvExpression Expression
expr Expression
_) = Formatted Expression -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Formatted Expression -> Doc ann
pretty ((PrintMode, Expression) -> Formatted Expression
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SALTY, Expression
expr))
  pretty (MvTail [Tail]
tails) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Tail -> Doc ann) -> [Tail] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Tail -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Tail -> Doc ann
pretty [Tail]
tails))

instance Pretty Subst where
  pretty :: forall ann. Subst -> Doc ann
pretty (Subst Map String MetaValue
mp) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      [ Doc ann
forall ann. Doc ann
lparen,
        Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent
          Int
2
          ( [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
              ( Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate
                  Doc ann
forall ann. Doc ann
comma
                  ( ((String, MetaValue) -> Doc ann)
-> [(String, MetaValue)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map
                      (\(String
key, MetaValue
value) -> String -> Doc ann
forall ann. String -> Doc ann
prettyMeta String
key Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
">>" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> MetaValue -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. MetaValue -> Doc ann
pretty MetaValue
value)
                      (Map String MetaValue -> [(String, MetaValue)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String MetaValue
mp)
                  )
              )
          ),
        Doc ann
forall ann. Doc ann
rparen
      ]

instance {-# OVERLAPPING #-} Pretty (Formatted [Subst]) where
  pretty :: forall ann. Formatted [Subst] -> Doc ann
pretty (Formatted (PrintMode
_, [])) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"[]"
  pretty (Formatted (PrintMode
mode, [Subst]
substs)) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"[", Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ((Subst -> Doc ann) -> [Subst] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Subst -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Subst -> Doc ann
pretty [Subst]
substs))), String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
"]"]

render :: (Pretty a) => a -> String
render :: forall a. Pretty a => a -> String
render a
printable = SimpleDocStream Any -> String
forall ann. SimpleDocStream ann -> String
renderString (LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions (a -> Doc Any
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
printable))

prettyBinding :: Binding -> String
prettyBinding :: Binding -> String
prettyBinding Binding
binding = Formatted Binding -> String
forall a. Pretty a => a -> String
render ((PrintMode, Binding) -> Formatted Binding
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SALTY, Binding
binding))

prettyAttribute :: Attribute -> String
prettyAttribute :: Attribute -> String
prettyAttribute = Attribute -> String
forall a. Pretty a => a -> String
render

prettySubsts :: [Subst] -> String
prettySubsts :: [Subst] -> String
prettySubsts = [Subst] -> String
forall a. Pretty a => a -> String
render

prettySubsts' :: [Subst] -> PrintMode -> String
prettySubsts' :: [Subst] -> PrintMode -> String
prettySubsts' [Subst]
substs PrintMode
mode = Formatted [Subst] -> String
forall a. Pretty a => a -> String
render ((PrintMode, [Subst]) -> Formatted [Subst]
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
mode, [Subst]
substs))

prettyExpression :: Expression -> String
prettyExpression :: Expression -> String
prettyExpression Expression
expr = Formatted Expression -> String
forall a. Pretty a => a -> String
render ((PrintMode, Expression) -> Formatted Expression
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SALTY, Expression
expr))

prettyProgram :: Program -> String
prettyProgram :: Program -> String
prettyProgram Program
prog = Formatted Program -> String
forall a. Pretty a => a -> String
render ((PrintMode, Program) -> Formatted Program
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
SALTY, Program
prog))

prettyProgram' :: Program -> PrintMode -> String
prettyProgram' :: Program -> PrintMode -> String
prettyProgram' Program
prog PrintMode
mode = Formatted Program -> String
forall a. Pretty a => a -> String
render ((PrintMode, Program) -> Formatted Program
forall a. (PrintMode, a) -> Formatted a
Formatted (PrintMode
mode, Program
prog))