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

diff --git a/harbl/src/Network/DNS/RBL/Domain/Hyphen.hs b/harbl/src/Network/DNS/RBL/Domain/Hyphen.hs
new file mode 100644
index 0000000..65793ff
--- /dev/null
+++ b/harbl/src/Network/DNS/RBL/Domain/Hyphen.hs
@@ -0,0 +1,117 @@
+-- | OK, I lied about "Network.DNS.RBL.Domain.Digit" and
+-- "Network.DNS.RBL.Domain.Letter" being the simplest modules you'd
+-- ever see. Because this is. It contains the 'Hyphen' type and a
+-- Parsec parser to parse one. We don't export its constructor because
+-- then you could do something dumb like stick a letter inside one.
+--
+module Network.DNS.RBL.Domain.Hyphen (
+  Hyphen,
+  hyphen )
+where
+
+import Text.Parsec ( char )
+import Text.Parsec.String ( Parser )
+
+import Network.DNS.RBL.Pretty ( Pretty(..) )
+
+
+
+-- | A wrapper around a single hyphen character.
+--
+--   ==== _Examples_
+--
+--   >>> Hyphen '-'
+--   Hyphen '-'
+--
+--   >>> let h1 = Hyphen '-'
+--   >>> let h2 = Hyphen '-'
+--   >>> h1 == h2
+--   True
+--
+newtype Hyphen = Hyphen Char
+
+
+-- | Equality is defined semantically (all hyphens are equal).
+--
+--   ==== _Examples_
+--
+--   >>> let h1 = Hyphen '-'
+--   >>> let h2 = Hyphen '-'
+--   >>> h1 == h2
+--   True
+--
+--   If you do something stupid, that's your fault:
+--
+--   >>> let h1 = Hyphen '-'
+--   >>> let h2 = Hyphen 'x'
+--   >>> h1 == h2
+--   True
+--
+instance Eq Hyphen where _ == _ = True
+
+
+-- | 'Show' is defined semantically; all hyphens display as \'-\'.
+--   The implementation is based on what GHC derives, discovered via
+--   @ghci -ddump-deriv@.
+--
+--   ==== _Examples_
+--
+--   >>> let h = Hyphen '-'
+--   >>> h
+--   Hyphen '-'
+--
+--   If you do something stupid, that's your fault:
+--
+--   >>> let h = Hyphen 'x'
+--   >>> h
+--   Hyphen '-'
+--
+instance Show Hyphen where
+  showsPrec d _ =
+    showParen (d > application_precedence) (showString "Hyphen '-'")
+    where
+      application_precedence = 10
+
+
+-- | 'Pretty' is defined semantically; all hyphens display as \'-\'.
+--
+--   ==== _Examples_
+--
+--   >>> let h = Hyphen '-'
+--   >>> pretty_print h
+--   -
+--
+--   If you do something stupid, that's your fault:
+--
+--   >>> let h = Hyphen 'x'
+--   >>> pretty_print h
+--   -
+--
+instance Pretty Hyphen where pretty_show _ = "-"
+
+
+-- | Parse a single hyphen and wrap it in our 'Hyphen' type.
+--
+--   ==== _Examples_
+--
+--   >>> import Text.Parsec ( parseTest )
+--
+--   Hyphens are parsed:
+--
+--   >>> parseTest hyphen "-"
+--   Hyphen '-'
+--
+--   But not letters or digits:
+--
+--   >>> parseTest hyphen "1"
+--   parse error at (line 1, column 1):
+--   unexpected "1"
+--   expecting "-"
+--
+--   >>> parseTest hyphen "x"
+--   parse error at (line 1, column 1):
+--   unexpected "x"
+--   expecting "-"
+--
+hyphen :: Parser Hyphen
+hyphen = fmap Hyphen (char '-')