source: adblock2privoxy/adblock2privoxy/src/Main.hs @ a2fcf33

Last change on this file since a2fcf33 was a2fcf33, checked in by Alexey Zubritskiy <a.zubritskiy@…>, 4 years ago

Release 1.4.2

  • Property mode set to 100644
File size: 3.6 KB
Line 
1module Main where
2import InputParser
3import ElementBlocker
4import UrlBlocker
5import Text.ParserCombinators.Parsec hiding (Line, many, optional)
6import Task
7import SourceInfo as Source
8import ProgramOptions as Options
9import System.Environment
10import Templates
11import Data.Time.Clock
12import Network.HTTP.Conduit
13import Network.URI
14import System.Directory
15import System.IO
16import Network
17import GHC.IO.Encoding
18
19getFileContent :: String -> IO String
20getFileContent url = do
21    handle <- openFile url ReadMode
22    hSetEncoding handle utf8
23    hGetContents handle
24
25processSources :: Options -> String -> [SourceInfo]-> IO ()
26processSources options taskFile sources = do
27        manager <- newManager tlsManagerSettings
28        (parsed, sourceInfo) <- unzip <$> mapM (parseSource manager) sources
29        let parsed' = concat parsed
30            sourceInfoText = showInfo sourceInfo
31            optionsText = logOptions options
32        createDirectoryIfMissing True $ _privoxyDir options
33        writeTask taskFile (sourceInfoText ++ optionsText) parsed'
34        if null._cssDomain $ options
35                then putStrLn "WARNING: CSS generation is not run because webserver domain is not specified"
36                else elemBlock (_webDir options) sourceInfoText parsed'
37        urlBlock (_privoxyDir options) sourceInfoText parsed'
38        writeTemplateFiles (_privoxyDir options) (_cssDomain options)
39        putStrLn $ "Run 'adblock2privoxy -t " ++ taskFile ++ "' every 1-2 days to process data updates."
40        where
41        parseSource manager sourceInfo = do
42            let
43                url = _url sourceInfo
44                loader = if isURI url then downloadHttp manager 5 else getFileContent
45            putStrLn $ "process " ++ url
46            text <- loader url
47            now <- getCurrentTime
48            let strictParse = text `seq` parse adblockFile url text
49            case strictParse of
50                Right parsed ->
51                        let sourceInfo' = updateInfo now parsed sourceInfo
52                            url' = _url sourceInfo'
53                        in if url == url'
54                           then return (parsed, sourceInfo')
55                           else parseSource manager sourceInfo'
56                Left msg -> return ([], sourceInfo) <$ putStrLn $ show msg
57
58main::IO()
59main =  do
60        setLocaleEncoding utf8
61        setFileSystemEncoding utf8
62        setForeignEncoding utf8
63        now <- getCurrentTime
64        args <- getArgs
65        (options@(Options printVersion _ _ taskFile _ forced), urls) <- parseOptions args
66        (options', task) <- do
67                fileExists <- doesFileExist taskFile
68                if fileExists
69                        then do task <- readTask taskFile
70                                return (fillFromLog options task, Just task)
71                        else return (options, Nothing)
72        let
73            action
74                | printVersion = putStrLn versionText
75                | not . null $ urls
76                   = processSources options' taskFile (makeInfo <$> urls)
77                | otherwise = case task of
78                        Nothing -> writeError "no input specified"
79                        (Just task') -> do
80                                let sources = Source.readLogInfos task'
81                                if forced || or (infoExpired now <$> sources)
82                                        then processSources options' taskFile sources
83                                        else putStrLn "all sources are up to date"
84
85        action
86        now' <- getCurrentTime
87        putStrLn $ concat ["Execution done in ", show $ diffUTCTime now' now, " seconds."]
Note: See TracBrowser for help on using the repository browser.