{-# LANGUAGE OverloadedStrings #-}

module Funcons.Printer (
    ppFuncons, ppValues, ppTypes, ppTerms,
    showValues, showFuncons, showTypes, showSorts, showTerms, showOp, showL,
    showValuesSeq, ppValuesSeq, showFunconsSeq, ppFunconsSeq,
    ) where

import Funcons.Types
import Funcons.RunOptions

import Data.List (intercalate)
import Data.Text (unpack)

showL :: [String] -> String
showL :: [[Char]] -> [Char]
showL [[Char]]
elems = [Char]
"[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," [[Char]]
elems forall a. [a] -> [a] -> [a]
++ [Char]
"]"

-- | Pretty-print a 'Values'.
showValues :: Values -> String
showValues :: Values -> [Char]
showValues = forall t. HasValues t => (t -> [Char]) -> Values t -> [Char]
ppValues Funcons -> [Char]
showFuncons 

-- | Pretty-print a sequence of `Values`.
showValuesSeq :: [Values] -> String
showValuesSeq :: [Values] -> [Char]
showValuesSeq = RunOptions -> [Values] -> [Char]
ppValuesSeq RunOptions
defaultRunOptions

showOp :: SeqSortOp -> String
showOp :: SeqSortOp -> [Char]
showOp = SeqSortOp -> [Char]
ppOp

ppValuesSeq :: RunOptions -> [Values] -> String
ppValuesSeq :: RunOptions -> [Values] -> [Char]
ppValuesSeq RunOptions
opts = RunOptions -> Bool -> [Funcons] -> [Char]
showArgs RunOptions
opts Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Values -> Funcons
FValue

-- | Pretty-print a 'Funcons'.
showFuncons :: Funcons -> String
showFuncons :: Funcons -> [Char]
showFuncons = RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
defaultRunOptions

-- | Pretty-print a sequence of `Funcons`.
showFunconsSeq :: [Funcons] -> String
showFunconsSeq :: [Funcons] -> [Char]
showFunconsSeq = RunOptions -> [Funcons] -> [Char]
ppFunconsSeq RunOptions
defaultRunOptions

ppFunconsSeq :: RunOptions -> [Funcons] -> String
ppFunconsSeq :: RunOptions -> [Funcons] -> [Char]
ppFunconsSeq RunOptions
opts = RunOptions -> Bool -> [Funcons] -> [Char]
showArgs RunOptions
opts Bool
False

-- | Pretty-print a 'Types'.
showTypes :: Types -> String
showTypes :: Types -> [Char]
showTypes = forall t. HasValues t => (t -> [Char]) -> Types t -> [Char]
ppTypes Funcons -> [Char]
showFuncons 

-- | Pretty-print a sort or 'ComputationType'
showSorts :: ComputationTypes -> String
showSorts :: ComputationTypes -> [Char]
showSorts = forall t.
HasValues t =>
(t -> [Char]) -> ComputationTypes t -> [Char]
ppComputationTypes Funcons -> [Char]
showFuncons 

showTerms :: FTerm -> String
showTerms :: FTerm -> [Char]
showTerms = RunOptions -> FTerm -> [Char]
ppTerms RunOptions
defaultRunOptions

ppFuncons :: RunOptions -> Funcons -> String
ppFuncons :: RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts (FApp Name
"list" [Funcons]
fs) = [Char]
"[" forall a. [a] -> [a] -> [a]
++ RunOptions -> Bool -> [Funcons] -> [Char]
showArgs RunOptions
opts Bool
False [Funcons]
fs forall a. [a] -> [a] -> [a]
++ [Char]
"]"
--ppFuncons opts (FTuple fs)   = "(" ++ showArgs opts False fs ++ ")"
ppFuncons RunOptions
opts (FSet [Funcons]
fs)     = [Char]
"{" forall a. [a] -> [a] -> [a]
++ RunOptions -> Bool -> [Funcons] -> [Char]
showArgs RunOptions
opts Bool
False [Funcons]
fs forall a. [a] -> [a] -> [a]
++ [Char]
"}"
ppFuncons RunOptions
opts (FMap [Funcons]
fs)     = 
  [Char]
"{" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," (forall a b. (a -> b) -> [a] -> [b]
map (RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts) [Funcons]
fs) forall a. [a] -> [a] -> [a]
++ [Char]
"}"
ppFuncons RunOptions
opts (FBinding Funcons
fk [Funcons]
fvs) = 
  RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts Funcons
