{-# LANGUAGE Safe #-}
module Copilot.Interpret.Render
( renderAsTable
, renderAsCSV
) where
import Data.List (intersperse, transpose, foldl')
import Data.Maybe (catMaybes)
import Copilot.Interpret.Eval (Output, ExecTrace (..))
import Text.PrettyPrint
import Prelude hiding ((<>))
renderAsTable :: ExecTrace -> String
renderAsTable :: ExecTrace -> String
renderAsTable
ExecTrace
{ interpTriggers :: ExecTrace -> [(String, [Maybe [String]])]
interpTriggers = [(String, [Maybe [String]])]
trigs
, interpObservers :: ExecTrace -> [(String, [String])]
interpObservers = [(String, [String])]
obsvs } = ( Doc -> String
render
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Doc]] -> Doc
asColumns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) ([Doc]
ppTriggerNames forall a. [a] -> [a] -> [a]
++ [Doc]
ppObserverNames)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose
) ([[Doc]]
ppTriggerOutputs forall a. [a] -> [a] -> [a]
++ [[Doc]]
ppObserverOutputs)
where
ppTriggerNames :: [Doc]
ppTriggerNames :: [Doc]
ppTriggerNames = forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ String
":")) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, [Maybe [String]])]
trigs)
ppObserverNames :: [Doc]
ppObserverNames :: [Doc]
ppObserverNames = forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ String
":")) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, [String])]
obsvs)
ppTriggerOutputs :: [[Doc]]
ppTriggerOutputs :: [[Doc]]
ppTriggerOutputs = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map Maybe [String] -> Doc
ppTriggerOutput) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(String, [Maybe [String]])]
trigs)
ppTriggerOutput :: Maybe [Output] -> Doc
ppTriggerOutput :: Maybe [String] -> Doc
ppTriggerOutput (Just [String]
vs) = String -> Doc
text forall a b. (a -> b) -> a -> b
$ String
"(" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. a -> [a] -> [a]
intersperse String
"," [String]
vs) forall a. [a] -> [a] -> [a]
++ String
")"
ppTriggerOutput Maybe [String]
Nothing = String -> Doc
text String
"--"
ppObserverOutputs :: [[Doc]]
ppObserverOutputs :: [[Doc]]
ppObserverOutputs = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(String, [String])]
obsvs)
renderAsCSV :: ExecTrace -> String
renderAsCSV :: ExecTrace -> String
renderAsCSV = Doc -> String
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecTrace -> Doc
unfold
unfold :: ExecTrace -> Doc
unfold :: ExecTrace -> Doc
unfold ExecTrace
r =
case ExecTrace -> (Doc, Maybe ExecTrace)
step ExecTrace
r of
(Doc
cs, Maybe ExecTrace
Nothing) -> Doc
cs
(Doc
cs, Just ExecTrace
r') -> Doc
cs Doc -> Doc -> Doc
$$ ExecTrace -> Doc
unfold ExecTrace
r'
step :: ExecTrace -> (Doc, Maybe ExecTrace)
step :: ExecTrace -> (Doc, Maybe ExecTrace)
step ExecTrace
{ interpTriggers :: ExecTrace -> [(String, [Maybe [String]])]
interpTriggers = [(String, [Maybe [String]])]
trigs
} =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, [Maybe [String]])]
trigs then (Doc
empty, forall a. Maybe a
Nothing)
else (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Doc -> Doc -> Doc
($$) Doc
empty (String -> Doc
text String
"#" forall a. a -> [a] -> [a]
: [Doc]
ppTriggerOutputs), Maybe ExecTrace
tails)
where
ppTriggerOutputs :: [Doc]
ppTriggerOutputs :: [Doc]
ppTriggerOutputs =
forall a. [Maybe a] -> [a]
catMaybes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Maybe [String]) -> Maybe Doc
ppTriggerOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> a
head)
forall a b. (a -> b) -> a -> b
$ [(String, [Maybe [String]])]
trigs
ppTriggerOutput :: (String, Maybe [Output]) -> Maybe Doc
ppTriggerOutput :: (String, Maybe [String]) -> Maybe Doc
ppTriggerOutput (String
_, Maybe [String]
Nothing) = forall a. Maybe a
Nothing
ppTriggerOutput (String
cs, Just [String]
xs) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
cs Doc -> Doc -> Doc
<> String -> Doc
text String
"," Doc -> Doc -> Doc
<>
(forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
(<>) Doc
empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse String
",") [String]
xs
tails :: Maybe ExecTrace
tails :: Maybe ExecTrace
tails =
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> [a]
tailforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) [(String, [Maybe [String]])]
trigs)
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just
ExecTrace
{ interpTriggers :: [(String, [Maybe [String]])]
interpTriggers = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> [a]
tail) [(String, [Maybe [String]])]
trigs
, interpObservers :: [(String, [String])]
interpObservers = []
}
asColumns :: [[Doc]] -> Doc
asColumns :: [[Doc]] -> Doc
asColumns = forall a b c. (a -> b -> c) -> b -> a -> c
flip [[Doc]] -> Int -> Doc
asColumnsWithBuff forall a b. (a -> b) -> a -> b
$ Int
1
asColumnsWithBuff :: [[Doc]] -> Int -> Doc
asColumnsWithBuff :: [[Doc]] -> Int -> Doc
asColumnsWithBuff [[Doc]]
lls Int
q = Doc
normalize
where
normalize :: Doc
normalize = [Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Doc] -> Doc
hsep
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\[Doc]
x -> forall a. Int -> Int -> a -> [a] -> [a]
pad (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc]
x) Int
longColumnLen Doc
empty [Doc]
x)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [[Doc]] -> [[Doc]]
pad' Int
longEntryLen Int
q
forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [[a]]
transpose [[Doc]]
lls
longColumnLen :: Int
longColumnLen = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Doc]]
lls)
longEntryLen :: Int
longEntryLen = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Doc -> Int
docLen (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Doc]]
lls)
docLen :: Doc -> Int
docLen Doc
d = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Doc -> String
render Doc
d
pad :: Int -> Int -> a -> [a] -> [a]
pad :: forall a. Int -> Int -> a -> [a] -> [a]
pad Int
lx Int
max a
b [a]
ls = [a]
ls forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
max forall a. Num a => a -> a -> a
- Int
lx) a
b
pad' :: Int
-> Int
-> [[Doc]]
-> [[Doc]]
pad' :: Int -> Int -> [[Doc]] -> [[Doc]]
pad' Int
_ Int
_ [] = []
pad' Int
mx Int
q ([Doc]
ls:[[Doc]]
xs) = forall a b. (a -> b) -> [a] -> [b]
map Doc -> Doc
buf [Doc]
ls forall a. a -> [a] -> [a]
: Int -> Int -> [[Doc]] -> [[Doc]]
pad' Int
mx Int
q [[Doc]]
xs
where
buf :: Doc -> Doc
buf Doc
x = Doc
x Doc -> Doc -> Doc
<> ([Doc] -> Doc
hcat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
q Doc
space) Doc -> Doc -> Doc
<> ([Doc] -> Doc
hcat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (Int
mx forall a. Num a => a -> a -> a
- (Doc -> Int
docLen Doc
x)) Doc
space)