Merge pull request #40 from essandess/hlint

adblock2privoxy: Update to version 2.3.0

README.md

@@ -105,6 +105,8 @@ If no source URLs are specified, task file is used to determine sources: previou
   Domain of CSS web server (required for Element Hide functionality)
 -u, --useHTTP
   Use HTTP for CSS web server; the default is HTTPS to avoid mixed content
+-g INT, --debugLevel=INT
+  Debug Level. 0: Off; 1: top directory CSS; 2: full directory.
 -t PATH, --taskFile=PATH
   Path to task file containing urls to process and options.
 -f, --forced

adblock2privoxy-utils/adblock2privoxy-utils.cabal

@@ -1,5 +1,5 @@
 name:           adblock2privoxy-utils
-version:        2.2.0
+version:        2.3.0
 cabal-version:  >= 1.10
 build-type:     Simple
 tested-with:    GHC==8.10.7
@@ -45,4 +45,4 @@ source-repository this
   type:         git
   location:     https://github.com/essandess/adblock2privoxy.git
   subdir:       adblock2privoxy-utils
-  tag:          v2.2.0
+  tag:          v2.3.0

adblock2privoxy/changelog → adblock2privoxy/CHANGELOG.md

@@ -1,3 +1,7 @@
+2.3.0
+	* hlint mods
+	* Add debug code with new DebugLevel option
+
 2.2.0
 	* Remove unused debug code
 

adblock2privoxy/README.rst

@@ -56,6 +56,10 @@ Options
       Css files output path
   -d DOMAIN,  --domainCSS=DOMAIN
       Domain of CSS web server (required for Element Hide functionality)
+   -u, --useHTTP
+      Use HTTP for CSS web server; the default is HTTPS to avoid mixed content
+  -g INT, --debugLevel=INT
+      Debug Level. 0: Off; 1: top directory CSS; 2: full directory.
   -t PATH,    --taskFile=PATH
       Path to task file containing urls to process and options.
   -f,         --forced

adblock2privoxy/adblock2privoxy.cabal

@@ -1,5 +1,5 @@
 name:           adblock2privoxy
-version:        2.2.0
+version:        2.3.0
 cabal-version:  >= 1.10
 build-type:     Simple
 tested-with:
@@ -65,28 +65,29 @@ executable adblock2privoxy
                 FlexibleContexts
   build-depends:
                 base >= 4 && < 9.9,
-                parsec,
-                mtl,
-                containers,
-                filepath,
-                directory,
-                MissingH >=1.4.3.0,
-                parsec-permutation >=0.1.2.0,
-                time >=1.4,
-                old-locale >=1.0,
-                strict >=0.3,
-                network >=2.4,
-                http-conduit,
-                text >=0.11,
-                network-uri,
-                case-insensitive
+                MissingH >= 1.6.0 && < 1.7,
+                containers >= 0.6.7 && < 0.7,
+                directory >= 1.3.8 && < 1.4,
+                filepath >= 1.4.200 && < 1.5,
+                mtl >= 2.3.1 && < 2.4,
+                time >= 1.12.2 && < 1.13,
+                network >= 3.1.4 && < 3.2,
+                old-locale >= 1.0.0 && < 1.1,
+                parsec >= 3.1.16 && < 3.2,
+                text >= 2.0.2 && < 2.1,
+                case-insensitive >= 1.2.1 && < 1.3,
+                http-conduit >= 2.3.8 && < 2.4,
+                network-uri >= 2.6.4 && < 2.7,
+                strict >= 0.5 && < 0.6,
+                parsec-permutation >= 0.1.2 && < 0.2
   ghc-options:  -Wall
   other-modules:
                 ElementBlocker,
                 InputParser,
                 Network,
                 OptionsConverter,
                 ParsecExt,
+                ParserExtTests,
                 Paths_adblock2privoxy,
                 PatternConverter,
                 PolicyTree,
@@ -103,4 +104,4 @@ source-repository this
   type:         git
   location:     https://github.com/essandess/adblock2privoxy.git
   subdir:       adblock2privoxy
-  tag:          v2.2.0
+  tag:          v2.3.0

adblock2privoxy/src/ElementBlocker.hs

