StatusCode: modified again

[Lucu.git] / Network / HTTP / Lucu / StatusCode / Internal.hs

diff --git a/Network/HTTP/Lucu/StatusCode/Internal.hs b/Network/HTTP/Lucu/StatusCode/Internal.hs
index 21210375bbfa3ae5d34cd84fe759bf8c6ecbe7ad..e3122da1f55e21af4587abf5cf7d4175e8ccdd93 100644 (file)
--- a/Network/HTTP/Lucu/StatusCode/Internal.hs
+++ b/Network/HTTP/Lucu/StatusCode/Internal.hs
@@ -4,13 +4,14 @@
   , MultiParamTypeClasses
   , OverlappingInstances
   , TemplateHaskell
+  , UndecidableInstances
   , UnicodeSyntax
   , ViewPatterns
   #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Network.HTTP.Lucu.StatusCode.Internal
     ( StatusCode(..)
-    , SomeStatusCode(..)
+    , SomeStatusCode
     , (≈)
     , (≉)
     , statusCodes
@@ -32,10 +33,10 @@ import Language.Haskell.TH.Quote
 import Network.HTTP.Lucu.Parser
 import Prelude.Unicode
 
--- |The type class for HTTP status codes.
+-- |Type class for HTTP status codes.
 --
 -- Declaring types for each statuses is surely a pain. See:
--- 'statusCodes'
+-- 'statusCodes' quasi-quoter.
 --
 -- Minimal complete definition: 'numericCode' and 'textualStatus'.
 class Show sc ⇒ StatusCode sc where
@@ -48,16 +49,16 @@ class Show sc ⇒ StatusCode sc where
     fromStatusCode ∷ sc → SomeStatusCode
     fromStatusCode = SomeStatusCode
 
--- |Container type for 'StatusCode' type class.
+instance StatusCode sc ⇒ Eq sc where
+    (==) = (≈)
+
+-- |Container type for the 'StatusCode' type class.
 data SomeStatusCode
     = ∀sc. StatusCode sc ⇒ SomeStatusCode sc
 
 instance Show SomeStatusCode where
     show (SomeStatusCode sc) = show sc
 
-instance Eq SomeStatusCode where
-    (SomeStatusCode α) == (SomeStatusCode β) = α ≈ β
-
 infix 4 ≈, ≉
 -- |Equivalence of 'StatusCode's. Two 'StatusCode's @a@ and @b@ are
 -- said to be equivalent iff @'numericCode' a '==' 'numericCode' b@.
@@ -183,9 +184,9 @@ statusDecl (num, phrase)
       instanceDecl ∷ Q [Dec]
       instanceDecl
           = [d| instance StatusCode $typ where
-                  {-# INLINE numericCode #-}
+                  {-# INLINE CONLIKE numericCode #-}
                   numericCode _ = $(lift num)
-                  {-# INLINE textualStatus #-}
+                  {-# INLINE CONLIKE textualStatus #-}
                   textualStatus _ = $txt
               |]