From 3b11901e6b398ea3cffda725dbc8410e8bf37a32 Mon Sep 17 00:00:00 2001
From: Marty Stumpf <thealmartyblog@gmail.com>
Date: Fri, 24 Sep 2021 11:24:49 -0700
Subject: [PATCH] Output to framegraph stack format.

---
 plutus-tx-plugin/executables/profile/Main.hs | 16 ++++++++++++----
 1 file changed, 12 insertions(+), 4 deletions(-)

diff --git a/plutus-tx-plugin/executables/profile/Main.hs b/plutus-tx-plugin/executables/profile/Main.hs
index bb1e1bc88ee..9a479501373 100644
--- a/plutus-tx-plugin/executables/profile/Main.hs
+++ b/plutus-tx-plugin/executables/profile/Main.hs
@@ -104,7 +104,7 @@ writeLogToFile fileName values = do
     WriteMode
     (\h -> hPutDoc h log)
   processed <- processLog filePath
-  writeFile (filePath<>".stacks") $ show processed
+  writeFile (filePath<>".stacks") processed
   pure ()
 
 data Stacks
@@ -117,6 +117,7 @@ data Stacks
   deriving (Show)
 
 -- processLog :: FilePath -> IO [([String],String, NominalDiffTime)]
+processLog :: FilePath -> IO [Char]
 processLog file = do
   content <- readFile file
   -- lEvents is in the form of [[t1,t2,t3,entering/exiting,var]]. Time is chopped to 3 parts.
@@ -134,7 +135,14 @@ processLog file = do
       lVar = map (!! 4) lEvents
       lTripleTimeVar = zip3 (lUTC lTime) lEnterOrExit lVar
       stacks = getStacks [] lTripleTimeVar
-  pure $ map (intercalate "; " . fst) stacks
+      fnsStacks = map (intercalate "; " . fst) stacks
+      stacksFgFormat (hdf:tlf) (hdt:tlt)=
+        hdf<>" "<>show hdt<>"\n":stacksFgFormat tlf tlt
+      stacksFgFormat _ _ = []
+  pure $
+    concat $
+      reverse $
+        stacksFgFormat fnsStacks (map ((*1000000) . snd) stacks)
 
 lUTC :: [String] -> [UTCTime]
 lUTC = map (read :: String -> UTCTime)
@@ -145,7 +153,7 @@ getStacks ::
   -- | the input log which is processed to a list of (UTCTime, entering/exiting, var name)
   [(UTCTime, String, String)] ->
   -- | a list of (fns it's in, var/function, the time spent on it)
-  [([String],NominalDiffTime)]
+  [([String],Double)]
 getStacks curStack (hd:tl) =
   case hd of
     (time, "entering", var) ->
@@ -167,7 +175,7 @@ getStacks curStack (hd:tl) =
           in
             -- time spent on this function is the total time spent
             -- minus the time spent on the functions it called.
-            (fnsEntered <> [var], duration - curTimeSpent):getStacks updatedStack tl
+            (fnsEntered <> [var], realToFrac (duration - curTimeSpent)::Double):getStacks updatedStack tl
         else error "getStacks: exiting a stack that is not on top of the stack."
     (_, what, _) -> error $
       show what <>