-- | This module contains the 'LdhStrLetDig' type a Parsec parser to
--   parse one.  This type isn't part of the RFC grammar, but it's
--   used implicitly. In RFC1035, Section 2.3.1, \"Preferred name
--   syntax\" <https://tools.ietf.org/html/rfc1035#section-2.3.1>:
--
--     <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
--
--   The stuff in square brackets can be thought of as an 'LdhStrLetDig'.
--
module Network.DNS.RBL.Domain.LdhStrLetDig (
  LdhStrLetDig,
  ldh_str_let_dig,
  ldh_str_let_dig_length )
where

import Text.Parsec.String ( Parser )

import Network.DNS.RBL.Domain.LdhStr ( LdhStr(..), ldh_str, ldh_str_length )
import Network.DNS.RBL.Domain.LetDig ( LetDig )
import Network.DNS.RBL.Domain.LetDigHyp ( LetDigHyp(..) )
import Network.DNS.RBL.Pretty ( Pretty(..) )
import Network.DNS.RBL.Reversible ( Reversible(..) )


-- | A type representing a Letter/Digit/Hyphen string followed by a
--   trailing Letter/Digit. This type isn't explicitly part of the
--   grammar, but it's what shows up in the square brackets of,
--
--     <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
--
--   The ldh-str is optional, but if one is present, we must also have
--   a trailing let-dig to prevent the name from ending with a
--   hyphen. This can be represented with a 'LdhStrLetDig',
--   which is why we're about to define it.
--
data LdhStrLetDig = LdhStrLetDig (Maybe LdhStr) LetDig
  deriving (Eq, Show)


-- | Pretty-printing for strings of letters/digits/hyphens (ending
--   with a letter or a digit) that we've already parsed.
--
--   ==== _Examples_
--
--   >>> import Text.Parsec ( parse )
--   >>> let (Right r) = parse ldh_str_let_dig "" "xy-z"
--   >>> pretty_print $ r
--   xy-z
--
instance Pretty LdhStrLetDig where
  pretty_show (LdhStrLetDig Nothing ld) = pretty_show ld
  pretty_show (LdhStrLetDig (Just s) ld) = (pretty_show s) ++ (pretty_show ld)



-- | Parse an 'LdhStrLetDig'. This isn't in the grammar, but we might
--   as well define the parser for it independently since we gave it
--   its own data type.
--
--   ==== _Examples_
--
--   >>> import Text.Parsec ( parse, parseTest )
--
--   Make sure we can parse a single character:
--
--   >>> parseTest ldh_str_let_dig "a"
--   LdhStrLetDig Nothing (LetDigLetter (Letter 'a'))
--
--   And longer strings:
--
--   >>> pretty_print $ parse ldh_str_let_dig "" "ab"
--   ab
--
--   >>> pretty_print $ parse ldh_str_let_dig "" "-b"
--   -b
--
--   >>> parseTest ldh_str_let_dig "b-"
--   parse error at (line 1, column 3):
--   label cannot end with a hyphen
--
ldh_str_let_dig :: Parser LdhStrLetDig
ldh_str_let_dig = do
  -- This will happily eat up the trailing let-dig...
  full_ldh <- ldh_str

  -- So we have to go back and see what happened.
  case (backwards full_ldh) of

    -- Fail on a single hyphen.
    (LdhStrSingleLdh (LetDigHypHyphen _)) ->
      fail "label cannot end with a hyphen"

    -- Fail for a hyphen followed by other stuff.
    (LdhStrMultipleLdh (LetDigHypHyphen _) _) ->
      fail "label cannot end with a hyphen"

    -- Simply return the thing if it's a single non-hyphen.
    (LdhStrSingleLdh (LetDigHypLetDig ld)) -> return $ LdhStrLetDig Nothing ld

    -- And peel off the last character for a non-hyphen followed by
    -- other stuff. We wind up reversing things twice, but whatever.
    (LdhStrMultipleLdh (LetDigHypLetDig ld) init_ldh_rev) ->
      let init_ldh = backwards init_ldh_rev
      in return $ LdhStrLetDig (Just init_ldh) ld



-- | Compute the length of a 'LdhStrLetDig'. It's at least one, since
--   the let-dig at the end is always there. And when there's an
--   ldh-str too, we add its length to one.
--
--   ==== _Examples_
--
--   >>> import Text.Parsec ( parse )
--
--   >>> let (Right r) = parse ldh_str_let_dig "" "a"
--   >>> ldh_str_let_dig_length r
--   1
--
--   >>> let (Right r) = parse ldh_str_let_dig "" "abc-def"
--   >>> ldh_str_let_dig_length r
--   7
--
ldh_str_let_dig_length :: LdhStrLetDig -> Int
ldh_str_let_dig_length (LdhStrLetDig Nothing _) = 1
ldh_str_let_dig_length (LdhStrLetDig (Just ldhstring) _) =
  1 + (ldh_str_length ldhstring)