ghcid 0.7.1 → 0.7.2

raw patch · 9 files changed

+97/−38 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.txt +5/−0
• LICENSE +1/−1
• ghcid.cabal +3/−3
• src/Ghcid.hs +43/−17
• src/Language/Haskell/Ghcid/Escape.hs +17/−8
• src/Language/Haskell/Ghcid/Util.hs +4/−0
• src/Test/Ghcid.hs +1/−1
• src/Test/Util.hs +8/−5
• src/Wait.hs +15/−3

@@ -1,5 +1,10 @@ Changelog for ghcid (* = breaking change) +0.7.2, released 2019-03-12+    #225, allow watching directories for new files+    #226, fix the polling behaviour+    #224, print out overly long files without line breaks+    #202, make --verbose print out version, arch, os 0.7.1, released 2018-09-07     #190, load benchmarks as well as tests when using stack     #171, support GHCJSi

@@ -1,4 +1,4 @@-Copyright Neil Mitchell 2014-2018.+Copyright Neil Mitchell 2014-2019. All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -1,19 +1,19 @@ cabal-version:      >= 1.18 build-type:         Simple name:               ghcid-version:            0.7.1+version:            0.7.2 license:            BSD3 license-file:       LICENSE category:           Development author:             Neil Mitchell <ndmitchell@gmail.com>, jpmoresmau maintainer:         Neil Mitchell <ndmitchell@gmail.com>-copyright:          Neil Mitchell 2014-2018+copyright:          Neil Mitchell 2014-2019 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.4.3, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4+tested-with:        GHC==8.6.4, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3 extra-doc-files:     CHANGES.txt     README.md

