Filter.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Logging.Filter ( Filter(..), Filterer ) where

import           Data.Aeson
import           Data.List                (stripPrefix)
import           Data.String
import           Prelude                  hiding (filter)

import           Logging.Class.Filterable
import           Logging.Logger
import           Logging.Record


-- | 'Filter's are used to perform arbitrary filtering of 'LogRecord's.
--
-- 'Sink's and 'Handler's can optionally use 'Filter' to filter 'LogRecord's
-- as desired.
-- It allows events which are below a certain point in the
-- sink hierarchy.
-- For example, a 'Filter' initialized with "A.B" will allow
-- events logged by loggers "A.B", "A.B.C", "A.B.C.D", "A.B.D" etc.
-- but not "A.BB", "B.A.B" etc.
--
-- If initialized with the empty string, all events are passed.
--
-- If initialized with a predicate function, the 'Logger' will be considered as
-- the 'Filter''s name, the function will be used to filter 'LogRecord's.
data Filter = Filter Logger (Maybe (LogRecord -> Bool))

instance IsString Filter where
  fromString = flip Filter Nothing

instance Read Filter where
  readsPrec _ s = [(fromString s, "")]

instance Show Filter where
  show (Filter logger _)         = "Filter " ++ (show logger)

-- | If two 'Filter's have same 'Logger' (name), they are equal.
instance Eq Filter where
  (Filter logger _) == (Filter logger' _) = logger == logger'

instance Filterable Filter where
  filter (Filter logger' Nothing) rcd@LogRecord{..}
    | logger' == "" = True
    | otherwise = case stripPrefix logger' logger of
                    Just ""      -> True
                    Just ('.':_) -> True
                    _            -> False
  filter (Filter _ (Just f)) rcd = f rcd

instance FromJSON Filter where
  parseJSON = (fmap read) . parseJSON


-- |List of Filter
type Filterer = [Filter]