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

   1 -- | The second-simplest module you'll ever see. It contains the
   2 --   'LetDig' type and a Parsec parser to parse one. We don't export
   3 --   its constructor because then you could do something dumb like
   4 --   stick a hyphen inside one.
   5 --
   6 --   These are defined in RFC1035, Section 2.3.1, \"Preferred name
   7 --   syntax\" <https://tools.ietf.org/html/rfc1035#section-2.3.1>:
   8 --
   9 --     <let-dig> ::= <letter> | <digit>
  10 --
  11 module Network.DNS.RBL.Domain.LetDig (
  12   LetDig,
  13   let_dig )
  14 where
  15
  16 import Text.Parsec ( (<|>) )
  17 import Text.Parsec.String ( Parser )
  18
  19 import Network.DNS.RBL.Domain.Digit ( Digit, digit )
  20 import Network.DNS.RBL.Domain.Letter ( Letter, letter )
  21 import Network.DNS.RBL.Pretty ( Pretty(..) )
  22
  23
  24 -- | A sum type representing either a letter or a digit.
  25 --
  26 --   ==== _Examples_
  27 --
  28 --   >>> import Text.Parsec ( parse )
  29 --
  30 --   >>> let (Right r) = parse letter "" "x"
  31 --   >>> LetDigLetter r
  32 --   LetDigLetter (Letter 'x')
  33 --
  34 --   >>> let (Right r) = parse digit "" "1"
  35 --   >>> LetDigDigit r
  36 --   LetDigDigit (Digit '1')
  37 --
  38 --   Case-insensitive equality is derived from that of 'Letter':
  39 --
  40 --   >>> let (Right r1) = parse letter "" "x"
  41 --   >>> let (Right r2) = parse letter "" "X"
  42 --   >>> LetDigLetter r1 == LetDigLetter r2
  43 --   True
  44 --
  45 data LetDig =
  46   LetDigLetter Letter |
  47   LetDigDigit  Digit
  48   deriving (Eq, Show)
  49
  50
  51 -- | Pretty-printing for letters that we've already parsed. Just
  52 --   shows/prints the letter or digit character.
  53 --
  54 --   ==== _Examples_
  55 --
  56 --   >>> import Text.Parsec ( parse )
  57 --
  58 --   >>> let (Right r) = parse letter "" "x"
  59 --   >>> pretty_print $ LetDigLetter r
  60 --   x
  61 --
  62 --   >>> let (Right r) = parse digit "" "1"
  63 --   >>> pretty_print $ LetDigDigit r
  64 --   1
  65 --
  66 instance Pretty LetDig where
  67   pretty_show (LetDigLetter l) = pretty_show l
  68   pretty_show (LetDigDigit d) = pretty_show d
  69
  70
  71 -- | Parse a letter or a digit and wrap it in our 'LetDig' type.
  72 --
  73 --   ==== _Examples_
  74 --
  75 --   >>> import Text.Parsec ( parseTest )
  76 --
  77 --   Letters are parsed correctly:
  78 --
  79 --   >>> parseTest let_dig "x"
  80 --   LetDigLetter (Letter 'x')
  81 --
  82 --   Digits are too:
  83 --
  84 --   >>> parseTest let_dig "1"
  85 --   LetDigDigit (Digit '1')
  86 --
  87 --   But not, for example, hyphens:
  88 --
  89 --   >>> parseTest let_dig "-"
  90 --   parse error at (line 1, column 1):
  91 --   unexpected "-"
  92 --   expecting letter or digit
  93 --
  94 let_dig :: Parser LetDig
  95 let_dig = (fmap LetDigLetter letter) <|> (fmap LetDigDigit digit)