fk forall a. [a] -> [a] -> [a]
++ [Char]
" |-> " forall a. [a] -> [a] -> [a]
++ RunOptions -> [Funcons] -> [Char]
ppFunconsSeq RunOptions
opts [Funcons]
fvs
ppFuncons RunOptions
opts (FValue Values
v)            = forall t. HasValues t => (t -> [Char]) -> Values t -> [Char]
ppValues (RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts) Values
v
ppFuncons RunOptions
opts (FName Name
nm)      = Name -> [Char]
unpack Name
nm
ppFuncons RunOptions
opts (FSortSeq Funcons
f SeqSortOp
o)  = RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts Funcons
f forall a. [a] -> [a] -> [a]
++ SeqSortOp -> [Char]
ppOp SeqSortOp
o
ppFuncons RunOptions
opts (FSortPower Funcons
f1 Funcons
f2) = RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts Funcons
f1 forall a. [a] -> [a] -> [a]
++ [Char]
"^" forall a. [a] -> [a] -> [a]
++ RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts Funcons
f2
ppFuncons RunOptions
opts (FSortUnion Funcons
f1 Funcons
f2) = [Char]
"(" forall a. [a] -> [a] -> [a]
++ RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts Funcons
f1 forall a. [a] -> [a] -> [a]
++ [Char]
"|" forall a. [a] -> [a] -> [a]
++ RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts Funcons
f2 forall a. [a] -> [a] -> [a]
++ [Char]
")"
ppFuncons RunOptions
opts (FSortInter Funcons
f1 Funcons
f2) = [Char]
"(" forall a. [a] -> [a] -> [a]
++ RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts Funcons
f1 forall a. [a] -> [a] -> [a]
++ [Char]
"&" forall a. [a] -> [a] -> [a]
++ RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts Funcons
f2 forall a. [a] -> [a] -> [a]
++ [Char]
")"
ppFuncons RunOptions
opts (FSortComplement Funcons
f1) = [Char]
"~("forall a. [a] -> [a] -> [a]
++ RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts Funcons
f1 forall a. [a] -> [a] -> [a]
++ [Char]
")"
ppFuncons RunOptions
opts (FSortComputes Funcons
f) = [Char]
"=>" forall a. [a] -> [a] -> [a]
++ RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts Funcons
f
ppFuncons RunOptions
opts (FSortComputesFrom Funcons
s Funcons
t) = RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts Funcons
s forall a. [a] -> [a] -> [a]
++ [Char]
"=>" forall a. [a] -> [a] -> [a]
++ RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts Funcons
t
-- some hard-coded funcons
ppFuncons RunOptions
opts (FApp Name
"closure" [Funcons
x, Funcons
y]) =
    let env :: Funcons
env | RunOptions -> Bool
pp_full_environments RunOptions
opts = Funcons
y
            | Bool
otherwise                 = [Char] -> Funcons
string_ [Char]
"..."
    in RunOptions -> [Char] -> [Funcons] -> [Char]
showFn RunOptions
opts [Char]
"closure" [Funcons
x, Funcons
env]
ppFuncons RunOptions
opts (FApp Name
"scope" [Funcons
x, Funcons
y]) =
    let env :: Funcons
env | Bool -> Bool
Prelude.not (RunOptions -> Bool
pp_full_environments RunOptions
opts) Bool -> Bool -> Bool
&& Funcons -> Bool
isMap Funcons
x = [Char] -> Funcons
string_ [Char]
"..."
            | Bool
otherwise                                          = Funcons
x
    in RunOptions -> [Char] -> [Funcons] -> [Char]
showFn RunOptions
opts [Char]
"scope" [Funcons
env, Funcons
y]
ppFuncons RunOptions
opts (FApp Name
nm [Funcons]
fs)     = Name -> [Char]
unpack Name
nm forall a. [a] -> [a] -> [a]
++ RunOptions -> Bool -> [Funcons] -> [Char]
showArgs RunOptions
opts Bool
True [Funcons]
fs 

-- helpers

showFn :: RunOptions -> String -> [Funcons] -> String
showFn :: RunOptions -> [Char] -> [Funcons] -> [Char]
showFn RunOptions
opts [Char]
n [Funcons]
xs = [Char]
n forall a. [a] -> [a] -> [a]
++ RunOptions -> Bool -> [Funcons] -> [Char]
showArgs RunOptions
opts Bool
True [Funcons]
xs

