packages feed

ztail (empty) → 1.0

raw patch · 9 files changed

+816/−0 lines, 9 filesdep +arraydep +basedep +hinotifysetup-changed

Dependencies added: array, base, hinotify, old-locale, process, regex-compat, time, unix

Files

+ Display.hs view
@@ -0,0 +1,99 @@+module Display (+    TermColor,+    parseColor,+    errMsg,+    output,+    reset+  ) where++import System.IO+import Data.Char+import Util++type TermColor = [Int]++displayColor :: TermColor -> String+displayColor [] = ""+displayColor c =+  "\ESC[" ++ (join ';' (map show c)) ++ "m"++displayResetColor = displayColor [colorReset]++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 "normal"	= colorValue "reset"+colorValue "bold"	= colorValue "br"+colorValue "nobold"	= colorValue "nobr"+colorValue "bright"	= colorValue "br"+colorValue "nobright"	= colorValue "nobr"+colorValue "dim"	= colorValue "dark"+colorValue "nodim"	= colorValue "nodark"+colorValue "standout"	= colorValue "so"+colorValue "nostandout"	= colorValue "noso"+colorValue "hilite"	= colorValue "hl"+colorValue "nohilite"	= colorValue "nohl"+colorValue "underline"  = colorValue "ul"+colorValue "nounderline"= colorValue "noul"+colorValue "blink"	= colorValue "bl"+colorValue "noblink"	= colorValue "nobl"+colorValue "reverse"	= colorValue "rev"+colorValue "noreverse"	= colorValue "norev"++colorValue x = error ("unknown color name: " ++ x)++colorSep = not . isAlphaNum++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+      where+	(x, r) = break colorSep s++errMsg :: String -> IO ()+errMsg m = putStr displayResetColor >> hPutStrLn stderr m++output :: TermColor -> String -> IO ()+output c m = putStrLn (displayColor (colorReset : c) ++ m)++reset :: IO ()+reset = putStr displayResetColor
+ Main.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE CPP #-}+import System.Exit+import Control.Monad+import qualified System.Environment+import qualified System.Console.GetOpt as GetOpt+import System.Posix.Signals (installHandler, sigINT, Handler(..))+import qualified GHC.IOBase+import qualified Control.Concurrent+import qualified Control.Exception+import qualified Data.IORef+import qualified Text.Regex+#ifdef INOTIFY+import qualified System.INotify as INotify+#endif++import Util+import Display+import TailTypes+import Tail+import TailHandle++data Options = Options{+  optionTails :: [Tail],+  optionTail :: Tail,+  optionMatch :: TailMatch+}++defaultTail = Tail{+  tailTarg = undefined, -- read "-",+  tailPollInterval = read "5",+  tailReopenInterval = read "0",+#ifdef INOTIFY+  tailPollINotify = True,+  tailReopenINotify = False,+#endif+  tailBegin = False,+  tailTimeFmt = "%c",+  tailMatches = []+}++defaultOptions = Options{+  optionTails = [],+  optionTail = defaultTail,+  optionMatch = MatchAll+}++set_opt :: (Tail -> Tail) -> Options -> Options+set_opt p o = o{ optionTail = p $ optionTail o }++set_match :: TailMatch -> Options -> Options+set_match m o = o{ optionMatch = m }++add_action :: TailAction -> Options -> Options+add_action a o = set_opt add o where+  add t = t{ tailMatches = (optionMatch o, a) : (tailMatches t) }++prog_header = "Usage: ztail [OPTIONS] FILE ...\n\+Follow the specified files (ala tail -f).  FILE may be a path, '-' for stdin,\n\+or '&N' for file descriptor N.  OPTIONS apply only to the following FILE\n\+(except for -irt), and match options (-amn) apply to all following actions\n\+(-hcdse).  Actions involving TEXT can contain the following \\-escapes:\n\+    \\0 current file        \\@ current time (from -t)\n\+    \\_ current line        \\` \\' pre- and post-matching text\n\+    \\& matching text       \\N (1-9) group in match\n\+\&" --"+prog_usage = GetOpt.usageInfo prog_header prog_options++prog_options :: [GetOpt.OptDescr (Options -> Options)]+prog_options = [+    GetOpt.Option "b" ["begin"]+      (GetOpt.NoArg (set_opt $ \p -> p{ tailBegin = True }))+      ("start reading at the beginning of the file (rather than only new lines at the end)"),+    GetOpt.Option "i" ["interval"]+      (GetOpt.ReqArg (\i -> set_opt $ \p -> p{ tailPollInterval = read i }) "INT")+      ("poll for data every INT seconds [" ++ show (tailPollInterval defaultTail) ++ "] on all following files"),+    GetOpt.Option "r" ["reopen"]+      (GetOpt.OptArg (\i -> set_opt $ \p -> p{ tailReopenInterval = maybe (tailPollInterval p) read i }) "INT")+      ("check file name (like tail -F) every INT seconds or every poll"),+    GetOpt.Option "t" ["timefmt"]+      (GetOpt.ReqArg (\t -> set_opt $ \p -> p{ tailTimeFmt = t }) "FMT")+      ("set time format for \\@ substitution (in strftime(3)) [" ++ tailTimeFmt defaultTail ++ "]"),+    GetOpt.Option "T" ["timestamp"]+      (GetOpt.OptArg (maybe id $ \t -> add_action (ActionSubst "\\@ \\_") . set_opt (\p -> p{ tailTimeFmt = t })) "FMT")+      ("timestamp with FMT; equivalent to: [-t FMT] -h '\\@ '"),+#ifdef INOTIFY+    GetOpt.Option "I" ["inotify"]+      (GetOpt.NoArg (set_opt $ \p -> p{ tailPollINotify = True, tailPollInterval = read "0" }))+      ("use inotify to poll for new data (only for regular files)"),+    GetOpt.Option "R" ["ireopen"]+      (GetOpt.NoArg (set_opt $ \p -> p{ tailReopenINotify = True }))+      ("use inotify to monitor file renames (only for preexisting, leaf files)"),+#endif++    GetOpt.Option "a" ["all"]+      (GetOpt.NoArg (set_match MatchAll))+      ("perform following action for every line from this FILE (default)"),+    GetOpt.Option "m" ["match"]+      (GetOpt.ReqArg (\m -> set_match $ MatchRegex $ Text.Regex.mkRegexWithOpts m False True) "REGEX")+      ("perform following action for each line matching REGEX"),+    GetOpt.Option "M" ["imatch"]+      (GetOpt.ReqArg (\m -> set_match $ MatchRegex $ Text.Regex.mkRegexWithOpts m False False) "REGEX")+      ("perform following action for each line matching REGEX (case-insensitive)"),+    GetOpt.Option "n" ["no-match"]+      (GetOpt.ReqArg (\m -> set_match $ MatchNotRegex $ Text.Regex.mkRegexWithOpts m False True) "REGEX")+      ("perform following action for each line not matching REGEX"),+    GetOpt.Option "N" ["no-imatch"]+      (GetOpt.ReqArg (\m -> set_match $ MatchNotRegex $ Text.Regex.mkRegexWithOpts m False False) "REGEX")+      ("perform following action for each line not matching REGEX (case-insensitive)"),++    GetOpt.Option "h" ["header"]+      (GetOpt.ReqArg (\h -> add_action $ ActionSubst (h ++ "\\_")) "TEXT")+      ("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,...)"),+    GetOpt.Option "d" ["hide"]+      (GetOpt.NoArg (add_action ActionHide))+      ("hide (matching) lines"),+    GetOpt.Option "s" ["substitute"]+      (GetOpt.ReqArg (\s -> add_action $ ActionSubst s) "TEXT")+      ("substitute (matching) lines with TEXT"),+    GetOpt.Option "e" ["execute"]+      (GetOpt.ReqArg (\e -> add_action $ ActionExecute e) "PROG")+      ("execute PROG for every (matching) line")+  ]+prog_arg a Options{ optionTails = l, optionTail = t } =+  Options{+    optionTails = t{+      tailTarg = read a,+      tailMatches = reverse (tailMatches t)+    } : l,+    optionTail = t{+      tailBegin = False,+      tailMatches = []+    },+    optionMatch = MatchAll+  }++run :: [Tail] -> IO (Control.Concurrent.MVar ExitCode)+run tails = do+  emv <- Control.Concurrent.newEmptyMVar+  let exit = Control.Concurrent.putMVar emv+  let exit0 = exit ExitSuccess+  let exit1 = exit (ExitFailure 1)+  installHandler sigINT (CatchOnce exit0) Nothing++  lockv <- Control.Concurrent.newQSem 0+  let lock = Control.Exception.bracket_ (Control.Concurrent.waitQSem lockv) (Control.Concurrent.signalQSem lockv)+  let unlock = Control.Exception.bracket_ (Control.Concurrent.signalQSem lockv) (Control.Concurrent.waitQSem lockv)++  count <- Data.IORef.newIORef (length tails)+#ifdef INOTIFY+  inotify <- +    catchOnlyIOET GHC.IOBase.UnsupportedOperation +      (Just =.< INotify.initINotify) +      (return Nothing)+#endif++  let error t e = if isint e then exit0 else tailErrMsg t (show e) >> exit1+      runt = runTail TailRuntime+	{ trText = tailText+	, trUnlock = unlock+#ifdef INOTIFY+	, trINotify = inotify+#endif+	}+  mapM_ (\t -> Control.Concurrent.forkIO $ lock $ Control.Exception.handle (error t) $ do+      runt t+      i <- Data.IORef.atomicModifyIORef count (\i -> (pred i, i))+      when (i == 1) exit0)+    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+  tails <- case (GetOpt.getOpt (GetOpt.ReturnInOrder prog_arg) prog_options args) of+    (s, [], []) -> case optionTails $ foldl (\s t -> t s) defaultOptions s of+      [] -> do+	putStrLn prog_usage+	exitWith ExitSuccess+      t -> return t+    (_, _, err) -> do+      mapM_ putStrLn err+      putStrLn prog_usage+      exitFailure+  e <- run tails >>= Control.Concurrent.takeMVar+  when (e == ExitSuccess) $+    errMsg "ztail: done"+  exitWith e
+ README view
@@ -0,0 +1,15 @@+An even more improved version of xtail/tail -f.++Requirements:+ - ghc+ - hinotify (http://hackage.haskell.org/cgi-bin/hackage-scripts/package/hinotify)++Example:+  ztail -I -r300 \+	-c bright,red /var/log/kernel \+	-c yellow /var/log/daemon \+	-a -c blue -t '%b %d %H:%M:%S' -h '\@ ' /var/log/Xorg.0.log++https://dylex.net:9947/src++Suggestions, improvements, patches, complaints welcome.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Tail.hs view
@@ -0,0 +1,82 @@+module Tail (+    tailText+  ) where++import Data.Array (Array, array, (//), (!))+import Text.Regex+import qualified Data.Char+import qualified System.Exit+import qualified System.Cmd+import qualified Data.Time.Clock+import qualified Data.Time.LocalTime+import qualified Data.Time.Format+import qualified System.Locale++import Util+import Display+import TailTypes++type Substitutions = Array Char String+default_subst :: Substitutions+default_subst = array ('\0','\127') [('\\',"\\")]++timeFmt :: String -> IO String+timeFmt f = do+  t <- Data.Time.Clock.getCurrentTime+  z <- Data.Time.LocalTime.getCurrentTimeZone+  return $ Data.Time.Format.formatTime System.Locale.defaultTimeLocale f (Data.Time.LocalTime.utcToLocalTime z t)++shellEscape :: String -> String+shellEscape [] = []+shellEscape (c:l)+  | Data.Char.isAlphaNum c = c: shellEscape l+  | otherwise = '\\':c: shellEscape l++substText :: Substitutions -> (String -> String) -> String -> String+substText sub f str = go str+  where+    go ('\\':x:l) = f (sub!x) ++ go l+    go (x:l) = x : go l+    go [] = []++matchText :: Substitutions -> TailMatch -> String -> Maybe Substitutions+matchText sub MatchAll t = Just (sub // [('_',t)])+matchText sub (MatchRegex m) t =+  case matchRegexAll m t of+    Nothing -> Nothing+    Just (pre, mat, post, exps) ->+      Just (sub+	// [('_',t), ('`',pre), ('&',mat), ('\'',post)]+	// zip ['1'..'9'] exps)+matchText sub (MatchNotRegex m) t =+  case matchRegex m t of+    Nothing -> Just (sub // [('_',t)])+    Just _ -> Nothing++execute :: Tail -> String -> IO System.Exit.ExitCode+execute th e =+  tailErrMsg th ("execute: " ++ e) >>+  System.Cmd.system e++processText :: Tail -> String -> IO ()+processText t x = do+  now <- timeFmt $ tailTimeFmt t+  let init_sub = default_subst // [('0',tailName t),('@',now)] +  case foldl mact (Just x, init_sub, [], []) (tailMatches t) of+    (Nothing, _, _, _) -> nop+    (Just out, _, color, exec) ->+      output color out >>+      mapM_ (execute t) exec+  where+    mact r@(Nothing, _, _, _) _ = r+    mact r@(Just s, sub, cl, el) (m, a) =+      case matchText sub m s of+	Nothing -> r+	Just sub -> case a of+	  ActionNone -> (Just s, sub, cl, el)+	  ActionHide -> (Nothing, sub, cl, el)+	  ActionColor c -> (Just s, sub, c ++ cl, el)+	  ActionSubst s' -> (Just (substText sub id s'), sub, cl, el)+	  ActionExecute e -> (Just s, sub, cl, (substText sub shellEscape e) : el)++tailText = processText
+ TailHandle.hs view
@@ -0,0 +1,261 @@+{-# LANGUAGE CPP, DeriveDataTypeable #-}+module TailHandle (+  runTail+  ) where++import Control.Monad+import System.Posix.Types+import System.Posix.Files+import System.Posix.IO+import qualified Data.Maybe+import qualified GHC.Handle (SeekMode(AbsoluteSeek))+import qualified GHC.IOBase+import Control.Concurrent+import qualified Control.Exception+import qualified Data.Typeable+#ifdef INOTIFY+import qualified System.INotify as INotify+#endif+import Data.IORef++import Util+import TailTypes++data TailHandle = TailHandle{+  thTail :: Tail,+  thRuntime :: TailRuntime,+  thPoll :: ThreadId,+  thReopen :: Maybe ThreadId,+  thFd :: Maybe Fd,+  thPos :: FileOffset,+  thIno :: Maybe FileID,+  thBuf :: String,+  thAgain :: Bool,+#ifdef INOTIFY+  thPollWatch :: Maybe INotify.WatchDescriptor,+  thReopenWatch :: Maybe INotify.WatchDescriptor,+#endif+  thSigPending :: IORef (Maybe TailSignal),+  thSigHandler :: IO () -> IO ()+}++data TailSignal = PollSignal | ReopenSignal deriving (Show, Data.Typeable.Typeable, Eq, Ord)++thErrMsg = tailErrMsg . thTail++catchDoesNotExist :: IO a -> IO (Maybe a)+catchDoesNotExist f = catchOnlyIOET GHC.IOBase.NoSuchThing (liftM Just f) (return Nothing)++bad = ioError . userError++closeTail :: TailHandle -> IO TailHandle+closeTail th@TailHandle{ thFd = Nothing } = return th+closeTail th@TailHandle{ thFd = Just fd } = do+#ifdef INOTIFY+  whenJust rm_watch (thPollWatch th)+  whenJust rm_watch (thReopenWatch th)+#endif+  closeFd fd+  return th{+    thFd = Nothing+  , thPos = 0+  , thIno = Nothing+#ifdef INOTIFY+  , thPollWatch = Nothing+  , thReopenWatch = Nothing +#endif+  }+#ifdef INOTIFY+  where+    rm_watch = INotify.removeWatch (Data.Maybe.fromJust (trINotify (thRuntime th)))+#endif++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 }++inotifyTail :: TailHandle -> IO TailHandle+#ifdef INOTIFY+inotifyTail th@TailHandle{ +    thRuntime = TailRuntime{ trINotify = Just inotify },+    thPoll = tid,+    thTail = Tail{+      tailTarg = TailPath path,+      tailPollINotify = ipoll,+      tailReopenINotify = ireopen+    } } = do+  poll <- justWhen ipoll $+    INotify.addWatch inotify [INotify.Modify] path +      (\_ -> Control.Exception.throwDynTo tid PollSignal)+  reopen <- justWhen ireopen $+    INotify.addWatch inotify [INotify.MoveSelf] path +      (\_ -> Control.Exception.throwDynTo tid ReopenSignal)+  return th{+    thPollWatch = poll,+    thReopenWatch = reopen+  }+#endif+inotifyTail th = return th++openTail :: TailHandle -> IO TailHandle+openTail th@TailHandle{ thFd = Nothing } = get (tailTarg (thTail th)) where+  get (TailFd fd) = got (Just fd)+  get (TailPath path) = got =<<+    catchDoesNotExist (+      openFd path ReadOnly Nothing OpenFileFlags{+	append = False, exclusive = False, noctty = False, nonBlock = True, trunc = False+      })+  got Nothing = thErrMsg th "No such file or directory" >. th{ thPos = 0 }+  got (Just fd) = do+    setFdOption fd NonBlockingRead True+    go fd =<< getFdStatus fd+  go fd stat+    | isBlockDevice stat || isDirectory stat || isSymbolicLink stat =+      closeFd fd >> bad "unsupported file type"+    | isRegularFile stat =+      inotifyTail th' >>= seekTail (if pos < 0 then max 0 $ sz + 1 + pos else min sz pos)+    | otherwise =+      return th'{ thPos = -1 }+    where+      th' = th{ thFd = Just fd, thIno = Just (fileID stat), thAgain = True }+      sz = fileSize stat+      pos = thPos th+openTail _ = bad "open on opened tail"++reopenTail :: TailHandle -> IO TailHandle+reopenTail th@TailHandle{ thTail = Tail{ tailTarg = TailPath path }, thIno = ino } = do+  stat <- catchDoesNotExist $ getFileStatus path+  case stat of+    Nothing -> return th+    Just _ | ino == Nothing -> openTail th+    Just stat | ino == Just (fileID stat) -> return th+    Just stat | fileSize stat == 0 -> return th+    _ -> do+      thErrMsg th "Following new file"+      closeTail th >>= openTail+reopenTail th = return th++noRead :: TailHandle -> (TailHandle, [String])+noRead th = (th{ thAgain = False }, [])++bufsiz :: ByteCount+bufsiz = 8192++readTail :: TailHandle -> IO (TailHandle, [String])+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+      checkbuf th >.= noRead+      -- thErrMsg th "closed?"+      -- closeTail th >.= noRead th+    else getFdStatus fd >.= fileSize >>= gotlen+  where+    checkbuf th@TailHandle{ thBuf = buf } = do+      when (buf /= "") $+	thErrMsg th ("Unterminated line: " ++ buf)+      return th{ thBuf = "" }+    gotlen len+      | len < pos = do+          thErrMsg th ("File truncated to " ++ show len)+	  seekTail 0 th >>= readTail+      | len == pos = do+	  checkbuf th >.= noRead+      | otherwise = do+	  let count = min (fromIntegral (len - pos)) bufsiz+	  (buf, buflen) <- readit (fromIntegral count)+	  when (buflen /= count) $+	    thErrMsg th ("Short read (" ++ show buflen ++ "/" ++ show count ++ ")")+	  return $ gotbuf th{ thPos = pos + fromIntegral buflen, thAgain = buflen == bufsiz } buf+    readsock =+      readit bufsiz >.= fst >.= gotbuf th{ thAgain = True }+    gotbuf th "" = noRead th+    gotbuf th@TailHandle{ thBuf = oldbuf } buf =+      case initlast $ split (== '\n') buf of+	([], r) ->+	  (th{ thBuf = oldbuf ++ r }, [])+	(l1 : l, r) ->+	  (th{ thBuf = r }, (oldbuf ++ l1) : l)+    readit len = catchOnlyIOET GHC.IOBase.ResourceExhausted +      (fdRead fd len)+      (return ("", 0))++pause :: IO ()+pause = threadDelay (30*60*1000000) -- fixme how? (-1) doesn't work++waitTail :: TailHandle -> IO ()+waitTail TailHandle{ thFd = Nothing } = pause+waitTail TailHandle{ thFd = Just fd, thPos = -1 } = threadWaitRead fd+waitTail TailHandle{ thTail = t, thAgain = again } = do+  if again+    then yield +    else if i == 0+      then pause+      else threadDelay i+  where +    i = fromInterval (tailPollInterval t)++reopenThread :: Int -> ThreadId -> IO ()+reopenThread ri tid = forever $ do+  threadDelay ri+  Control.Exception.throwDynTo tid ReopenSignal++newTail :: TailRuntime -> Tail -> IO TailHandle+newTail tr tail = do+  tid <- myThreadId+  rid <- justWhen (ri /= 0) $ forkIO (reopenThread ri tid)+  sigpend <- newIORef Nothing+  return TailHandle{+    thTail = tail,+    thRuntime = tr,+    thPoll = tid,+    thReopen = rid,+    thFd = Nothing,+    thPos = if tailBegin tail then 0 else -1,+    thIno = Nothing,+    thBuf = [],+    thAgain = True,+#ifdef INOTIFY+    thPollWatch = Nothing,+    thReopenWatch = Nothing,+#endif+    thSigPending = sigpend,+    thSigHandler = (flip Control.Exception.catchDyn) (\s ->+      modifyIORef sigpend (max (Just s)))+  }+  where +    ri = fromInterval (tailReopenInterval tail)++runTail :: TailRuntime -> Tail -> IO ()+runTail tr tail = Control.Exception.block $+  newTail tr tail >>=+  openTail >>= go >>= +  \TailHandle{ thReopen = wid } -> whenJust killThread wid+  where+    catch th ReopenSignal = reopenTail th -- >>= wait+    catch th PollSignal = return th+    wait th = do+      sig <- readIORef (thSigPending th)+      writeIORef (thSigPending th) Nothing+      maybe +	(Control.Exception.catchDyn +	  (trUnlock tr $ waitTail th >. th) +	  (catch th))+	(catch th)+	sig+    poll th+      | thReopen th == Nothing+	&& (thFd th == Nothing+	  || (thAgain th == False && thPos th /= -1+	    && fromInterval (tailPollInterval (thTail th)) == 0+#ifdef INOTIFY+	    && thPollWatch th == Nothing +	    && thReopenWatch th == Nothing+#endif+	    ))+	= return th+      | otherwise = wait th >>= go+    go th = readTail th >>= proc >>= poll+    proc (th, s) = mapM_ (thSigHandler th . fun) s >. th+    fun = (trText tr) tail
+ TailTypes.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE CPP, Rank2Types #-}+module TailTypes (+    Interval,+    fromInterval,+    TailTarget(..),+    TailRuntime(..),+    TailMatch(..), TailAction(..),+    TailMatches,+    Tail(..), +    tailName, tailErrMsg+  ) where++import qualified System.Posix.Types+import qualified System.Posix.IO+import qualified Text.Regex+#ifdef INOTIFY+import qualified System.INotify as INotify+#endif++import Display++newtype Interval = Interval Int+instance Show Interval where+  show (Interval x) = show (fromIntegral x / 1000000.0)+instance Read Interval where+  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+instance Show TailTarget where+  show (TailFd 0) = "-"+  show (TailFd x) = '&':(show x)+  show (TailPath path) = path+instance Read TailTarget where+  readsPrec _ "-" = [(TailFd System.Posix.IO.stdInput, "")]+  readsPrec n ('&':s) = map (\(f,s) -> (TailFd f, s)) $ readsPrec n s+  readsPrec _ s = [(TailPath s, "")]++data TailMatch =+    MatchAll+  | MatchRegex Text.Regex.Regex+  | MatchNotRegex Text.Regex.Regex+data TailAction =+    ActionNone+  | ActionHide+  | ActionColor TermColor+  | ActionSubst String+  | ActionExecute String+type TailMatches = [(TailMatch, TailAction)]++data Tail = Tail{+  tailTarg :: TailTarget,+  tailPollInterval :: Interval,+  tailReopenInterval :: Interval,+#ifdef INOTIFY+  tailPollINotify :: Bool,+  tailReopenINotify :: Bool,+#endif+  tailBegin :: Bool,+  tailTimeFmt :: String,+  tailMatches :: TailMatches+}++tailName = show . tailTarg++tailErrMsg t msg =+  errMsg ("ztail " ++ tailName t ++ ": " ++ msg)++data TailRuntime = TailRuntime+  { trUnlock :: forall a. IO a -> IO a+  , trText :: Tail -> String -> IO ()+#ifdef INOTIFY+  , trINotify :: Maybe INotify.INotify+#endif+}+
+ Util.hs view
@@ -0,0 +1,65 @@+module Util (+    split,+    join,+    initlast,+    (>.=), (>.), (=.<),+    nop,+    justIf,+    whenJust, justWhen,+    catchOnlyIOET+  ) where++import qualified GHC.IOBase+import Control.Monad hiding (join)++split :: (a -> Bool) -> [a] -> [[a]]+{-# SPECIALIZE split :: (Char -> Bool) -> String -> [String] #-}+split p = splitp where+  splitp [] = [[]]+  splitp (x:l)+    | p x       = []     : splitp  l+    | otherwise = (x:l1) : l'+	where (l1:l') = splitp l++join :: a -> [[a]] -> [a]+{-# SPECIALIZE join :: Char -> [String] -> String #-}+join p = joinp where+  joinp [] = []+  joinp [x] = x+  joinp (x:l) = x ++ p : joinp l++initlast :: [a] -> ([a], a)+initlast [] = error "initlast: empty list"+initlast [x] = ([], x)+initlast (x:l) = (x:l1, r) where+  (l1, r) = initlast l++infixl 1 >., >.=+infixr 1 =.<+(>.) :: Monad m => m a -> b -> m b+(>.=) :: Monad m => m a -> (a -> b) -> m b+(=.<) :: Monad m => (a -> b) -> m a -> m b++(>.) e r = e >> return r+(>.=) e r = e >>= return . r+(=.<) r e = return . r =<< e -- fmap, <$>, liftM++nop :: Monad m => m ()+nop = return ()++whenJust :: Monad m => (a -> m ()) -> Maybe a -> m ()+whenJust = maybe nop++justIf :: Bool -> a -> Maybe a+justIf False = const Nothing+justIf True = Just++justWhen :: Monad m => Bool -> m a -> m (Maybe a)+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
+ ztail.cabal view
@@ -0,0 +1,23 @@+Name:		ztail+Version:	1.0+Author:		Dylan Simon+Maintainer:     dylan@dylex.net+License:        BSD3+Synopsis:	Multi-file, colored, filtered log tailer.+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+tested-with:    GHC == 6.8.2, GHC == 6.10.1+extra-source-files: README++Flag INotify+    Description:	Enable inotify support++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+    if flag(inotify)+        Build-Depends:	hinotify+        CPP-Options:	-DINOTIFY