harbl/src/Network/DNS/RBL/Domain/LdhStrLetDig.hs

   1 -- | This module contains the 'LdhStrLetDig' type a Parsec parser to
   2 --   parse one.  This type isn't part of the RFC grammar, but it's
   3 --   used implicitly. In RFC1035, Section 2.3.1, \"Preferred name
   4 --   syntax\" <https://tools.ietf.org/html/rfc1035#section-2.3.1>:
   5 --
   6 --     <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
   7 --
   8 --   The stuff in square brackets can be thought of as an 'LdhStrLetDig'.
   9 --
  10 module Network.DNS.RBL.Domain.LdhStrLetDig (
  11   LdhStrLetDig,
  12   ldh_str_let_dig,
  13   ldh_str_let_dig_length )
  14 where
  15
  16 import Text.Parsec.String ( Parser )
  17
  18 import Network.DNS.RBL.Domain.LdhStr ( LdhStr(..), ldh_str, ldh_str_length )
  19 import Network.DNS.RBL.Domain.LetDig ( LetDig )
  20 import Network.DNS.RBL.Domain.LetDigHyp ( LetDigHyp(..) )
  21 import Network.DNS.RBL.Pretty ( Pretty(..) )
  22 import Network.DNS.RBL.Reversible ( Reversible(..) )
  23
  24
  25 -- | A type representing a Letter/Digit/Hyphen string followed by a
  26 --   trailing Letter/Digit. This type isn't explicitly part of the
  27 --   grammar, but it's what shows up in the square brackets of,
  28 --
  29 --     <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
  30 --
  31 --   The ldh-str is optional, but if one is present, we must also have
  32 --   a trailing let-dig to prevent the name from ending with a
  33 --   hyphen. This can be represented with a 'LdhStrLetDig',
  34 --   which is why we're about to define it.
  35 --
  36 data LdhStrLetDig = LdhStrLetDig (Maybe LdhStr) LetDig
  37   deriving (Eq, Show)
  38
  39
  40 -- | Pretty-printing for strings of letters/digits/hyphens (ending
  41 --   with a letter or a digit) that we've already parsed.
  42 --
  43 --   ==== _Examples_
  44 --
  45 --   >>> import Text.Parsec ( parse )
  46 --   >>> let (Right r) = parse ldh_str_let_dig "" "xy-z"
  47 --   >>> pretty_print $ r
  48 --   xy-z
  49 --
  50 instance Pretty LdhStrLetDig where
  51   pretty_show (LdhStrLetDig Nothing ld) = pretty_show ld
  52   pretty_show (LdhStrLetDig (Just s) ld) = (pretty_show s) ++ (pretty_show ld)
  53
  54
  55
  56 -- | Parse an 'LdhStrLetDig'. This isn't in the grammar, but we might
  57 --   as well define the parser for it independently since we gave it
  58 --   its own data type.
  59 --
  60 --   ==== _Examples_
  61 --
  62 --   >>> import Text.Parsec ( parse, parseTest )
  63 --
  64 --   Make sure we can parse a single character:
  65 --
  66 --   >>> parseTest ldh_str_let_dig "a"
  67 --   LdhStrLetDig Nothing (LetDigLetter (Letter 'a'))
  68 --
  69 --   And longer strings:
  70 --
  71 --   >>> pretty_print $ parse ldh_str_let_dig "" "ab"
  72 --   ab
  73 --
  74 --   >>> pretty_print $ parse ldh_str_let_dig "" "-b"
  75 --   -b
  76 --
  77 --   >>> parseTest ldh_str_let_dig "b-"
  78 --   parse error at (line 1, column 3):
  79 --   label cannot end with a hyphen
  80 --
  81 ldh_str_let_dig :: Parser LdhStrLetDig
  82 ldh_str_let_dig = do
  83   -- This will happily eat up the trailing let-dig...
  84   full_ldh <- ldh_str
  85
  86   -- So we have to go back and see what happened.
  87   case (backwards full_ldh) of
  88
  89     -- Fail on a single hyphen.
  90     (LdhStrSingleLdh (LetDigHypHyphen _)) ->
  91       fail "label cannot end with a hyphen"
  92
  93     -- Fail for a hyphen followed by other stuff.
  94     (LdhStrMultipleLdh (LetDigHypHyphen _) _) ->
  95       fail "label cannot end with a hyphen"
  96
  97     -- Simply return the thing if it's a single non-hyphen.
  98     (LdhStrSingleLdh (LetDigHypLetDig ld)) -> return $ LdhStrLetDig Nothing ld
  99
 100     -- And peel off the last character for a non-hyphen followed by
 101     -- other stuff. We wind up reversing things twice, but whatever.
 102     (LdhStrMultipleLdh (LetDigHypLetDig ld) init_ldh_rev) ->
 103       let init_ldh = backwards init_ldh_rev
 104       in return $ LdhStrLetDig (Just init_ldh) ld
 105
 106
 107
 108 -- | Compute the length of a 'LdhStrLetDig'. It's at least one, since
 109 --   the let-dig at the end is always there. And when there's an
 110 --   ldh-str too, we add its length to one.
 111 --
 112 --   ==== _Examples_
 113 --
 114 --   >>> import Text.Parsec ( parse )
 115 --
 116 --   >>> let (Right r) = parse ldh_str_let_dig "" "a"
 117 --   >>> ldh_str_let_dig_length r
 118 --   1
 119 --
 120 --   >>> let (Right r) = parse ldh_str_let_dig "" "abc-def"
 121 --   >>> ldh_str_let_dig_length r
 122 --   7
 123 --
 124 ldh_str_let_dig_length :: LdhStrLetDig -> Int
 125 ldh_str_let_dig_length (LdhStrLetDig Nothing _) = 1
 126 ldh_str_let_dig_length (LdhStrLetDig (Just ldhstring) _) =
 127   1 + (ldh_str_length ldhstring)