diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -1,5 +1,7 @@ Changelog for GHCiD +0.3.2 + #18, reformat excessively long lines, add a --width flag 0.3.1 Ensure if there are lots of warnings, the first error gets shown 0.3 diff --git a/ghcid.cabal b/ghcid.cabal --- a/ghcid.cabal +++ b/ghcid.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.10 build-type: Simple name: ghcid -version: 0.3.1 +version: 0.3.2 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==7.8.2, GHC==7.6.3 +tested-with: GHC==7.8.3, GHC==7.6.3 extra-source-files: CHANGES.txt README.md diff --git a/src/Ghcid.hs b/src/Ghcid.hs --- a/src/Ghcid.hs +++ b/src/Ghcid.hs @@ -4,10 +4,10 @@ -- | The application entry point module Ghcid(main, runGhcid) where -import Control.Applicative import Control.Exception import Control.Monad.Extra -import Data.List +import Data.List.Extra +import Data.Maybe import Data.Time.Clock import Data.Version import System.Console.CmdArgs @@ -19,7 +19,6 @@ import Paths_ghcid import Language.Haskell.Ghcid import Language.Haskell.Ghcid.Terminal -import Language.Haskell.Ghcid.Types import Language.Haskell.Ghcid.Util @@ -27,6 +26,7 @@ data Options = Options {command :: String ,height :: Maybe Int + ,width :: Maybe Int ,topmost :: Bool } deriving (Data,Typeable,Show) @@ -35,6 +35,7 @@ options = cmdArgsMode $ Options {command = "" &= typ "COMMAND" &= help "Command to run (defaults to ghci or cabal repl)" ,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)" } &= verbosity &= program "ghcid" &= summary ("Auto reloading GHCi daemon v" ++ showVersion version) @@ -44,9 +45,14 @@ main = do opts@Options{..} <- cmdArgsRun options when topmost terminalTopmost - height <- return $ case height of - Nothing -> maybe 8 snd <$> terminalSize - Just h -> return h + height <- return $ case (width, height) of + (Just w, Just h) -> return (w,h) + _ -> do + term <- terminalSize + let f user def sel = fromMaybe (maybe def sel term) user + -- 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 @@ -54,13 +60,13 @@ hFlush stdout -- must flush, since we don't finish with a newline -runGhcid :: String -> IO Int -> ([String] -> IO ()) -> IO () -runGhcid command height output = do - do height <- height; output $ "Loading..." : replicate (height - 1) "" +runGhcid :: String -> IO (Int,Int) -> ([String] -> IO ()) -> IO () +runGhcid command size output = do + do (_,height) <- size; output $ "Loading..." : replicate (height - 1) "" (ghci,initLoad) <- startGhci command Nothing let fire load warnings = do load <- return $ filter (not . whitelist) load - height <- height + (width, height) <- size start <- getCurrentTime modsActive <- fmap (map snd) $ showModules ghci let modsLoad = nub $ map loadFile load @@ -69,7 +75,8 @@ 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 "" - outFill $ prettyOutput height $ filter isMessage load ++ warn + outFill $ prettyOutput height + [m{loadMessage = concatMap (chunksOfWord width (width `div` 5)) $ loadMessage m} | m@Message{} <- load ++ warn] reason <- awaitFiles start $ nub $ modsLoad ++ modsActive outFill $ "Reloading..." : map (" " ++) reason load2 <- reload ghci 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 @@ -2,6 +2,7 @@ -- Copyright Neil Mitchell 2014. module Language.Haskell.Ghcid.Util ( dropPrefixRepeatedly + , chunksOfWord , outStrLn , outStr , allGoodMessage @@ -9,8 +10,10 @@ import Control.Concurrent.Extra import System.IO.Unsafe -import Data.List +import Data.List.Extra +import Data.Char + -- | Drop a prefix from a list, no matter how many times that prefix is present dropPrefixRepeatedly :: Eq a => [a] -> [a] -> [a] dropPrefixRepeatedly [] s = s @@ -32,3 +35,11 @@ allGoodMessage :: String allGoodMessage = "All good" +-- | Like chunksOf, but deal with words up to some gap. +-- Flows onto a subsequent line if less than N characters end up being empty. +chunksOfWord :: Int -> Int -> String -> [String] +chunksOfWord mx gap = repeatedly $ \x -> + let (a,b) = splitAt mx x in + 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) diff --git a/test/Language/Haskell/Ghcid/PollingTest.hs b/test/Language/Haskell/Ghcid/PollingTest.hs --- a/test/Language/Haskell/Ghcid/PollingTest.hs +++ b/test/Language/Haskell/Ghcid/PollingTest.hs @@ -43,7 +43,7 @@ try_ $ system "chmod og-w . .ghci" bracket ( - forkIO $ runGhcid "ghci" (return 50) $ \msg -> + forkIO $ runGhcid "ghci" (return (100, 50)) $ \msg -> unless (isLoading msg) $ putMVarNow ref msg ) killThread $ \_ -> do require requireAllGood diff --git a/test/Language/Haskell/Ghcid/UtilTest.hs b/test/Language/Haskell/Ghcid/UtilTest.hs --- a/test/Language/Haskell/Ghcid/UtilTest.hs +++ b/test/Language/Haskell/Ghcid/UtilTest.hs @@ -11,6 +11,7 @@ utilsTests :: TestTree utilsTests=testGroup "Utility tests" [ dropPrefixTests + , chunksOfWordTests ] dropPrefixTests :: TestTree @@ -19,4 +20,10 @@ , testCase "Empty prefix" $ dropPrefixRepeatedly "" "string" @?= "string" , testCase "Prefix found once" $ dropPrefixRepeatedly "str" "string" @?= "ing" , testCase "Prefix found twice" $ dropPrefixRepeatedly "str" "strstring" @?= "ing" + ] + +chunksOfWordTests :: TestTree +chunksOfWordTests = testGroup "chunksOfWord" + [ testCase "Max 0" $ chunksOfWord 4 0 "ab cd efgh" @?= ["ab c","d ef","gh"] + , testCase "Max 2" $ chunksOfWord 4 2 "ab cd efgh" @?= ["ab ","cd ","efgh"] ]