{-# LANGUAGE CPP, Rank2Types, OverloadedStrings #-} module TailTypes ( Interval , threadDelayInterval , TailTarget(..) , TailRuntime(..) , TailMatch(..) , TailAction(..) , TailMatches , Tail(..) , tailName , tailErrMsg , tailOutput ) where import Control.Arrow (first) import Control.Concurrent (threadDelay) import qualified Data.ByteString.Char8 as BS import qualified Data.Fixed as Fixed import Data.Monoid ((<>)) #ifdef VERSION_hinotify import qualified System.INotify as INotify #endif import System.Posix.Types (Fd) import System.Posix.IO (stdInput) import Text.Regex.Posix (Regex) import Display newtype Interval = Interval { intervalMicroseconds :: Int } deriving (Eq, Ord, Bounded) intervalToFixed :: Interval -> Fixed.Micro intervalToFixed (Interval i) = Fixed.MkFixed (toInteger i) intervalFromFixed :: Fixed.Micro -> Interval intervalFromFixed (Fixed.MkFixed i) | i < 0 = error "intervalFromFixed: negative interval" | i > toInteger (intervalMicroseconds maxBound) = error "intervalFromFixed: interval too large" | otherwise = Interval (fromInteger i) instance Show Interval where show = Fixed.showFixed True . intervalToFixed instance Read Interval where readsPrec n s = map (first intervalFromFixed) $ readsPrec n s instance Num Interval where Interval x + Interval y = Interval (x + y) x * y = intervalFromFixed $ intervalToFixed x * intervalToFixed y Interval x - Interval y = Interval (x - y) negate (Interval x) = Interval (negate x) abs (Interval x) = Interval (abs x) signum (Interval x) = Interval (signum x) fromInteger = intervalFromFixed . fromInteger threadDelayInterval :: Interval -> IO () threadDelayInterval (Interval i) = threadDelay i data TailTarget = TailPath !FilePath | TailFd !Fd instance Show TailTarget where show (TailFd 0) = "-" show (TailFd x) = '&':(show x) show (TailPath path) = path instance Read TailTarget where readsPrec _ "-" = [(TailFd stdInput, "")] readsPrec n ('&':s) = map (first TailFd) $ readsPrec n s readsPrec _ s = [(TailPath s, "")] data TailMatch = MatchAll | MatchRegex !Regex | MatchNotRegex !Regex data TailAction = ActionNone | ActionHide | ActionColor !TermColor | ActionSubst !BS.ByteString | ActionExecute !BS.ByteString type TailMatches = [(TailMatch, TailAction)] data Tail = Tail { tailTarg :: TailTarget , tailPollInterval :: !Interval , tailReopenInterval :: !Interval #ifdef VERSION_hinotify , tailPollINotify :: !Bool , tailReopenINotify :: !Bool #endif , tailBegin :: !Bool -- start at beginning of file , tailFileTail :: !Bool -- enable this tail for non-directories (almost always True) , tailDirTail :: !Bool -- tail immediate children , tailDirList :: !Bool -- enable this tail for directory content , tailDirRecursive :: !Bool -- tail children recursively , tailTimeFmt :: !String , tailMatches :: !TailMatches } tailName :: Tail -> BS.ByteString tailName = BS.pack . show . tailTarg data TailRuntime = TailRuntime { trOutput :: Output -> IO () , trAddTail :: Tail -> IO () #ifdef VERSION_hinotify , trINotify :: Maybe INotify.INotify #endif } tailErrMsg :: TailRuntime -> Tail -> BS.ByteString -> IO () tailErrMsg r t = trOutput r . OutputError . (("ztail " <> tailName t <> ": ") <>) tailOutput :: TailRuntime -> TermColor -> BS.ByteString -> IO () tailOutput tr c = trOutput tr . OutputLine c