{-# LANGUAGE OverloadedStrings #-}

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

import Funcons.Types
import Funcons.RunOptions

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

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

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

showOp :: SeqSortOp -> String
showOp :: SeqSortOp -> String
showOp = SeqSortOp -> String
ppOp

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

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

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

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

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

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

showTerms :: FTerm -> String
showTerms :: FTerm -> String
showTerms = RunOptions -> FTerm -> String
ppTerms RunOptions
defaultRunOptions

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

-- helpers

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

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

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