, MultiParamTypeClasses
, OverlappingInstances
, TemplateHaskell
+ , UndecidableInstances
, UnicodeSyntax
, ViewPatterns
#-}
-- 'statusCodes' quasi-quoter.
--
-- Minimal complete definition: 'numericCode' and 'textualStatus'.
-class (Eq sc, Show sc) ⇒ StatusCode sc where
+class Show sc ⇒ StatusCode sc where
-- |Return the 3-digit integer for this status e.g. @200@
numericCode ∷ sc → Int
-- |Return the combination of 3-digit integer and reason phrase
fromStatusCode ∷ sc → SomeStatusCode
fromStatusCode = SomeStatusCode
+instance StatusCode sc ⇒ Eq sc where
+ (==) = (≈)
+
-- |Container type for the 'StatusCode' type class.
data SomeStatusCode
= ∀sc. StatusCode sc ⇒ SomeStatusCode sc
-instance Eq SomeStatusCode where
- (==) = (≈)
-
instance Show SomeStatusCode where
show (SomeStatusCode sc) = show sc
-- becomes:
--
-- @
--- data OK = OK deriving ('Eq', 'Show')
+-- data OK = OK deriving ('Show')
-- instance OK where
-- 'numericCode' _ = 200
-- 'textualStatus' _ = 'cs' (\"200 OK\" ∷ Ascii)
--
--- data BadRequest = BadRequest deriving ('Eq', 'Show')
+-- data BadRequest = BadRequest deriving ('Show')
-- instance BadRequest where
-- 'numericCode' _ = 400
-- 'textualStatus' _ = 'cs' (\"400 Bad Request\" ∷ Ascii)
--
--- data MethodNotAllowed = MethodNotAllowed deriving ('Eq', 'Show')
+-- data MethodNotAllowed = MethodNotAllowed deriving ('Show')
-- instance MethodNotAllowed where
-- 'numericCode' _ = 405
-- 'textualStatus' _ = 'cs' (\"405 Method Not Allowed\" ∷ Ascii)
name = mkName $ concatMap cs phrase
dataDecl ∷ Q Dec
- dataDecl = dataD (cxt []) name [] [con] [''Eq, ''Show]
+ dataDecl = dataD (cxt []) name [] [con] [''Show]
instanceDecl ∷ Q [Dec]
instanceDecl