Changeset 47e082f in adblock2privoxy


Ignore:
Timestamp:
Apr 8, 2014 12:56:04 PM (6 years ago)
Author:
zubr <a@…>
Branches:
master
Children:
d515b21
Parents:
0fb2c4e
Message:

Tasks introduced

Files:
1 added
5 edited

Legend:

Unmodified
Added
Removed
  • adblock2privoxy.cabal

    r5479aa1 r47e082f  
    4848                   time >=1.4.0 && <1.5, 
    4949                   old-locale >=1.0.0 && <1.1, 
    50                    strict >=0.3.2 && <0.4 
     50                   strict >=0.3.2 && <0.4, 
     51                   HTTP >=4000.2.8 && <4000.3, 
     52                   network >=2.4.2 && <2.5 
    5153  ghc-options:     -Wall 
    5254  other-modules:    
  • src/Main.hs

    r899fa03 r47e082f  
    11module Main where 
    22import InputParser 
    3 import System.IO 
    43import ElementBlocker 
    54import UrlBlocker 
    65import Text.ParserCombinators.Parsec hiding (Line, many, optional) 
    7 import Statistics 
     6import Task 
    87import Control.Applicative hiding (many) 
    98import SourceInfo 
    109import System.Console.GetOpt 
    1110import System.Environment 
    12 import Control.Monad 
    1311import Templates (writeTemplateFiles) 
    1412import Data.Time.Clock (getCurrentTime) 
     13import Network.HTTP 
     14import Network.URI 
     15import Utils 
    1516 
    1617data Options = Options 
     
    1819     , _privoxyDir  :: FilePath 
    1920     , _webDir      :: FilePath 
     21     , _taskFile    :: FilePath 
    2022     } deriving Show 
    2123 
    2224options :: [OptDescr (Options -> Options)] 
    2325options = 
    24      [ Option ['V'] ["version"] 
     26     [ Option "V" ["version"] 
    2527         (NoArg (\ opts -> opts { _showVersion = True })) 
    2628         "show version number" 
    27      , Option ['p']     ["privoxyDir"] 
     29     , Option "p"   ["privoxyDir"] 
    2830         (ReqArg (\ f opts -> opts { _privoxyDir = f }) 
    2931                 "PATH") 
    3032         "privoxy config output path (required)" 
    31      , Option ['w']     ["webDir"] 
     33     , Option "w"   ["webDir"] 
    3234         (ReqArg (\ f opts -> opts { _webDir = f }) 
    3335                 "PATH") 
    3436         "css files output path (optional, privoxyDir is used by default)" 
     37     , Option "t"   ["taskFile"] 
     38         (ReqArg (\ f opts -> opts { _taskFile = f }) 
     39                 "PATH") 
     40         "path to task file containing urls to process" 
    3541     ] 
    3642 
     
    3945   case getOpt Permute options argv of 
    4046      (opts,nonOpts,[]  ) ->  
    41                 case foldl (flip id) (Options False [] []) opts of 
    42                         Options False [] _ -> writeError "Privoxy dir is not specified.\n" 
    43                         opts'@(Options _ privoxyDir []) -> return (opts'{_webDir = privoxyDir}, nonOpts) 
     47                case foldl (flip id) (Options False "" "" "") opts of 
     48                        Options False "" _ _ -> writeError "Privoxy dir is not specified.\n" 
     49                        opts'@(Options _ privoxyDir "" _) -> return (opts'{_webDir = privoxyDir}, nonOpts) 
    4450                        opts' -> return (opts', nonOpts) 
    4551      (_,_,errs) -> writeError $ concat errs 
    46   where  
    47         writeError msg = ioError $ userError $ msg ++ usageInfo header options 
    48         header = "Usage: adblock2privoxy [OPTION...] adblockFiles..." 
     52   
     53writeError :: String -> IO a 
     54writeError msg = ioError $ userError $ msg ++ usageInfo header options 
     55        where          
     56        header = "Usage: adblock2privoxy [OPTION...] [URL...]" 
    4957 
     58getResponse :: String -> IO String 
     59getResponse url = do 
     60        response <- simpleHTTP (getRequest url) 
     61        getResponseBody response 
    5062 
    51 processFiles :: String -> String -> [String] -> IO [()] 
    52 processFiles privoxyDir webDir filenames = do  
    53         let parseFile filename = do 
    54             putStrLn $ "parse " ++ filename 
    55             inputFile <- openFile filename ReadMode 
    56             text <- hGetContents inputFile 
    57             case parse adblockFile filename text of 
    58                 Right parsed -> return (parsed, extractInfo parsed, inputFile) 
    59                 Left msg -> return ([], NoInfo, inputFile) <$ putStrLn $ show msg 
    60                      
    61         (parsed, sourceInfo, handlers) <- unzip3 <$> mapM parseFile filenames 
    62         showInfo' <- showInfo <$> getCurrentTime     
     63processSources :: String -> String -> [SourceInfo]-> IO () 
     64processSources privoxyDir webDir sources = do  
     65        (parsed, sourceInfo) <- unzip <$> mapM parseSource sources    
    6366        let parsed' = concat parsed  
    64             info    = (sourceInfo >>= showInfo') ++ ["------- end ------\n"]                
    65         stat privoxyDir info parsed' 
    66         elemBlock webDir info parsed' 
    67         urlBlock privoxyDir info parsed' 
     67        infoText <- showInfos <$> getCurrentTime $> sourceInfo                
     68        writeTask privoxyDir infoText parsed' 
     69        elemBlock webDir infoText parsed' 
     70        urlBlock privoxyDir infoText parsed' 
    6871        writeTemplateFiles privoxyDir 
    69         sequence $ hClose <$> handlers 
     72        where  
     73        parseSource sourceInfo = do 
     74                            let  
     75                                url = _url sourceInfo 
     76                                loader = if isURI url then getResponse else readFile 
     77                            putStrLn $ "parse " ++ url 
     78                            text <- loader url 
     79                            now <- getCurrentTime 
     80                            case parse adblockFile url text of 
     81                                Right parsed -> return (parsed, updateInfo now parsed sourceInfo) 
     82                                Left msg -> return ([], sourceInfo) <$ putStrLn $ show msg 
    7083         
    7184main::IO() 
    7285main = do  
    7386        args <- getArgs 
    74         (opts, filenames) <- parseOptions args 
    75         when (_showVersion opts) $ putStrLn "adblock2privoxy version 1.0" 
    76         when (not . null $_privoxyDir opts) $ 
    77                 do _ <- processFiles (_privoxyDir opts) (_webDir opts) filenames 
    78                    putStrLn "done" 
     87        (opts, urls) <- parseOptions args 
     88        let acton 
     89                | _showVersion opts = putStrLn "adblock2privoxy version 1.0" 
     90                | not . null $ urls  
     91                   =    processSources (_privoxyDir opts) (_webDir opts) (makeInfo <$> urls) 
     92                | not . null $ _taskFile opts  
     93                   = do task <- readTask . _taskFile $ opts 
     94                        processSources (_privoxyDir opts) (_webDir opts) (logInfo task) 
     95                | otherwise = writeError "no input specified" 
     96        acton 
     97        putStrLn "done" 
    7998 
  • src/ParserExtTests.hs

    r9dc8cfc r47e082f  
    11module ParserExtTests ( 
    2 parseMorse, 
     2testParsecExt, 
     3testParseMorse, 
    34encodeMorse 
    45) where 
     
    103104morseParser :: Int -> StringStateParser (ZipListM String) 
    104105morseParser pos = do     acc' <- get 
    105                          let acc = case acc' of 
    106                                       Nothing -> "" 
    107                                       Just val -> val 
     106                         let acc = fromMaybe "" acc' 
    108107                             candidates = filter (\x -> isPrefixOf acc x && acc /= x) morseCharCodes 
    109108                             steps = drop (length acc) <$> findMorseSteps acc candidates 
     
    111110                         res <- lift parser 
    112111                         put (Just $ acc ++ res) 
    113                          return (zipListM $ (replicate pos "") ++ (res : repeat "")) 
     112                         return (zipListM $ replicate pos "" ++ (res : repeat "")) 
    114113                   
    115114 
     
    120119parseMorse s = (fmap.fmap) postProcess $ parseMorseRaw "x" s 
    121120            where  
    122             parseMorseRaw =  parse (cases $ morseParsers)  
     121            parseMorseRaw =  parse (cases morseParsers)  
    123122            postProcess = decodeMorse.toLists  
    124             toLists = (takeWhile $ not.null) . getZipListM  
     123            toLists = takeWhile (not . null) . getZipListM  
    125124             
  • src/SourceInfo.hs

    r9dc8cfc r47e082f  
    11module SourceInfo 
    22( 
    3 SourceInfo(..), 
    4 extractInfo, 
    5 showInfo 
     3SourceInfo(_url), 
     4showInfos, 
     5updateInfo, 
     6makeInfo, 
     7logInfo 
    68) where 
    79import InputParser 
     
    1315import System.Locale 
    1416import Data.Time.Format 
     17import Data.Maybe (catMaybes) 
     18import Data.String.Utils (split) 
    1519 
    1620 
    17 data SourceInfo = SourceInfo { _title, _filename, _license, _homepage :: String,  
    18                                _lastUpdated :: UTCTime, _expires, _version :: Integer } | NoInfo 
     21data SourceInfo = SourceInfo { _title, _url, _license, _homepage :: String,  
     22                               _lastUpdated :: UTCTime, _expires, _version :: Integer } 
    1923 
    2024emptySourceInfo :: SourceInfo 
    2125emptySourceInfo = SourceInfo "" "" "" "" (UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 0) ) 72 0 
    2226 
     27separator :: String 
     28separator = "----- source -----" 
     29 
     30endMark :: String 
     31endMark = "------- end ------" 
     32 
     33showInfos :: UTCTime -> [SourceInfo] -> [String]  
     34showInfos now sourceInfos = (sourceInfos >>= showInfo now) ++ [endMark ++ "\n"] 
     35 
    2336showInfo :: UTCTime -> SourceInfo -> [String]  
    24 showInfo _ NoInfo = ["----- a source skipped -----"] 
    25 showInfo now sourceInfo@(SourceInfo _ filename _ _ lastUpdated expires _) =  
    26                     [concat ["----- source -----"]] 
    27                     ++ optionalLine "Title: " _title 
    28                     ++ [concat ["Filename: ", filename], 
    29                     concat ["Last modified: ", formatTime defaultTimeLocale "%d %b %Y %H:%M %Z" lastUpdated], 
    30                     concat ["Expires: ", show expires, " hours", expired]]  
    31                     ++ optionalLine "Version: " _version 
    32                     ++ optionalLine "License: " _license 
    33                     ++ optionalLine "Homepage: " _homepage 
     37showInfo now sourceInfo@(SourceInfo _ url _ _ lastUpdated expires _) =  
     38        catMaybes [ Just separator, 
     39                    optionalLine "Title: " _title, 
     40                    Just $ concat ["Url: ", url], 
     41                    Just $ concat ["Last modified: ", formatTime defaultTimeLocale "%d %b %Y %H:%M %Z" lastUpdated], 
     42                    Just $ concat ["Expires: ", show expires, " hours", expired],  
     43                    optionalLine "Version: " _version, 
     44                    optionalLine "License: " _license, 
     45                    optionalLine "Homepage: " _homepage ] 
    3446    where  
    3547    expired | (diffUTCTime now lastUpdated) > (fromInteger $ expires * 60 * 60) = " (expired)" 
    36                                 | otherwise = [] 
    37     optionalLine caption getter | getter sourceInfo == getter emptySourceInfo = [] 
    38                                 | otherwise = [concat [caption, show $ getter sourceInfo]]  
     48            | otherwise = "" 
     49    optionalLine caption getter | getter sourceInfo == getter emptySourceInfo = Nothing 
     50                                | otherwise = Just $ concat [caption, show $ getter sourceInfo]  
    3951 
    40 extractInfo :: [Line] -> SourceInfo 
    41 extractInfo lns@(Line RecordSource{_position = pos} _:_)  
    42     = execState (sequence $ lineInfo <$> take 50 lns) initial 
    43     where initial =emptySourceInfo { _filename = sourceName pos}  
    44 extractInfo _ = NoInfo 
     52updateInfo :: UTCTime -> [Line] -> SourceInfo -> SourceInfo 
     53updateInfo now lns initial 
     54    = execState (sequence $ parseInfo . lineComment <$> take 50 lns) initial' 
     55    where initial' = initial { _lastUpdated = now }  
     56     
     57makeInfo :: String -> SourceInfo 
     58makeInfo url = emptySourceInfo { _url = url } 
    4559 
    46 lineInfo :: Line -> State SourceInfo () 
    47 lineInfo (Line _ (Comment text)) = do 
     60logInfo :: [String] -> [SourceInfo] 
     61logInfo lns = chunkInfo <$> chunks 
     62   where  
     63   chunks = split [separator] . takeWhile (/= endMark) $ lns 
     64   chunkInfo chunk = execState (sequence $ parseInfo <$> chunk) emptySourceInfo 
     65 
     66lineComment :: Line -> String 
     67lineComment (Line _ (Comment text)) = text 
     68lineComment _ = "" 
     69 
     70parseInfo :: String -> State SourceInfo () 
     71parseInfo text = do 
    4872    info <- get 
    49     let titleParser = (\x -> info{_title = x}) <$> (string "Title: " *> many1 anyChar) 
     73    let urlParser = (\x -> info{_url = x}) <$> (string "Url: " *> many1 anyChar) 
     74        titleParser = (\x -> info{_title = x}) <$> (string "Title: " *> many1 anyChar) 
    5075        homepageParser = (\x -> info{_homepage = x}) <$> (string "Homepage: " *> many1 anyChar) 
    5176        lastUpdatedParser = (\x -> case x of  
     
    5883                *> skipMany (char ' ') *> many1 anyChar) 
    5984        expiresParser = (\n unit -> info{_expires = unit * read n})  
    60             <$> (string "Expires: " *> many1 digit) <*> (24 <$ string " days" <|> 1 <$ string " hours") 
     85            <$> (string "Expires: " *> many1 digit) <*> (24 <$ string " days" <|> 1 <$ string " hours")  
    6186        versionParser = (\x -> info{_version = read x}) <$> (string "Version: " *> many1 digit) 
    62         commentParser = skipMany (char ' ') *>  
    63             (try titleParser <|> try expiresParser <|> try versionParser  
     87        stringParser = skipMany (char ' ') *>  
     88            (try urlParser <|> try titleParser <|> try expiresParser <|> try versionParser  
    6489              <|> try licenseParser <|> try homepageParser <|> try lastUpdatedParser) 
    65     case parse commentParser "" text of 
     90    case parse stringParser "" text of 
    6691        Left _ -> return () 
    6792        Right info' -> put info'  
    68 lineInfo _ = return () 
  • src/Statistics.hs

    r9dc8cfc r47e082f  
    1 module Statistics where 
     1{-# LANGUAGE OverloadedStrings #-} 
     2module Statistics ( 
     3        collectStat 
     4)where 
    25import qualified Data.Map as Map 
    36import InputParser 
    47import Data.Maybe  
    5 import System.IO 
    6 import System.FilePath 
    7 import Control.Applicative ((<$>)) 
     8import Control.Applicative  
    89import Control.Monad.State 
    910 
    1011type Stat = Map.Map String Int  
    1112 
    12 stat :: String -> [String] -> [Line] -> IO () 
    13 stat path info lns =  
    14     let result = collectStat lns  
    15         filename = path </> "ab2p.stat" 
    16         resultLine (name, value) = concat [name, ": ", show value]  
    17         errorLine (Line position (Error text))  
    18             = [concat ["ERROR: ", recordSourceText position, " - ", text]] 
    19         errorLine _ = [] 
    20     in do   
    21         outFile <- openFile filename WriteMode 
    22         _ <- mapM (hPutStrLn outFile) info 
    23         _ <- sequence $ hPutStrLn outFile . resultLine <$> Map.toAscList result 
    24         _ <- sequence $ hPutStrLn outFile <$> (lns >>= errorLine) 
    25         hClose outFile 
    26  
    27 collectStat :: [Line] -> Stat 
    28 collectStat = foldr getStat Map.empty 
     13collectStat :: [Line] -> [String] 
     14collectStat = liftA resultLine . Map.toAscList . foldr getStat Map.empty 
     15        where 
     16        resultLine (name, value) = concat [name, ": ", show value] 
    2917 
    3018increment :: String -> Stat-> Stat 
Note: See TracChangeset for help on using the changeset viewer.