@@ -1,9 +1,12 @@
+{-# LANGUAGE StrictData #-}
+
 module ElementBlocker (
 elemBlock
 ) where
 import InputParser hiding (Policy(..))
 import qualified InputParser
 import PolicyTree
+import ProgramOptions (DebugLevel(DebugLevel))
 import qualified Data.Map as Map
 import Data.Maybe
 import Utils
@@ -19,51 +22,45 @@ import Data.String.Utils (startswith)
 type BlockedRulesTree = DomainTree [Pattern]
 data ElemBlockData = ElemBlockData [Pattern] BlockedRulesTree deriving Show
 
-elemBlock :: String -> [String] -> [Line] -> IO ()
-elemBlock path info = writeElemBlock . elemBlockData
+elemBlock :: String -> [String] -> DebugLevel -> [Line] -> IO ()
+elemBlock path info debug = writeElemBlock . elemBlockData
     where
     writeElemBlock :: ElemBlockData -> IO ()
     writeElemBlock (ElemBlockData flatPatterns rulesTree) =
         do
-           let filteredInfo = filter ((||) <$> not . startswith "Url:" <*> startswith "Url: http") info
-               -- debugPath = path </> "debug"
+           let debugPath = path </> "debug"
+               filteredInfo = filter ((||) <$> not . startswith "Url:" <*> startswith "Url: http") info
            createDirectoryIfMissing True path
            cont <- getDirectoryContents path
-           _ <- sequence $ removeOld <$> cont
-           -- createDirectoryIfMissing True debugPath
-           -- writeBlockTree path debugPath rulesTree
-           writeBlockTree path rulesTree
-           writePatterns_with_debug filteredInfo (path </> "ab2p.common.css") "" flatPatterns
-           -- writePatterns_with_debug filteredInfo (path </> "ab2p.common.css") (debugPath </> "ab2p.common.css") flatPatterns
+           mapM_ removeOld cont
+           when (debug > DebugLevel 0) $ createDirectoryIfMissing True debugPath
+           writeBlockTree path debugPath rulesTree
+           writePatterns filteredInfo (path </> "ab2p.common.css") (if debug > DebugLevel 0 then debugPath </> "ab2p.common.css" else "") flatPatterns
     removeOld entry' =
         let entry = path </> entry'
         in do
            isDir <- doesDirectoryExist entry
            if isDir then when (head entry' /= '.') $ removeDirectoryRecursive entry
                     else when (takeExtension entry == ".css") $ removeFile entry
-    -- writeBlockTree :: String -> String -> BlockedRulesTree -> IO ()
-    -- writeBlockTree normalNodePath debugNodePath (Node name patterns children) =
-    writeBlockTree :: String -> BlockedRulesTree -> IO ()
-    writeBlockTree normalNodePath (Node name patterns children) =
+    writeBlockTree :: String -> String -> BlockedRulesTree -> IO ()
+    writeBlockTree normalNodePath debugNodePath (Node name patterns children) =
         do
             createDirectoryIfMissing True normalPath
-            -- createDirectoryIfMissing True debugPath
-            -- _ <- sequence (writeBlockTree normalPath debugPath <$> children)
-            -- writePatterns ["See ab2p.common.css for sources info"] normalFilename debugFilename patterns
-            _ <- sequence (writeBlockTree normalPath <$> children)
-            writePatterns ["See ab2p.common.css for sources info"] normalFilename patterns
+            when (debug > DebugLevel 1) $ createDirectoryIfMissing True debugPath
+            mapM_ (writeBlockTree normalPath debugPath) children
+            writePatterns ["See ab2p.common.css for sources info"] normalFilename (if debug > DebugLevel 1 then debugFilename else "") patterns
         where
             normalPath
                 | null name = normalNodePath
                 | otherwise = normalNodePath </> name
-            -- debugPath
-            --     | null name = debugNodePath
-            --     | otherwise = debugNodePath </> name
+            debugPath
+                | null name = debugNodePath
+                | otherwise = debugNodePath </> name
             normalFilename = normalPath </> "ab2p.css"
-            -- debugFilename = debugPath </> "ab2p.css"
-    writePatterns_with_debug :: [String] -> String -> String -> [Pattern] -> IO ()
-    writePatterns_with_debug _ _ _ [] = return ()
-    writePatterns_with_debug info' normalFilename debugFilename patterns =
+            debugFilename = debugPath </> "ab2p.css"
+    writePatterns :: [String] -> String -> String -> [Pattern] -> IO ()
+    writePatterns _ _ _ [] = return ()
+    writePatterns info' normalFilename debugFilename patterns =
          do
             writeCssFile normalFilename $ intercalate "\n" ((++ Templates.blockCss) . intercalate "," <$>
                     splitEvery 4000 patterns)
@@ -75,24 +72,7 @@ elemBlock path info = writeElemBlock . elemBlockData
                 do outFile <- openFile filename WriteMode
                    hSetEncoding outFile utf8
                    hPutStrLn outFile "/*"
-                   _ <- mapM (hPutStrLn outFile) info'
-                   hPutStrLn outFile "*/"
-                   hPutStrLn outFile content
-                   hClose outFile
-    writePatterns :: [String] -> String -> [Pattern] -> IO ()
-    writePatterns _ _ [] = return ()
-    writePatterns info' normalFilename patterns =
-         do
-            -- writeCssFile debugFilename $ intercalate "\n" $ (++ Templates.blockCss) <$> patterns
-            writeCssFile normalFilename $ intercalate "\n" ((++ Templates.blockCss) . intercalate "," <$>
-                                                                            splitEvery 4000 patterns)
-         where
-         splitEvery n = takeWhile (not . null) . unfoldr (Just . splitAt n)
-         writeCssFile filename content =
-                do outFile <- openFile filename WriteMode
-                   hSetEncoding outFile utf8
-                   hPutStrLn outFile "/*"
-                   _ <- mapM (hPutStrLn outFile) info'
+                   mapM_ (hPutStrLn outFile) info'
                    hPutStrLn outFile "*/"
                    hPutStrLn outFile content
                    hClose outFile