X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fharbl.git;a=blobdiff_plain;f=harbl%2Fsrc%2FNetwork%2FDNS%2FRBL%2FDomain%2FLetter.hs;fp=harbl%2Fsrc%2FNetwork%2FDNS%2FRBL%2FDomain%2FLetter.hs;h=bd26786066599a7c291bd5675492a95147873339;hp=0000000000000000000000000000000000000000;hb=4dd314687c806419fac1fc88c96df6541e1dff4b;hpb=7decace098b98d7f19b7af43e9d0c641f445640f

diff --git a/harbl/src/Network/DNS/RBL/Domain/Letter.hs b/harbl/src/Network/DNS/RBL/Domain/Letter.hs
new file mode 100644
index 0000000..bd26786
--- /dev/null
+++ b/harbl/src/Network/DNS/RBL/Domain/Letter.hs
@@ -0,0 +1,104 @@
+-- | The... also... the simplest module you'll ever see. It contains
+--   the 'Letter' type and a Parsec parser to parse one. We don't
+--   export its constructor because then you could do something dumb
+--   like stick a digit inside one.
+--
+--   These are defined in RFC1035, Section 2.3.1, \"Preferred name
+--   syntax\" <https://tools.ietf.org/html/rfc1035#section-2.3.1>:
+--
+--     <letter> ::= any one of the 52 alphabetic characters A through
+--     Z in upper case and a through z in lower case
+--
+module Network.DNS.RBL.Domain.Letter (
+  Letter,
+  letter )
+where
+
+import Data.Char ( toLower )
+import qualified Text.Parsec as Parsec ( letter )
+import Text.Parsec.String ( Parser )
+
+import Network.DNS.RBL.Pretty ( Pretty(..) )
+
+-- * Letters
+
+-- | A wrapper around a letter character.
+--
+--   ==== _Examples_
+--
+--   >>> Letter 'x'
+--   Letter 'x'
+--
+newtype Letter = Letter Char deriving (Show)
+
+
+-- | Pretty-printing for letters that we've already parsed. Just
+--   shows/prints the letter character.
+--
+--   ==== _Examples_
+--
+--   >>> let l = Letter 'x'
+--   >>> pretty_print l
+--   x
+--
+instance Pretty Letter where pretty_show (Letter l) = [l]
+
+
+-- | Parse a single letter, but wrap it in our 'Letter' type.
+--
+--   ==== _Examples_
+--
+--   >>> import Text.Parsec ( parseTest )
+--
+--   Letters are parsed correctly:
+--
+--   >>> parseTest letter "x"
+--   Letter 'x'
+--
+--   But digits are not:
+--
+--   >>> parseTest letter "1"
+--   parse error at (line 1, column 1):
+--   unexpected "1"
+--   expecting letter
+--
+letter :: Parser Letter
+letter = fmap Letter Parsec.letter
+
+
+
+-- | The derived instance of 'Eq' for letters is incorrect. All
+--   comparisons should be made case-insensitively. The following
+--   is an excerpt from RFC1035:
+--
+--     2.3.3. Character Case
+--
+--     For all parts of the DNS that are part of the official
+--     protocol, all comparisons between character strings (e.g.,
+--     labels, domain names, etc.)  are done in a case-insensitive
+--     manner...
+--
+--   Since each part of DNS name is composed of our custom types, it
+--   suffices to munge the equality for 'Letter'. RFC4343
+--   <https://tools.ietf.org/html/rfc4343> clarifies the
+--   case-insensitivity rules, but the fact that we're treating DNS
+--   names as strings makes most of those problems go away (in
+--   exchange for new ones).
+--
+--   ==== _Examples_
+--
+--   >>> let l1 = Letter 'x'
+--   >>> let l2 = Letter 'x'
+--   >>> let l3 = Letter 'X'
+--   >>> let l4 = Letter 'X'
+--   >>> l1 == l2
+--   True
+--   >>> l1 == l3
+--   True
+--   >>> l1 == l4
+--   True
+--   >>> l3 == l4
+--   True
+--
+instance Eq Letter where
+  (Letter l1) == (Letter l2) = (toLower l1) == (toLower l2)