@@ -2,7 +2,7 @@ {-# OPTIONS_GHC -fno-cse #-}  -- | The application entry point-module Ghcid(main, mainWithTerminal) where+module Ghcid(main, mainWithTerminal, TermSize(..), WordWrap(..)) where  import Control.Exception import System.IO.Error@@ -22,6 +22,7 @@ import System.Time.Extra import System.Exit import System.FilePath+import System.Info import System.IO.Extra  import Paths_ghcid@@ -161,8 +162,14 @@         withArgs (extra ++ orig) act  +data TermSize = TermSize+    {termWidth :: Int+    ,termHeight :: Int+    ,termWrap :: WordWrap+    }+ -- | Like 'main', but run with a fake terminal for testing-mainWithTerminal :: IO (Int,Int) -> ([String] -> IO ()) -> IO ()+mainWithTerminal :: IO TermSize -> ([String] -> IO ()) -> IO () mainWithTerminal termSize termOutput =     handle (\(UnexpectedExit cmd _) -> do putStrLn $ "Command \"" ++ cmd ++ "\" exited unexpectedly"; exitFailure) $         forever $ withWindowIcon $ withSession $ \session -> do@@ -173,18 +180,25 @@             hSetBuffering stderr NoBuffering             origDir <- getCurrentDirectory             opts <- withGhcidArgs $ cmdArgsRun options+            whenLoud $ do+                outStrLn $ "%OS: " ++ os+                outStrLn $ "%ARCH: " ++ arch+                outStrLn $ "%VERSION: " ++ showVersion version             withCurrentDirectory (directory opts) $ do                 opts <- autoOptions opts                 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 (w,h)+                    (Just w, Just h) -> return $ TermSize w 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 (fromMaybe (pred $ fst term) w, fromMaybe (snd term) h)+                        return $ TermSize+                            (fromMaybe (pred $ termWidth term) w)+                            (fromMaybe (termHeight term) h)+                            (if isJust w then WrapHard else termWrap term)                  restyle <- do                     useStyle <- case color opts of@@ -204,7 +218,11 @@ main :: IO () main = mainWithTerminal termSize termOutput     where-        termSize = maybe (80, 8) (Term.width &&& Term.height) <$> Term.size+        termSize = do+            x <- Term.size+            return $ case x of+                Nothing -> TermSize 80 8 WrapHard+                Just t -> TermSize (Term.width t) (Term.height t) WrapSoft          termOutput xs = do             outStr $ concatMap ('\n':) xs@@ -215,16 +233,24 @@  -- If we return successfully, we restart the whole process -- Use Continue not () so that inadvertant exits don't restart-runGhcid :: Session -> Waiter -> IO (Int,Int) -> ([String] -> IO ()) -> Options -> IO Continue+runGhcid :: Session -> Waiter -> IO TermSize -> ([String] -> IO ()) -> Options -> IO Continue 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-            (width, height) <- termSize-            let n = height - length msg-            load <- return $ take (if isJust load then n else 0) $ prettyOutput max_messages currTime (maybe 0 fst load)-                [ m{loadMessage = map fromEsc $ concatMap (chunksOfWordE width (width `div` 5) . Esc) $ loadMessage m}-                | m@Message{} <- maybe [] snd load]-            termOutput $ load ++ msg ++ replicate (height - (length load + length msg)) ""+            load <- return $ case load of+                Nothing -> []+                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 ""+            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      when (ignoreLoaded && null reload) $ do         putStrLn "--reload must be set when using --ignore-loaded"@@ -285,7 +311,7 @@                     if takeExtension file == ".json" then                         showJSON [("loaded",map jString loaded),("messages",map jMessage $ filter isMessage messages)]                     else-                        unlines $ map unescape $ prettyOutput max_messages currTime loadedCount ordMessages+                        unlines $ map unescape $ prettyOutput currTime loadedCount $ limitMessages ordMessages             when (null loaded && not ignoreLoaded) $ do                 putStrLn "No files loaded, nothing to wait for. Fix the last error and restart."                 exitFailure@@ -319,10 +345,10 @@   -- | Given an available height, and a set of messages to display, show them as best you can.-prettyOutput :: Maybe Int -> String -> Int -> [Load] -> [String]-prettyOutput _ currTime loaded [] =-    [allGoodMessage ++ " (" ++ show loaded ++ " module" ++ ['s' | loaded /= 1] ++ ", at " ++ currTime ++ ")"]-prettyOutput maxMsgs _ loaded xs = concat $ maybe id take maxMsgs $ map loadMessage xs+prettyOutput :: String -> Int -> [Load] -> [String]+prettyOutput currTime loadedCount [] =+    [allGoodMessage ++ " (" ++ show loadedCount ++ " module" ++ ['s' | loadedCount /= 1] ++ ", at " ++ currTime ++ ")"]+prettyOutput _ _ xs = concatMap loadMessage xs   showJSON :: [(String, [String])] -> String

@@ -2,9 +2,10 @@  -- | Module for dealing with escape codes module Language.Haskell.Ghcid.Escape(+    WordWrap(..),     Esc(..), unescape,     stripInfixE, stripPrefixE, isPrefixOfE, spanE, trimStartE, unwordsE, unescapeE,-    chunksOfWordE+    wordWrapE     ) where  import Data.Char@@ -98,11 +99,19 @@ lengthE :: Esc -> Int lengthE = length . unescapeE --- | Like chunksOf, but deal with words up to some gap.++-- | 'WrapHard' means you have to+data WordWrap = WrapHard | WrapSoft+    deriving (Eq,Show)+++-- | Word wrap a string into N separate strings. --   Flows onto a subsequent line if less than N characters end up being empty.-chunksOfWordE :: Int -> Int -> Esc -> [Esc]-chunksOfWordE mx gap = repeatedlyE $ \x ->-    let (a,b) = splitAtE mx x in-    if b == Esc "" then (a, Esc "") else-        let (a1,a2) = breakEndE isSpace a in-        if lengthE a2 <= gap then (a1, app a2 b) else (a, trimStartE b)+wordWrapE :: Int -> Int -> Esc -> [(Esc, WordWrap)]+wordWrapE mx gap = repeatedlyE f+    where+        f x =+            let (a,b) = splitAtE mx x in+            if b == Esc "" then ((a, WrapHard), Esc "") else+                let (a1,a2) = breakEndE isSpace a in+                if lengthE a2 <= gap then ((a1, WrapHard), app a2 b) else ((a, WrapSoft), trimStartE b)

@@ -4,6 +4,7 @@     ghciFlagsRequired, ghciFlagsRequiredVersioned,     ghciFlagsUseful, ghciFlagsUsefulVersioned,     dropPrefixRepeatedly,+    takeRemainder,     outStr, outStrLn,     ignored,     allGoodMessage,@@ -94,6 +95,9 @@     (\_ -> return Nothing)     (Just <$> getModificationTime file) +-- | Returns both the amount left (could have been taken more) and the list+takeRemainder :: Int -> [a] -> (Int, [a])+takeRemainder n xs = let ys = take n xs in (n - length ys, ys)  -- | Get the current time in the current timezone in HH:MM:SS format getShortTime :: IO String

@@ -77,7 +77,7 @@     res <- bracket         (flip forkFinally (const $ signalBarrier done ()) $             withArgs (["--no-title","--no-status"]++args) $-                mainWithTerminal (return (100, 50)) output)+                mainWithTerminal (return $ TermSize 100 50 WrapHard) output)         killThread $ \_ -> script require     waitBarrier done     return res

