ghcid 0.6.1 → 0.6.2
raw patch · 10 files changed
+96/−33 lines, 10 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGES.txt +10/−1
- README.md +1/−0
- ghcid.cabal +1/−1
- src/Ghcid.hs +24/−11
- src/Language/Haskell/Ghcid.hs +37/−10
- src/Language/Haskell/Ghcid/Parser.hs +10/−1
- src/Session.hs +9/−5
- src/Test/Parser.hs +2/−2
- src/Test/Polling.hs +1/−1
- src/Wait.hs +1/−1
CHANGES.txt view
@@ -1,5 +1,14 @@-Changelog for GHCiD+Changelog for ghcid +0.6.2+ #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+ Make --verbose echo all things sent to stdin+ #57, support wrappers that access stdin first (e.g. stack)+ #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 Add --reload to add files that reload, but do not restart #56, allow --restart to take directories
README.md view
@@ -35,3 +35,4 @@ * _This isn't as good as full IDE._ I've gone for simplicity over features. It's a point in the design space, but not necessarily the best point in the design space for you. For "real" IDEs see [the Haskell wiki](http://www.haskell.org/haskellwiki/IDEs). * _If I delete a file and put it back it gets stuck._ Yes, that's a [bug in GHCi](https://ghc.haskell.org/trac/ghc/ticket/9648). If you see GHCi getting confused just kill `ghcid` and start it again.+* _I want to run arbitrary commands when arbitrary files change._ This project reloads `ghci` when files loaded by `ghci` change. If you want a more general mechanism something like [Steel Overseer](https://github.com/steeloverseer/steeloverseer) will probably work better.
ghcid.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.10 build-type: Simple name: ghcid-version: 0.6.1+version: 0.6.2 license: BSD3 license-file: LICENSE category: Development
src/Ghcid.hs view
@@ -5,6 +5,7 @@ module Ghcid(main, runGhcid) where import Control.Exception+import System.IO.Error import Control.Monad.Extra import Data.List.Extra import Data.Maybe@@ -18,6 +19,7 @@ import System.Exit import System.FilePath import System.IO+import System.IO.Unsafe import Paths_ghcid import Language.Haskell.Ghcid@@ -32,6 +34,7 @@ {command :: String ,arguments :: [String] ,test :: Maybe String+ ,warnings :: Bool ,height :: Maybe Int ,width :: Maybe Int ,topmost :: Bool@@ -48,12 +51,13 @@ {command = "" &= typ "COMMAND" &= help "Command to run (defaults to ghci or cabal repl)" ,arguments = [] &= args &= typ "MODULE" ,test = Nothing &= name "T" &= typ "EXPR" &= help "Command to run after successful loading"+ ,warnings = False &= name "W" &= help "Allow tests to run even with warnings" ,height = Nothing &= help "Number of lines to use (defaults to console height)"- ,width = Nothing &= help "Number of columns to use (defaults to console width)"+ ,width = Nothing &= name "w" &= help "Number of columns to use (defaults to console width)" ,topmost = False &= name "t" &= help "Set window topmost (Windows only)" ,notitle = False &= help "Don't update the shell title/icon"- ,restart = [] &= typFile &= help "Restart the command if any of these files change (defaults to .ghci or .cabal)"- ,reload = [] &= typFile &= help "Reload if any of these files change (defaults to none)"+ ,restart = [] &= typ "PATH" &= help "Restart the command when the given file or directory contents change (defaults to .ghci and any .cabal file)"+ ,reload = [] &= typ "PATH" &= help "Reload when the given file or directory contents change (defaults to none)" ,directory = "." &= typDir &= name "C" &= help "Set the current directory" ,outputfile = [] &= typFile &= name "o" &= help "File to write the full output to" } &= verbosity &=@@ -88,10 +92,15 @@ | command /= "" = return $ f [command] [] | otherwise = do files <- getDirectoryContents "."++ -- use unsafePerformIO to get nicer pattern matching for logic (read-only operations)+ let isStack dir = unsafePerformIO $ flip catchIOError (const $ return False) $+ doesFileExist (dir </> "stack.yaml") &&^ doesDirectoryExist (dir </> ".stack-work")+ let cabal = filter ((==) ".cabal" . takeExtension) files let opts = ["-fno-code" | isNothing test] return $ case () of- _ | "stack.yaml" `elem` files, ".stack-work" `elem` files ->+ _ | cabal /= [], isStack "." || isStack ".." -> -- stack file might be parent, see #62 let flags = if null arguments then "stack ghci --test" : ["--no-load" | ".ghci" `elem` files] ++@@ -128,7 +137,7 @@ return (f width 80 (pred . fst), f height 8 snd) withWaiterNotify $ \waiter -> handle (\(UnexpectedExit cmd _) -> putStrLn $ "Command \"" ++ cmd ++ "\" exited unexpectedly") $- runGhcid session waiter (nubOrd restart) (nubOrd reload) command outputfile test height (not notitle) $ \xs -> do+ runGhcid session waiter (nubOrd restart) (nubOrd reload) command outputfile test warnings height (not notitle) $ \xs -> do outWith $ forM_ (groupOn fst xs) $ \x@((s,_):_) -> do when (s == Bold) $ setSGR [SetConsoleIntensity BoldIntensity] putStr $ concatMap ((:) '\n' . snd) x@@ -139,8 +148,8 @@ data Style = Plain | Bold deriving Eq -runGhcid :: Session -> Waiter -> [FilePath] -> [FilePath] -> String -> [FilePath] -> Maybe String -> IO (Int,Int) -> Bool -> ([(Style,String)] -> IO ()) -> IO ()-runGhcid session waiter restart reload command outputfiles test size titles output = do+runGhcid :: Session -> Waiter -> [FilePath] -> [FilePath] -> String -> [FilePath] -> Maybe String -> Bool -> IO (Int,Int) -> Bool -> ([(Style,String)] -> IO ()) -> IO ()+runGhcid session waiter restart reload command outputfiles test warnings size titles output = do let outputFill :: Maybe (Int, [Load]) -> [String] -> IO () outputFill load msg = do (width, height) <- size@@ -162,7 +171,7 @@ let (countErrors, countWarnings) = both sum $ unzip [if loadSeverity == Error then (1,0) else (0,1) | m@Message{..} <- messages, loadMessage /= []]- test <- return $ if countErrors == 0 && countWarnings == 0 then test else Nothing+ test <- return $ if countErrors == 0 && (warnings || countWarnings == 0) then test else Nothing when titles $ setWindowIcon $ if countErrors > 0 then IconError else if countWarnings > 0 then IconWarning else IconOK@@ -182,9 +191,13 @@ exitFailure whenJust test $ \t -> do whenLoud $ outStrLn $ "%TESTING: " ++ t- sessionExecAsync session t $ do+ sessionExecAsync session t $ \stderr -> do whenLoud $ outStrLn "%TESTING: Completed"- updateTitle "(test done)"+ if "*** Exception: " `isPrefixOf` stderr then do+ updateTitle "(test failed)"+ setWindowIcon IconError+ else+ updateTitle "(test done)" reason <- nextWait $ restart ++ reload ++ loaded outputFill Nothing $ "Reloading..." : map (" " ++) reason@@ -193,7 +206,7 @@ nextWait <- waitFiles waiter fire nextWait =<< sessionReload session else do- runGhcid session waiter restart reload command outputfiles test size titles output+ runGhcid session waiter restart reload command outputfiles test warnings size titles output nextWait <- waitFiles waiter (messages, loaded) <- sessionStart session command
src/Language/Haskell/Ghcid.hs view
@@ -52,13 +52,18 @@ hSetBuffering out LineBuffering hSetBuffering err LineBuffering hSetBuffering inp LineBuffering+ let writeInp x = do+ whenLoud $ outStrLn $ "%STDIN: " ++ x+ hPutStrLn inp x + -- Some programs (e.g. stack) might use stdin before starting ghci (see #57)+ -- Send them an empty line+ hPutStrLn inp ""+ -- I'd like the GHCi prompt to go away, but that's not possible, so I set it to a special -- string and filter that out. let ghcid_prefix = "#~GHCID-START~#" let removePrefix = dropPrefixRepeatedly ghcid_prefix- hPutStrLn inp $ ":set prompt " ++ ghcid_prefix- hPutStrLn inp ":set -fno-break-on-exception -fno-break-on-error" -- see #43 -- At various points I need to ensure everything the user is waiting for has completed -- So I send messages on stdout/stderr and wait for them to arrive@@ -66,7 +71,7 @@ let syncReplay = do i <- readVar syncCount let msg = "#~GHCID-FINISH-" ++ show i ++ "~#"- hPutStrLn inp $ "Prelude.putStrLn " ++ show msg ++ "\nPrelude.error " ++ show msg+ writeInp $ "Prelude.putStrLn " ++ show msg ++ "\nPrelude.error " ++ show msg return $ isInfixOf msg let syncFresh = do modifyVar_ syncCount $ return . succ@@ -96,7 +101,6 @@ Nothing -> throwIO $ UnexpectedExit cmd msg Just v -> return v - -- held while interrupting, and briefly held when starting an exec -- ensures exec values queue up behind an ongoing interrupt and no two interrupts run at once isInterrupting <- newLock@@ -107,8 +111,7 @@ let ghciExec command echo = do withLock isInterrupting $ return () res <- withLockTry isRunning $ do- whenLoud $ outStrLn $ "%GHCINP: " ++ command- hPutStrLn inp command+ writeInp command stop <- syncFresh void $ consume2 command $ \strm s -> if stop s then return $ Just () else do echo strm s; return Nothing@@ -129,7 +132,31 @@ void $ consume2 "Interrupt" $ \_ s -> return $ if stop s then Just () else Nothing let ghci = Ghci{..}- r <- parseLoad <$> execBuffer ghci "" echo0++ -- Now wait for 'GHCi, version' to appear before sending anything real, required for #57+ stdout <- newIORef []+ stderr <- newIORef []+ sync <- newIORef $ const False+ consume2 "" $ \strm s -> do+ stop <- readIORef sync+ if stop s then+ return $ Just ()+ else do+ -- there may be some initial prompts on stdout before I set the prompt properly+ s <- return $ maybe s (removePrefix . snd) $ stripInfix ghcid_prefix s+ whenLoud $ outStrLn $ "%STDOUT2: " ++ s+ modifyIORef (if strm == Stdout then stdout else stderr) (s:)+ when ("GHCi, version " `isPrefixOf` s) $ do+ -- the thing before me may have done its own Haskell compiling+ writeIORef stdout []+ writeIORef stderr []+ writeIORef sync =<< syncFresh+ writeInp $ ":set prompt " ++ ghcid_prefix+ writeInp ":set -fno-break-on-exception -fno-break-on-error" -- see #43+ echo0 strm s+ return Nothing+ r <- parseLoad . reverse <$> ((++) <$> readIORef stderr <*> readIORef stdout)+ execStream ghci "" echo0 return (ghci, r) @@ -157,9 +184,9 @@ execBuffer ghci cmd echo = do stdout <- newIORef [] stderr <- newIORef []- execStream ghci cmd $ \i s -> do- modifyIORef (if i == Stdout then stdout else stderr) (s:)- echo i s+ execStream ghci cmd $ \strm s -> do+ modifyIORef (if strm == Stdout then stdout else stderr) (s:)+ echo strm s reverse <$> ((++) <$> readIORef stderr <*> readIORef stdout) -- | Send a command, get lines of result. Must be called single-threaded.
src/Language/Haskell/Ghcid/Parser.hs view
@@ -8,6 +8,9 @@ import System.FilePath import Data.Char import Data.List.Extra+import Data.Tuple.Extra+import Control.Applicative+import Prelude import Language.Haskell.Ghcid.Types @@ -31,7 +34,7 @@ f rest f (x:xs) | not $ " " `isPrefixOf` x- , (file,':':rest) <- break (== ':') x+ , Just (file,rest) <- breakFileColon x , takeExtension file `elem` [".hs",".lhs"] , (pos,rest2) <- span (\c -> c == ':' || isDigit c) rest , [p1,p2] <- map read $ words $ map (\c -> if c == ':' then ' ' else c) pos@@ -51,3 +54,9 @@ [Message Error m (0,0) [] | m <- nubOrd ms] ++ f rest f (_:xs) = f xs f [] = []+++-- A filename, followed by a colon - be careful to handle Windows drive letters, see #61+breakFileColon :: String -> Maybe (FilePath, String)+breakFileColon (x:':':xs) | isLetter x = first ([x,':']++) <$> stripInfix ":" xs+breakFileColon xs = stripInfix ":" xs
src/Session.hs view
@@ -111,18 +111,22 @@ -- | Run an exec operation asynchronously. Should not be a @:reload@ or similar.--- Will be automatically aborted if it takes too long.-sessionExecAsync :: Session -> String -> IO () -> IO ()+-- Will be automatically aborted if it takes too long. Only fires done if not aborted.+-- Argument to done is the final stderr line.+sessionExecAsync :: Session -> String -> (String -> IO ()) -> IO () sessionExecAsync Session{..} cmd done = do Just ghci <- readIORef ghci+ stderr <- newIORef "" modifyVar_ running $ const $ return True void $ forkIO $ do- execStream ghci cmd $ \_ msg ->- when (msg /= "*** Exception: ExitSuccess") $+ execStream ghci cmd $ \strm msg ->+ when (msg /= "*** Exception: ExitSuccess") $ do+ when (strm == Stderr) $ writeIORef stderr msg outStrLn msg old <- modifyVar running $ \b -> return (False, b) -- don't fire Done if someone interrupted us- when old done+ stderr <- readIORef stderr+ when old $ done stderr -- | Ignore entirely pointless messages and remove unnecessary lines.
src/Test/Parser.hs view
@@ -30,7 +30,7 @@ , Message {loadSeverity = Error, loadFile = "GHCi.hs", loadFilePos = (70,1), loadMessage = ["GHCi.hs:70:1: Parse error: naked expression at top level"]} , Message {loadSeverity = Error, loadFile = "GHCi.hs", loadFilePos = (72,13), loadMessage = ["GHCi.hs:72:13:"," No instance for (Num ([String] -> [String]))"," arising from the literal `1'"," Possible fix:"," add an instance declaration for (Num ([String] -> [String]))"," In the expression: 1"," In an equation for `parseLoad': parseLoad = 1"]} , Message {loadSeverity = Warning, loadFile = "GHCi.hs", loadFilePos = (81,1), loadMessage = ["GHCi.hs:81:1: Warning: Defined but not used: `foo'"]}- , Message {loadSeverity = Warning, loadFile = "GHCi.hs", loadFilePos = (82,1), loadMessage = ["GHCi.hs:82:1: warning: Defined but not used: \8216foo\8217"]}+ , Message {loadSeverity = Warning, loadFile = "C:\\GHCi.hs", loadFilePos = (82,1), loadMessage = ["C:\\GHCi.hs:82:1: warning: Defined but not used: \8216foo\8217"]} ] ] @@ -46,5 +46,5 @@ , " In the expression: 1" , " In an equation for `parseLoad': parseLoad = 1" , "GHCi.hs:81:1: Warning: Defined but not used: `foo'"- , "GHCi.hs:82:1: warning: Defined but not used: \8216foo\8217" -- GHC 7.12 uses lowercase+ , "C:\\GHCi.hs:82:1: warning: Defined but not used: \8216foo\8217" -- GHC 7.12 uses lowercase ]
src/Test/Polling.hs view
@@ -42,7 +42,7 @@ try_ $ system "chmod og-w . .ghci" withSession $ \session -> withWaiterPoll $ \waiter -> bracket (- forkIO $ runGhcid session waiter [] [] "ghci" [] Nothing (return (100, 50)) False $ \msg ->+ forkIO $ runGhcid session waiter [] [] "ghci" [] Nothing False (return (100, 50)) False $ \msg -> unless (isLoading $ map snd msg) $ putMVarNow ref $ map snd msg ) killThread $ \_ -> do require requireAllGood
src/Wait.hs view
@@ -50,7 +50,7 @@ return $ \files -> handle (\(e :: IOError) -> do sleep 0.1; return [show e]) $ do whenLoud $ outStrLn $ "%WAITING: " ++ unwords files files <- fmap concat $ forM files $ \file ->- ifM (doesDirectoryExist file) (listFiles file) (return [file])+ ifM (doesDirectoryExist file) (listFilesInside (return . not . isPrefixOf "." . takeFileName) file) (return [file]) case waiter of WaiterPoll -> return () WaiterNotify manager kick mp -> do