adblock2privoxy-1.0.0: src/Statistics.hs

module Statistics where
import qualified Data.Map as Map
import InputParser
import Data.Maybe 
import System.IO
import System.FilePath
import Control.Applicative ((<$>))
import Control.Monad.State

type Stat = Map.Map String Int 

stat :: String -> [String] -> [Line] -> IO ()
stat path info lns = 
    let result = collectStat lns 
        filename = path </> "ab2p.stat"
        resultLine (name, value) = concat [name, ": ", show value] 
        errorLine (Line position (Error text)) 
            = [concat ["ERROR: ", recordSourceText position, " - ", text]]
        errorLine _ = []
    in do  
        outFile <- openFile filename WriteMode
        _ <- mapM (hPutStrLn outFile) info
        _ <- sequence $ hPutStrLn outFile . resultLine <$> Map.toAscList result
        _ <- sequence $ hPutStrLn outFile <$> (lns >>= errorLine)
        hClose outFile

collectStat :: [Line] -> Stat
collectStat = foldr getStat Map.empty

increment :: String -> Stat-> Stat
increment key = Map.insertWith (+) key 1

isJustFilled :: Maybe [a] -> Bool
isJustFilled Nothing = False
isJustFilled (Just list) = not.null $ list


getStat :: Line -> Stat-> Stat
getStat  (Line _ Comment {} ) = increment "Comments"
getStat  (Line _ Error {}) = increment "Errors"
getStat  (Line _ ElementHide {}) = increment "Elements hiding rules"
getStat  (Line _ (RequestBlock policy _ (RequestOptions _ thirdParty domains _ _ _ _ _))) = execState stateState
    where 
    incrementState = modify . increment
    stateState = do
        incrementState "Request block rules total"
        when (policy == InputParser.Unblock) $ incrementState "Request block rules for exception"
        when (isJust thirdParty) $ incrementState "Rules with third party option"
        when ((not.null._negative $ domains) || (isJustFilled . _positive $ domains)) $ incrementState "Request block rules with domain option"
        when ((not.null._negative $ domains) || (isJustFilled . _positive $ domains)) $ incrementState "Request block rules with request type options"