ztail 1.0 → 1.0.1
raw patch · 7 files changed
+84/−86 lines, 7 filesdep ~base
Dependency ranges changed: base
Files
- Display.hs +42/−45
- Main.hs +7/−7
- README +3/−0
- TailHandle.hs +12/−11
- TailTypes.hs +13/−13
- Util.hs +4/−7
- ztail.cabal +3/−3
Display.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE PatternGuards #-} module Display ( TermColor, parseColor,@@ -17,49 +18,49 @@ displayColor c = "\ESC[" ++ (join ';' (map show c)) ++ "m" -displayResetColor = displayColor [colorReset]+displayResetColor = displayColor colorReset +isInteger :: String -> Bool+isInteger [] = False+isInteger x = all isDigit x+ colorReset = colorValue "reset"-colorValue "reset" = 0-colorValue "br" = 1---colorValue "dark" = 2-colorValue "so" = 3-colorValue "hl" = 3-colorValue "ul" = 4-colorValue "bl" = 5-colorValue "rev" = 7-colorValue "hidden" = 8-colorValue "nobr" = 22--21---colorValue "nodark" = 22-colorValue "noso" = 23-colorValue "nohl" = 23-colorValue "noul" = 24-colorValue "nobl" = 25-colorValue "norev" = 27-colorValue "nohidden" = 28-colorValue "black" = 30-colorValue "red" = 31-colorValue "green" = 32-colorValue "yellow" = 33-colorValue "blue" = 34-colorValue "magenta" = 35-colorValue "cyan" = 36-colorValue "white" = 37---colorValue ('/':c) = 10 + colorValue c-colorValue "/black" = 40-colorValue "/red" = 41-colorValue "/green" = 42-colorValue "/yellow" = 43-colorValue "/blue" = 44-colorValue "/magenta" = 45-colorValue "/cyan" = 46-colorValue "/white" = 47+colorValue :: String -> TermColor+colorValue "reset" = [0]+colorValue "bo" = [1]+--colorValue "dark" = [2]+colorValue "so" = [3]+colorValue "hl" = [3]+colorValue "ul" = [4]+colorValue "bl" = [5]+colorValue "rev" = [7]+colorValue "hidden" = [8]+colorValue "nobo" = [22]--[21]+--colorValue "nodark" = [22]+colorValue "noso" = [23]+colorValue "nohl" = [23]+colorValue "noul" = [24]+colorValue "nobl" = [25]+colorValue "norev" = [27]+colorValue "nohidden" = [28]+colorValue "black" = [30]+colorValue "red" = [31]+colorValue "green" = [32]+colorValue "yellow" = [33]+colorValue "blue" = [34]+colorValue "magenta" = [35]+colorValue "cyan" = [36]+colorValue "white" = [37]+colorValue "default" = [39]+colorValue ('c':'o':'l':'o':'r':n) | isInteger n = [38,5,read n]+colorValue ('m':'o':'d':'e':n) | isInteger n = [read n]+colorValue ('b':'r':'i':'g':'h':'t':c) | [n] <- colorValue c, n >= 30 && n < 40 = [60 + n]+colorValue ('b':'r':c) | [n] <- colorValue c, n >= 30 && n < 40 = [60 + n]+colorValue ('/':c) | (n:r) <- colorValue c = 10+n:r colorValue "normal" = colorValue "reset"-colorValue "bold" = colorValue "br"-colorValue "nobold" = colorValue "nobr"-colorValue "bright" = colorValue "br"-colorValue "nobright" = colorValue "nobr"+colorValue "bold" = colorValue "bo"+colorValue "nobold" = colorValue "nobo" colorValue "dim" = colorValue "dark" colorValue "nodim" = colorValue "nodark" colorValue "standout" = colorValue "so"@@ -79,13 +80,9 @@ parseColor :: String -> TermColor parseColor [] = []-parseColor ('/':s) =- colorValue ('/':x) : parseColor r- where- (x, r) = break colorSep s parseColor s@(c:s') | colorSep c = parseColor s'- | otherwise = colorValue x : parseColor r+ | otherwise = colorValue x ++ parseColor r where (x, r) = break colorSep s @@ -93,7 +90,7 @@ errMsg m = putStr displayResetColor >> hPutStrLn stderr m output :: TermColor -> String -> IO ()-output c m = putStrLn (displayColor (colorReset : c) ++ m)+output c m = putStrLn (displayColor (colorReset ++ c) ++ m) reset :: IO () reset = putStr displayResetColor
Main.hs view
@@ -4,7 +4,8 @@ import qualified System.Environment import qualified System.Console.GetOpt as GetOpt import System.Posix.Signals (installHandler, sigINT, Handler(..))-import qualified GHC.IOBase+import qualified GHC.IO.Exception+import qualified System.IO.Error import qualified Control.Concurrent import qualified Control.Exception import qualified Data.IORef@@ -112,7 +113,7 @@ ("display TEXT header before (matching) lines (same as -s 'TEXT\\_')"), GetOpt.Option "c" ["color"] (GetOpt.ReqArg (\c -> add_action $ ActionColor $ parseColor c) "COLOR")- ("display (matching) lines in COLOR (valid colors are: normal, br,ul,bl,rev,hidden, nobr,noul..., black,red,green,yellow,blue,magenta,cyan,white, /black,/red,...)"),+ ("display (matching) lines in COLOR (valid colors are: normal, bo,ul,bl,rev, nobo,noul..., black,red,green,yellow,blue,magenta,cyan,white, /black,/red,...)"), GetOpt.Option "d" ["hide"] (GetOpt.NoArg (add_action ActionHide)) ("hide (matching) lines"),@@ -151,12 +152,14 @@ count <- Data.IORef.newIORef (length tails) #ifdef INOTIFY inotify <- - catchOnlyIOET GHC.IOBase.UnsupportedOperation + catchWhen ((GHC.IO.Exception.UnsupportedOperation ==) . System.IO.Error.ioeGetErrorType) (Just =.< INotify.initINotify) (return Nothing) #endif - let error t e = if isint e then exit0 else tailErrMsg t (show e) >> exit1+ let error t e = case Control.Exception.fromException e of+ Just Control.Exception.UserInterrupt -> exit0+ _ -> tailErrMsg t (show e) >> exit1 runt = runTail TailRuntime { trText = tailText , trUnlock = unlock@@ -171,9 +174,6 @@ tails Control.Concurrent.signalQSem lockv return emv- where- isint (Control.Exception.IOException e) = GHC.IOBase.ioe_type e == GHC.IOBase.Interrupted- isint _ = False main = do args <- System.Environment.getArgs
README view
@@ -10,6 +10,9 @@ -c yellow /var/log/daemon \ -a -c blue -t '%b %d %H:%M:%S' -h '\@ ' /var/log/Xorg.0.log +TODO:+ configuration file (currently the command line can get unwieldy)+ https://dylex.net:9947/src Suggestions, improvements, patches, complaints welcome.
TailHandle.hs view
@@ -7,9 +7,9 @@ import System.Posix.Types import System.Posix.Files import System.Posix.IO+import System.IO.Error import qualified Data.Maybe-import qualified GHC.Handle (SeekMode(AbsoluteSeek))-import qualified GHC.IOBase+import GHC.IO.Handle (SeekMode(AbsoluteSeek)) import Control.Concurrent import qualified Control.Exception import qualified Data.Typeable@@ -40,11 +40,12 @@ } data TailSignal = PollSignal | ReopenSignal deriving (Show, Data.Typeable.Typeable, Eq, Ord)+instance Control.Exception.Exception TailSignal thErrMsg = tailErrMsg . thTail catchDoesNotExist :: IO a -> IO (Maybe a)-catchDoesNotExist f = catchOnlyIOET GHC.IOBase.NoSuchThing (liftM Just f) (return Nothing)+catchDoesNotExist f = catchWhen isDoesNotExistError (liftM Just f) (return Nothing) bad = ioError . userError @@ -73,7 +74,7 @@ seekTail :: FileOffset -> TailHandle -> IO TailHandle seekTail _ TailHandle{ thFd = Nothing } = bad "seek on closed fd" seekTail c th@TailHandle{ thFd = Just fd } =- fdSeek fd GHC.Handle.AbsoluteSeek c >. th{ thPos = c }+ fdSeek fd AbsoluteSeek c >. th{ thPos = c } inotifyTail :: TailHandle -> IO TailHandle #ifdef INOTIFY@@ -87,10 +88,10 @@ } } = do poll <- justWhen ipoll $ INotify.addWatch inotify [INotify.Modify] path - (\_ -> Control.Exception.throwDynTo tid PollSignal)+ (\_ -> Control.Exception.throwTo tid PollSignal) reopen <- justWhen ireopen $ INotify.addWatch inotify [INotify.MoveSelf] path - (\_ -> Control.Exception.throwDynTo tid ReopenSignal)+ (\_ -> Control.Exception.throwTo tid ReopenSignal) return th{ thPollWatch = poll, thReopenWatch = reopen@@ -146,7 +147,7 @@ readTail th@TailHandle{ thFd = Nothing } = return (noRead th) readTail th@TailHandle{ thFd = Just fd, thPos = pos } = if pos == -1- then catchOnlyIOET GHC.IOBase.EOF readsock $ do+ then catchWhen isEOFError readsock $ do checkbuf th >.= noRead -- thErrMsg th "closed?" -- closeTail th >.= noRead th@@ -177,7 +178,7 @@ (th{ thBuf = oldbuf ++ r }, []) (l1 : l, r) -> (th{ thBuf = r }, (oldbuf ++ l1) : l)- readit len = catchOnlyIOET GHC.IOBase.ResourceExhausted + readit len = catchWhen isFullError (fdRead fd len) (return ("", 0)) @@ -199,7 +200,7 @@ reopenThread :: Int -> ThreadId -> IO () reopenThread ri tid = forever $ do threadDelay ri- Control.Exception.throwDynTo tid ReopenSignal+ Control.Exception.throwTo tid ReopenSignal newTail :: TailRuntime -> Tail -> IO TailHandle newTail tr tail = do@@ -221,7 +222,7 @@ thReopenWatch = Nothing, #endif thSigPending = sigpend,- thSigHandler = (flip Control.Exception.catchDyn) (\s ->+ thSigHandler = Control.Exception.handle (\s -> modifyIORef sigpend (max (Just s))) } where @@ -239,7 +240,7 @@ sig <- readIORef (thSigPending th) writeIORef (thSigPending th) Nothing maybe - (Control.Exception.catchDyn + (Control.Exception.catch (trUnlock tr $ waitTail th >. th) (catch th)) (catch th)
TailTypes.hs view
@@ -26,7 +26,7 @@ readsPrec n s = map (\(x,s) -> (Interval $ floor (1000000.0 * x), s)) $ readsPrec n s fromInterval (Interval x) = x -data TailTarget = TailPath FilePath | TailFd System.Posix.Types.Fd+data TailTarget = TailPath !FilePath | TailFd !System.Posix.Types.Fd instance Show TailTarget where show (TailFd 0) = "-" show (TailFd x) = '&':(show x)@@ -38,27 +38,27 @@ data TailMatch = MatchAll- | MatchRegex Text.Regex.Regex- | MatchNotRegex Text.Regex.Regex+ | MatchRegex !Text.Regex.Regex+ | MatchNotRegex !Text.Regex.Regex data TailAction = ActionNone | ActionHide- | ActionColor TermColor- | ActionSubst String- | ActionExecute String+ | ActionColor !TermColor+ | ActionSubst !String+ | ActionExecute !String type TailMatches = [(TailMatch, TailAction)] data Tail = Tail{ tailTarg :: TailTarget,- tailPollInterval :: Interval,- tailReopenInterval :: Interval,+ tailPollInterval :: !Interval,+ tailReopenInterval :: !Interval, #ifdef INOTIFY- tailPollINotify :: Bool,- tailReopenINotify :: Bool,+ tailPollINotify :: !Bool,+ tailReopenINotify :: !Bool, #endif- tailBegin :: Bool,- tailTimeFmt :: String,- tailMatches :: TailMatches+ tailBegin :: !Bool,+ tailTimeFmt :: !String,+ tailMatches :: !TailMatches } tailName = show . tailTarg
Util.hs view
@@ -6,10 +6,10 @@ nop, justIf, whenJust, justWhen,- catchOnlyIOET+ catchWhen ) where -import qualified GHC.IOBase+import qualified Control.Exception import Control.Monad hiding (join) split :: (a -> Bool) -> [a] -> [[a]]@@ -58,8 +58,5 @@ justWhen False _ = return Nothing justWhen True r = Just =.< r -catchOnlyIOET :: GHC.IOBase.IOErrorType -> IO a -> IO a -> IO a-catchOnlyIOET t f h = catch f c where- c e - | GHC.IOBase.ioe_type e == t = h- | otherwise = ioError e+catchWhen :: Control.Exception.Exception e => (e -> Bool) -> IO a -> IO a -> IO a+catchWhen t f h = Control.Exception.catchJust (guard . t) f (\() -> h)
ztail.cabal view
@@ -1,5 +1,5 @@ Name: ztail-Version: 1.0+Version: 1.0.1 Author: Dylan Simon Maintainer: dylan@dylex.net License: BSD3@@ -7,7 +7,7 @@ Description: An even more improved version of xtail/tail -f, including inotify support, full regex-based filtering, substitution, and colorization. Category: System,Console Build-Type: Simple-Cabal-Version: >= 1.2+Cabal-Version: >= 1.6 tested-with: GHC == 6.8.2, GHC == 6.10.1 extra-source-files: README @@ -17,7 +17,7 @@ Executable ztail Main-is: Main.hs Other-Modules: Util, Display, TailTypes, TailHandle, Tail- Build-Depends: base < 4, regex-compat, unix, time, old-locale, process, array+ Build-Depends: base == 4.*, regex-compat, unix, time, old-locale, process, array if flag(inotify) Build-Depends: hinotify CPP-Options: -DINOTIFY