Slightly changed the definition of StatusCode.

diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs
index 8f45440a603411875b05a8d35a760734660941f9..1ff9ae71c51904dd87f427921527dd35d92fe014 100644 (file)
--- a/Network/HTTP/Lucu/Response.hs
+++ b/Network/HTTP/Lucu/Response.hs
@@ -11,7 +11,7 @@
 module Network.HTTP.Lucu.Response
     ( -- * Class and Types
       StatusCode(..)
 module Network.HTTP.Lucu.Response
     ( -- * Class and Types
       StatusCode(..)

-    , SomeStatusCode(..)
+    , SomeStatusCode

     , Response(..)
     , statusCodes
     , module Network.HTTP.Lucu.StatusCode
     , Response(..)
     , statusCodes
     , module Network.HTTP.Lucu.StatusCode

diff --git a/Network/HTTP/Lucu/StatusCode/Internal.hs b/Network/HTTP/Lucu/StatusCode/Internal.hs
index 21210375bbfa3ae5d34cd84fe759bf8c6ecbe7ad..38188568de8646037ee84465cce740e2df68b8d3 100644 (file)
--- a/Network/HTTP/Lucu/StatusCode/Internal.hs
+++ b/Network/HTTP/Lucu/StatusCode/Internal.hs
@@ -10,7 +10,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Network.HTTP.Lucu.StatusCode.Internal
     ( StatusCode(..)
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Network.HTTP.Lucu.StatusCode.Internal
     ( StatusCode(..)

-    , SomeStatusCode(..)
+    , SomeStatusCode

     , (≈)
     , (≉)
     , statusCodes
     , (≈)
     , (≉)
     , statusCodes


@@ -32,13 +32,13 @@ import Language.Haskell.TH.Quote
 import Network.HTTP.Lucu.Parser
 import Prelude.Unicode
 
 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:
 --
 -- Declaring types for each statuses is surely a pain. See:

--- 'statusCodes'
+-- 'statusCodes' quasi-quoter.

 --
 -- Minimal complete definition: 'numericCode' and 'textualStatus'.
 --
 -- Minimal complete definition: 'numericCode' and 'textualStatus'.

-class Show sc ⇒ StatusCode sc where
+class (Eq sc, 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
     -- |Return the 3-digit integer for this status e.g. @200@
     numericCode ∷ sc → Int
     -- |Return the combination of 3-digit integer and reason phrase


@@ -48,16 +48,16 @@ class Show sc ⇒ StatusCode sc where
     fromStatusCode ∷ sc → SomeStatusCode
     fromStatusCode = SomeStatusCode
 
     fromStatusCode ∷ sc → SomeStatusCode
     fromStatusCode = SomeStatusCode
 

--- |Container type for 'StatusCode' type class.
+-- |Container type for the 'StatusCode' type class.

 data SomeStatusCode
     = ∀sc. StatusCode sc ⇒ SomeStatusCode sc
 
 data SomeStatusCode
     = ∀sc. StatusCode sc ⇒ SomeStatusCode sc
 

+instance Eq SomeStatusCode where
+    (==) = (≈)
+

 instance Show SomeStatusCode where
     show (SomeStatusCode sc) = show 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@.
 infix 4 ≈, ≉
 -- |Equivalence of 'StatusCode's. Two 'StatusCode's @a@ and @b@ are
 -- said to be equivalent iff @'numericCode' a '==' 'numericCode' b@.


@@ -110,17 +110,17 @@ instance StatusCode sc ⇒ ConvertAttempt sc AsciiBuilder where
 -- becomes:
 --
 -- @
 -- becomes:
 --
 -- @

---   data OK = OK deriving ('Show')
+--   data OK = OK deriving ('Eq', 'Show')

 --   instance OK where
 --     'numericCode'   _ = 200
 --     'textualStatus' _ = 'cs' (\"200 OK\" ∷ Ascii)
 --
 --   instance OK where
 --     'numericCode'   _ = 200
 --     'textualStatus' _ = 'cs' (\"200 OK\" ∷ Ascii)
 --

---   data BadRequest = BadRequest deriving ('Show')
+--   data BadRequest = BadRequest deriving ('Eq', 'Show')

 --   instance BadRequest where
 --     'numericCode'   _ = 400
 --     'textualStatus' _ = 'cs' (\"400 Bad Request\" ∷ Ascii)
 --
 --   instance BadRequest where
 --     'numericCode'   _ = 400
 --     'textualStatus' _ = 'cs' (\"400 Bad Request\" ∷ Ascii)
 --

---   data MethodNotAllowed = MethodNotAllowed deriving ('Show')
+--   data MethodNotAllowed = MethodNotAllowed deriving ('Eq', 'Show')

 --   instance MethodNotAllowed where
 --     'numericCode'   _ = 405
 --     'textualStatus' _ = 'cs' (\"405 Method Not Allowed\" ∷ Ascii)
 --   instance MethodNotAllowed where
 --     'numericCode'   _ = 405
 --     'textualStatus' _ = 'cs' (\"405 Method Not Allowed\" ∷ Ascii)


@@ -178,14 +178,14 @@ statusDecl (num, phrase)
       name = mkName $ concatMap cs phrase
 
       dataDecl ∷ Q Dec
       name = mkName $ concatMap cs phrase
 
       dataDecl ∷ Q Dec

-      dataDecl = dataD (cxt []) name [] [con] [''Show]
+      dataDecl = dataD (cxt []) name [] [con] [''Eq, ''Show]

 
       instanceDecl ∷ Q [Dec]
       instanceDecl
           = [d| instance StatusCode $typ where
 
       instanceDecl ∷ Q [Dec]
       instanceDecl
           = [d| instance StatusCode $typ where

-                  {-# INLINE numericCode #-}
+                  {-# INLINE CONLIKE numericCode #-}

                   numericCode _ = $(lift num)
                   numericCode _ = $(lift num)

-                  {-# INLINE textualStatus #-}
+                  {-# INLINE CONLIKE textualStatus #-}

                   textualStatus _ = $txt
               |]
 
                   textualStatus _ = $txt
               |]
 

diff --git a/cabal-package.mk b/cabal-package.mk
index bec1d1419da2a391f41db8acf50c6422ae8ed693..831b0b20a9fb8ed03c0cb9ed6f9d5d8021de17dc 100644 (file)
--- a/cabal-package.mk
+++ b/cabal-package.mk
@@ -22,6 +22,7 @@ HADDOCK_OPTS   ?= --hyperlink-source
 HLINT_OPTS     ?= \
        --hint=Default --hint=Dollar --hint=Generalise \
        --cross \
 HLINT_OPTS     ?= \
        --hint=Default --hint=Dollar --hint=Generalise \
        --cross \

+       --ignore="Parse error" \

        --report=dist/report.html
 
 SETUP_FILE := $(wildcard Setup.*hs)
        --report=dist/report.html
 
 SETUP_FILE := $(wildcard Setup.*hs)