ztail-1.2.0.2: TailTypes.hs

{-# 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