working on readme

README.md

@@ -1,7 +1,183 @@
 # Graph Trace
 
-A ghc plugin that a creates a log file which can be compiled to a graph for
-display with `graphviz` or some other means. Contrary to traditional debug
-tracing where all output is interleaved into a flat sequence of lines, the
-graph structure produced by this plugin takes into account the actual flow of
-the program with individual function calls represented as edges in the graph.
+A GHC plugin that causes your Haskell program to create a log file which can be
+compiled to a graph for display with `Graphviz` or some other means. Contrary
+to traditional debug tracing where all output is interleaved into a flat
+sequence of lines, the graph structure produced by this plugin takes into
+account the actual call graph of the program with individual function calls
+represented as edges in the graph.
+
+__Contents:__
+- [Demonstration](#demonstration)
+- [Quickstart](#quickstart)
+- [User's guide](#users-guide)
+  - [`Graph.Trace` plugin](#graphtrace-plugin)
+  - [`graph-trace-viz` utility](#graph-trace-viz-utility)
+- [Caveats](#caveats)
+
+## Demonstration
+
+Consider this simplistic program that greets the user by name:
+```haskell
+import Graph.Trace (TraceDeep, traceM)
+import Data.Char (toUpper, toLower)
+
+main :: TraceDeep => IO ()
+main = do
+  firstName <- prompt "Enter your first name"
+  lastName <- prompt "Enter your last name"
+  greet firstName lastName
+
+prompt :: String -> IO String
+prompt str = do
+  putStrLn str
+  input <- getLine
+  traceM $ "input: " <> input
+  pure $ capitalize input
+
+capitalize :: String -> String
+capitalize [] = []
+capitalize (x:xs) = toUpper x : map toLower xs
+
+greet :: String -> String -> IO ()
+greet firstName lastName =
+  putStrLn $ "Hello, " <> firstName <> " " <> lastName <> "!"
+```
+
+Using the `Graph.Trace` plugin along with the `graph-trace-viz` utility, we can
+run this program to generate the following trace of the call graph:
+
+![demo image](/images/demo.svg)
+
+## Quickstart
+
+1. Add the `graph-trace` package as a dependency to your project.
+2. Enable the plugin by adding the following GHC options:
+   `-fplugin=Graph.Trace -fplugin-opt Graph.Trace:debug-all -fno-full-laziness -fno-cse`.
+   This can be placed in the `ghc-options` field of the cabal or
+   package.yaml file (depending on whether you use cabal or stack to build).
+   For example:
+
+   in `package.yaml`:
+   ```
+   executables:
+     my-exe:
+       ...
+       ghc-options:
+         -fplugin=Graph.Trace
+         -fplugin-opt Graph.Trace:debug-all
+         -fno-full-laziness
+         -fno-cse
+   ```
+   or in `foo.cabal`:
+   ```
+   executable my-exe
+     ...
+     ghc-options:
+       -fplugin=Graph.Trace
+       -fplugin-opt Graph.Trace:debug-all
+       -fno-full-laziness
+       -fno-cse
+   ```
+3. Build your project (`cabal build all` or `stack build`).
+4. Running your program should now generate a file called `<executable-name>.trace`.
+5. Install [Graphviz](https://graphviz.org) and the `graph-trace-viz` program.
+   Invoke `graph-trace-viz` within the same directory as the trace file.
+6. There should now be a file such as `<executable-name>.html` which can be
+   viewed in your browser.
+
+## User's Guide
+
+### `Graph.Trace` plugin
+To use this plugin simply add `graph-trace` as a package dependency and pass
+the `-fplugin=Graph.Trace` option to GHC.
+The main functionality of the `Graph.Trace` plugin is to automatically
+instrument your code so that it will emit trace logging to a `*.trace` file
+when run. There are two types of traces:
+- __Function call__  
+  This trace is emitted when the term returned by a function is evaluated to
+  WHNF. Each emission of an entry trace generates a unique ID for that particular
+  function invocation. The trace also includes the ID of the code from which the
+  function was called (if applicable) so that a graph edge can be constructed
+  between the two. Entry traces are only emitted for functions that have
+  signatures.  If the function does not have a signature then it will simply
+  inherit the ID of the calling context and will therefore not generate a new
+  node in the call graph.
+
+- __Debug trace__  
+  Debug traces are textual messages that the user can emit from the body of a
+  function. When rendered, they appear as plain text in the body of a call graph
+  node. The API for debug traces matches that of the familiar `Debug.Trace`
+  module and is available through the `Graph.Trace` module. A debug trace will
+  only be emitted when the thing it is applied to is evaluated to WHNF.
+
+The plugin gives you some control over how and when traces are emitted.  There
+are a variety of constraints you can put on function signatures to control
+tracing, all of which are exported by `Graph.Trace`:
+
+- `Trace`  
+  On its own, this constraint says that traces should be emitted for a given
+  function using the name of that function as the identifier. Notably, function
+  calls made from within the body of the function do not inherit this behavior
+  and so will not emit traces unless otherwise instructed to do so.
+
+- `TraceDeep`  
+  This is similar to `Trace` except that function calls made within the function
+  body will also emit traces even if they don't have a trace constraint (unless
+  they are being muted). For example, putting `TraceDeep` on the `main` function
+  will result in the full execution the program being traced.
+
+- `TraceMute`  
+  If a function has this constraint then any invocation of it as well as the
+  function calls it makes will not emit any traces. This constraint overrides all
+  the others and is inherited by function calls made from within its body.
+
+- `TraceKey`  
+  This constraint is the same as `Trace` but it takes a type level string
+  argument which will be used as the function identifier instead of the
+  function's actual name. Notably, if the identifier of a called function is
+  overridden to be the same as that of the function calling it then its output
+  will be placed in the graph node of the calling function rather than
+  generating its own node. There is also a `TraceDeepKey` constraint that does
+  the same thing but for `TraceDeep`.
+
+If you want every function in your program to emit traces, you can use the
+`debug-all` plugin option which effectively adds the `Trace` constraint to all
+function definitons. To use this option, pass the `-fplugin-opt Graph.Trace:debug-all`
+option to GHC in addition to `-fplugin=Graph.Trace`.
+
+If a trace file already exists for your executable being then new entries will
+be appended to that file. To start a new trace you'll need to rename or delete
+the old file.
+
+### `graph-trace-viz` utility
+Once you've generated a `*.trace` file by compiling your program with the
+`Graph.Trace` plugin and running it, the `graph-trace-viz` utility can render
+the graph as an html document. It is dependent on
+[Graphviz](https://graphviz.org), so you must install that on your system
+(there should be an executable called `dot` on your PATH). Simply invoke
+`graph-trace-viz` in the same directory as the `*.trace` file and it will write
+an `*.html` document. By default it will read all trace files in the current
+directory but you can specify the files by giving them as command line
+arguments instead.
+
+## Caveats
+
+There are several known caveats you should be aware of:
+
+- __Undesirable optimisations__  
+  If you compile with the common sub-expression or full laziness optimisations,
+  which are on by default for `O1` and `O2` settings, graph nodes that should
+  be distinct can sometimes get merged into a single node. To prevent this, it
+  is recommended that you turn these optimisations off using the `-fno-cse` and
+  `-fno-full-laziness` flags when compiling with the `graph-trace` plugin.
+- __Type class methods__  
+  For type class instance methods to be traced correctly, the class method
+  definitions must be in a package compiled with the plugin and you'll also
+  need to put a type signature on the instance method declarations, which
+  requires the `InstanceSigs` GHC extension.
+- __Impredicative types__  
+  If you have a function binding that takes a rank-n quantified type as a
+  parameter, this can cause compilation with the plugin to fail. With GHC 9.2
+  and above, giving a type signature to the binding will resolve the issue.
+- The plugin does not support GHC versions less than 8.10

exe/app/Class.hs

@@ -1,9 +1,10 @@
+{-# OPTIONS_GHC -fplugin=Graph.Trace #-}
 module Class where
 
 import           Graph.Trace
 
 class Show a => Classy a where
-  classy :: Trace => a -> String
+  classy :: a -> String
 
   deff :: Trace => a -> String
   deff = show

exe/app/Main.hs

@@ -3,6 +3,8 @@
 -- {-# OPTIONS_GHC -fno-full-laziness -fno-cse #-}
 --{-# OPTIONS_GHC -ddump-rn-ast #-}
 
+{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -17,123 +19,152 @@ import           Data.Functor.Identity (Identity(..))
 import Graph.Trace
 --import           Debug.Trace
 import Class
+import           Data.Char
 
 import qualified System.Random as Rand
 import           System.IO.Unsafe
 
 main :: TraceDeep => IO ()
-main = trace bah print unassuming >> buzzard
-  where
-    unassuming :: Either Bool Int
-    --thisIsABoolean :: Bool
-    unassuming@(Left thisIsABoolean@True) =
-      trace bah $! (Left True :: Either Bool Int)
+main = do
+  firstName <- prompt "Enter your first name"
+  lastName <- prompt "Enter your last name"
+  greet firstName lastName
 
-    buzzard = do
-      putStrLn $ "please, help" <&> "boo"
-      traceM bah
+prompt :: String -> IO String
+prompt str = do
+  putStrLn str
+  input <- getLine
+  traceM $ "input: " <> input
+  pure $ capitalize input
 
-    bah :: String
-    bah = unsafePerformIO $ do
-      getLine
+capitalize :: String -> String
+capitalize [] = []
+capitalize (x:xs) = toUpper x : map toLower xs
 
-(<&>) :: String -> String -> String
-a <&> b = a
+greet :: String -> String -> IO ()
+greet first last =
+  putStrLn $ "Hello, " <> first <> " " <> last <> "!"
 
---         where
---           inFlight = putStrLn "need help now"
-         -- shitty = ()
-  --replicateM_ 2 $ forkIO test
---   andAnother
---   test'
+{-# NOINLINE main #-}
+-- main :: TraceDeep => IO ()
+-- main = trace bah print unassuming >> buzzard
+--   where
+--     unassuming :: Either Bool Int
+--     --thisIsABoolean :: Bool
+--     unassuming@(Left thisIsABoolean@True) =
+--       trace bah $! (Left True :: Either Bool Int)
+-- 
+--     buzzard = do
+--       putStrLn $ "hello" <&> "boo"
+--       traceM bah
+-- 
+--     bah :: String
+--     bah = unsafePerformIO $ do
+--       getLine
+-- (<&>) :: String -> String -> String
+-- a <&> b = a
 
--- test' :: IO ()
--- test' = do
---   andAnother
---   trace "test\ntest" pure ()
---   traceM "yo"
---   putStrLn $ deff (I 3)
---   x <- readLn
---   case x of
---     3 -> putStrLn $ classy (I x)
---     _ -> pure ()
---   putStrLn $ classier (I 5)
---   inWhere
---   let inLet :: IO ()
---       inLet = do
---         letWhere
---         another
---           where letWhere = trace ("hello" \/& "two") pure ()
---   inLet
---   !_ <- another
---   let letBound = letBoundThing
---   trace letBound pure ()
---   trace "leaving" pure ()
---     where
---       inWhere :: Debug => IO ()
---       inWhere = do
---         innerWhere
---           where
---             innerWhere :: Debug => IO ()
---             innerWhere = trace "innerWhere" pure ()
--- 
--- another :: Debug => IO ()
--- another
---   | trace "another" True = do
---     pure ()
---   | otherwise = pure ()
--- 
--- andAnother :: Debug => IO ()
--- andAnother = trace "hello!" pure ()
--- 
--- letBoundThing :: Debug => String
--- letBoundThing = "bound by let"
--- 
--- (\/&) :: String -> String -> String
--- a \/& b = the a <> ('\\' : b)
--- 
--- the :: a -> a
--- the = id
--- 
--- newtype I = I Int deriving Show
--- 
--- instance Classy I where
---   classy :: Debug => I -> String
---   classy = boo
---     where
---       boo :: Debug => I -> String
---       boo i = trace (show i) "..."
--- 
--- instance Classier I where
---   classier = show
+-- main :: Trace => IO ()
+-- main = test'
+
+test' :: Trace => IO ()
+test' = do
+  andAnother
+  trace "test\ntest" pure ()
+  traceM "yo"
+  putStrLn $ deff (I 3)
+  x <- readLn
+  case x of
+    3 -> putStrLn $ classy (I x)
+    _ -> pure ()
+  putStrLn $ classier (I 5)
+  inWhere
+  let inLet :: Trace => IO ()
+      inLet = do
+        letWhere
+        another
+          where letWhere = trace ("hello" \/& "two") pure ()
+  inLet
+  !_ <- another
+  let letBound = letBoundThing
+  trace letBound pure ()
+  trace "leaving" pure ()
+    where
+      inWhere :: Trace => IO ()
+      inWhere = do
+        innerWhere
+          where
+            innerWhere :: Trace => IO ()
+            innerWhere = trace "innerWhere" pure ()
+
+another :: Trace => IO ()
+another
+  | trace "another" True = do
+    pure ()
+  | otherwise = pure ()
+
+andAnother :: (Trace, Monad m) => m ()
+andAnother = trace "hello!" pure ()
+
+letBoundThing :: Trace => String
+letBoundThing = "bound by let"
+
+(\/&) :: String -> String -> String
+a \/& b = the a <> ('\\' : b)
+
+the :: a -> a
+the = id
+
+newtype I = I Int deriving Show
+
+instance Classy I where
+  classy :: Trace => I -> String
+  classy = boo
+    where
+      boo :: Trace => I -> String
+      boo i = trace (show i) "..."
+
+instance Classier I where
+  classier = show
 -- 
 -- -- test :: (?x :: String) => IO ()
 -- -- test = print ?x
 -- 
--- data FieldUpdate a
---   = FieldValue a
---   | FieldOmitted
---   | FieldNull
--- 
--- mkUpdater :: f FieldUpdate
---           -> f Maybe
---           -> (forall a. f a -> a x)
---           -> Maybe x
--- mkUpdater update original getField =
---   case getField update of
---     FieldValue a -> Just a
---     FieldOmitted -> getField original
---     FieldNull -> Nothing
--- 
--- data T f =
---   MkT
---     { t1 :: f Bool
---     , t2 :: f String
---     }
--- 
+data FieldUpdate a
+  = FieldValue a
+  | FieldOmitted
+  | FieldNull
+
+mkUpdater :: f FieldUpdate
+          -> f Maybe
+          -> (forall a. f a -> a x)
+          -> Maybe x
+mkUpdater update original getField =
+  case getField update of
+    FieldValue a -> Just a
+    FieldOmitted -> getField original
+    FieldNull -> Nothing
+
+data T f =
+  MkT
+    { t1 :: f Bool
+    , t2 :: f String
+    }
+
+type TY = forall x. (forall a. T a -> a x) -> Maybe x
+
+-- zz :: Int
+-- zz =
+--   let x :: [forall x. x -> x]
+--       x = [id, id]
+--    in id head x 4
+
+zzz :: Int
+zzz = id head [1,2,3]
+
 -- zzzz :: T FieldUpdate -> T Maybe -> T Maybe
 -- zzzz update orig =
---   let updater :: DebugMute => (forall a. T a -> a x) -> Maybe x
+--   let updater :: TY --(forall a. T a -> a x) -> Maybe x
 --       updater | let ?x = 1
 --         = mkUpdater update orig
 --    in MkT
@@ -141,34 +172,15 @@ a <&> b = a
 --         , t2 = updater t2
 --         }
 
--- fzzz :: (?_debug_ip :: Maybe DebugIPTy) => T FieldUpdate -> T Maybe -> T Maybe
+-- fzzz :: Trace => T FieldUpdate -> T Maybe -> T Maybe
 -- fzzz update orig = entry $
---   let --updater :: (?_debug_ip :: Maybe DebugIPTy)
---       --        => (forall a. T a -> a x) -> Maybe x
+--   let updater :: -- (?_debug_ip :: Maybe DebugContext)
+--               (forall a. T a -> a x) -> Maybe x
 --       updater -- | let ?_debug_ip = newIP'
 --               = --entry $
 --                 mkUpdater update orig
---         where
---           newIP' =
---             let mPrevTag = fmap snd ?_debug_ip
---              in unsafePerformIO $ do
---                     newId <- Rand.randomIO :: IO Word
---                     let newTag = DT
---                           { invocationId = newId
---                           , debugKey = Right "test"
---                           }
---                     pure $ Just (mPrevTag, newTag)
+--       addOne = (+1)
 --    in MkT
 --      { t1 = updater t1
 --      , t2 = updater t2
 --      }
---   where
---     newIP =
---       let mPrevTag = fmap snd ?_debug_ip
---        in unsafePerformIO $ do
---               newId <- Rand.randomIO :: IO Word
---               let newTag = DT
---                     { invocationId = newId
---                     , debugKey = Right "test"
---                     }
---               pure $ Just (mPrevTag, newTag)

exe/exe.cabal

@@ -34,4 +34,4 @@ executable test-exe
                      , random
   -- hs-source-dirs:
   default-language:    Haskell2010
---  ghc-options: -fplugin=Graph.Trace
+--  ghc-options: -fplugin=Graph.Trace -fplugin-opt Graph.Trace:debug-all -fno-cse -fno-full-laziness

images/demo.svg

@@ -0,0 +1,106 @@
+<svg width="198pt" height="187pt"
+ viewBox="0.00 0.00 197.50 187.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">
+<g id="graph0" class="graph" transform="scale(1 1) rotate(0) translate(4 183)">
+<polygon fill="white" stroke="transparent" points="-4,4 -4,-183 193.5,-183 193.5,4 -4,4"/>
+<!-- main138835950170271710 -->
+<g id="node1" class="node">
+<title>main138835950170271710</title>
+<g id="a_node1"><a xlink:title=" ">
+<g id="a_node1_0"><a xlink:title="defined at app/Main.hs:28:1">
+<polygon fill="none" stroke="black" points="75,-150 75,-175 116,-175 116,-150 75,-150"/>
+<text text-anchor="start" x="80" y="-159.8" font-family="Times,serif" font-weight="bold" font-size="14.00">main</text>
+</a>
+</g>
+<g id="a_node1_1"><a xlink:href="#prompt924477568213965436" xlink:title="called at app/Main.hs:29:16">
+<polygon fill="#a6d854" stroke="transparent" points="75,-137 75,-150 116,-150 116,-137 75,-137"/>
+<polygon fill="none" stroke="black" points="75,-137 75,-150 116,-150 116,-137 75,-137"/>
+<text text-anchor="start" x="77" y="-141.6" font-family="Times,serif" font-size="8.00">prompt</text>
+</a>
+</g>
+<g id="a_node1_2"><a xlink:href="#prompt8331185687311588863" xlink:title="called at app/Main.hs:30:15">
+<polygon fill="#e78ac3" stroke="transparent" points="75,-124 75,-137 116,-137 116,-124 75,-124"/>
+<polygon fill="none" stroke="black" points="75,-124 75,-137 116,-137 116,-124 75,-124"/>
+<text text-anchor="start" x="77" y="-128.6" font-family="Times,serif" font-size="8.00">prompt</text>
+</a>
+</g>
+<g id="a_node1_3"><a xlink:title="called at app/Main.hs:31:3">
+<polygon fill="#8da0cb" stroke="transparent" points="75,-111 75,-124 116,-124 116,-111 75,-111"/>
+<polygon fill="none" stroke="black" points="75,-111 75,-124 116,-124 116,-111 75,-111"/>
+<text text-anchor="start" x="77" y="-115.6" font-family="Times,serif" font-size="8.00">greet</text>
+</a>
+</g>
+</a>
+</g>
+</g>
+<!-- prompt924477568213965436 -->
+<g id="node2" class="node">
+<title>prompt924477568213965436</title>
+<g id="a_node2"><a xlink:title=" ">
+<g id="a_node2_4"><a xlink:href="#main138835950170271710" xlink:title="defined at app/Main.hs:34:1">
+<polygon fill="#a6d854" stroke="transparent" points="8,-41.5 8,-66.5 80,-66.5 80,-41.5 8,-41.5"/>
+<polygon fill="none" stroke="black" points="8,-41.5 8,-66.5 80,-66.5 80,-41.5 8,-41.5"/>
+<text text-anchor="start" x="16" y="-51.3" font-family="Times,serif" font-size="7.00">←</text>
+<text text-anchor="start" x="23" y="-51.3" font-family="Times,serif" font-size="14.00"> </text>
+<text text-anchor="start" x="27" y="-51.3" font-family="Times,serif" font-weight="bold" font-size="14.00">prompt</text>
+</a>
+</g>
+<g id="a_node2_5"><a xlink:title="printed at app/Main.hs:37:3">
+<polygon fill="none" stroke="black" points="8,-16.5 8,-41.5 80,-41.5 80,-16.5 8,-16.5"/>
+<text text-anchor="start" x="13" y="-25.3" font-family="Times,serif" font-size="14.00">input: john</text>
+</a>
+</g>
+<g id="a_node2_6"><a xlink:title="called at app/Main.hs:38:10">
+<polygon fill="#fc8d62" stroke="transparent" points="8,-3.5 8,-16.5 80,-16.5 80,-3.5 8,-3.5"/>
+<polygon fill="none" stroke="black" points="8,-3.5 8,-16.5 80,-16.5 80,-3.5 8,-3.5"/>
+<text text-anchor="start" x="10" y="-8.1" font-family="Times,serif" font-size="8.00">capitalize</text>
+</a>
+</g>
+</a>
+</g>
+</g>
+<!-- main138835950170271710&#45;&gt;prompt924477568213965436 -->
+<g id="edge1" class="edge">
+<title>main138835950170271710:3&#45;&gt;prompt924477568213965436</title>
+<g id="a_edge1"><a xlink:title=" ">
+<path fill="none" stroke="#a6d854" d="M74,-144C46.44,-144 40.24,-110.82 40.18,-81.32"/>
+<polygon fill="#a6d854" stroke="#a6d854" points="43.68,-81.17 40.39,-71.11 36.69,-81.03 43.68,-81.17"/>
+</a>
+</g>
+</g>
+<!-- prompt8331185687311588863 -->
+<g id="node3" class="node">
+<title>prompt8331185687311588863</title>
+<g id="a_node3"><a xlink:title=" ">
+<g id="a_node3_7"><a xlink:href="#main138835950170271710" xlink:title="defined at app/Main.hs:34:1">
+<polygon fill="#e78ac3" stroke="transparent" points="115,-41.5 115,-66.5 182,-66.5 182,-41.5 115,-41.5"/>
+<polygon fill="none" stroke="black" points="115,-41.5 115,-66.5 182,-66.5 182,-41.5 115,-41.5"/>
+<text text-anchor="start" x="120.5" y="-51.3" font-family="Times,serif" font-size="7.00">←</text>
+<text text-anchor="start" x="127.5" y="-51.3" font-family="Times,serif" font-size="14.00"> </text>
+<text text-anchor="start" x="131.5" y="-51.3" font-family="Times,serif" font-weight="bold" font-size="14.00">prompt</text>
+</a>
+</g>
+<g id="a_node3_8"><a xlink:title="printed at app/Main.hs:37:3">
+<polygon fill="none" stroke="black" points="115,-16.5 115,-41.5 182,-41.5 182,-16.5 115,-16.5"/>
+<text text-anchor="start" x="120" y="-25.3" font-family="Times,serif" font-size="14.00">input: doe</text>
+</a>
+</g>
+<g id="a_node3_9"><a xlink:title="called at app/Main.hs:38:10">
+<polygon fill="#66c2a5" stroke="transparent" points="115,-3.5 115,-16.5 182,-16.5 182,-3.5 115,-3.5"/>
+<polygon fill="none" stroke="black" points="115,-3.5 115,-16.5 182,-16.5 182,-3.5 115,-3.5"/>
+<text text-anchor="start" x="117" y="-8.1" font-family="Times,serif" font-size="8.00">capitalize</text>
+</a>
+</g>
+</a>
+</g>
+</g>
+<!-- main138835950170271710&#45;&gt;prompt8331185687311588863 -->
+<g id="edge2" class="edge">
+<title>main138835950170271710:2&#45;&gt;prompt8331185687311588863</title>
+<g id="a_edge2"><a xlink:title=" ">
+<path fill="none" stroke="#e78ac3" d="M117,-130C139.52,-130 147.07,-105.26 149.1,-81.23"/>
+<polygon fill="#e78ac3" stroke="#e78ac3" points="152.61,-81.23 149.66,-71.05 145.62,-80.84 152.61,-81.23"/>
+</a>
+</g>
+</g>
+</g>
+</svg>