Begin moving the name parsers to the Network.DNS.RBL.Domain namespace.

[dead/harbl.git] / harbl / src / Network / DNS / RBL / Domain / LetDigHyp.hs

diff --git a/harbl/src/Network/DNS/RBL/Domain/LetDigHyp.hs b/harbl/src/Network/DNS/RBL/Domain/LetDigHyp.hs
new file mode 100644 (file)
index 0000000..06e420a
--- /dev/null
+++ b/harbl/src/Network/DNS/RBL/Domain/LetDigHyp.hs
@@ -0,0 +1,110 @@
+-- | This module contains the 'LetDigHyp' type and a Parsec parser to
+--   parse one. We don't export its constructor because then you could
+--   do something dumb like stick a semicolon inside one.
+--
+--   These are defined in RFC1035, Section 2.3.1, \"Preferred name
+--   syntax\" <https://tools.ietf.org/html/rfc1035#section-2.3.1>:
+--
+--     <let-dig-hyp> ::= <let-dig> | "-"
+--
+--   We export the constructors of 'LetDigHyp' so that we can pattern
+--   match against them when checking to see if a label ends with a
+--   hyphen.
+--
+module Network.DNS.RBL.Domain.LetDigHyp (
+  LetDigHyp(..),
+  let_dig_hyp )
+where
+
+import Text.Parsec ( (<|>) )
+import Text.Parsec.String ( Parser )
+
+import Network.DNS.RBL.Domain.Hyphen ( Hyphen, hyphen )
+import Network.DNS.RBL.Domain.LetDig ( LetDig, let_dig )
+import Network.DNS.RBL.Pretty ( Pretty(..) )
+
+
+-- | A sum type representing a letter, digit, or hyphen.
+--
+--   ==== _Examples_
+--
+--   >>> import Text.Parsec ( parse )
+--
+--   We can create a 'LetDigHyp' from any appropriate value:
+--
+--   >>> let (Right r) = parse let_dig "" "1"
+--   >>> LetDigHypLetDig r
+--   LetDigHypLetDig (LetDigDigit (Digit '1'))
+--
+--   >>> let (Right r) = parse let_dig "" "x"
+--   >>> LetDigHypLetDig r
+--   LetDigHypLetDig (LetDigLetter (Letter 'x'))
+--
+--   >>> let (Right r) = parse hyphen "" "-"
+--   >>> LetDigHypHyphen r
+--   LetDigHypHyphen (Hyphen '-')
+--
+data LetDigHyp =
+  LetDigHypLetDig LetDig |
+  LetDigHypHyphen Hyphen
+  deriving (Eq, Show)
+
+
+-- | Pretty-printing for letters, digits, or hyphens that we've
+--   already parsed. Just shows/prints the underlying character.
+--
+--   ==== _Examples_
+--
+--   >>> import Text.Parsec ( parse )
+--
+--   >>> let (Right r) = parse let_dig "" "1"
+--   >>> pretty_print $ LetDigHypLetDig r
+--   1
+--
+--   >>> let (Right r) = parse let_dig "" "x"
+--   >>> pretty_print $ LetDigHypLetDig r
+--   x
+--
+--   >>> let (Right r) = parse hyphen "" "-"
+--   >>> pretty_print $ LetDigHypHyphen r
+--   -
+--
+instance Pretty LetDigHyp where
+  pretty_show (LetDigHypLetDig ld) = pretty_show ld
+  pretty_show (LetDigHypHyphen h) = pretty_show h
+
+
+-- | A parser that will parse either a 'LetDig', or a 'Hyphen'. The
+--   result is packed in a 'LetDigHyp'.
+--
+--   ==== _Examples_
+--
+--   >>> import Text.Parsec ( parseTest )
+--
+--   Letters, digits, and hyphens are all parsed:
+--
+--   >>> parseTest let_dig_hyp "a"
+--   LetDigHypLetDig (LetDigLetter (Letter 'a'))
+--
+--   >>> parseTest let_dig_hyp "7"
+--   LetDigHypLetDig (LetDigDigit (Digit '7'))
+--
+--   >>> parseTest let_dig_hyp "-"
+--   LetDigHypHyphen (Hyphen '-')
+--
+--   However, an underscore (for example) is not:
+--
+--   >>> parseTest let_dig_hyp "_"
+--   parse error at (line 1, column 1):
+--   unexpected "_"
+--   expecting letter, digit or "-"
+--
+let_dig_hyp :: Parser LetDigHyp
+let_dig_hyp =
+  parse_letdig <|> parse_hyphen
+  where
+    parse_letdig :: Parser LetDigHyp
+    parse_letdig = fmap LetDigHypLetDig let_dig
+
+    parse_hyphen :: Parser LetDigHyp
+    parse_hyphen = fmap LetDigHypHyphen hyphen