cabal-mon 1.0.1 → 1.0.2
raw patch · 2 files changed
+37/−25 lines, 2 files
Files
- CabalMon.hs +35/−23
- cabal-mon.cabal +2/−2
CabalMon.hs view
@@ -19,7 +19,6 @@ import System.Directory (getHomeDirectory,doesFileExist,doesDirectoryExist) import System.Exit(exitFailure)-import System.Environment(getArgs) import Data.Char(isSpace) import Text.Read (readMaybe) import Data.Bits (testBit)@@ -35,7 +34,7 @@ , logDir :: FilePath } deriving Show -data Status = Modified | Unmodified+data Status = Modified Int | Unmodified deriving Show data Settings = Settings@@ -59,7 +58,8 @@ "Use the latency (see: fswatch -l)." $ ReqArg "DOUBLE" $ \a s -> case readMaybe a of- Just n | n > 0.1 -> Right s { fsOpts = "-l" : a : fsOpts s }+ Just n | (n::Double) > 0.1+ -> Right s { fsOpts = "-l" : a : fsOpts s } _ -> Left "Invalid latency." , Option ['p'] ["path"]@@ -118,8 +118,15 @@ txt <- readFile cfg case mapMaybe isLogLine (lines txt) of l : _ -> return l- _ -> do d <- getHomeDirectory- return (d </> ".cabal" </> "logs")++ -- Default, let's do some guess work+ _ ->+ do let stackDir = ".stack-work"+ yes <- doesDirectoryExist stackDir+ if yes+ then return (stackDir </> "logs")+ else do d <- getHomeDirectory+ return (d </> ".cabal" </> "logs") where configFile = do let sandbox = "cabal.sandbox.config" yes <- doesFileExist sandbox@@ -141,7 +148,6 @@ evt <- nextEvent vty case evt of EvResize _ y -> upd $ \st -> st { pageHeight = y }- EvMouse {} -> again EvKey k _ -> case k of KEsc -> shutdown vty@@ -196,6 +202,7 @@ _ -> again+ _ -> again where again = vtyLoop vty ref upd f = do modifyIORef' ref f@@ -223,17 +230,19 @@ [ ppItem True (fromMaybe "(no files)" (curBuf st)) ] ++ map (ppItem False) (nextBufs st) - ppItem sel x = string a name -- (name ++ " (" ++ show n ++ ")")+ ppItem sel x = case mbN of+ Nothing -> string a name+ Just n -> string a (name ++ " (" ++ show n ++ ")") where- name = dropExtension (takeFileName x)- a = if sel then a' `withStyle` reverseVideo else a'- (a',n) = case Map.lookup x (buffers st) of- Nothing -> (noramlText, 0)- Just (sta,b) ->- case sta of- _ | Just x == watching st -> (watchingTxt, chLineNum b)- Modified -> (changedText, chLineNum b)- Unmodified -> (noramlText, chLineNum b)+ name = dropExtension (takeFileName x)+ a = if sel then a' `withStyle` reverseVideo else a'+ (a',mbN) = case Map.lookup x (buffers st) of+ Nothing -> (noramlText, Nothing)+ Just (sta,_) ->+ case sta of+ _ | Just x == watching st -> (watchingTxt, Nothing)+ Modified n -> (changedText, Just n)+ Unmodified -> (noramlText, Nothing) preview = case (`Map.lookup` buffers st) =<< watching st of Just (_,buf) -> vertCat $ map ppLine@@ -280,11 +289,11 @@ -- Is this a new buffer? Nothing -> let bufs1 = Map.insert file- (Modified, Buffer { chText = ls- , chStart = Nothing- , chLineNum = lNum- , chLineSt = Nothing- })+ (Modified 1, Buffer { chText = ls+ , chStart = Nothing+ , chLineNum = lNum+ , chLineSt = Nothing+ }) (buffers st) in case curBuf st of Nothing -> st { buffers = bufs1@@ -296,10 +305,13 @@ } -- Existing buffer- Just (_,b) -> st { buffers = Map.insert file- (Modified, bufSetText+ Just (_,b) -> st { buffers = Map.insertWith jn file+ (Modified 1, bufSetText (pageHeight st) ls b) (buffers st) }+ where+ jn (Modified x, a) (Modified n, _) = (Modified (x + n), a)+ jn a _ = a
cabal-mon.cabal view
@@ -1,5 +1,5 @@ name: cabal-mon-version: 1.0.1+version: 1.0.2 synopsis: A monitor for cabal builds description: A vty-based wrapper around the `fswatch` utility, which makes it easy to monitor parallel Cabal builds.@@ -23,7 +23,7 @@ filepath, process, directory- GHC-options: -threaded+ GHC-options: -threaded -Wall default-language: Haskell2010 source-repository head