{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Regfish.Parser ( readZoneIO ) where import qualified Data.List as L import qualified Data.ByteString.Lazy.Char8 as LBS8 import Regfish.Types import Text.HandsomeSoup import Text.XML.HXT.Core normalizeId :: String -> String normalizeId = \case 'a':'_':xs -> xs 'r':'r':'_':xs -> drop 1 . dropWhile (/='_') $ xs xs -> xs normalizeRR :: IOSLA (XIOState ()) XmlTree XmlTree normalizeRR = processAttrl (changeAttrValue normalizeId `when` hasName "id") <<< (filterA $ neg $ hasAttr "nowrap") <<< (removeAttr "style") readZoneIO :: LBS8.ByteString -> IO [RR] readZoneIO b = concat <$> mapM (flip readRRs $ LBS8.unpack b) [ "NS" , "MX" , "A" , "AAAA" , "ALIAS" , "CNAME" , "TXT" , "SRV" ] readRRs :: String -> String -> IO [RR] readRRs rrtype s = do let --body = LBS8.unpack b -- $ r ^. W.responseBody doc = parseHtml s t = processTopDown normalizeRR <<< removeAllWhiteSpace' <<< css ("." ++ rrtype) <<< doc -- t also contains