showArgs :: RunOptions -> Bool -> [Funcons] -> String
showArgs :: RunOptions -> Bool -> [Funcons] -> [Char]
showArgs RunOptions
opts Bool
b [Funcons]
args | Bool
b         = [Char]
"(" forall a. [a] -> [a] -> [a]
++ [Char]
seq forall a. [a] -> [a] -> [a]
++ [Char]
")"
                     | Bool
otherwise = [Char]
seq
 where seq :: [Char]
seq = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," (forall a b. (a -> b) -> [a] -> [b]
map (RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts) [Funcons]
args)

ppTerms :: RunOptions -> FTerm -> String
ppTerms :: RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts (TApp Name
"list" [FTerm]
ts)   = [Char]
"[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," (forall a b. (a -> b) -> [a] -> [b]
map (RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts) [FTerm]
ts) forall a. [a] -> [a] -> [a]
++ [Char]
"]"
ppTerms RunOptions
opts (TApp Name
nm [FTerm]
ts) = Name -> [Char]
unpack Name
nm forall a. [a] -> [a] -> [a]
++ [Char]
"(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," (forall a b. (a -> b) -> [a] -> [b]
map (RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts) [FTerm]
ts) forall a. [a] -> [a] -> [a]
++ [Char]
")"
ppTerms RunOptions
opts (TName Name
nm)   = Name -> [Char]
unpack Name
nm
ppTerms RunOptions
opts (TVar [Char]
var)   = [Char]
var
ppTerms RunOptions
opts (TSeq [FTerm]
ts)    = [Char]
"(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," (forall a b. (a -> b) -> [a] -> [b]
map (RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts) [FTerm]
ts) forall a. [a] -> [a] -> [a]
++ [Char]
")"
ppTerms RunOptions
opts (TSet [FTerm]
ts)    = [Char]
"{" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," (forall a b. (a -> b) -> [a] -> [b]
map (RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts) [FTerm]
ts) forall a. [a] -> [a] -> [a]
++ [Char]
"}"
ppTerms RunOptions
opts (TMap [FTerm]
ts)    = [Char]
"map" forall a. [a] -> [a] -> [a]
++ [Char]
"(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," (forall a b. (a -> b) -> [a] -> [b]
map (RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts) [FTerm]
ts) forall a. [a] -> [a] -> [a]
++ [Char]
")"
ppTerms RunOptions
opts (TBinding FTerm
fk FTerm
fv) = RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts FTerm
fk forall a. [a] -> [a] -> [a]
++ [Char]
" |-> " forall a. [a] -> [a] -> [a]
++ RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts FTerm
fv
ppTerms RunOptions
opts (TSortSeq FTerm
term SeqSortOp
op) = RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts FTerm
term forall a. [a] -> [a] -> [a]
++ SeqSortOp -> [Char]
ppOp SeqSortOp
op
ppTerms RunOptions
opts (TSortPower FTerm
t1 FTerm
t2) = RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts FTerm
t1 forall a. [a] -> [a] -> [a]
++ [Char]
"^" forall a. [a] -> [a] -> [a]
++ RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts FTerm
t2
ppTerms RunOptions
opts (TSortUnion FTerm
t1 FTerm
t2) = RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts FTerm
t1 forall a. [a] -> [a] -> [a]
++ [Char]
"|" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show FTerm
t2
ppTerms RunOptions
opts (TSortInter FTerm
t1 FTerm
t2) = RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts FTerm
t1 forall a. [a] -> [a] -> [a]
++ [Char]
"&" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show FTerm
t2
ppTerms RunOptions
opts (TSortComplement FTerm
t1) = [Char]
"~(" forall a. [a] -> [a] -> [a]
++ RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts FTerm
t1 forall a. [a] -> [a] -> [a]
++ [Char]
")"
ppTerms RunOptions
opts (TSortComputes FTerm
to) = [Char]
"=>" forall a. [a] -> [a] -> [a]
++ RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts FTerm
to
ppTerms RunOptions
opts (TSortComputesFrom FTerm
from FTerm
to) = RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts FTerm
from forall a. [a] -> [a] -> [a]
++ [Char]
"=>" forall a. [a] -> [a] -> [a]
++ RunOptions -> FTerm -> [Char]
ppTerms RunOptions
opts FTerm
to
ppTerms RunOptions
opts (TFuncon Funcons
f)  = RunOptions -> Funcons -> [Char]
ppFuncons RunOptions
opts Funcons
f
ppTerms RunOptions
opts FTerm
TAny         = [Char]
"_"