module ElementBlocker (
elemBlock
) where
import InputParser hiding (Policy(..))
import qualified InputParser
import PolicyTree
import qualified Data.Map as Map
import Data.Maybe
import Utils
import System.IO
import System.FilePath
import Data.List
import System.Directory
import qualified Templates
import Control.Monad
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
    where
    writeElemBlock :: ElemBlockData -> IO ()
    writeElemBlock (ElemBlockData flatPatterns rulesTree) =
        do
           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") (debugPath </> "ab2p.common.css") 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) =
        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
        where
            normalPath
                | null name = normalNodePath
                | otherwise = normalNodePath </> 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 =
         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'
                   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'
                   hPutStrLn outFile "*/"
                   hPutStrLn outFile content
                   hClose outFile

elemBlockData :: [Line] -> ElemBlockData
elemBlockData input = ElemBlockData
                        (Map.foldrWithKey appendFlatPattern []              policyTreeMap)
                        (Map.foldrWithKey appendTreePattern (Node "" [] []) policyTreeMap)
    where
    policyTreeMap :: Map.Map String PolicyTree
    policyTreeMap =  Map.unionWith (trimTree Block .*. mergePolicyTrees Unblock)
                            blockLinesMap
                            (erasePolicy Block <$> unblockLinesMap)
        where
        blockLinesMap = Map.fromListWith (mergeAndTrim Block) (mapMaybe blockLine input)
        unblockLinesMap = Map.fromListWith (mergeAndTrim Unblock) (mapMaybe unblockLine input)
        unblockLine (Line _ (ElementHide domains InputParser.Unblock pattern)) = (,) pattern <$> restrictionsTree Unblock domains
        unblockLine _ = Nothing
        blockLine (Line _ (ElementHide domains InputParser.Block pattern)) = (,) pattern <$> restrictionsTree Block domains
        blockLine _ = Nothing

    appendTreePattern ::  Pattern -> PolicyTree -> BlockedRulesTree -> BlockedRulesTree
    appendTreePattern pattern policyTree
          | null $ _children policyTree     = id
          | otherwise                       = mergeTrees appendPattern policyTree
       where appendPattern policy patterns = case policy of
                                                Block -> pattern:patterns
                                                _     -> patterns

    appendFlatPattern ::  Pattern -> PolicyTree -> [Pattern] -> [Pattern]
    appendFlatPattern pattern policyTree patterns
          | null (_children policyTree) && _value policyTree == Block  = pattern:patterns
          | otherwise                                                  = patterns