@@ -1,3 +1,4 @@+ -- | Test utility functions module Test.Util(utilsTests) where @@ -10,7 +11,7 @@ utilsTests :: TestTree utilsTests = testGroup "Utility tests"     [dropPrefixTests-    ,chunksOfWordTests+    ,wordWrapTests     ]  dropPrefixTests :: TestTree@@ -21,8 +22,10 @@     ,testCase "Prefix found twice" $ dropPrefixRepeatedly "str" "strstring" @?= "ing"     ] -chunksOfWordTests :: TestTree-chunksOfWordTests = testGroup "chunksOfWord"-    [testCase "Max 0" $ chunksOfWordE 4 0 (Esc "ab cd efgh") @?= map Esc ["ab c","d ef","gh"]-    ,testCase "Max 2" $ chunksOfWordE 4 2 (Esc "ab cd efgh") @?= map Esc ["ab ","cd ","efgh"]+wordWrapTests :: TestTree+wordWrapTests = testGroup "wordWrap"+    [testCase "Max 0" $ wordWrapE 4 0 (Esc "ab cd efgh") @?= [s"ab c",s"d ef",h"gh"]+    ,testCase "Max 2" $ wordWrapE 4 2 (Esc "ab cd efgh") @?= [h"ab ",h"cd ",h"efgh"]     ]+    where h x = (Esc x, WrapHard)+          s x = (Esc x, WrapSoft)

@@ -32,6 +32,16 @@     var <- newVar Map.empty     f $ WaiterNotify manager mvar var +-- `listContentsInside test dir` will list files and directories inside `dir`,+-- recursing into those subdirectories which pass `test`.+-- Note that `dir` and files it directly contains are always listed, regardless of `test`.+-- Subdirectories will have a trailing path separator, and are only listed if we recurse into them.+listContentsInside :: (FilePath -> IO Bool) -> FilePath -> IO [FilePath]+listContentsInside test dir = do+    (dirs,files) <- partitionM doesDirectoryExist =<< listContents dir+    recurse <- filterM test dirs+    rest <- concatMapM (listContentsInside test) recurse+    return $ addTrailingPathSeparator dir : files ++ rest  -- | Given the pattern: --@@ -48,10 +58,12 @@     base <- getCurrentTime     return $ \files -> handle (\(e :: IOError) -> do sleep 1.0; return ["Error when waiting, if this happens repeatedly, raise a ghcid bug.",show e]) $ do         whenLoud $ outStrLn $ "%WAITING: " ++ unwords files+        -- As listContentsInside returns directories, we are waiting on them explicitly and so+        -- will pick up new files, as creating a new file changes the containing directory's modtime.         files <- fmap concat $ forM files $ \file ->-            ifM (doesDirectoryExist file) (listFilesInside (return . not . isPrefixOf "." . takeFileName) file) (return [file])+            ifM (doesDirectoryExist file) (listContentsInside (return . not . isPrefixOf "." . takeFileName) file) (return [file])         case waiter of-            WaiterPoll t -> sleep $ max 0 $ t - 0.1 -- subtract the initial 0.1 sleep from above+            WaiterPoll t -> return ()             WaiterNotify manager kick mp -> do                 dirs <- fmap Set.fromList $ mapM canonicalizePathSafe $ nubOrd $ map takeDirectory files                 modifyVar_ mp $ \mp -> do@@ -74,7 +86,7 @@         recheck files old = do             sleep 0.1             case waiter of-                WaiterPoll _ -> return ()+                WaiterPoll t -> sleep $ max 0 $ t - 0.1 -- subtract the initial 0.1 sleep from above                 WaiterNotify _ kick _ -> do                     takeMVar kick                     whenLoud $ outStrLn "%WAITING: Notify signaled"