diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -1,17 +1,22 @@ Changelog for ghcid -0.6.8 +0.6.9, released 2018-01-26 + #121, add a --poll flag to use polling instead of notifiers + Require time-1.5 or above + #124, add timestamp to "All good" message + After the test completes write a message +0.6.8, released 2017-11-10 #110, work even if -v0 is passed to ghci Read additional arguments from .ghcid file if present -0.6.7 +0.6.7, released 2017-09-17 #104, add --ignore-loaded flag for use with -fobject-code #103, deal with new GHC error formatting -0.6.6 +0.6.6, released 2016-11-11 #89, exit sooner when the child process exits unexpectedly Add Eq instance for Ghci #88, add a --project flag Rename --notitle flag to --no-title -0.6.5 +0.6.5, released 2016-08-10 #82, properly deal with warning messages including spans #78, support boot files better Better support for dealing with GHC 8.0 call stack messages @@ -19,11 +24,11 @@ #71, improve multi-project stack support #74, make sure Cygwin terminals flush output properly If the test exits then exit ghcid -0.6.4 +0.6.4, released 2016-05-13 #69, fix up for stack project with file arguments -0.6.3 +0.6.3, released 2016-05-11 #68, add --no-status to avoid printing the reloading message -0.6.2 +0.6.2, released 2016-04-25 #63, detect test failures and update the titlebar/icon #66, add --warnings to run tests even in there are warnings #62, find stack.yaml in the parent directory @@ -32,17 +37,17 @@ #67, make --reload/--restart recurse through directories #61, deal with drive letters in files (for stack on Windows) #58, improve the --help message -0.6.1 +0.6.1, released 2016-04-06 Add --reload to add files that reload, but do not restart #56, allow --restart to take directories -0.6 +0.6, released 2016-04-06 #38, implement loading with stack Add process, quit and execStream to the API #29, add interrupt function Add Data instances for the types Make stopGhci more effective, now kills the underlying process Make startGhci take a function to write the buffer to -0.5.1 +0.5.1, released 2016-03-02 #17, deal with recursive modules errors properly #50, use -fno-code when not running tests (about twice as fast) #44, abbreviate the redundant module import error @@ -50,18 +55,18 @@ #42, always show the first error in full #43, work even if people use break-on-exception flags #42, make the first error a minimum of 5 lines -0.5 +0.5, released 2015-06-20 Add an extra boolean argument to startGhci Add the number of modules loaded after All good Print out messages until the prompt comes up #23, add arguments and change what commands get invoked #35, change the titlebar icon on Windows -0.4.2 +0.4.2, released 2015-06-11 Fix a GHC 7.6 warning -0.4.1 +0.4.1, released 2015-06-11 #37, add a --notitle flag Require extra-1.2 -0.4 +0.4, released 2015-06-07 #33, make Ctrl-C more robust #31, add an outputfile feature #32, make newer warnings first (save a file, view its warnings) @@ -70,43 +75,42 @@ Add a --directory flag to change directory first #26, use fs-notify to avoid excessive wakeups #25, detect console size just before using it -0.3.6 +0.3.6, released 2015-03-09 #24, don't error out if error/putStrLn are not imported -0.3.5 +0.3.5, released 2015-02-25 #19, put errors in bold #9, display interesting information in the title bar #7, reload if the .ghci or .cabal file changes Use nubOrd Require extra-1.1 -0.3.4 +0.3.4, released 2014-12-24 #21, if you aren't waiting for any files, exit -0.3.3 +0.3.3, released 2014-12-21 #21, if the root file is missing, report an error #20, avoid an O(n^2) nub -0.3.2 +0.3.2, released 2014-11-06 #18, reformat excessively long lines, add a --width flag -0.3.1 +0.3.1, released 2014-10-28 Ensure if there are lots of warnings, the first error gets shown -0.3 +0.3, released 2014-10-24 #11, ignore certain GHCi-only warnings #13, fix version printing #8, display Loading... when starting Require the extra library #14, figure out the terminal height automatically -0.2 +0.2, released 2014-10-06 #6, rewrite as a library Remove duplicate error messages from cabal repl -0.1.3 +0.1.3, released 2014-09-29 #2, handle files that get deleted while loaded #3, flesh out the test suite #4, give a polite error if ghci does not start #5, add --topmost flag to make the window topmost -0.1.2 Add a very simple test suite Default to cabal repl if there is no .ghci file #1, if there is an IOError just :reload Say why you are reloading -0.1.1 +0.1.1, released 2014-09-27 Support arguments to --command -0.1 +0.1, released 2014-09-27 Initial version diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Neil Mitchell 2014-2017. +Copyright Neil Mitchell 2014-2018. All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/ghcid.cabal b/ghcid.cabal --- a/ghcid.cabal +++ b/ghcid.cabal @@ -1,19 +1,19 @@ cabal-version: >= 1.18 build-type: Simple name: ghcid -version: 0.6.8 +version: 0.6.9 license: BSD3 license-file: LICENSE category: Development author: Neil Mitchell , jpmoresmau maintainer: Neil Mitchell -copyright: Neil Mitchell 2014-2017 +copyright: Neil Mitchell 2014-2018 synopsis: GHCi based bare bones IDE description: 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.2.1, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3 +tested-with: GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3 extra-doc-files: CHANGES.txt README.md @@ -28,15 +28,11 @@ build-depends: base >= 4, filepath, - time, + time >= 1.5, directory, extra >= 1.2, process >= 1.1, cmdargs >= 0.10 - if os(windows) - build-depends: Win32 - else - build-depends: unix exposed-modules: Language.Haskell.Ghcid @@ -54,7 +50,7 @@ build-depends: base == 4.*, filepath, - time, + time >= 1.5, directory, containers, fsnotify, @@ -86,7 +82,7 @@ build-depends: base >= 4, filepath, - time, + time >= 1.5, directory, process, containers, diff --git a/src/Ghcid.hs b/src/Ghcid.hs --- a/src/Ghcid.hs +++ b/src/Ghcid.hs @@ -18,6 +18,7 @@ import System.Console.ANSI import System.Environment import System.Directory.Extra +import System.Time.Extra import System.Exit import System.FilePath import System.IO.Extra @@ -49,6 +50,7 @@ ,directory :: FilePath ,outputfile :: [FilePath] ,ignoreLoaded :: Bool + ,poll :: Maybe Seconds } deriving (Data,Typeable,Show) @@ -69,6 +71,7 @@ ,directory = "." &= typDir &= name "C" &= help "Set the current directory" ,outputfile = [] &= typFile &= name "o" &= help "File to write the full output to" ,ignoreLoaded = False &= explicit &= name "ignore-loaded" &= help "Keep going if no files are loaded. Requires --reload to be set." + ,poll = Nothing &= typ "SECONDS" &= opt "0.1" &= explicit &= name "poll" &= help "Use polling every N seconds (defaults to using notifiers)" } &= verbosity &= program "ghcid" &= summary ("Auto reloading GHCi daemon v" ++ showVersion version) @@ -158,7 +161,7 @@ -- so putStrLn width 'x' uses up two lines return (fromMaybe (pred $ fst term) w, fromMaybe (snd term) h) - withWaiterNotify $ \waiter -> + maybe withWaiterNotify withWaiterPoll (poll opts) $ \waiter -> handle (\(UnexpectedExit cmd _) -> putStrLn $ "Command \"" ++ cmd ++ "\" exited unexpectedly") $ runGhcid session waiter termSize termOutput opts @@ -186,7 +189,8 @@ outputFill load msg = do (width, height) <- termSize let n = height - length msg - load <- return $ take (if isJust load then n else 0) $ prettyOutput (maybe 0 fst load) + currTime <- getShortTime + load <- return $ take (if isJust load then n else 0) $ prettyOutput currTime (maybe 0 fst load) [ m{loadMessage = concatMap (chunksOfWord width (width `div` 5)) $ loadMessage m} | m@Message{} <- maybe [] snd load] termOutput $ load ++ map (Plain,) msg ++ replicate (height - (length load + length msg)) (Plain,"") @@ -197,6 +201,7 @@ restartTimes <- mapM getModTime restart curdir <- getCurrentDirectory + currTime <- getShortTime -- fire, given a waiter, the messages/loaded let fire nextWait (messages, loaded) = do @@ -216,7 +221,7 @@ let updateTitle extra = unless no_title $ setTitle $ let f n msg = if n == 0 then "" else show n ++ " " ++ msg ++ ['s' | n > 1] - in (if countErrors == 0 && countWarnings == 0 then allGoodMessage else f countErrors "error" ++ + in (if countErrors == 0 && countWarnings == 0 then allGoodMessage ++ ", at " ++ currTime else f countErrors "error" ++ (if countErrors > 0 && countWarnings > 0 then ", " else "") ++ f countWarnings "warning") ++ " " ++ extra ++ [' ' | extra /= ""] ++ "- " ++ (if null project then takeFileName curdir else project) @@ -224,7 +229,7 @@ updateTitle $ if isJust test then "(running test)" else "" outputFill (Just (loadedCount, messages)) ["Running test..." | isJust test] forM_ outputfile $ \file -> - writeFile file $ unlines $ map snd $ prettyOutput loadedCount $ filter isMessage messages + writeFile file $ unlines $ map snd $ prettyOutput currTime loadedCount $ filter isMessage messages when (null loaded && not ignoreLoaded) $ do putStrLn "No files loaded, nothing to wait for. Fix the last error and restart." exitFailure @@ -236,8 +241,9 @@ if "*** Exception: " `isPrefixOf` stderr then do updateTitle "(test failed)" setWindowIcon IconError - else + else do updateTitle "(test done)" + whenNormal $ outStrLn "\n...done" reason <- nextWait $ restart ++ reload ++ loaded unless no_status $ outputFill Nothing $ "Reloading..." : map (" " ++) reason @@ -257,8 +263,8 @@ -- | Given an available height, and a set of messages to display, show them as best you can. -prettyOutput :: Int -> [Load] -> [(Style,String)] -prettyOutput loaded [] = [(Plain,allGoodMessage ++ " (" ++ show loaded ++ " module" ++ ['s' | loaded /= 1] ++ ")")] -prettyOutput loaded xs = concat $ msg1:msgs +prettyOutput :: String -> Int -> [Load] -> [(Style,String)] +prettyOutput currTime loaded [] = [(Plain,allGoodMessage ++ " (" ++ show loaded ++ " module" ++ ['s' | loaded /= 1] ++ ", at " ++ currTime ++ ")")] +prettyOutput _ loaded xs = concat $ msg1:msgs where (err, warn) = partition ((==) Error . loadSeverity) xs msg1:msgs = map (map (Bold,) . loadMessage) err ++ map (map (Plain,) . loadMessage) warn diff --git a/src/Language/Haskell/Ghcid/Util.hs b/src/Language/Haskell/Ghcid/Util.hs --- a/src/Language/Haskell/Ghcid/Util.hs +++ b/src/Language/Haskell/Ghcid/Util.hs @@ -5,7 +5,7 @@ chunksOfWord, outWith, outStrLn, allGoodMessage, - getModTime, getModTimeResolution + getModTime, getModTimeResolution, getShortTime ) where import Control.Concurrent.Extra @@ -13,9 +13,13 @@ import System.IO.Unsafe import System.IO.Extra import System.FilePath +import System.Info.Extra +import Data.Version.Extra import Data.List.Extra import Data.Char import Data.Time.Clock +import Data.Time.Format +import Data.Time.LocalTime import System.IO.Error import System.Directory import Control.Exception @@ -62,7 +66,11 @@ (Just <$> getModificationTime file) +-- | Get the current time in the current timezone in HH:MM:SS format +getShortTime :: IO String +getShortTime = formatTime defaultTimeLocale "%H:%M:%S" <$> getZonedTime + -- | Get the smallest difference that can be reported by two modification times getModTimeResolution :: IO Seconds getModTimeResolution = return getModTimeResolutionCache @@ -82,6 +90,10 @@ writeFile file $ show (i,j) t2 <- getModificationTime file return $ if t1 == t2 then Left $ j+1 else Right () + + -- GHC 7.6 and below only have 1 sec resolution timestamps + mtime <- return $ if compilerVersion < makeVersion [7,8] then max mtime 1 else mtime + putStrLn $ "Longest file modification time lag was " ++ show (ceiling (mtime * 1000)) ++ "ms" -- add a little bit of safety, but if it's really quick, don't make it that much slower return $ mtime + min 0.1 mtime diff --git a/src/Test/Ghcid.hs b/src/Test/Ghcid.hs --- a/src/Test/Ghcid.hs +++ b/src/Test/Ghcid.hs @@ -49,11 +49,11 @@ withCurrentDirectory tdir act -whenStack :: IO a -> IO () -whenStack act = do - v <- findExecutable "stack" +whenExecutable :: String -> IO a -> IO () +whenExecutable exe act = do + v <- findExecutable exe case v of - Nothing -> putStrLn "Couldn't run test because stack is missing" + Nothing -> putStrLn $ "Couldn't run test because " ++ exe ++ " is missing" Just _ -> void act @@ -177,7 +177,7 @@ cabalTest :: TestTree -cabalTest = testCase "Ghcid Cabal" $ copyDir "test/bar" $ do +cabalTest = testCase "Ghcid Cabal" $ copyDir "test/bar" $ whenExecutable "cabal" $ do env <- getEnvironment let db = ["--package-db=" ++ x | x <- maybe [] splitSearchPath $ lookup "GHC_PACKAGE_PATH" env] (_, _, _, pid) <- createProcess $ @@ -193,7 +193,7 @@ require [allGoodMessage] stackTest :: TestTree -stackTest = testCase "Ghcid Stack" $ copyDir "test/bar" $ whenStack $ do +stackTest = testCase "Ghcid Stack" $ copyDir "test/bar" $ whenExecutable "stack" $ do system_ "stack init" createDirectoryIfMissing True ".stack-work" @@ -201,8 +201,10 @@ require [allGoodMessage] append "src/Literate.lhs" "> x" require ["src/Literate.lhs:5:3","Parse error:"] - +{- + -- Stack seems to have changed, and continues to do so - lets just test the basics withGhcid ["src/Boot.hs"] $ \require -> do require [allGoodMessage] writeFile "src/Boot.hs" "X" require ["src/Boot.hs:1:1","Parse error:"] +-} diff --git a/src/Wait.hs b/src/Wait.hs --- a/src/Wait.hs +++ b/src/Wait.hs @@ -21,11 +21,11 @@ import Language.Haskell.Ghcid.Util -data Waiter = WaiterPoll +data Waiter = WaiterPoll Seconds | WaiterNotify WatchManager (MVar ()) (Var (Map.Map FilePath StopListening)) -withWaiterPoll :: (Waiter -> IO a) -> IO a -withWaiterPoll f = f WaiterPoll +withWaiterPoll :: Seconds -> (Waiter -> IO a) -> IO a +withWaiterPoll x f = f $ WaiterPoll x withWaiterNotify :: (Waiter -> IO a) -> IO a withWaiterNotify f = withManagerConf defaultConfig{confDebounce=NoDebounce} $ \manager -> do @@ -52,7 +52,7 @@ files <- fmap concat $ forM files $ \file -> ifM (doesDirectoryExist file) (listFilesInside (return . not . isPrefixOf "." . takeFileName) file) (return [file]) case waiter of - WaiterPoll -> return () + WaiterPoll t -> sleep $ max 0 $ t - 0.1 -- subtract the initial 0.1 sleep from above WaiterNotify manager kick mp -> do dirs <- fmap Set.fromList $ mapM canonicalizePathSafe $ nubOrd $ map takeDirectory files modifyVar_ mp $ \mp -> do @@ -75,7 +75,7 @@ recheck files old = do sleep 0.1 case waiter of - WaiterPoll -> return () + WaiterPoll _ -> return () WaiterNotify _ kick _ -> do takeMVar kick whenLoud $ outStrLn "%WAITING: Notify signaled"