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

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

diff --git a/harbl/src/Network/DNS/RBL/Domain/LetDig.hs b/harbl/src/Network/DNS/RBL/Domain/LetDig.hs
new file mode 100644 (file)
index 0000000..6ffcde5
--- /dev/null
+++ b/harbl/src/Network/DNS/RBL/Domain/LetDig.hs
@@ -0,0 +1,95 @@
+-- | The second-simplest module you'll ever see. It contains the
+--   'LetDig' type and a Parsec parser to parse one. We don't export
+--   its constructor because then you could do something dumb like
+--   stick a hyphen 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> ::= <letter> | <digit>
+--
+module Network.DNS.RBL.Domain.LetDig (
+  LetDig,
+  let_dig )
+where
+
+import Text.Parsec ( (<|>) )
+import Text.Parsec.String ( Parser )
+
+import Network.DNS.RBL.Domain.Digit ( Digit, digit )
+import Network.DNS.RBL.Domain.Letter ( Letter, letter )
+import Network.DNS.RBL.Pretty ( Pretty(..) )
+
+
+-- | A sum type representing either a letter or a digit.
+--
+--   ==== _Examples_
+--
+--   >>> import Text.Parsec ( parse )
+--
+--   >>> let (Right r) = parse letter "" "x"
+--   >>> LetDigLetter r
+--   LetDigLetter (Letter 'x')
+--
+--   >>> let (Right r) = parse digit "" "1"
+--   >>> LetDigDigit r
+--   LetDigDigit (Digit '1')
+--
+--   Case-insensitive equality is derived from that of 'Letter':
+--
+--   >>> let (Right r1) = parse letter "" "x"
+--   >>> let (Right r2) = parse letter "" "X"
+--   >>> LetDigLetter r1 == LetDigLetter r2
+--   True
+--
+data LetDig =
+  LetDigLetter Letter |
+  LetDigDigit  Digit
+  deriving (Eq, Show)
+
+
+-- | Pretty-printing for letters that we've already parsed. Just
+--   shows/prints the letter or digit character.
+--
+--   ==== _Examples_
+--
+--   >>> import Text.Parsec ( parse )
+--
+--   >>> let (Right r) = parse letter "" "x"
+--   >>> pretty_print $ LetDigLetter r
+--   x
+--
+--   >>> let (Right r) = parse digit "" "1"
+--   >>> pretty_print $ LetDigDigit r
+--   1
+--
+instance Pretty LetDig where
+  pretty_show (LetDigLetter l) = pretty_show l
+  pretty_show (LetDigDigit d) = pretty_show d
+
+
+-- | Parse a letter or a digit and wrap it in our 'LetDig' type.
+--
+--   ==== _Examples_
+--
+--   >>> import Text.Parsec ( parseTest )
+--
+--   Letters are parsed correctly:
+--
+--   >>> parseTest let_dig "x"
+--   LetDigLetter (Letter 'x')
+--
+--   Digits are too:
+--
+--   >>> parseTest let_dig "1"
+--   LetDigDigit (Digit '1')
+--
+--   But not, for example, hyphens:
+--
+--   >>> parseTest let_dig "-"
+--   parse error at (line 1, column 1):
+--   unexpected "-"
+--   expecting letter or digit
+--
+let_dig :: Parser LetDig
+let_dig = (fmap LetDigLetter letter) <|> (fmap LetDigDigit digit)