ghcid 0.3.4 → 0.3.5

raw patch · 8 files changed

+72/−48 lines, 8 filesdep +ansi-terminaldep −containersdep ~extraPVP ok

version bump matches the API change (PVP)

Dependencies added: ansi-terminal

Dependencies removed: containers

Dependency ranges changed: extra

API changes (from Hackage documentation)

Files

• CHANGES.txt +6/−0
• LICENSE +1/−1
• ghcid.cabal +8/−9
• src/Ghcid.hs +48/−19
• src/Language/Haskell/Ghcid/Parser.hs +1/−2
• src/Language/Haskell/Ghcid/Util.hs +5/−14
• test/Language/Haskell/Ghcid/PollingTest.hs +2/−2
• test/Language/Haskell/Ghcid/UtilTest.hs +1/−1

@@ -1,5 +1,11 @@ Changelog for GHCiD +0.3.5+    #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     #21, if you aren't waiting for any files, exit 0.3.3

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

@@ -1,19 +1,19 @@ cabal-version:      >= 1.10 build-type:         Simple name:               ghcid-version:            0.3.4+version:            0.3.5 license:            BSD3 license-file:       LICENSE category:           Development author:             Neil Mitchell <ndmitchell@gmail.com>, jpmoresmau maintainer:         Neil Mitchell <ndmitchell@gmail.com>-copyright:          Neil Mitchell 2014+copyright:          Neil Mitchell 2014-2015 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==7.8.3, GHC==7.6.3+tested-with:        GHC==7.10.1, GHC==7.8.3, GHC==7.6.3 extra-source-files:     CHANGES.txt     README.md@@ -30,8 +30,7 @@         filepath,         time,         directory,-        containers,-        extra >= 0.4,+        extra >= 1.1,         process >= 1.1,         cmdargs >= 0.10   if !os(windows)@@ -53,11 +52,11 @@       base == 4.*,       filepath,       time,-      containers,       directory,-      extra >= 0.4,+      extra >= 1.1,       process >= 1.1,       cmdargs >= 0.10,+      ansi-terminal,       terminal-size >= 0.3   other-modules:                       Language.Haskell.Ghcid.Types,@@ -75,9 +74,9 @@     filepath,     time,     directory,-    containers,     process,-    extra >= 0.4,+    extra >= 1.1,+    ansi-terminal,     cmdargs,     tasty,     tasty-hunit

@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards, DeriveDataTypeable, CPP, ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards, DeriveDataTypeable, CPP, ScopedTypeVariables, TupleSections #-} {-# OPTIONS_GHC -O2 #-} -- only here to test ticket #11  -- | The application entry point@@ -13,8 +13,10 @@ import Data.Version import qualified System.Console.Terminal.Size as Term import System.Console.CmdArgs+import System.Console.ANSI import System.Directory import System.Exit+import System.FilePath import System.IO import System.IO.Error import System.Time.Extra@@ -31,6 +33,7 @@     ,height :: Maybe Int     ,width :: Maybe Int     ,topmost :: Bool+    ,restart :: [FilePath]     }     deriving (Data,Typeable,Show) @@ -40,13 +43,25 @@     ,height = Nothing &= help "Number of lines to show (defaults to console height)"     ,width = Nothing &= help "Number of columns to show (defaults to console width)"     ,topmost = False &= name "t" &= help "Set window topmost (Windows only)"+    ,restart = [] &= help "Restart the command if any of these files change (defaults to .ghci or .cabal)"     } &= verbosity &=     program "ghcid" &= summary ("Auto reloading GHCi daemon v" ++ showVersion version)  +autoOptions :: Options -> IO Options+autoOptions o+    | command o /= "" = return o+    | otherwise = do+        files <- getDirectoryContents "."+        let cabal = filter ((==) ".cabal" . takeExtension) files+        if null cabal || ".ghci" `elem` files+            then return o{command="ghci", restart=[".ghci"]}+            else return o{command="cabal repl", restart=cabal}++ main :: IO () main = do-    opts@Options{..} <- cmdArgsRun options+    opts@Options{..} <- autoOptions =<< cmdArgsRun options     when topmost terminalTopmost     height <- return $ case (width, height) of         (Just w, Just h) -> return (w,h)@@ -56,38 +71,52 @@             -- if we write to the end of the window then it wraps automatically             -- so putStrLn width 'x' uses up two lines             return (f width 80 (pred . fst), f height 8 snd)-    command <- if command /= "" then return command else-               ifM (doesFileExist ".ghci") (return "ghci") (return "cabal repl")-    runGhcid command height $ \xs -> do-        outStr $ concatMap ('\n':) xs+    runGhcid restart command height $ \xs -> do+        outWith $ forM_ (groupOn fst xs) $ \x@((b,_):_) -> do+            when b $ setSGR [SetConsoleIntensity BoldIntensity]+            putStr $ concatMap ((:) '\n' . snd) x+            when b $ setSGR []         hFlush stdout -- must flush, since we don't finish with a newline  -runGhcid :: String -> IO (Int,Int) -> ([String] -> IO ()) -> IO ()-runGhcid command size output = do-    do (_,height) <- size; output $ "Loading..." : replicate (height - 1) ""+runGhcid :: [FilePath] -> String -> IO (Int,Int) -> ([(Bool,String)] -> IO ()) -> IO ()+runGhcid restart command size output = do+    restartTimes <- mapM mtime restart+    do (_,height) <- size; output $ map (False,) $ "Loading..." : replicate (height - 1) ""     (ghci,initLoad) <- startGhci command Nothing+    curdir <- getCurrentDirectory     let fire load warnings = do             load <- return $ filter (not . whitelist) load             (width, height) <- size             start <- getCurrentTime             modsActive <- fmap (map snd) $ showModules ghci-            let modsLoad = nub $ map loadFile load+            let modsLoad = nubOrd $ map loadFile load             whenLoud $ do                 outStrLn $ "%ACTIVE: " ++ show modsActive                 outStrLn $ "%LOAD: " ++ show load             let warn = [w | w <- warnings, loadFile w `elem` modsActive, loadFile w `notElem` modsLoad]-            let outFill msg = output $ take height $ msg ++ replicate height ""+            let outFill msg = output $ take height $ msg ++ map (False,) (replicate height "")             outFill $ prettyOutput height                 [m{loadMessage = concatMap (chunksOfWord width (width `div` 5)) $ loadMessage m} | m@Message{} <- load ++ warn]-            let wait = nub $ modsLoad ++ modsActive+            setTitle $+                let (errs, warns) = both sum $ unzip [if loadSeverity m == Error then (1,0) else (0,1) | m@Message{} <- load ++ warn]+                    f n msg = if n == 0 then "" else show n ++ " " ++ msg ++ ['s' | n > 1]+                in (if errs == 0 && warns == 0 then "All good" else f errs "error" +++                    (if errs > 0 && warns > 0 then ", " else "") ++ f warns "warning") +++                   " - " ++ takeFileName curdir+            let wait = nubOrd $ modsLoad ++ modsActive             when (null wait) $ do                 putStrLn $ "No files loaded, probably did not start GHCi.\nCommand: " ++ command                 exitFailure-            reason <- awaitFiles start wait-            outFill $ "Reloading..." : map ("  " ++) reason-            load2 <- reload ghci-            fire load2 [m | m@Message{..} <- warn ++ load, loadSeverity == Warning]+            reason <- awaitFiles start $ restart ++ wait+            outFill $ map (False,) $ "Reloading..." : map ("  " ++) reason+            restartTimes2 <- mapM mtime restart+            if restartTimes == restartTimes2 then do+                load2 <- reload ghci+                fire load2 [m | m@Message{..} <- warn ++ load, loadSeverity == Warning]+             else do+                stopGhci ghci+                runGhcid restart command size output     fire initLoad []  @@ -97,11 +126,11 @@ whitelist _ = False  -prettyOutput :: Int -> [Load] -> [String]-prettyOutput _ [] = [allGoodMessage]+prettyOutput :: Int -> [Load] -> [(Bool,String)]+prettyOutput _ [] = [(False,allGoodMessage)] prettyOutput height xs = take (max 3 $ height - (length msgs * 2)) msg1 ++ concatMap (take 2) msgs     where (err, warn) = partition ((==) Error . loadSeverity) xs-          msg1:msgs = map loadMessage err ++ map loadMessage warn+          msg1:msgs = map (map (True,) . loadMessage) err ++ map (map (False,) . loadMessage) warn   -- | return a message about why you are continuing (usually a file name)

