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

   1 -- | This module contains the 'LetDigHyp' type and a Parsec parser to
   2 --   parse one. We don't export its constructor because then you could
   3 --   do something dumb like stick a semicolon inside one.
   4 --
   5 --   These are defined in RFC1035, Section 2.3.1, \"Preferred name
   6 --   syntax\" <https://tools.ietf.org/html/rfc1035#section-2.3.1>:
   7 --
   8 --     <let-dig-hyp> ::= <let-dig> | "-"
   9 --
  10 --   We export the constructors of 'LetDigHyp' so that we can pattern
  11 --   match against them when checking to see if a label ends with a
  12 --   hyphen.
  13 --
  14 module Network.DNS.RBL.Domain.LetDigHyp (
  15   LetDigHyp(..),
  16   let_dig_hyp )
  17 where
  18
  19 import Text.Parsec ( (<|>) )
  20 import Text.Parsec.String ( Parser )
  21
  22 import Network.DNS.RBL.Domain.Hyphen ( Hyphen, hyphen )
  23 import Network.DNS.RBL.Domain.LetDig ( LetDig, let_dig )
  24 import Network.DNS.RBL.Pretty ( Pretty(..) )
  25
  26
  27 -- | A sum type representing a letter, digit, or hyphen.
  28 --
  29 --   ==== _Examples_
  30 --
  31 --   >>> import Text.Parsec ( parse )
  32 --
  33 --   We can create a 'LetDigHyp' from any appropriate value:
  34 --
  35 --   >>> let (Right r) = parse let_dig "" "1"
  36 --   >>> LetDigHypLetDig r
  37 --   LetDigHypLetDig (LetDigDigit (Digit '1'))
  38 --
  39 --   >>> let (Right r) = parse let_dig "" "x"
  40 --   >>> LetDigHypLetDig r
  41 --   LetDigHypLetDig (LetDigLetter (Letter 'x'))
  42 --
  43 --   >>> let (Right r) = parse hyphen "" "-"
  44 --   >>> LetDigHypHyphen r
  45 --   LetDigHypHyphen Hyphen
  46 --
  47 data LetDigHyp =
  48   LetDigHypLetDig LetDig |
  49   LetDigHypHyphen Hyphen
  50   deriving (Eq, Show)
  51
  52
  53 -- | Pretty-printing for letters, digits, or hyphens that we've
  54 --   already parsed. Just shows/prints the underlying character.
  55 --
  56 --   ==== _Examples_
  57 --
  58 --   >>> import Text.Parsec ( parse )
  59 --
  60 --   >>> let (Right r) = parse let_dig "" "1"
  61 --   >>> pretty_print $ LetDigHypLetDig r
  62 --   1
  63 --
  64 --   >>> let (Right r) = parse let_dig "" "x"
  65 --   >>> pretty_print $ LetDigHypLetDig r
  66 --   x
  67 --
  68 --   >>> let (Right r) = parse hyphen "" "-"
  69 --   >>> pretty_print $ LetDigHypHyphen r
  70 --   -
  71 --
  72 instance Pretty LetDigHyp where
  73   pretty_show (LetDigHypLetDig ld) = pretty_show ld
  74   pretty_show (LetDigHypHyphen h) = pretty_show h
  75
  76
  77 -- | A parser that will parse either a 'LetDig', or a 'Hyphen'. The
  78 --   result is packed in a 'LetDigHyp'.
  79 --
  80 --   ==== _Examples_
  81 --
  82 --   >>> import Text.Parsec ( parseTest )
  83 --
  84 --   Letters, digits, and hyphens are all parsed:
  85 --
  86 --   >>> parseTest let_dig_hyp "a"
  87 --   LetDigHypLetDig (LetDigLetter (Letter 'a'))
  88 --
  89 --   >>> parseTest let_dig_hyp "7"
  90 --   LetDigHypLetDig (LetDigDigit (Digit '7'))
  91 --
  92 --   >>> parseTest let_dig_hyp "-"
  93 --   LetDigHypHyphen Hyphen
  94 --
  95 --   However, an underscore (for example) is not:
  96 --
  97 --   >>> parseTest let_dig_hyp "_"
  98 --   parse error at (line 1, column 1):
  99 --   unexpected "_"
 100 --   expecting letter, digit or "-"
 101 --
 102 let_dig_hyp :: Parser LetDigHyp
 103 let_dig_hyp =
 104   parse_letdig <|> parse_hyphen
 105   where
 106     parse_letdig :: Parser LetDigHyp
 107     parse_letdig = fmap LetDigHypLetDig let_dig
 108
 109     parse_hyphen :: Parser LetDigHyp
 110     parse_hyphen = fmap LetDigHypHyphen hyphen