Changeset 96c17d9 in adblock2privoxy


Ignore:
Timestamp:
Sep 25, 2013 10:46:37 PM (6 years ago)
Author:
zubr <a@…>
Branches:
master
Children:
d0db38d
Parents:
dcd1d6c
Message:
 
Files:
7 added
4 edited
1 moved

Legend:

Unmodified
Added
Removed
  • AdBlock2Privoxy.cabal

    rdcd1d6c r96c17d9  
    1414                   parsec-permutation, 
    1515                   mtl, 
    16                    containers 
     16                   containers, 
     17                   filepath, 
     18                   directory 
    1719  ghc-options:     -Wall 
    1820  other-modules:    
     
    2527                   PatternConvertor, 
    2628                   ElementBlocker, 
    27                    PolicyTree 
     29                   PolicyTree, 
     30                   HeadersMatcher 
    2831 
  • src/ElementBlocker.hs

    rdcd1d6c r96c17d9  
    11module ElementBlocker ( 
    2 elemBlockTree, 
     2elemBlockData, 
    33BlockedRulesTree, 
    4 ElemBlockData (..) 
     4ElemBlockData (..), 
     5writeElemBlock 
    56) where 
    67import InputParser 
     
    1011import Data.Maybe 
    1112import Utils 
    12      
     13import System.IO 
     14import System.FilePath.Posix 
     15import Data.List  
     16import System.Directory (createDirectoryIfMissing) 
     17import Control.Monad (when) 
     18   
    1319 
    1420type BlockedRulesTree = DomainTree [Pattern]  
    1521data ElemBlockData = ElemBlockData [Pattern] BlockedRulesTree deriving Show 
    1622 
    17 elemBlockTree :: [Line] -> ElemBlockData  
    18 elemBlockTree input = ElemBlockData  
     23writeElemBlock :: String -> ElemBlockData -> IO () 
     24writeElemBlock path (ElemBlockData flatPatterns rulesTree) =  
     25    do 
     26       writeBlockTree path rulesTree  
     27       writePatterns (path </> "adblock.common.css") flatPatterns            
     28 
     29writeBlockTree :: String -> BlockedRulesTree -> IO () 
     30writeBlockTree path (Node name patterns children) = 
     31    do 
     32        createDirectoryIfMissing True path' 
     33        _ <- sequence (writeBlockTree path' <$> children) 
     34        writePatterns filename patterns         
     35    where 
     36        path'  
     37            | null name = path 
     38            | otherwise = path </> name 
     39        filename = path' </> "adblock.css" 
     40         
     41writePatterns :: String -> [Pattern] -> IO () 
     42writePatterns filename patterns =  
     43     do outFile <- openFile filename WriteMode 
     44        hPutStrLn outFile $ intercalate "," patterns 
     45        when (not $ null patterns) $ hPutStrLn outFile $ blockCss 
     46        hClose outFile 
     47     where 
     48        blockCss = "{display:none,visibility:hidden}" 
     49 
     50elemBlockData :: [Line] -> ElemBlockData  
     51elemBlockData input = ElemBlockData  
    1952                        (Map.foldrWithKey appendFlatPattern []              policyTreeMap) 
    2053                        (Map.foldrWithKey appendTreePattern (Node "" [] []) policyTreeMap)  
  • src/InputParser.hs

    rdcd1d6c r96c17d9  
    44RequestOptions (..), 
    55Record (..), 
     6RequestType (..), 
    67Pattern, 
    78Domain, 
     
    5758-- helpers 
    5859data Restrictions a = Restrictions { 
    59                           positive :: Maybe [a], 
    60                           negative :: [a]} 
     60                          _positive :: Maybe [a], 
     61                          _negative :: [a]} 
    6162        deriving (Read,Show,Eq) 
    6263 
  • src/Main.hs

    rdcd1d6c r96c17d9  
    11module Main where 
    22import InputParser 
    3 import Control.Applicative hiding ((<|>)) 
    4 import Text.ParserCombinators.Parsec hiding (Line, many, optional) 
     3import Control.Applicative  
     4import Text.ParserCombinators.Parsec hiding (Line, many, optional, (<|>)) 
    55import Control.Monad 
    66import Data.List 
     
    1111import PolicyTree 
    1212import ElementBlocker 
     13import qualified Data.Map as Map 
     14import Data.Maybe  
    1315 
    1416 
    1517filename :: String 
    16 filename = "/home/alexey/Projects/AdBlock2Privoxy/testData" 
     18--filename = "/home/alexey/Projects/AdBlock2Privoxy/testData"c 
     19filename = "/home/alexey/Downloads/easylist.txt" 
     20--filename = "/home/alexey/Downloads/advblock.txt" 
     21outDir = "/home/alexey/test/ab" 
     22type Stat = Map.Map String Int  
    1723 
    18 data Stat = Stat {total,comm,block,el::Int} deriving (Show) 
     24 
     25increment :: String -> Stat-> Stat 
     26increment key map = Map.insertWith (+) key 1 map 
     27 
     28isJustFilled Nothing = False 
     29isJustFilled (Just list) = not.null $ list 
    1930 
    2031getStat :: Line -> Stat-> Stat 
    21 getStat  (Line _ Comment) (Stat t c b e) = Stat (t + 1) (c + 1) b e 
    22 getStat  (Line _ RequestBlock {}) (Stat t c b e) = Stat (t + 1) c (b + 1) e 
    23 getStat  (Line _ ElementHide {}) (Stat t c b e) = Stat (t + 1) c b (e + 1)  
    24 getStat  _ (Stat t c b e) = Stat (t + 1) c b e 
     32getStat  (Line _ Comment) = increment "comments" 
     33getStat  (Line _ Error {}) = increment "errors" 
     34getStat  (Line _ ElementHide {}) = increment "elemHide" 
     35getStat  (Line _ (RequestBlock exclude _ (RequestOptions requestType thirdParty domains _ _ _ _))) = r 
     36    where  
     37 
     38    r s = r8 s 
     39    r1 = increment "RBlock" 
     40    r2 | exclude = r1 . increment "excludeRBlock" 
     41       | otherwise = r1 
     42    r3 | isJust thirdParty = r2 . increment "thidrPartyRBlock" 
     43       | otherwise = r2 
     44    r4 | (not.null._negative $ domains) || ((isJustFilled . _positive) $ domains) = r3 . increment "domainsRBlock" 
     45       | otherwise = r3 
     46    r5 | isJust thirdParty && ((not.null._negative $ domains) || ((isJustFilled . _positive) $ domains)) = r4 . increment "domains&thirdPartyRBlock" 
     47       | otherwise = r4 
     48    r6 | ((not.null._negative $ requestType) && ((isJustFilled . _positive) $ requestType)) = r5 . increment "mixedRequestTypeRBlock" 
     49       | otherwise = r5 
     50    r7 | ((not.null._negative $ requestType) || ((isJustFilled . _positive) $ requestType)) = r6 . increment "requestTypeRBlock" 
     51       | otherwise = r6 
     52    r8 | isJust thirdParty && ((not.null._negative $ requestType) || ((isJustFilled . _positive) $ requestType)) = r7 . increment "requestType&thirdPartyRBlock" 
     53       | otherwise = r7 
     54     
     55 
     56getWrong  (Line text (RequestBlock exclude _ (RequestOptions requestType thirdParty domains _ _ _ _))) 
     57    | ((not.null._negative $ requestType) && ((isJustFilled . _positive) $ requestType)) = Just text 
     58getWrong _ = Nothing 
    2559 
    2660main::IO() 
     
    2963        text <- hGetContents inputFile 
    3064        parsed <- return $ parse adblockFile filename text 
    31         let res = case parsed of 
    32                         Right parsed' -> show $ elemBlockTree $ fixLines parsed' 
    33                         Left msg -> show msg 
     65         
     66        case parsed of 
     67            --Right parsed' -> writeElemBlock outDir $ (elemBlockData $ (fixLines $ parsed')) 
     68            Right parsed' -> putStrLn $ show $ collectStat parsed' 
     69            Left msg -> putStrLn $ show msg 
    3470        ---putStrLn $ show $ fixLines <$> parsed 
    35         putStrLn res 
     71        --putStrLn res 
    3672        hClose inputFile 
    3773        putStrLn "done" 
    3874    where 
    39         lineText (Line t _) = t 
    40         concatText = join . intersperse ('\n':[]) . map lineText 
    41         collectStat = foldr getStat (Stat 0 0 0 0) 
    42         problems (Line _ Error {}) = True 
    43         problems _= False 
     75        collectStat = foldr getStat (Map.empty) 
  • test-data/testData

    rdcd1d6c r96c17d9  
    1919one.org,other.org,~no.other.org,two.one.org##org blocked unblock 
    2020~something.org,~something.one.org,~very.deep.one.org,free.one.org,deep.one.org,~two.one.org#@#org blocked unblock 
    21 smth.com#@#root excluded 
    22 ~smth.nl##root excluded2 
     21!smth.com#@#root excluded 
     22!~smth.nl##root excluded2 
    2323 
    2424 
    2525 
    2626 
    27 !ElemBlockData ["more Root Level Block","rootLevelBlock"] "" - ["root excluded","root excluded2"] 
     27!ElemBlockData ["more Root Level Block","rootLevelBlock"]  
     28!"" - ["root excluded","root excluded2"] 
    2829!  "us" - ["root excluded","root excluded2"] 
    2930!    "com" - ["root excluded","root excluded2"] 
Note: See TracChangeset for help on using the changeset viewer.