@@ -12,7 +12,6 @@ import Data.List.Extra  import Language.Haskell.Ghcid.Types-import Language.Haskell.Ghcid.Util   -- | Parse messages from show modules command@@ -24,7 +23,7 @@ -- | Parse messages given on reload -- nub, because cabal repl sometimes does two reloads at the start parseLoad :: [String] -> [Load]-parseLoad  = ordNub . parseLoad'            +parseLoad  = nubOrd . parseLoad'  -- | Parse messages given on reload parseLoad' :: [String] -> [Load]

@@ -3,17 +3,16 @@ module Language.Haskell.Ghcid.Util   ( dropPrefixRepeatedly   , chunksOfWord+  , outWith   , outStrLn   , outStr   , allGoodMessage-  , ordNub   ) where  import Control.Concurrent.Extra import System.IO.Unsafe import Data.List.Extra import Data.Char-import qualified Data.Set as Set   -- | Drop a prefix from a list, no matter how many times that prefix is present@@ -26,8 +25,11 @@ lock :: Lock lock = unsafePerformIO newLock +outWith :: IO a -> IO a+outWith = withLock lock+ outStr :: String -> IO ()-outStr = withLock lock . putStr+outStr = outWith . putStr  outStrLn :: String -> IO () outStrLn s = outStr $ s ++ "\n"@@ -45,14 +47,3 @@     if null b then (a, []) else         let (a1,a2) = breakEnd isSpace a in         if length a2 <= gap then (a1, a2 ++ b) else (a, dropWhile isSpace b)----- ordNub function from <https://github.com/nh2/haskell-ordnub>-ordNub :: (Ord a) => [a] -> [a]-ordNub l = go Set.empty l-  where-    go _ [] = []-    go s (x:xs) =-      if x `Set.member` s-        then go s xs-        else x : go (Set.insert x s) xs

@@ -43,8 +43,8 @@         try_ $ system "chmod og-w . .ghci"          bracket (-          forkIO $ runGhcid "ghci" (return (100, 50)) $ \msg ->-            unless (isLoading msg) $ putMVarNow ref msg+          forkIO $ runGhcid [] "ghci" (return (100, 50)) $ \msg ->+            unless (isLoading $ map snd msg) $ putMVarNow ref $ map snd msg           ) killThread $ \_ -> do                 require requireAllGood             testScript require

@@ -13,7 +13,7 @@   [ dropPrefixTests   , chunksOfWordTests   ]-  + dropPrefixTests :: TestTree dropPrefixTests = testGroup "dropPrefix"   [ testCase "Prefix not found" $ dropPrefixRepeatedly "prefix" "string"  @?= "string"