{-# LANGUAGE DeriveGeneric #-}
module Copilot.Visualize.UntypedTrace
( AppData(..)
, Trace
, TraceElem(..)
, TraceValue(..)
, makeTraceEval
)
where
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)
import Copilot.Core (Spec (..), triggerArgs, triggerName)
import Copilot.Interpret.Eval (ExecTrace, Output, interpObservers,
interpTriggers)
data AppData = AppData
{ AppData -> Trace
adTraceElems :: Trace
, AppData -> Int
adLastSample :: Int
}
deriving ((forall x. AppData -> Rep AppData x)
-> (forall x. Rep AppData x -> AppData) -> Generic AppData
forall x. Rep AppData x -> AppData
forall x. AppData -> Rep AppData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AppData -> Rep AppData x
from :: forall x. AppData -> Rep AppData x
$cto :: forall x. Rep AppData x -> AppData
to :: forall x. Rep AppData x -> AppData
Generic, Int -> AppData -> ShowS
[AppData] -> ShowS
AppData -> String
(Int -> AppData -> ShowS)
-> (AppData -> String) -> ([AppData] -> ShowS) -> Show AppData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AppData -> ShowS
showsPrec :: Int -> AppData -> ShowS
$cshow :: AppData -> String
show :: AppData -> String
$cshowList :: [AppData] -> ShowS
showList :: [AppData] -> ShowS
Show)
instance ToJSON AppData
type Trace = [ TraceElem ]
data TraceElem = TraceElem
{ TraceElem -> String
teName :: String
, TraceElem -> Bool
teIsBoolean :: Bool
, TraceElem -> Bool
teIsFloat :: Bool
, TraceElem -> [TraceValue]
teValues :: [ TraceValue ]
}
deriving ((forall x. TraceElem -> Rep TraceElem x)
-> (forall x. Rep TraceElem x -> TraceElem) -> Generic TraceElem
forall x. Rep TraceElem x -> TraceElem
forall x. TraceElem -> Rep TraceElem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TraceElem -> Rep TraceElem x
from :: forall x. TraceElem -> Rep TraceElem x
$cto :: forall x. Rep TraceElem x -> TraceElem
to :: forall x. Rep TraceElem x -> TraceElem
Generic, Int -> TraceElem -> ShowS
Trace -> ShowS
TraceElem -> String
(Int -> TraceElem -> ShowS)
-> (TraceElem -> String) -> (Trace -> ShowS) -> Show TraceElem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceElem -> ShowS
showsPrec :: Int -> TraceElem -> ShowS
$cshow :: TraceElem -> String
show :: TraceElem -> String
$cshowList :: Trace -> ShowS
showList :: Trace -> ShowS
Show)
instance ToJSON TraceElem
data TraceValue = TraceValue
{ TraceValue -> String
tvValue :: String
, TraceValue -> Bool
tvIsEmpty :: Bool
}
deriving ((forall x. TraceValue -> Rep TraceValue x)
-> (forall x. Rep TraceValue x -> TraceValue) -> Generic TraceValue
forall x. Rep TraceValue x -> TraceValue
forall x. TraceValue -> Rep TraceValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TraceValue -> Rep TraceValue x
from :: forall x. TraceValue -> Rep TraceValue x
$cto :: forall x. Rep TraceValue x -> TraceValue
to :: forall x. Rep TraceValue x -> TraceValue
Generic, Int -> TraceValue -> ShowS
[TraceValue] -> ShowS
TraceValue -> String
(Int -> TraceValue -> ShowS)
-> (TraceValue -> String)
-> ([TraceValue] -> ShowS)
-> Show TraceValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceValue -> ShowS
showsPrec :: Int -> TraceValue -> ShowS
$cshow :: TraceValue -> String
show :: TraceValue -> String
$cshowList :: [TraceValue] -> ShowS
showList :: [TraceValue] -> ShowS
Show)
instance ToJSON TraceValue
makeTraceEval :: Int
-> Spec
-> ExecTrace
-> AppData
makeTraceEval :: Int -> Spec -> ExecTrace -> AppData
makeTraceEval Int
k Spec
spec ExecTrace
e =
Trace -> Int -> AppData
AppData (Trace
observerTEs Trace -> Trace -> Trace
forall a. [a] -> [a] -> [a]
++ Trace
triggerTEs) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
where
observerTEs :: Trace
observerTEs = ((String, [Maybe String]) -> TraceElem)
-> [(String, [Maybe String])] -> Trace
forall a b. (a -> b) -> [a] -> [b]
map (String, [Maybe String]) -> TraceElem
mkTraceElem (Spec -> ExecTrace -> [(String, [Maybe String])]
interpObserversOpt Spec
spec ExecTrace
e)
triggerTEs :: Trace
triggerTEs = ((String, [Maybe String]) -> TraceElem)
-> [(String, [Maybe String])] -> Trace
forall a b. (a -> b) -> [a] -> [b]
map (String, [Maybe String]) -> TraceElem
mkTraceElem (Spec -> ExecTrace -> [(String, [Maybe String])]
interpTriggersWithArgs Spec
spec ExecTrace
e)
mkTraceElem :: (String, [Maybe Output]) -> TraceElem
mkTraceElem :: (String, [Maybe String]) -> TraceElem
mkTraceElem (String
name, [Maybe String]
outputs) = TraceElem
{ teName :: String
teName = String
name
, teValues :: [TraceValue]
teValues = [TraceValue]
values
, teIsBoolean :: Bool
teIsBoolean = (TraceValue -> Bool) -> [TraceValue] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> Bool
isBoolean (String -> Bool) -> (TraceValue -> String) -> TraceValue -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceValue -> String
tvValue) [TraceValue]
values
, teIsFloat :: Bool
teIsFloat = (TraceValue -> Bool) -> [TraceValue] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> Bool
isFloat (String -> Bool) -> (TraceValue -> String) -> TraceValue -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceValue -> String
tvValue) [TraceValue]
values
}
where
values :: [TraceValue]
values = (Maybe String -> TraceValue) -> [Maybe String] -> [TraceValue]
forall a b. (a -> b) -> [a] -> [b]
map Maybe String -> TraceValue
mkTraceValue [Maybe String]
outputs
mkTraceValue :: Maybe Output -> TraceValue
mkTraceValue :: Maybe String -> TraceValue
mkTraceValue Maybe String
x = String -> Bool -> TraceValue
TraceValue (Maybe String -> String
showValue Maybe String
x) (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
x)
interpObserversOpt :: Spec -> ExecTrace -> [(String, [Maybe Output])]
interpObserversOpt :: Spec -> ExecTrace -> [(String, [Maybe String])]
interpObserversOpt Spec
_spec = ((String, [String]) -> (String, [Maybe String]))
-> [(String, [String])] -> [(String, [Maybe String])]
forall a b. (a -> b) -> [a] -> [b]
map (([String] -> [Maybe String])
-> (String, [String]) -> (String, [Maybe String])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((String -> Maybe String) -> [String] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe String
forall a. a -> Maybe a
Just)) ([(String, [String])] -> [(String, [Maybe String])])
-> (ExecTrace -> [(String, [String])])
-> ExecTrace
-> [(String, [Maybe String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecTrace -> [(String, [String])]
interpObservers
interpTriggersWithArgs :: Spec -> ExecTrace -> [(String, [Maybe Output])]
interpTriggersWithArgs :: Spec -> ExecTrace -> [(String, [Maybe String])]
interpTriggersWithArgs Spec
spec = ((String, [Maybe [String]]) -> [(String, [Maybe String])])
-> [(String, [Maybe [String]])] -> [(String, [Maybe String])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [Maybe [String]]) -> [(String, [Maybe String])]
triggerOutputs ([(String, [Maybe [String]])] -> [(String, [Maybe String])])
-> (ExecTrace -> [(String, [Maybe [String]])])
-> ExecTrace
-> [(String, [Maybe String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecTrace -> [(String, [Maybe [String]])]
interpTriggers
where
triggerOutputs :: (String, [Maybe [Output]]) -> [(String, [Maybe Output])]
triggerOutputs :: (String, [Maybe [String]]) -> [(String, [Maybe String])]
triggerOutputs (String
triggerName, [Maybe [String]]
triggerArgs) =
(String
triggerName, [Maybe String]
triggerValues) (String, [Maybe String])
-> [(String, [Maybe String])] -> [(String, [Maybe String])]
forall a. a -> [a] -> [a]
: [String] -> [[Maybe String]] -> [(String, [Maybe String])]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
argNames [[Maybe String]]
argValues
where
triggerValues :: [Maybe String]
triggerValues = (Maybe [String] -> Maybe String)
-> [Maybe [String]] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map Maybe [String] -> Maybe String
triggerValue [Maybe [String]]
triggerArgs
triggerValue :: Maybe [Output] -> Maybe Output
triggerValue :: Maybe [String] -> Maybe String
triggerValue Maybe [String]
Nothing = String -> Maybe String
forall a. a -> Maybe a
Just String
"false"
triggerValue (Just [String]
_) = String -> Maybe String
forall a. a -> Maybe a
Just String
"true"
argNames :: [String]
argNames = (Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
ix -> String
triggerName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Arg" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
ix) [Integer
0..]
argValues :: [[Maybe String]]
argValues = [[Maybe String]] -> [[Maybe String]]
forall a. [[a]] -> [[a]]
transpose (Int -> [Maybe [String]] -> [[Maybe String]]
forall a. Int -> [Maybe [a]] -> [[Maybe a]]
transMaybes Int
numArgs [Maybe [String]]
triggerArgs)
numArgs :: Int
numArgs = Spec -> String -> Int
triggerNumArgs Spec
spec String
triggerName
triggerNumArgs :: Spec -> String -> Int
triggerNumArgs :: Spec -> String -> Int
triggerNumArgs Spec
spec String
name =
case (Trigger -> Bool) -> [Trigger] -> Maybe Trigger
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Trigger
t -> Trigger -> String
triggerName Trigger
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name) (Spec -> [Trigger]
specTriggers Spec
spec) of
Maybe Trigger
Nothing -> String -> Int
forall a. HasCallStack => String -> a
error String
"Couldn't find given trigger in spec, should never occur!"
Just Trigger
t -> [UExpr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([UExpr] -> Int) -> [UExpr] -> Int
forall a b. (a -> b) -> a -> b
$ Trigger -> [UExpr]
triggerArgs Trigger
t
isBoolean :: String -> Bool
isBoolean :: String -> Bool
isBoolean String
"true" = Bool
True
isBoolean String
"false" = Bool
True
isBoolean String
_ = Bool
False
isFloat :: String -> Bool
isFloat :: String -> Bool
isFloat String
s = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
asInt Bool -> Bool -> Bool
|| Maybe Float -> Bool
forall a. Maybe a -> Bool
isJust Maybe Float
asFloat
where
asInt :: Maybe Int
asInt :: Maybe Int
asInt = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
s
asFloat :: Maybe Float
asFloat :: Maybe Float
asFloat = String -> Maybe Float
forall a. Read a => String -> Maybe a
readMaybe String
s
showValue :: Maybe Output -> String
showValue :: Maybe String -> String
showValue Maybe String
Nothing = String
"--"
showValue (Just String
s) | String -> Bool
isFloat String
s = ShowS
showValueFloat String
s
| Bool
otherwise = String
s
showValueFloat :: Output -> String
showValueFloat :: ShowS
showValueFloat = Double -> String
formatFloat (Double -> String) -> (String -> Double) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Double
forall a. Read a => String -> a
read
where
formatFloat :: Double -> String
formatFloat :: Double -> String
formatFloat = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.2g"
transMaybes :: Int -> [Maybe [a]] -> [[Maybe a]]
transMaybes :: forall a. Int -> [Maybe [a]] -> [[Maybe a]]
transMaybes = (Maybe [a] -> [Maybe a]) -> [Maybe [a]] -> [[Maybe a]]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe [a] -> [Maybe a]) -> [Maybe [a]] -> [[Maybe a]])
-> (Int -> Maybe [a] -> [Maybe a])
-> Int
-> [Maybe [a]]
-> [[Maybe a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe [a] -> [Maybe a]
forall {a}. Int -> Maybe [a] -> [Maybe a]
transMaybes'
where
transMaybes' :: Int -> Maybe [a] -> [Maybe a]
transMaybes' Int
argsLength (Just [a]
xs) = (a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just [a]
xs
transMaybes' Int
argsLength Maybe [a]
Nothing = Int -> Maybe a -> [Maybe a]
forall a. Int -> a -> [a]
replicate Int
argsLength Maybe a
forall a. Maybe a
Nothing