diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -1,5 +1,8 @@ Changelog for ghcid (* = breaking change) +0.7.4, released 2019-04-17 + #237, ability to cope better with large error messages + #237, add --clear, --no-height-limit, --reverse-errors 0.7.3, released 2019-04-15 #236, add hlint support, pass --lint 0.7.2, released 2019-03-12 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -75,3 +75,6 @@ #### I want to match on the file/line/column to get jump-to-error functionality in my editor. You will variously see `file:line:col:message`, `file:line:col1-col2:msg` and `file:(line1,col1)-(line2,col2):message`, as these are the formats GHC uses. To match all of them you can use a regular expression such as `^(\\S*?):(?|(\\d+):(\\d+)(?:-\\d+)?|\\((\\d+),(\\d+)\\)-\\(\\d+,\\d+\\)):([^\n]*)`. + +#### What if the error message is too big for my console? +You can let `ghcid` print more with `--no-height-limit`. The first error message might end up outside of the console view, so you can use `--reverse-errors` to flip the order of the errors and warnings. Further error messages are just a scroll away. Finally if you're going to be scrolling, you can achieve a cleaner experience with the `--clear` flag, which clears the console on reload. diff --git a/ghcid.cabal b/ghcid.cabal --- a/ghcid.cabal +++ b/ghcid.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.18 build-type: Simple name: ghcid -version: 0.7.3 +version: 0.7.4 license: BSD3 license-file: LICENSE category: Development diff --git a/src/Ghcid.hs b/src/Ghcid.hs --- a/src/Ghcid.hs +++ b/src/Ghcid.hs @@ -6,6 +6,7 @@ import Control.Exception import System.IO.Error +import Control.Applicative import Control.Monad.Extra import Data.List.Extra import Data.Maybe @@ -33,7 +34,6 @@ import Language.Haskell.Ghcid.Types import Wait -import Data.Functor import Prelude @@ -46,6 +46,9 @@ ,warnings :: Bool ,lint :: Maybe String ,no_status :: Bool + ,clear :: Bool + ,reverse_errors :: Bool + ,no_height_limit :: Bool ,height :: Maybe Int ,width :: Maybe Int ,topmost :: Bool @@ -79,6 +82,9 @@ ,warnings = False &= name "W" &= help "Allow tests to run even with warnings" ,lint = Nothing &= typ "COMMAND" &= name "lint" &= opt "hlint" &= help "Linter to run if there are no errors. Defaults to hlint." ,no_status = False &= name "S" &= help "Suppress status messages" + ,clear = False &= name "clear" &= help "Clear screen when reloading" + ,reverse_errors = False &= help "Reverse output order (works best with --no-height-limit)" + ,no_height_limit = False &= name "no-height-limit" &= help "Disable height limit" ,height = Nothing &= help "Number of lines to use (defaults to console height)" ,width = Nothing &= name "w" &= help "Number of columns to use (defaults to console width)" ,topmost = False &= name "t" &= help "Set window topmost (Windows only)" @@ -167,7 +173,7 @@ data TermSize = TermSize {termWidth :: Int - ,termHeight :: Int + ,termHeight :: Maybe Int -- ^ Nothing means the height is unlimited ,termWrap :: WordWrap } @@ -192,17 +198,22 @@ opts <- return $ opts{restart = nubOrd $ (origDir ".ghcid") : restart opts, reload = nubOrd $ reload opts} when (topmost opts) terminalTopmost - termSize <- return $ case (width opts, height opts) of - (Just w, Just h) -> return $ TermSize w h WrapHard + termSize <- case (width opts, height opts) of + (Just w, Just h) -> return $ TermSize w (Just h) WrapHard (w, h) -> do term <- termSize -- if we write to the final column of the window then it wraps automatically -- so putStrLn width 'x' uses up two lines return $ TermSize (fromMaybe (pred $ termWidth term) w) - (fromMaybe (termHeight term) h) + (h <|> termHeight term) (if isJust w then WrapHard else termWrap term) + termSize <- return $ + if no_height_limit opts + then termSize { termHeight = Nothing } + else termSize + restyle <- do useStyle <- case color opts of Always -> return True @@ -213,8 +224,13 @@ when (isNothing h) $ setEnv "HSPEC_OPTIONS" "--color" -- see #87 return $ if useStyle then id else map unescape + clear <- return $ + if clear opts + then (clearScreen *>) + else id + maybe withWaiterNotify withWaiterPoll (poll opts) $ \waiter -> - runGhcid session waiter termSize (termOutput . restyle) opts + runGhcid session waiter (return termSize) (clear . termOutput . restyle) opts @@ -224,8 +240,8 @@ termSize = do x <- Term.size return $ case x of - Nothing -> TermSize 80 8 WrapHard - Just t -> TermSize (Term.width t) (Term.height t) WrapSoft + Nothing -> TermSize 80 (Just 8) WrapHard + Just t -> TermSize (Term.width t) (Just $ Term.height t) WrapSoft termOutput xs = do outStr $ concatMap ('\n':) xs @@ -247,14 +263,30 @@ Just (loadedCount, msgs) -> prettyOutput currTime loadedCount $ filter isMessage msgs TermSize{..} <- termSize let wrap = concatMap (wordWrapE termWidth (termWidth `div` 5) . Esc) - (termHeight, msg) <- return $ takeRemainder termHeight $ wrap msg - (termHeight, load) <- return $ takeRemainder termHeight $ wrap load - let pad = replicate termHeight "" + (msg, load, pad) <- + case termHeight of + Nothing -> return (wrap msg, wrap load, []) + Just termHeight -> do + (termHeight, msg) <- return $ takeRemainder termHeight $ wrap msg + (termHeight, load) <- + let takeRemainder' = + if reverse_errors + then -- When reversing the errors we want to crop out + -- the top instead of the bottom of the load + fmap reverse . takeRemainder termHeight . reverse + else takeRemainder termHeight + in return $ takeRemainder' $ wrap load + return (msg, load, replicate termHeight "") let mergeSoft ((Esc x,WrapSoft):(Esc y,q):xs) = mergeSoft $ (Esc (x++y), q) : xs mergeSoft ((x,_):xs) = x : mergeSoft xs mergeSoft [] = [] - termOutput $ map fromEsc ((if termWrap == WrapSoft then mergeSoft else map fst) $ load ++ msg) ++ pad + applyPadding x = + if reverse_errors + then pad ++ x + else x ++ pad + termOutput $ applyPadding $ map fromEsc ((if termWrap == WrapSoft then mergeSoft else map fst) $ load ++ msg) + when (ignoreLoaded && null reload) $ do putStrLn "--reload must be set when using --ignore-loaded" exitFailure @@ -307,7 +339,8 @@ -- sort error messages by modtime, so newer edits cause the errors to float to the top - see #153 errTimes <- sequence [(x,) <$> getModTime x | x <- nubOrd $ map loadFile msgError] let f x = lookup (loadFile x) errTimes - return $ sortOn (Down . f) msgError ++ msgWarn + moduleSorted = sortOn (Down . f) msgError ++ msgWarn + return $ (if reverse_errors then reverse else id) moduleSorted outputFill currTime (Just (loadedCount, ordMessages)) ["Running test..." | isJust test] forM_ outputfile $ \file -> diff --git a/src/Test/Ghcid.hs b/src/Test/Ghcid.hs --- a/src/Test/Ghcid.hs +++ b/src/Test/Ghcid.hs @@ -77,7 +77,7 @@ res <- bracket (flip forkFinally (const $ signalBarrier done ()) $ withArgs (["--no-title","--no-status"]++args) $ - mainWithTerminal (return $ TermSize 100 50 WrapHard) output) + mainWithTerminal (return $ TermSize 100 (Just 50) WrapHard) output) killThread $ \_ -> script require waitBarrier done return res