diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -1,5 +1,11 @@ Changelog for ghcid (* = breaking change) +0.7.5, released 2019-07-04 + #263, fix not resizing on terminal resize + #262, add --test-message flag + #253, try and keep the cursor visible after Ctrl-C + #248, add --eval flag to evaluate code snippets + #245, link with -rtsopts to be able to use RTS flags 0.7.4, released 2019-04-17 #237, ability to cope better with large error messages #237, add --clear, --no-height-limit, --reverse-errors diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -37,6 +37,7 @@ * [VS Code](plugins/vscode/) * [nvim](plugins/nvim/) +* [vim](https://github.com/aiya000/vim-ghcid-quickfix) * [Emacs](plugins/emacs/) ### Usage tips @@ -78,3 +79,7 @@ #### 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. + +#### I use Alex (`.x`) and Happy (`.y`) files, how can I check them? + +Ghcid only notices when the `.hs` files change. To make it respond to other files you can pass the `.x` and `.y` files to `--restart`, e.g. `--restart=myparser.y`. As long as you set the initial command to something that runs Happy/Alex (e.g. `cabal repl`) then when those files change everything will restart, causing the initial command to be rerun. 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.4 +version: 0.7.5 license: BSD3 license-file: LICENSE category: Development @@ -13,7 +13,7 @@ Either \"GHCi as a daemon\" or \"GHC + a bit of an IDE\". A very simple Haskell development tool which shows you the errors in your project and updates them whenever you save. Run @ghcid --topmost --command=ghci@, where @--topmost@ makes the window on top of all others (Windows only) and @--command@ is the command to start GHCi on your project (defaults to @ghci@ if you have a @.ghci@ file, or else to @cabal repl@). homepage: https://github.com/ndmitchell/ghcid#readme bug-reports: https://github.com/ndmitchell/ghcid/issues -tested-with: GHC==8.6.4, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3 +tested-with: GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3 extra-doc-files: CHANGES.txt README.md @@ -47,7 +47,7 @@ executable ghcid hs-source-dirs: src default-language: Haskell2010 - ghc-options: -main-is Ghcid.main -threaded + ghc-options: -main-is Ghcid.main -threaded -rtsopts main-is: Ghcid.hs build-depends: base >= 4.7 && < 5, diff --git a/src/Ghcid.hs b/src/Ghcid.hs --- a/src/Ghcid.hs +++ b/src/Ghcid.hs @@ -42,6 +42,7 @@ {command :: String ,arguments :: [String] ,test :: [String] + ,test_message :: String ,run :: [String] ,warnings :: Bool ,lint :: Maybe String @@ -63,6 +64,7 @@ ,max_messages :: Maybe Int ,color :: ColorMode ,setup :: [String] + ,allow_eval :: Bool } deriving (Data,Typeable,Show) @@ -78,7 +80,8 @@ {command = "" &= name "c" &= typ "COMMAND" &= help "Command to run (defaults to ghci or cabal repl)" ,arguments = [] &= args &= typ "MODULE" ,test = [] &= name "T" &= typ "EXPR" &= help "Command to run after successful loading" - ,run = [] &= name "r" &= typ "EXPR" &= opt "main" &= help "Command to run after successful loading (defaults to main)" + ,test_message = "Running test..." &= typ "MESSAGE" &= help "Message to show before running the test (defaults to \"Running test...\")" + ,run = [] &= name "r" &= typ "EXPR" &= opt "main" &= help "Command to run after successful loading (like --test but defaults to main)" ,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" @@ -99,6 +102,7 @@ ,max_messages = Nothing &= name "n" &= help "Maximum number of messages to print" ,color = Auto &= name "colour" &= name "color" &= opt Always &= typ "always/never/auto" &= help "Color output (defaults to when the terminal supports it)" ,setup = [] &= name "setup" &= typ "COMMAND" &= help "Setup commands to pass to ghci on stdin, usually :set " + ,allow_eval = False &= name "allow-eval" &= help "Execute REPL commands in comments" } &= verbosity &= program "ghcid" &= summary ("Auto reloading GHCi daemon v" ++ showVersion version) @@ -198,22 +202,18 @@ opts <- return $ opts{restart = nubOrd $ (origDir ".ghcid") : restart opts, reload = nubOrd $ reload opts} when (topmost opts) terminalTopmost - termSize <- case (width opts, height opts) of - (Just w, Just h) -> return $ TermSize w (Just h) WrapHard + let noHeight = if no_height_limit opts then const Nothing else id + termSize <- return $ case (width opts, height opts) of + (Just w, Just h) -> return $ TermSize w (noHeight $ 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) - (h <|> termHeight term) + (noHeight $ 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 @@ -230,7 +230,7 @@ else id maybe withWaiterNotify withWaiterPoll (poll opts) $ \waiter -> - runGhcid session waiter (return termSize) (clear . termOutput . restyle) opts + runGhcid (if allow_eval opts then enableEval session else session) waiter termSize (clear . termOutput . restyle) opts @@ -256,11 +256,11 @@ runGhcid session waiter termSize termOutput opts@Options{..} = do let limitMessages = maybe id (take . max 1) max_messages - let outputFill :: String -> Maybe (Int, [Load]) -> [String] -> IO () - outputFill currTime load msg = do + let outputFill :: String -> Maybe (Int, [Load]) -> [EvalResult] -> [String] -> IO () + outputFill currTime load evals msg = do load <- return $ case load of Nothing -> [] - Just (loadedCount, msgs) -> prettyOutput currTime loadedCount $ filter isMessage msgs + Just (loadedCount, msgs) -> prettyOutput currTime loadedCount (filter isMessage msgs) evals TermSize{..} <- termSize let wrap = concatMap (wordWrapE termWidth (termWidth `div` 5) . Esc) (msg, load, pad) <- @@ -314,6 +314,7 @@ outStrLn $ "%MESSAGES: " ++ show messages outStrLn $ "%LOADED: " ++ show loaded + let evals = [e | Eval e <- messages] let (countErrors, countWarnings) = both sum $ unzip [if loadSeverity == Error then (1,0) else (0,1) | m@Message{..} <- messages, loadMessage /= []] let hasErrors = countErrors /= 0 || (countWarnings /= 0 && not warnings) @@ -342,13 +343,13 @@ moduleSorted = sortOn (Down . f) msgError ++ msgWarn return $ (if reverse_errors then reverse else id) moduleSorted - outputFill currTime (Just (loadedCount, ordMessages)) ["Running test..." | isJust test] + outputFill currTime (Just (loadedCount, ordMessages)) evals [test_message | isJust test] forM_ outputfile $ \file -> writeFile file $ if takeExtension file == ".json" then showJSON [("loaded",map jString loaded),("messages",map jMessage $ filter isMessage messages)] else - unlines $ map unescape $ prettyOutput currTime loadedCount $ limitMessages ordMessages + unlines $ map unescape $ prettyOutput currTime loadedCount (limitMessages ordMessages) evals when (null loaded && not ignoreLoaded) $ do putStrLn "No files loaded, nothing to wait for. Fix the last error and restart." exitFailure @@ -375,10 +376,10 @@ currTime <- getShortTime if not $ null restartChanged then do -- exit cleanly, since the whole thing is wrapped in a forever - unless no_status $ outputFill currTime Nothing $ "Restarting..." : map (" " ++) restartChanged + unless no_status $ outputFill currTime Nothing evals $ "Restarting..." : map (" " ++) restartChanged return Continue else do - unless no_status $ outputFill currTime Nothing $ "Reloading..." : map (" " ++) reason + unless no_status $ outputFill currTime Nothing evals $ "Reloading..." : map (" " ++) reason nextWait <- waitFiles waiter fire nextWait =<< sessionReload session @@ -386,10 +387,24 @@ -- | Given an available height, and a set of messages to display, show them as best you can. -prettyOutput :: String -> Int -> [Load] -> [String] -prettyOutput currTime loadedCount [] = - [allGoodMessage ++ " (" ++ show loadedCount ++ " module" ++ ['s' | loadedCount /= 1] ++ ", at " ++ currTime ++ ")"] -prettyOutput _ _ xs = concatMap loadMessage xs +prettyOutput :: String -> Int -> [Load] -> [EvalResult] -> [String] +prettyOutput currTime loadedCount [] evals = + (allGoodMessage ++ " (" ++ show loadedCount ++ " module" ++ ['s' | loadedCount /= 1] ++ ", at " ++ currTime ++ ")") + : concatMap printEval evals +prettyOutput _ _ xs evals = concatMap loadMessage xs ++ concatMap printEval evals + +printEval :: EvalResult -> [String] +printEval (EvalResult file (line, col) msg result) = + [ " " + , concat + [ file + , ":" + , show line + , ":" + , show col + ] + ] ++ map ("$> " ++) (lines msg) + ++ lines result showJSON :: [(String, [String])] -> String diff --git a/src/Language/Haskell/Ghcid/Types.hs b/src/Language/Haskell/Ghcid/Types.hs --- a/src/Language/Haskell/Ghcid/Types.hs +++ b/src/Language/Haskell/Ghcid/Types.hs @@ -4,7 +4,7 @@ module Language.Haskell.Ghcid.Types( GhciError(..), Stream(..), - Load(..), Severity(..), + Load(..), Severity(..), EvalResult(..), isMessage, isLoading, isLoadConfig ) where @@ -45,6 +45,16 @@ LoadConfig {loadFile :: FilePath -- ^ The file that was being loaded, @.ghci@. } + | -- | A response to an eval comment + Eval EvalResult + deriving (Show, Eq, Ord) + +data EvalResult = EvalResult + {evalFile :: FilePath -- ^ The file that was being loaded, @.ghci@. + ,evalFilePos :: (Int, Int) + ,evalCommand :: String + ,evalResult :: String + } deriving (Show, Eq, Ord) -- | Is a 'Load' a 'Message'? diff --git a/src/Session.hs b/src/Session.hs --- a/src/Session.hs +++ b/src/Session.hs @@ -3,7 +3,7 @@ -- | A persistent version of the Ghci session, encoding lots of semantics on top. -- Not suitable for calling multithreaded. module Session( - Session, withSession, + Session, enableEval, withSession, sessionStart, sessionReload, sessionExecAsync, ) where @@ -13,6 +13,7 @@ import Language.Haskell.Ghcid.Util import Language.Haskell.Ghcid.Types import Data.IORef +import System.Console.ANSI import System.Time.Extra import System.Process import System.FilePath @@ -23,6 +24,7 @@ import Data.List.Extra import Control.Applicative import Prelude +import System.IO.Extra data Session = Session @@ -32,9 +34,13 @@ ,curdir :: IORef FilePath -- ^ The current working directory ,running :: Var Bool -- ^ Am I actively running an async command ,withThread :: ThreadId -- ^ Thread that called withSession + ,allowEval :: Bool -- ^ Is the allow-eval flag set? } +enableEval :: Session -> Session +enableEval s = s { allowEval = True } + debugShutdown x = when False $ print ("DEBUG SHUTDOWN", x) -- | The function 'withSession' expects to be run on the main thread, @@ -49,6 +55,7 @@ running <- newVar False debugShutdown "Starting session" withThread <- myThreadId + let allowEval = False f Session{..} `finally` do debugShutdown "Start finally" modifyVar_ running $ const $ return False @@ -69,7 +76,10 @@ debugShutdown "Before terminateProcess" ignored $ terminateProcess $ process ghci debugShutdown "After terminateProcess" - + -- Ctrl-C after a tests keeps the cursor hidden, + -- `setSGR []`didn't seem to be enough + -- See: https://github.com/ndmitchell/ghcid/issues/254 + showCursor loadedModules :: [Load] -> [FilePath] loadedModules = nubOrd . map loadFile . filter (not . isLoadConfig) @@ -104,18 +114,21 @@ writeIORef curdir dir messages <- return $ qualify dir messages + let loaded = loadedModules messages + evals <- performEvals v allowEval loaded + -- install a handler forkIO $ do - waitForProcess $ process v + code <- waitForProcess $ process v whenJustM (readIORef ghci) $ \ghci -> when (ghci == v) $ do sleep 0.3 -- give anyone reading from the stream a chance to throw first - throwTo withThread $ ErrorCall $ "Command \"" ++ cmd ++ "\" exited unexpectedly" + throwTo withThread $ ErrorCall $ "Command \"" ++ cmd ++ "\" exited unexpectedly with " ++ show code -- handle what the process returned messages <- return $ mapMaybe tidyMessage messages writeIORef warnings [m | m@Message{..} <- messages, loadSeverity == Warning] - return (messages, loadedModules messages) + return (messages ++ evals, loaded) -- | Call 'sessionStart' at the previous command. @@ -125,6 +138,40 @@ sessionStart session cmd setup +performEvals :: Ghci -> Bool -> [FilePath] -> IO [Load] +performEvals _ False _ = return [] +performEvals ghci True reloaded = do + cmds <- mapM getCommands reloaded + fmap join $ forM cmds $ \(file, cmds') -> + forM cmds' $ \(num, cmd) -> do + ref <- newIORef [] + execStream ghci (unwords $ lines cmd) $ \_ resp -> modifyIORef ref (resp :) + resp <- concat . reverse <$> readIORef ref + return $ Eval $ EvalResult file (num, 1) cmd resp + + +getCommands :: FilePath -> IO (FilePath, [(Int, String)]) +getCommands fp = do + ls <- readFileUTF8' fp + return (fp, splitCommands $ zipFrom 1 $ lines ls) + +splitCommands :: [(Int, String)] -> [(Int, String)] +splitCommands [] = [] +splitCommands ((num, line) : ls) + | isCommand line = + let (cmds, xs) = span (isCommand . snd) ls + in (num, unlines $ fmap (drop $ length commandPrefix) $ line : fmap snd cmds) : splitCommands xs + | otherwise = splitCommands ls + +isCommand :: String -> Bool +isCommand = isPrefixOf commandPrefix + +commandPrefix :: String +commandPrefix = "-- $> " + + + + -- | Reload, returning the same information as 'sessionStart'. In particular, any -- information that GHCi doesn't repeat (warnings from loaded modules) will be -- added back in. @@ -144,6 +191,7 @@ loaded <- map ((dir ) . snd) <$> showModules ghci let reloaded = loadedModules messages warn <- readIORef warnings + evals <- performEvals ghci allowEval reloaded -- only keep old warnings from files that are still loaded, but did not reload let validWarn w = loadFile w `elem` loaded && loadFile w `notElem` reloaded @@ -151,7 +199,7 @@ messages <- return $ messages ++ filter validWarn warn writeIORef warnings [m | m@Message{..} <- messages, loadSeverity == Warning] - return (messages, nubOrd $ loaded ++ reloaded) + return (messages ++ evals, nubOrd $ loaded ++ reloaded) -- | Run an exec operation asynchronously. Should not be a @:reload@ or similar.