Finish moving all of the DNS name components under Network.DNS.RBL.Domain.
[dead/harbl.git] / harbl / src / Network / DNS / RBL / Domain / LdhStrLetDig.hs
1 -- | This module contains the 'LdhStrLetDig' type a Parsec parser to
2 -- parse one. This type isn't part of the RFC grammar, but it's
3 -- used implicitly. In RFC1035, Section 2.3.1, \"Preferred name
4 -- syntax\" <https://tools.ietf.org/html/rfc1035#section-2.3.1>:
5 --
6 -- <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
7 --
8 -- The stuff in square brackets can be thought of as an 'LdhStrLetDig'.
9 --
10 module Network.DNS.RBL.Domain.LdhStrLetDig (
11 LdhStrLetDig,
12 ldh_str_let_dig,
13 ldh_str_let_dig_length )
14 where
15
16 import Text.Parsec.String ( Parser )
17
18 import Network.DNS.RBL.Domain.LdhStr ( LdhStr(..), ldh_str, ldh_str_length )
19 import Network.DNS.RBL.Domain.LetDig ( LetDig )
20 import Network.DNS.RBL.Domain.LetDigHyp ( LetDigHyp(..) )
21 import Network.DNS.RBL.Pretty ( Pretty(..) )
22 import Network.DNS.RBL.Reversible ( Reversible(..) )
23
24
25 -- | A type representing a Letter/Digit/Hyphen string followed by a
26 -- trailing Letter/Digit. This type isn't explicitly part of the
27 -- grammar, but it's what shows up in the square brackets of,
28 --
29 -- <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
30 --
31 -- The ldh-str is optional, but if one is present, we must also have
32 -- a trailing let-dig to prevent the name from ending with a
33 -- hyphen. This can be represented with a 'LdhStrLetDig',
34 -- which is why we're about to define it.
35 --
36 data LdhStrLetDig = LdhStrLetDig (Maybe LdhStr) LetDig
37 deriving (Eq, Show)
38
39
40 -- | Pretty-printing for strings of letters/digits/hyphens (ending
41 -- with a letter or a digit) that we've already parsed.
42 --
43 -- ==== _Examples_
44 --
45 -- >>> import Text.Parsec ( parse )
46 -- >>> let (Right r) = parse ldh_str_let_dig "" "xy-z"
47 -- >>> pretty_print $ r
48 -- xy-z
49 --
50 instance Pretty LdhStrLetDig where
51 pretty_show (LdhStrLetDig Nothing ld) = pretty_show ld
52 pretty_show (LdhStrLetDig (Just s) ld) = (pretty_show s) ++ (pretty_show ld)
53
54
55
56 -- | Parse an 'LdhStrLetDig'. This isn't in the grammar, but we might
57 -- as well define the parser for it independently since we gave it
58 -- its own data type.
59 --
60 -- ==== _Examples_
61 --
62 -- >>> import Text.Parsec ( parse, parseTest )
63 --
64 -- Make sure we can parse a single character:
65 --
66 -- >>> parseTest ldh_str_let_dig "a"
67 -- LdhStrLetDig Nothing (LetDigLetter (Letter 'a'))
68 --
69 -- And longer strings:
70 --
71 -- >>> pretty_print $ parse ldh_str_let_dig "" "ab"
72 -- ab
73 --
74 -- >>> pretty_print $ parse ldh_str_let_dig "" "-b"
75 -- -b
76 --
77 -- >>> parseTest ldh_str_let_dig "b-"
78 -- parse error at (line 1, column 3):
79 -- label cannot end with a hyphen
80 --
81 ldh_str_let_dig :: Parser LdhStrLetDig
82 ldh_str_let_dig = do
83 -- This will happily eat up the trailing let-dig...
84 full_ldh <- ldh_str
85
86 -- So we have to go back and see what happened.
87 case (backwards full_ldh) of
88
89 -- Fail on a single hyphen.
90 (LdhStrSingleLdh (LetDigHypHyphen _)) ->
91 fail "label cannot end with a hyphen"
92
93 -- Fail for a hyphen followed by other stuff.
94 (LdhStrMultipleLdh (LetDigHypHyphen _) _) ->
95 fail "label cannot end with a hyphen"
96
97 -- Simply return the thing if it's a single non-hyphen.
98 (LdhStrSingleLdh (LetDigHypLetDig ld)) -> return $ LdhStrLetDig Nothing ld
99
100 -- And peel off the last character for a non-hyphen followed by
101 -- other stuff. We wind up reversing things twice, but whatever.
102 (LdhStrMultipleLdh (LetDigHypLetDig ld) init_ldh_rev) ->
103 let init_ldh = backwards init_ldh_rev
104 in return $ LdhStrLetDig (Just init_ldh) ld
105
106
107
108 -- | Compute the length of a 'LdhStrLetDig'. It's at least one, since
109 -- the let-dig at the end is always there. And when there's an
110 -- ldh-str too, we add its length to one.
111 --
112 -- ==== _Examples_
113 --
114 -- >>> import Text.Parsec ( parse )
115 --
116 -- >>> let (Right r) = parse ldh_str_let_dig "" "a"
117 -- >>> ldh_str_let_dig_length r
118 -- 1
119 --
120 -- >>> let (Right r) = parse ldh_str_let_dig "" "abc-def"
121 -- >>> ldh_str_let_dig_length r
122 -- 7
123 --
124 ldh_str_let_dig_length :: LdhStrLetDig -> Int
125 ldh_str_let_dig_length (LdhStrLetDig Nothing _) = 1
126 ldh_str_let_dig_length (LdhStrLetDig (Just ldhstring) _) =
127 1 + (ldh_str_length ldhstring)