1
1
mirror of https://github.com/github/semantic.git synced 2024-12-20 13:21:59 +03:00

Merge pull request #2195 from github/ghci-slowness

Prevent slowdowns when pretty-printing in ghci.
This commit is contained in:
Patrick Thomson 2018-10-04 15:57:42 -04:00 committed by GitHub
commit 932a613cf4
4 changed files with 11 additions and 8 deletions

2
.ghci
View File

@ -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

View File

@ -197,6 +197,7 @@ library
, Semantic.Telemetry.Stat
, Semantic.Timeout
, Semantic.Util
, Semantic.Util.Pretty
, Semantic.Util.Rewriting
, Semantic.Version
-- Serialization

View File

@ -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) #-}

View File

@ -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