UntypedTrace.hs

{-# LANGUAGE DeriveGeneric #-}
-- |
-- Copyright : (c) NASA, 2024-2025
-- License   : BSD-style (see the LICENSE file in the distribution)
--
-- Abstract representation of a trace as a series named streams with their
-- values, together with functions needed to convert a 'Spec' into a trace.
--
-- This trace is flat (untyped). Information about the types is captured
-- using boolean flags. This kind of trace is most useful to render values
-- on in logicless templates, since they don't have the capability to examine
-- the Haskell types.
module Copilot.Visualize.UntypedTrace
    ( AppData(..)
    , Trace
    , TraceElem(..)
    , TraceValue(..)
    , makeTraceEval
    )
  where

-- External imports
import Data.Aeson     (ToJSON (..))
import Data.Bifunctor (second)
import Data.List      (find, transpose)
import Data.Maybe     (isJust, isNothing)
import GHC.Generics   (Generic)
import Text.Printf    (printf)
import Text.Read      (readMaybe)

-- External imports: Copilot
import Copilot.Core           (Spec (..), triggerArgs, triggerName)
import Copilot.Interpret.Eval (ExecTrace, Output, interpObservers,
                               interpTriggers)

-- * Abstract representation of a trace

-- | Data related to a specification.
data AppData = AppData
    { adTraceElems :: Trace
    , adLastSample :: Int
    }
  deriving (Generic, Show)

instance ToJSON AppData

-- | A trace, defined by a list of trace elements, each defining a stream (in
-- an abstract sense).
type Trace = [ TraceElem ]

-- | An element of a trace, or stream, with a name, its values, and information
-- about its type, needed to render it correctly.
data TraceElem = TraceElem
    { teName      :: String
    , teIsBoolean :: Bool
    , teIsFloat   :: Bool
    , teValues    :: [ TraceValue ]
    }
  deriving (Generic, Show)

instance ToJSON TraceElem

-- | An individual sample, with a value and an indication of whether the sample
-- exists.
data TraceValue = TraceValue
    { tvValue   :: String
    , tvIsEmpty :: Bool
    }
  deriving (Generic, Show)

instance ToJSON TraceValue

-- | Generate an abstract representation of a trace of a specification
-- interpreted for a given number of steps.
makeTraceEval :: Int
              -> Spec
              -> ExecTrace
              -> AppData
makeTraceEval k spec e =
    AppData (observerTEs ++ triggerTEs) (k - 1)
  where
    observerTEs = map mkTraceElem (interpObserversOpt spec e)
    triggerTEs  = map mkTraceElem (interpTriggersWithArgs spec e)

-- | Generate an element of a trace from a stream name and its values over
-- time.
mkTraceElem :: (String, [Maybe Output]) -> TraceElem
mkTraceElem (name, outputs) = TraceElem
    { teName      = name
    , teValues    = values
    , teIsBoolean = any (isBoolean . tvValue) values
    , teIsFloat   = any (isFloat . tvValue) values
    }
  where
    values = map mkTraceValue outputs

-- | Generate an individual value (sample) of a trace.
mkTraceValue :: Maybe Output -> TraceValue
mkTraceValue x = TraceValue (showValue x) (isNothing x)

-- * Auxiliary functions

-- | Compute the list of values associated to observers.
interpObserversOpt :: Spec -> ExecTrace -> [(String, [Maybe Output])]
interpObserversOpt _spec = map (second (map Just)) . interpObservers

-- | Compute the list of values associated to triggers and their arguments.
--
-- For each trigger, we first include the values of the trigger itself, and
-- then the values of the arguments to the trigger.
interpTriggersWithArgs :: Spec -> ExecTrace -> [(String, [Maybe Output])]
interpTriggersWithArgs spec = concatMap triggerOutputs . interpTriggers
  where
    -- This function adds one more output for the trigger itself.
    triggerOutputs :: (String, [Maybe [Output]]) -> [(String, [Maybe Output])]
    triggerOutputs (triggerName, triggerArgs) =
        (triggerName, triggerValues) : zip argNames argValues
      where
        triggerValues = map triggerValue triggerArgs

        -- Value for the trigger at a given time, based on the values of its
        -- arguments.
        triggerValue :: Maybe [Output] -> Maybe Output
        triggerValue Nothing  = Just "false"
        triggerValue (Just _) = Just "true"

        -- Names and values for the arguments.
        argNames  = map (\ix -> triggerName ++ "Arg" ++ show ix) [0..]
        argValues = transpose (transMaybes numArgs triggerArgs)
        numArgs   = triggerNumArgs spec triggerName

-- Number of arguments to a trigger in a spec.
--
-- PRE: name exists as a trigger in spec.
triggerNumArgs :: Spec -> String -> Int
triggerNumArgs spec name =
  case find (\t -> triggerName t == name) (specTriggers spec) of
    Nothing -> error "Couldn't find given trigger in spec, should never occur!"
    Just t  -> length $ triggerArgs t

-- | True if the input value denotes a boolean value.
isBoolean :: String -> Bool
isBoolean "true"  = True
isBoolean "false" = True
isBoolean _       = False

-- | True if the input value denotes a floating point value.
isFloat :: String -> Bool
isFloat s = isJust asInt || isJust asFloat
  where
    asInt :: Maybe Int
    asInt = readMaybe s

    asFloat :: Maybe Float
    asFloat = readMaybe s

-- | Show a value.
showValue :: Maybe Output -> String
showValue Nothing  = "--"
showValue (Just s) | isFloat s = showValueFloat s
                   | otherwise = s

-- | Show a floating point value.
showValueFloat :: Output -> String
showValueFloat = formatFloat . read
  where
    formatFloat :: Double -> String
    formatFloat = printf "%.2g"

-- | Given a list of maybe lists of known length, this function creates a list
-- of lists, pushing the Maybe's inside.
transMaybes :: Int -> [Maybe [a]] -> [[Maybe a]]
transMaybes = map . transMaybes'
  where
    transMaybes' argsLength (Just xs) = map Just xs
    transMaybes' argsLength Nothing   = replicate argsLength Nothing