-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.

-- | Pretty-print the results of a simulation.

{-# 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 ((<>))

-- | Render an execution trace as a table, formatted to faciliate readability.
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
                                  (Doc -> String) -> ([[Doc]] -> Doc) -> [[Doc]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Doc]] -> Doc
asColumns
                                  ([[Doc]] -> Doc) -> ([[Doc]] -> [[Doc]]) -> [[Doc]] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Doc]] -> [[Doc]]
forall a. [[a]] -> [[a]]
transpose
                                  ([[Doc]] -> [[Doc]]) -> ([[Doc]] -> [[Doc]]) -> [[Doc]] -> [[Doc]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) ([Doc]
ppTriggerNames [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
ppObserverNames)
                                  ([[Doc]] -> [[Doc]]) -> ([[Doc]] -> [[Doc]]) -> [[Doc]] -> [[Doc]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Doc]] -> [[Doc]]
forall a. [[a]] -> [[a]]
transpose
                                  ) ([[Doc]]
ppTriggerOutputs [[Doc]] -> [[Doc]] -> [[Doc]]
forall a. [a] -> [a] -> [a]
++ [[Doc]]
ppObserverOutputs)
     where

     ppTriggerNames :: [Doc]
     ppTriggerNames :: [Doc]
ppTriggerNames  = (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":")) (((String, [Maybe [String]]) -> String)
-> [(String, [Maybe [String]])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [Maybe [String]]) -> String
forall a b. (a, b) -> a
fst [(String, [Maybe [String]])]
trigs)

     ppObserverNames :: [Doc]
     ppObserverNames :: [Doc]
ppObserverNames = (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":")) (((String, [String]) -> String) -> [(String, [String])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [String]) -> String
forall a b. (a, b) -> a
fst [(String, [String])]
obsvs)

     ppTriggerOutputs :: [[Doc]]
     ppTriggerOutputs :: [[Doc]]
ppTriggerOutputs = ([Maybe [String]] -> [Doc]) -> [[Maybe [String]]] -> [[Doc]]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe [String] -> Doc) -> [Maybe [String]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Maybe [String] -> Doc
ppTriggerOutput) (((String, [Maybe [String]]) -> [Maybe [String]])
-> [(String, [Maybe [String]])] -> [[Maybe [String]]]
forall a b. (a -> b) -> [a] -> [b]
map (String, [Maybe [String]]) -> [Maybe [String]]
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 (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"," [String]
vs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
     ppTriggerOutput Maybe [String]
Nothing   = String -> Doc
text String
"--"

     ppObserverOutputs :: [[Doc]]
     ppObserverOutputs :: [[Doc]]
ppObserverOutputs = ([String] -> [Doc]) -> [[String]] -> [[Doc]]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text) (((String, [String]) -> [String])
-> [(String, [String])] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (String, [String]) -> [String]
forall a b. (a, b) -> b
snd [(String, [String])]
obsvs)

-- | Render an execution trace as using comma-separate value (CSV) format.
renderAsCSV :: ExecTrace -> String
renderAsCSV :: ExecTrace -> String
renderAsCSV = Doc -> String
render (Doc -> String) -> (ExecTrace -> Doc) -> ExecTrace -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecTrace -> Doc
unfold

-- | Pretty print all the steps of the execution trace and concatenate the
-- results.
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'

-- | Pretty print the state of the triggers, and provide a continuation
-- for the execution trace at the next point in time.
step :: ExecTrace -> (Doc, Maybe ExecTrace)
step :: ExecTrace -> (Doc, Maybe ExecTrace)
step ExecTrace
       { interpTriggers :: ExecTrace -> [(String, [Maybe [String]])]
interpTriggers  = [(String, [Maybe [String]])]
trigs
       } =
  if [(String, [Maybe [String]])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, [Maybe [String]])]
trigs then (Doc
empty, Maybe ExecTrace
forall a. Maybe a
Nothing)
    else ((Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Doc -> Doc -> Doc
($$) Doc
empty (String -> Doc
text String
"#" Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
ppTriggerOutputs), Maybe ExecTrace
tails)

  where

  ppTriggerOutputs :: [Doc]
  ppTriggerOutputs :: [Doc]
ppTriggerOutputs =
      [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
catMaybes
    ([Maybe Doc] -> [Doc])
-> ([(String, [Maybe [String]])] -> [Maybe Doc])
-> [(String, [Maybe [String]])]
-> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Maybe [String]) -> Maybe Doc)
-> [(String, Maybe [String])] -> [Maybe Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Maybe [String]) -> Maybe Doc
ppTriggerOutput
    ([(String, Maybe [String])] -> [Maybe Doc])
-> ([(String, [Maybe [String]])] -> [(String, Maybe [String])])
-> [(String, [Maybe [String]])]
-> [Maybe Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, [Maybe [String]]) -> (String, Maybe [String]))
-> [(String, [Maybe [String]])] -> [(String, Maybe [String])]
forall a b. (a -> b) -> [a] -> [b]
map (([Maybe [String]] -> Maybe [String])
-> (String, [Maybe [String]]) -> (String, Maybe [String])
forall a b. (a -> b) -> (String, a) -> (String, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe [String]] -> Maybe [String]
forall a. HasCallStack => [a] -> a
head)
    ([(String, [Maybe [String]])] -> [Doc])
