Changeset 26a672b in adblock2privoxy


Ignore:
Timestamp:
Oct 6, 2013 3:30:49 PM (6 years ago)
Author:
zubr <a@…>
Branches:
master
Children:
e90f7e4
Parents:
d0db38d
Message:

Refactoring

Location:
src
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • src/OptionsConverter.hs

    rd0db38d r26a672b  
    11module OptionsConverter ( 
    2     FilterChain (..), 
     2    HeaderFilters, 
    33    Filter (..), 
    44    HeaderType (..), 
     
    2222data HeaderPolicy = Specific Filter | Any | None deriving Eq   
    2323data HeaderFilter = HeaderFilter HeaderType Filter            
    24 data FilterChain = Terminal Policy |  
    25                    Chain { _filters :: [HeaderFilter], _next :: FilterChain }  
    26 data FilterNode = Node { _pattern :: [Pattern], _chain :: FilterChain, _isNested :: Bool, _policy :: Policy} 
    27  
     24type HeaderFilters = [[HeaderFilter]] 
     25data FilterNode = Node { _pattern :: [Pattern], _filters :: HeaderFilters, _isNested :: Bool, _policy :: Policy} 
    2826 
    2927--TODO: SPECIAL CASE 1 & 2 
     
    4139filterNodes :: Policy -> [Pattern] -> RequestOptions -> [FilterNode] 
    4240filterNodes policy patterns requestOptions  
    43     = collectNodes patterns $ filterChain policy requestOptions 2 
     41    = collectNodes patterns $ headerFilters policy requestOptions 2 
    4442    where collectNodes _ Nothing = []  
    45           collectNodes patterns' (Just chain@Chain{ _next = next })  
    46             = Node patterns' chain (null patterns') policy : collectNodes [] (Just next) 
    47           collectNodes patterns' (Just chain) = [Node patterns' chain (null patterns') policy] 
     43          collectNodes patterns' (Just filters@(_: next))  
     44            = Node patterns' filters (null patterns') policy : collectNodes [] (Just next) 
     45          collectNodes patterns' (Just []) = [Node patterns' [] (null patterns') policy] 
    4846 
    4947 
    50 filterChain :: Policy -> RequestOptions -> Int -> Maybe FilterChain 
    51 filterChain policy _ 1 = Just $ Terminal policy 
    52 filterChain policy requestOptions level 
    53     = do nextLevel <- filterChain policy requestOptions (level - 1) 
     48headerFilters :: Policy -> RequestOptions -> Int -> Maybe HeaderFilters 
     49headerFilters _ _ 1 = Just [] 
     50headerFilters policy requestOptions level 
     51    = do  
     52         nextLevel <- headerFilters policy requestOptions (level - 1) 
    5453         let filters = do 
    5554                       headerType <- allTypes 
     
    6261         return $ case catMaybes filters of 
    6362                    []       -> nextLevel 
    64                     filters' -> Chain filters' nextLevel 
     63                    filters' -> filters' : nextLevel 
    6564  
    6665acceptFilter, contentTypeFilter, requestedWithFilter, referrerFilter :: FilterFabrique 
  • src/UrlBlocker.hs

    rd0db38d r26a672b  
    1313 
    1414data TaggerType = Client | Server 
    15 data TaggerForwarder = Forward (Maybe Filter) FilterChain | Cancel Tagger  
     15data TaggerForwarder = Forward (Maybe Filter) String | Cancel Tagger  
    1616data Tagger = Tagger { _taggerCode :: String, _forwarding :: [TaggerForwarder], _headerType :: HeaderType } 
    1717 
     
    2626 
    2727urlBlockData :: [Line] -> UrlBlockData  
    28 urlBlockData lns = mconcat [chainResult node | node <- sortBy cmpPolicy filterNodesList ] 
     28urlBlockData lns = mconcat [nodeResult node | node <- sortBy cmpPolicy filterNodesList ] 
    2929    where 
    3030    cmpPolicy node1 node2 = compare (_policy node1) (_policy node2) 
     
    3232        where 
    3333        blockLine (Line _ (RequestBlock policy pattern options))  
    34             = [(name $ _chain node, node) | node <- filterNodes policy [pattern] options] 
     34            = [(name node, node) | node <- filterNodes policy [pattern] options] 
    3535        blockLine _ = []   
    36         joinNodes (Node patterns1 chain1 nested1 policy1)  
     36        joinNodes (Node patterns1 filters1 nested1 policy1)  
    3737                  (Node patterns2 _ nested2 _)  
    38             = Node (patterns1 ++ patterns2) chain1 (nested1 || nested2) policy1  
     38            = Node (patterns1 ++ patterns2) filters1 (nested1 || nested2) policy1  
    3939         
    4040 
    41 chainResult :: FilterNode -> UrlBlockData 
    42 chainResult (Node patterns chain@(Chain filters nextChain) nested policy) 
     41nodeResult :: FilterNode -> UrlBlockData 
     42nodeResult node@(Node patterns (levelFilters : nextLevelFilters) nested policy) 
    4343    = (taggers, (mainAction : auxActions)) 
    4444    where  
    45     mainAction = Action { _actionCode = name chain, 
     45    mainAction = Action { _actionCode = name node, 
    4646                          _switches   = appendIf (policy == Unblock)  
    4747                                            (Switch False BlockAction) 
     
    5656                       _ -> mzero 
    5757     
    58     taggers = filters >>= filterTaggers 
     58    taggers = levelFilters >>= filterTaggers 
    5959    filterTaggers (HeaderFilter headerType@HeaderType {_typeCode = typeCode} filter'@(Filter filterCode _ orEmpty))   
    6060        | orEmpty   = [orEmptyTagger, mainTagger [Cancel orEmptyTagger]] 
    6161        | otherwise = [mainTagger []] 
    6262        where 
    63         mainTagger moreForwarders = Tagger { _taggerCode = makeName nextChain $ typeCode : filterCode, 
    64                                              _forwarding = Forward (Just filter') nextChain : moreForwarders, 
     63        nextNodeName = makeName policy nextLevelFilters 
     64        mainTagger moreForwarders = Tagger {   _taggerCode = nextNodeName $ typeCode : filterCode, 
     65                                               _forwarding = Forward (Just filter') (nextNodeName "") : moreForwarders, 
     66                                               _headerType = headerType } 
     67        orEmptyTagger             = Tagger { _taggerCode = nextNodeName ['n', typeCode], 
     68                                             _forwarding = [Forward Nothing (nextNodeName "")], 
    6569                                             _headerType = headerType } 
    66         orEmptyTagger             = Tagger { _taggerCode = makeName nextChain $ ['n', typeCode], 
    67                                              _forwarding = [Forward Nothing nextChain], 
    68                                              _headerType = headerType } 
    69 chainResult (Node patterns chain nested policy) = ([], [baseAction]) 
    70     where baseAction = Action (name chain) [Switch (policy == Block) TerminalAction] patterns nested 
     70nodeResult node@(Node patterns [] nested policy) = ([], [baseAction]) 
     71    where baseAction = Action (name node) [Switch (policy == Block) TerminalAction] patterns nested 
    7172             
    72 instance Named FilterChain where 
    73     name chain = makeName chain ""  
     73instance Named FilterNode where 
     74    name (Node _ filters _ policy)  = makeName policy filters ""  
    7475     
    75 makeName :: FilterChain -> String -> String 
    76 makeName (Terminal policy) rest  
     76makeName :: Policy -> HeaderFilters -> String -> String 
     77makeName policy [] rest  
    7778    = join [Templates.ab2pPrefix, toLower <$> show policy, (if null rest then "" else "-"), rest] 
    78 makeName (Chain filters next) rest  
    79     = makeName next $ join [filtersCode, (if null rest then "" else "-when-"), rest] 
     79makeName policy (levelFilters : nextLevelFilters) rest  
     80    = makeName policy nextLevelFilters $ join [filtersCode, (if null rest then "" else "-when-"), rest] 
    8081    where  
    81     filtersCode = (intercalate "-" $ filterCode <$> filters) 
     82    filtersCode = (intercalate "-" $ filterCode <$> levelFilters) 
    8283    filterCode (HeaderFilter HeaderType {_typeCode = typeCode} (Filter code _ orEmpty)) 
    8384        | orEmpty   = 'n' : typeCode : '-' : mainCode   
     
    99100        = intercalate "\n" (caption : (forward <$> forwarding)) 
    100101        where caption = show taggerType ++ (':' : ' ' : code) 
    101               forward (Forward (Just filter') tagret) = foreardRegex headerName (_regex filter') ":" "" tagret 
    102               forward (Forward Nothing tagret) = foreardRegex "" "" "" "" tagret 
    103               forward (Cancel tagger) = foreardRegex headerName "" ":" "-" tagger 
    104               foreardRegex header lookahead' value tagPrefix tagret 
     102              forward (Forward (Just filter') tagret) = forwardRegex headerName (_regex filter') ":" "" tagret 
     103              forward (Forward Nothing tagret) = forwardRegex "" "" "" "" tagret 
     104              forward (Cancel tagger) = forwardRegex headerName "" ":" "-" (name tagger) 
     105              forwardRegex header lookahead' value tagPrefix tagret 
    105106                = let modifier  
    106107                        | '$' `elem` lookahead' = "TDi" 
    107108                        | otherwise            = "Ti" 
    108                   in join ["s@^", header, lookahead', value, ".*@", tagPrefix, name tagret, "@", modifier]  
     109                  in join ["s@^", header, lookahead', value, ".*@", tagPrefix, tagret, "@", modifier]  
    109110     
    110111instance Named Bool where 
Note: See TracChangeset for help on using the changeset viewer.