From d56377aea954b3e722af90dc3887a9818ca67900 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Thu, 4 Oct 2018 14:38:36 -0400
Subject: [PATCH] Prevent slowdowns when pretty-printing in ghci.

Right now, when opening a shell with `script/ghci`, you can encounter
a tremendous slowdown by turning on pretty-printing (with `pretty`)
then printing any value (`[0..3]` should work).

This stems from the fact that our `.ghci` specifies the `prettyShow`
function, defined in Semantic.Util, as its `-interactive-print`
function. While this is a good choice of a pretty-printer, the fact
that it is in Util, a file which imports many modules and uses fancy
types, is not good: pretty-printing cannot begin until Util is
recompiled and linked in. This explains why benchmarking this slowdown
revealed nothing but `dlsym` calls: we thought it was due to linking
in the tree-sitter libraries, but it was actually waiting for Util to
compile and link in.

The fix is simple: define `prettyShow` in another module. This should
provide significant speedups to our developer workflow.
---
 .ghci                       | 2 +-
 semantic.cabal              | 1 +
 src/Semantic/Util.hs        | 8 +-------
 src/Semantic/Util/Pretty.hs | 8 ++++++++
 4 files changed, 11 insertions(+), 8 deletions(-)
 create mode 100644 src/Semantic/Util/Pretty.hs

diff --git a/.ghci b/.ghci
index 18b1832d2..639be4528 100644
--- a/.ghci
+++ b/.ghci
@@ -3,7 +3,7 @@
 
 -- See docs/💡ProTip!.md
 :undef pretty
-:def pretty \ _ -> return (unlines [":set -interactive-print Semantic.Util.prettyShow"])
+:def pretty \ _ -> return ":set -interactive-print Semantic.Util.Pretty.prettyShow"
 
 -- See docs/💡ProTip!.md
 :undef no-pretty
diff --git a/semantic.cabal b/semantic.cabal
index ee2bc6d2e..89f73bbc5 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -197,6 +197,7 @@ library
                      , Semantic.Telemetry.Stat
                      , Semantic.Timeout
                      , Semantic.Util
+                     , Semantic.Util.Pretty
                      , Semantic.Util.Rewriting
                      , Semantic.Version
                      -- Serialization
diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs
index 9095013fe..ee116058c 100644
--- a/src/Semantic/Util.hs
+++ b/src/Semantic/Util.hs
@@ -24,8 +24,6 @@ import           Data.List (uncons)
 import           Data.Project hiding (readFile)
 import           Data.Quieterm (quieterm)
 import           Data.Sum (weaken)
-import           Language.Haskell.HsColour
-import           Language.Haskell.HsColour.Colourise
 import           Parsing.Parser
 import           Prologue hiding (weaken)
 import           Semantic.Config
@@ -35,7 +33,7 @@ import           Semantic.Task
 import           Semantic.Telemetry (LogQueue, StatQueue)
 import           System.Exit (die)
 import           System.FilePath.Posix (takeDirectory)
-import           Text.Show.Pretty (ppShow)
+
 
 justEvaluating
   = runM
@@ -145,8 +143,4 @@ mergeExcs = either (\ (SomeExc sum) -> Left (SomeExc (weaken sum))) (either (\ (
 reassociate :: Either (SomeExc exc1) (Either (SomeExc exc2) (Either (SomeExc exc3) (Either (SomeExc exc4) (Either (SomeExc exc5) (Either (SomeExc exc6) (Either (SomeExc exc7) result)))))) -> Either (SomeExc (Sum '[exc7, exc6, exc5, exc4, exc3, exc2, exc1])) result
 reassociate = mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . mergeExcs . Right
 
-
-prettyShow :: Show a => a -> IO ()
-prettyShow = putStrLn . hscolour TTY defaultColourPrefs False False "" False . ppShow
-
 {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
diff --git a/src/Semantic/Util/Pretty.hs b/src/Semantic/Util/Pretty.hs
new file mode 100644
index 000000000..7cc1bf77b
--- /dev/null
+++ b/src/Semantic/Util/Pretty.hs
@@ -0,0 +1,8 @@
+module Semantic.Util.Pretty (prettyShow) where
+
+import Language.Haskell.HsColour
+import Language.Haskell.HsColour.Colourise
+import Text.Show.Pretty (ppShow)
+
+prettyShow :: Show a => a -> IO ()
+prettyShow = putStrLn . hscolour TTY defaultColourPrefs False False "" False . ppShow