-> [(String, [Maybe [String]])] -> [Doc]
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) = Maybe Doc
forall a. Maybe a
Nothing
  ppTriggerOutput (String
cs, Just [String]
xs) = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
    String -> Doc
text String
cs Doc -> Doc -> Doc
<> String -> Doc
text String
"," Doc -> Doc -> Doc
<>
      ((Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
(<>) Doc
empty ([Doc] -> Doc) -> ([String] -> [Doc]) -> [String] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text ([String] -> [Doc]) -> ([String] -> [String]) -> [String] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
",") [String]
xs

  tails :: Maybe ExecTrace
  tails :: Maybe ExecTrace
tails =
    if ([Maybe [String]] -> Bool) -> [[Maybe [String]]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Maybe [String]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (((String, [Maybe [String]]) -> [Maybe [String]])
-> [(String, [Maybe [String]])] -> [[Maybe [String]]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Maybe [String]] -> [Maybe [String]]
forall a. HasCallStack => [a] -> [a]
tail([Maybe [String]] -> [Maybe [String]])
-> ((String, [Maybe [String]]) -> [Maybe [String]])
-> (String, [Maybe [String]])
-> [Maybe [String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String, [Maybe [String]]) -> [Maybe [String]]
forall a b. (a, b) -> b
snd) [(String, [Maybe [String]])]
trigs)
      then Maybe ExecTrace
forall a. Maybe a
Nothing
      else ExecTrace -> Maybe ExecTrace
forall a. a -> Maybe a
Just
        ExecTrace
          { interpTriggers :: [(String, [Maybe [String]])]
interpTriggers  = ((String, [Maybe [String]]) -> (String, [Maybe [String]]))
-> [(String, [Maybe [String]])] -> [(String, [Maybe [String]])]
forall a b. (a -> b) -> [a] -> [b]
map (([Maybe [String]] -> [Maybe [String]])
-> (String, [Maybe [String]]) -> (String, [Maybe [String]])
forall a b. (a -> b) -> (String, a) -> (String, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe [String]] -> [Maybe [String]]
forall a. HasCallStack => [a] -> [a]
tail) [(String, [Maybe [String]])]
trigs
          , interpObservers :: [(String, [String])]
interpObservers = []
          }

-- Copied from pretty-ncols because of incompatibility with newer GHC versions.
asColumns :: [[Doc]] -> Doc
asColumns :: [[Doc]] -> Doc
asColumns = ([[Doc]] -> Int -> Doc) -> Int -> [[Doc]] -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip [[Doc]] -> Int -> Doc
asColumnsWithBuff (Int -> [[Doc]] -> Doc) -> Int -> [[Doc]] -> Doc
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ([Doc] -> Doc) -> [[Doc]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [Doc] -> Doc
hsep
                    ([[Doc]] -> [Doc]) -> [[Doc]] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ([Doc] -> [Doc]) -> [[Doc]] -> [[Doc]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Doc]
x -> Int -> Int -> Doc -> [Doc] -> [Doc]
forall a. Int -> Int -> a -> [a] -> [a]
pad ([Doc] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc]
x) Int
longColumnLen Doc
empty [Doc]
x)
                    ([[Doc]] -> [[Doc]]) -> [[Doc]] -> [[Doc]]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [[Doc]] -> [[Doc]]
pad' Int
longEntryLen Int
q
                    ([[Doc]] -> [[Doc]]) -> [[Doc]] -> [[Doc]]
forall a b. (a -> b) -> a -> b
$ [[Doc]] -> [[Doc]]
forall a. [[a]] -> [[a]]
transpose [[Doc]]
lls -- normalize column height
          longColumnLen :: Int
longColumnLen = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (([Doc] -> Int) -> [[Doc]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Doc] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Doc]]
lls)
          longEntryLen :: Int
longEntryLen = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Doc -> Int) -> [Doc] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> Int
docLen ([[Doc]] -> [Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Doc]]
lls)

docLen :: Doc -> Int
docLen Doc
d = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ Doc -> String
render Doc
d

-- | Pad a string on the right to reach an expected length.
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 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
max Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lx) a
b

-- | Pad a list of strings on the right with spaces.
pad' :: Int      -- ^ Mininum number of spaces to add
     -> Int      -- ^ Maximum number of spaces to add
     -> [[Doc]]  -- ^ List of documents to pad
     -> [[Doc]]
pad' :: Int -> Int -> [[Doc]] -> [[Doc]]
pad' Int
_ Int
_ []       = []
pad' Int
mx Int
q ([Doc]
ls:[[Doc]]
xs) = (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> Doc
buf [Doc]
ls [Doc] -> [[Doc]] -> [[Doc]]
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate Int
q Doc
space) Doc -> Doc -> Doc
<> ([Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate (Int
mx Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Doc -> Int
docLen Doc
x)) Doc
space)