ghcid 0.1 → 0.1.1
raw patch · 9 files changed
+234/−205 lines, 9 files
Files
- CHANGES.txt +2/−0
- GHCi.hs +0/−105
- Main.hs +0/−79
- README.md +28/−3
- Util.hs +0/−16
- ghcid.cabal +3/−2
- src/GHCi.hs +106/−0
- src/Main.hs +79/−0
- src/Util.hs +16/−0
CHANGES.txt view
@@ -1,4 +1,6 @@ Changelog for GHCiD +0.1.1+ Support arguments to --command 0.1 Initial version
− GHCi.hs
@@ -1,105 +0,0 @@- -module GHCi( - ghci, - parseShowModules, - Severity(..), Load(..), isMessage, parseLoad - ) where - -import System.IO -import System.Process -import Control.Concurrent -import Control.Monad -import Data.Char -import Data.List -import Data.Maybe -import System.FilePath -import System.Console.CmdArgs.Verbosity -import Util - - ---------------------------------------------------------------------- --- IO INTERACTION WITH GHCI - -ghci :: String -> IO (String -> IO [String]) -ghci cmd = do - (inp, out, err, pid) <- runInteractiveProcess cmd [] Nothing Nothing - hSetBuffering out LineBuffering - hSetBuffering err LineBuffering - hSetBuffering inp LineBuffering - - lock <- newMVar () -- ensure only one person talks to ghci at a time - outs <- newMVar [] -- result that is buffering up - errs <- newMVar [] - flush <- newEmptyMVar -- result is moved to push once we see separate - - let prefix = "#~GHCID-PREFIX~#" - let separate = "#~GHCID-SEPARATE~#" - hPutStrLn inp $ ":set prompt " ++ prefix - - forM_ [(out,outs,"GHCOUT"),(err,errs,"GHCERR")] $ \(h,buf,strm) -> forkIO $ forever $ do - s <- hGetLine h - whenLoud $ outStrLn $ "%" ++ strm ++ ": " ++ s - if s == separate then do - outs <- modifyMVar outs $ \s -> return ([], reverse s) - errs <- modifyMVar errs $ \s -> return ([], reverse s) - putMVar flush $ outs ++ errs - else - modifyMVar_ buf $ return . (fromMaybe s (stripPrefix prefix s):) - - return $ \s -> withMVar lock $ const $ do - whenLoud $ outStrLn $ "%GHCINP: " ++ s - hPutStrLn inp $ s ++ "\nputStrLn \"\\n" ++ separate ++ "\"" - res <- takeMVar flush - return res - - ---------------------------------------------------------------------- --- PARSING THE OUTPUT - --- Main ( Main.hs, interpreted ) --- GHCi ( GHCi.hs, interpreted ) -parseShowModules :: [String] -> [(String, FilePath)] -parseShowModules xs = - [ (takeWhile (not . isSpace) $ dropWhile isSpace a, takeWhile (/= ',') b) - | x <- xs, (a,'(':' ':b) <- [break (== '(') x]] - -data Severity = Warning | Error deriving (Show,Eq) - -data Load - = Loading {loadModule :: String, loadFile :: FilePath} - | Message - {loadSeverity :: Severity - ,loadFile :: FilePath - ,loadFilePos :: (Int,Int) - ,loadMessage :: [String] - } - deriving Show - -isMessage Message{} = True; isMessage _ = False - --- [1 of 2] Compiling GHCi ( GHCi.hs, interpreted ) --- GHCi.hs:70:1: Parse error: naked expression at top level --- 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 --- GHCi.hs:81:1: Warning: Defined but not used: `foo' -parseLoad :: [String] -> [Load] -parseLoad (('[':xs):rest) = - map (uncurry Loading) (parseShowModules [drop 11 $ dropWhile (/= ']') xs]) ++ - parseLoad rest -parseLoad (x:xs) - | not $ " " `isPrefixOf` x - , (file,':':rest) <- break (== ':') x - , takeExtension file `elem` [".hs",".lhs"] - , (pos,rest) <- span (\x -> x == ':' || isDigit x) rest - , [p1,p2] <- map read $ words $ map (\x -> if x == ':' then ' ' else x) pos - , (msg,xs) <- span (isPrefixOf " ") xs - , rest <- dropWhile isSpace rest - , sev <- if "Warning:" `isPrefixOf` rest then Warning else Error - = Message sev file (p1,p2) (x:msg) : parseLoad xs -parseLoad (x:xs) = parseLoad xs -parseLoad [] = []
− Main.hs
@@ -1,79 +0,0 @@-{-# LANGUAGE RecordWildCards, DeriveDataTypeable, CPP #-} - -module Main(main) where - -import Control.Concurrent -import Control.Monad -import System.Directory -import Data.Time.Clock -import Data.List -import GHCi -import Util -import System.Console.CmdArgs - -data Options = Options - {command :: String - ,height :: Int - } - deriving (Data,Typeable,Show) - -options = cmdArgsMode $ Options - {command = "ghci" &= help "Command to run (defaults to ghci)" - ,height = 8 &= help "Number of lines to show" - } &= verbosity - -#if defined(mingw32_HOST_OS) -foreign import stdcall unsafe "windows.h GetConsoleWindow" - c_GetConsoleWindow :: IO Int - -foreign import stdcall unsafe "windows.h SetWindowPos" - c_SetWindowPos :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> IO Int - -c_HWND_TOPMOST = -1 -#endif - -main :: IO () -main = do - Options{..} <- cmdArgsRun options -#if defined(mingw32_HOST_OS) - wnd <- c_GetConsoleWindow - c_SetWindowPos wnd c_HWND_TOPMOST 0 0 0 0 3 -#endif - ghci <- ghci command - let fire msg warnings = do - start <- getCurrentTime - load <- fmap parseLoad $ ghci msg - modsActive <- fmap (map snd . parseShowModules) $ ghci ":show modules" - modsLoad <- return $ nub $ map loadFile load - whenLoud $ do - outStrLn $ "%ACTIVE: " ++ show modsActive - outStrLn $ "%LOAD: " ++ show load - warn <- return [w | w <- warnings, loadFile w `elem` modsActive, loadFile w `notElem` modsLoad] - let msg = prettyOutput height $ filter isMessage load ++ warn - outStr $ unlines $ take height $ msg ++ replicate height "" - awaitFiles start $ nub $ modsLoad ++ modsActive - fire ":reload" [m | m@Message{..} <- warn ++ load, loadSeverity == Warning] - fire "" [] - - -prettyOutput :: Int -> [Load] -> [String] -prettyOutput height [] = ["All good"] -prettyOutput height xs = take (height - (length msgs * 2)) msg1 ++ concatMap (take 2) msgs - where (err, warn) = partition ((==) Error . loadSeverity) xs - msg1:msgs = map loadMessage err ++ map loadMessage warn - - -awaitFiles :: UTCTime -> [FilePath] -> IO () -awaitFiles base files = do - whenLoud $ outStrLn $ "% WAITING: " ++ unwords files - new <- mapM getModificationTime files - when (all (< base) new) $ recheck new - where - recheck old = do - sleep 0.1 - new <- mapM getModificationTime files - when (old == new) $ recheck new - - -sleep :: Double -> IO () -sleep x = threadDelay $ ceiling $ x * 1000000
README.md view
@@ -1,4 +1,29 @@-ghcid-=====+# ghcid [](http://hackage.haskell.org/package/ghcid) [](https://travis-ci.org/ndmitchell/ghcid) -Very low feature GHCi based IDE+Either "GHCi as a daemon" or "GHC + a bit of an IDE". Unlike other Haskell development tools, `ghcid` is intended to be _incredibly simple_. In particular, it doesn't integrate with any editors, doesn't depend on GHC the library and doesn't start web servers.++**Using it**++Run `cabal update && cabal install ghcid` to install it as normal. Then run `ghcid --height=10 "--command=ghci Main.hs"`. The `height` is the number of lines you are going to resize your console window to (defaults to 8), and the `command` is how you start this project in `ghci`. Personally, I always create a `.ghci` file at the root of all my projects, which usually reads something like:++ :set -fwarn-unused-binds -fwarn-unused-imports+ :load Main++If you have that, then you can pass `--command=ghci` (or nothing, since that is the default).++After that, resize your console and make it so you can see it while working in your editor. On Windows the console will automatically sit on top of all other windows. On Linux, you probably want to use your window manager to make it topmost or use a [tiling window manager](http://xmonad.org/).++**What you get**++On every save you'll see a list of the errors and warnings in your project. It uses `ghci` under the hood, so even relatively large projects should update their status pretty quickly. As an example:++ Main.hs:23:10:+ Not in scope: `verbosit'+ Perhaps you meant `verbosity' (imported from System.Console.CmdArgs)+ Util.hs:18:1: Warning: Defined but not used: `foo'++Or, if everything is good, you see:++ All good++Please [report any bugs](https://github.com/ndmitchell/ghcid/issues) you find.
− Util.hs
@@ -1,16 +0,0 @@- -module Util(outStrLn, outStr) where - -import Control.Concurrent -import System.IO.Unsafe - - -{-# NOINLINE lock #-} -lock :: MVar () -lock = unsafePerformIO $ newMVar () - -outStr :: String -> IO () -outStr = withMVar lock . const . putStr - -outStrLn :: String -> IO () -outStrLn s = outStr $ s ++ "\n"
ghcid.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.10 build-type: Simple name: ghcid-version: 0.1+version: 0.1.1 license: BSD3 license-file: LICENSE category: Development@@ -10,7 +10,7 @@ copyright: Neil Mitchell 2014 synopsis: GHCi based bare bones IDE description:- Bare bones IDE.+ 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 --height=10 --command=ghci@, where @--height@ is the height of the console you will use, and @--command@ is the command to start GHCi on your project. 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@@ -23,6 +23,7 @@ location: https://github.com/ndmitchell/ghcid.git executable ghcid+ hs-source-dirs: src default-language: Haskell2010 main-is: Main.hs build-depends:
+ src/GHCi.hs view
@@ -0,0 +1,106 @@+ +module GHCi( + ghci, + parseShowModules, + Severity(..), Load(..), isMessage, parseLoad + ) where + +import System.IO +import System.Process +import Control.Concurrent +import Control.Monad +import Data.Char +import Data.List +import Data.Maybe +import System.FilePath +import System.Console.CmdArgs.Verbosity +import Util + + +--------------------------------------------------------------------- +-- IO INTERACTION WITH GHCI + +ghci :: String -> IO (String -> IO [String]) +ghci cmd = do + (Just inp, Just out, Just err, pid) <- + createProcess (shell cmd){std_in=CreatePipe, std_out=CreatePipe, std_err=CreatePipe} + hSetBuffering out LineBuffering + hSetBuffering err LineBuffering + hSetBuffering inp LineBuffering + + lock <- newMVar () -- ensure only one person talks to ghci at a time + outs <- newMVar [] -- result that is buffering up + errs <- newMVar [] + flush <- newEmptyMVar -- result is moved to push once we see separate + + let prefix = "#~GHCID-PREFIX~#" + let separate = "#~GHCID-SEPARATE~#" + hPutStrLn inp $ ":set prompt " ++ prefix + + forM_ [(out,outs,"GHCOUT"),(err,errs,"GHCERR")] $ \(h,buf,strm) -> forkIO $ forever $ do + s <- hGetLine h + whenLoud $ outStrLn $ "%" ++ strm ++ ": " ++ s + if s == separate then do + outs <- modifyMVar outs $ \s -> return ([], reverse s) + errs <- modifyMVar errs $ \s -> return ([], reverse s) + putMVar flush $ outs ++ errs + else + modifyMVar_ buf $ return . (fromMaybe s (stripPrefix prefix s):) + + return $ \s -> withMVar lock $ const $ do + whenLoud $ outStrLn $ "%GHCINP: " ++ s + hPutStrLn inp $ s ++ "\nputStrLn \"\\n" ++ separate ++ "\"" + res <- takeMVar flush + return res + + +--------------------------------------------------------------------- +-- PARSING THE OUTPUT + +-- Main ( Main.hs, interpreted ) +-- GHCi ( GHCi.hs, interpreted ) +parseShowModules :: [String] -> [(String, FilePath)] +parseShowModules xs = + [ (takeWhile (not . isSpace) $ dropWhile isSpace a, takeWhile (/= ',') b) + | x <- xs, (a,'(':' ':b) <- [break (== '(') x]] + +data Severity = Warning | Error deriving (Show,Eq) + +data Load + = Loading {loadModule :: String, loadFile :: FilePath} + | Message + {loadSeverity :: Severity + ,loadFile :: FilePath + ,loadFilePos :: (Int,Int) + ,loadMessage :: [String] + } + deriving Show + +isMessage Message{} = True; isMessage _ = False + +-- [1 of 2] Compiling GHCi ( GHCi.hs, interpreted ) +-- GHCi.hs:70:1: Parse error: naked expression at top level +-- 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 +-- GHCi.hs:81:1: Warning: Defined but not used: `foo' +parseLoad :: [String] -> [Load] +parseLoad (('[':xs):rest) = + map (uncurry Loading) (parseShowModules [drop 11 $ dropWhile (/= ']') xs]) ++ + parseLoad rest +parseLoad (x:xs) + | not $ " " `isPrefixOf` x + , (file,':':rest) <- break (== ':') x + , takeExtension file `elem` [".hs",".lhs"] + , (pos,rest) <- span (\x -> x == ':' || isDigit x) rest + , [p1,p2] <- map read $ words $ map (\x -> if x == ':' then ' ' else x) pos + , (msg,xs) <- span (isPrefixOf " ") xs + , rest <- dropWhile isSpace rest + , sev <- if "Warning:" `isPrefixOf` rest then Warning else Error + = Message sev file (p1,p2) (x:msg) : parseLoad xs +parseLoad (x:xs) = parseLoad xs +parseLoad [] = []
+ src/Main.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE RecordWildCards, DeriveDataTypeable, CPP #-} + +module Main(main) where + +import Control.Concurrent +import Control.Monad +import System.Directory +import Data.Time.Clock +import Data.List +import GHCi +import Util +import System.Console.CmdArgs + +data Options = Options + {command :: String + ,height :: Int + } + deriving (Data,Typeable,Show) + +options = cmdArgsMode $ Options + {command = "ghci" &= help "Command to run (defaults to ghci)" + ,height = 8 &= help "Number of lines to show" + } &= verbosity + +#if defined(mingw32_HOST_OS) +foreign import stdcall unsafe "windows.h GetConsoleWindow" + c_GetConsoleWindow :: IO Int + +foreign import stdcall unsafe "windows.h SetWindowPos" + c_SetWindowPos :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> IO Int + +c_HWND_TOPMOST = -1 +#endif + +main :: IO () +main = do + Options{..} <- cmdArgsRun options +#if defined(mingw32_HOST_OS) + wnd <- c_GetConsoleWindow + c_SetWindowPos wnd c_HWND_TOPMOST 0 0 0 0 3 +#endif + ghci <- ghci command + let fire msg warnings = do + start <- getCurrentTime + load <- fmap parseLoad $ ghci msg + modsActive <- fmap (map snd . parseShowModules) $ ghci ":show modules" + modsLoad <- return $ nub $ map loadFile load + whenLoud $ do + outStrLn $ "%ACTIVE: " ++ show modsActive + outStrLn $ "%LOAD: " ++ show load + warn <- return [w | w <- warnings, loadFile w `elem` modsActive, loadFile w `notElem` modsLoad] + let msg = prettyOutput height $ filter isMessage load ++ warn + outStr $ unlines $ take height $ msg ++ replicate height "" + awaitFiles start $ nub $ modsLoad ++ modsActive + fire ":reload" [m | m@Message{..} <- warn ++ load, loadSeverity == Warning] + fire "" [] + + +prettyOutput :: Int -> [Load] -> [String] +prettyOutput height [] = ["All good"] +prettyOutput height xs = take (height - (length msgs * 2)) msg1 ++ concatMap (take 2) msgs + where (err, warn) = partition ((==) Error . loadSeverity) xs + msg1:msgs = map loadMessage err ++ map loadMessage warn + + +awaitFiles :: UTCTime -> [FilePath] -> IO () +awaitFiles base files = do + whenLoud $ outStrLn $ "% WAITING: " ++ unwords files + new <- mapM getModificationTime files + when (all (< base) new) $ recheck new + where + recheck old = do + sleep 0.1 + new <- mapM getModificationTime files + when (old == new) $ recheck new + + +sleep :: Double -> IO () +sleep x = threadDelay $ ceiling $ x * 1000000
+ src/Util.hs view
@@ -0,0 +1,16 @@+ +module Util(outStrLn, outStr) where + +import Control.Concurrent +import System.IO.Unsafe + + +{-# NOINLINE lock #-} +lock :: MVar () +lock = unsafePerformIO $ newMVar () + +outStr :: String -> IO () +outStr = withMVar lock . const . putStr + +outStrLn :: String -> IO () +outStrLn s = outStr $ s ++ "\n"