X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fharbl.git;a=blobdiff_plain;f=harbl%2Fsrc%2FNetwork%2FDNS%2FRBL%2FDomain%2FLdhStrLetDig.hs;fp=harbl%2Fsrc%2FNetwork%2FDNS%2FRBL%2FDomain%2FLdhStrLetDig.hs;h=50c8b97e70b9ad72892d2120dd6a62f377f4bcae;hp=0000000000000000000000000000000000000000;hb=5c8702f0be60474482c587ba353e01ddf24f79cc;hpb=014dacb6ef0e93d0e67ebb154c397e999431469f

diff --git a/harbl/src/Network/DNS/RBL/Domain/LdhStrLetDig.hs b/harbl/src/Network/DNS/RBL/Domain/LdhStrLetDig.hs
new file mode 100644
index 0000000..50c8b97
--- /dev/null
+++ b/harbl/src/Network/DNS/RBL/Domain/LdhStrLetDig.hs
@@ -0,0 +1,127 @@
+-- | 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)