content: {-# LANGUAGE DeriveDataTypeable #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE NoMonomorphismRestriction #-}
  {-# LANGUAGE CPP #-}
  
  {-|
  This script parses the public suffix list, and constructs a data structure which can
  be used with the isSuffix function in Lookup.hs. It exports a GSink which produces
  the opaque 'DataStructure' and can be fed any Source as input.
  
  This makes an few assumption about the information in the public suffix list:
  namely, that no rule is a suffix of another rule. For example, if there is a rule
  abc.def.ghi
  then there is no other rule
  def.ghi
  or
  !def.ghi
  
  The actual data structure involved here is a tree where the nodes have no value and
  the edges are DNS labels. There are two trees: one to handle the exception rules,
  and one to handle the regular rules.
  -}
  
  module Network.PublicSuffixList.Create (PublicSuffixListException, sink) where
  
  import           Control.Exception
  import qualified Data.ByteString      as BS
  import qualified Data.Conduit         as C
  import qualified Data.Conduit.List    as CL
  import qualified Data.Conduit.Text    as CT
  import qualified Data.Map             as M
  import qualified Data.Text            as T
  import           Data.Typeable
  import           Text.IDNA
  import Control.Monad.Catch (MonadThrow)
  
  import           Network.PublicSuffixList.Types
  
  data PublicSuffixListException = PublicSuffixListException
    deriving (Show, Typeable)
  
  instance Exception PublicSuffixListException
  
  insert :: (Ord e) => Tree e -> [e] -> Tree e
  insert _ [] = def
  insert t (p : ps) = case M.lookup p $ children t of
    Nothing -> t { children = M.insert p (insert def ps) $ children t }
    Just l -> t { children = M.insert p (insert l ps) $ children t }
  
  foldingFunction :: DataStructure -> T.Text -> DataStructure
  foldingFunction d@(rules, exceptions) s'
    | T.null s = d
    | T.take 2 s == "//" = d
    | T.head s == '!' = (rules, insert exceptions $ labelList $ T.tail s)
    | otherwise = (insert rules $ labelList s, exceptions)
    where ss = filter (not . T.null) $ T.words s'
          s
            | null ss = ""
            | otherwise = head ss
          labelList = reverse . map internationalize . T.split (== '.')
          internationalize str
            | str == "*" = str
            | otherwise = case toASCII False True $ T.toLower str of
                            Just x -> x
                            Nothing -> throw PublicSuffixListException
  
  {-
  Generate the opaque 'DataStructure'
  -}
  sink :: MonadThrow m => C.Sink BS.ByteString m DataStructure
  sink = CT.decode CT.utf8 C.=$ CT.lines C.=$ CL.fold foldingFunction (def, def)
  
  