ghcid 0.7.4 → 0.7.5
raw patch · 6 files changed
+115/−31 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Language.Haskell.Ghcid: Eval :: EvalResult -> Load
Files
- CHANGES.txt +6/−0
- README.md +5/−0
- ghcid.cabal +3/−3
- src/Ghcid.hs +36/−21
- src/Language/Haskell/Ghcid/Types.hs +11/−1
- src/Session.hs +54/−6
CHANGES.txt view
@@ -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
README.md view
@@ -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.
ghcid.cabal view
@@ -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,
src/Ghcid.hs view
@@ -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 <something>"+ ,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
src/Language/Haskell/Ghcid/Types.hs view
@@ -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'?
src/Session.hs view
@@ -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.