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