{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}


module Regfish.Parser
    ( readZone
    ) where

import qualified Data.ByteString.Lazy.Char8 as LBS8
import Regfish.Types
import Text.HTML.TagSoup


readZone :: LBS8.ByteString -> [Record]
readZone = parseRecords . dnszone


parseRecords :: [Tag LBS8.ByteString] -> [Record]
parseRecords =
    map toRecord . filter knownRecord . rec []
  where
    knownRecord (_ : _ : _ : namespace : type_ : _) =
        namespace == "IN" && type_ `elem` ["MX", "A", "CNAME"]

    knownRecord x =
        errorBadArgument "parseRecords.knownRecord" x

    rec ys = \case
        (TagOpen "tr" attrs:xs) ->
            case getRecordId attrs of
                Just id_ ->
                    let (r,_:xs') = span (/=TagClose "tr") xs
                    in rec (parseRecord id_ r:ys) xs'
                _ ->
                    let xs' = drop 1 $ dropWhile (/=TagClose "tr") xs
                    in rec ys xs'

        [] -> ys

        x -> errorBadArgument "parseRecords.rec" x

    getRecordId attrs =
        case maybe Nothing (Just . LBS8.unpack) $ lookup "id" attrs of
            Just ('a':'_':xs) -> Just (LBS8.pack xs)
            _ -> Nothing



toRecord :: [LBS8.ByteString] -> Record
toRecord xs = case map LBS8.unpack xs of
    [rrid, rrname, rrttl, "IN", rrtype, rraux, rrdata] ->
        Record rrid rrtype rrname (read rrttl) (read rraux) rrdata
    [rrid, rrname, rrttl, "IN", rrtype, rrdata] ->
        Record rrid rrtype rrname (read rrttl) 0 rrdata
    x ->
        errorBadArgument "toRecord" x


dnszone :: LBS8.ByteString -> [Tag LBS8.ByteString]
dnszone =
    filter p . (dnszoneSoup . parseTags)
  where
    p = \case
        TagOpen "tr" _ -> True
        TagClose "tr" -> True
        TagText x
          | x /= "\n" -> True
          | otherwise -> False
        _ -> False


parseRecord :: LBS8.ByteString -> [Tag LBS8.ByteString] -> [LBS8.ByteString]
parseRecord id_ =
    (id_:) . add_def_ttl "0" . filter p . map f
  where
    f (TagText x) = x
    f x = errorBadArgument "parseRecord" x
    p x
        | x == "\160" = False
        | x == " "    = False
        | otherwise   = True

    add_def_ttl def_ttl (x:"IN":xs) = x : def_ttl : "IN" : xs
    add_def_ttl _ xs = xs


dnszoneSoup :: [Tag LBS8.ByteString] -> [Tag LBS8.ByteString]
dnszoneSoup =
    takeWhile (\t -> not $ t ~== dnszoneClose) .
    dropWhile (\t -> not $ t ~== dnszoneOpen)


dnszoneOpen, dnszoneClose :: Tag LBS8.ByteString
dnszoneOpen  = TagOpen "table" [("id", "dnszone")]
dnszoneClose = TagClose "table"


errorBadArgument :: Show a => String -> a -> b
errorBadArgument name x =
    error $ "Regfish.Parser." ++ name ++ ": bad argument: " ++ show x