06e420a3a0c94d615f7926084029967b0f5d6858
[dead/harbl.git] / 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