{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}

-- 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 (hexToStr, hexToNum)

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)}

-- Minimal matcher function (required for view pattern)
matchDataoObject :: Expression -> Maybe (String, String)
matchDataoObject :: Expression -> Maybe (String, String)
matchDataoObject
  ( ExApplication
      (ExDispatch (ExDispatch (ExDispatch Expression
ExGlobal (AtLabel String
"org")) (AtLabel String
"eolang")) (AtLabel String
label))
      ( BiTau
          (AtAlpha Integer
0)
          ( ExApplication
              (ExDispatch (ExDispatch (ExDispatch Expression
ExGlobal (AtLabel String
"org")) (AtLabel String
"eolang")) (AtLabel String
"bytes"))
              ( BiTau
                  (AtAlpha Integer
0)
                  (ExFormation [BiDelta String
bts, BiVoid Attribute
AtRho])
                )
            )
        )
    ) = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
label, String
bts)
matchDataoObject Expression
_ = Maybe (String, String)
forall a. Maybe a
Nothing

pattern DataObject :: String -> String -> Expression
pattern $mDataObject :: forall {r}.
Expression -> (String -> String -> r) -> ((# #) -> r) -> r
$bDataObject :: String -> String -> Expression
DataObject label bts <- (matchDataoObject -> Just (label, bts))
  where
    DataObject String
label String
bts =
      Expression -> Binding -> Expression
ExApplication
        (Expression -> Attribute -> Expression
ExDispatch (Expression -> Attribute -> Expression
ExDispatch (Expression -> Attribute -> Expression
ExDispatch Expression
ExGlobal (String -> Attribute
AtLabel String
"org")) (String -> Attribute
AtLabel String
"eolang")) (String -> Attribute
AtLabel String
label))
        ( Attribute -> Expression -> Binding
BiTau
            (Integer -> Attribute
AtAlpha Integer
0)
            ( Expression -> Binding -> Expression
ExApplication
                (Expression -> Attribute -> Expression
ExDispatch (Expression -> Attribute -> Expression
ExDispatch (Expression -> Attribute -> Expression
ExDispatch Expression
ExGlobal (String -> Attribute
AtLabel String
"org")) (String -> Attribute
AtLabel String
"eolang")) (String -> Attribute
AtLabel String
"bytes"))
                ( Attribute -> Expression -> Binding
BiTau
                    (Integer -> Attribute
AtAlpha Integer
0)
                    ([Binding] -> Expression
ExFormation [String -> Binding
BiDelta String
bts, Attribute -> Binding
BiVoid Attribute
AtRho])
                )
            )
        )

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))) = do
    let voids' :: [Attribute]
voids' = [Binding] -> [Attribute]
voids [Binding]
bindings
    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
        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
          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
_ -> []
  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
mode, [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
mode, Binding
bd))) [Binding]
bds))

complexApplication :: Expression -> (Expression, [Binding], [Expression])
complexApplication :: Expression -> (Expression, [Binding], [Expression])
complexApplication (ExApplication (ExApplication Expression
expr Binding
tau) Binding
tau') = do
  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
  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')) = do
    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)))
    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)) = do
    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))
    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) = 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))