X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FStatusCode%2FInternal.hs;h=e3122da1f55e21af4587abf5cf7d4175e8ccdd93;hb=8de439e0d2869f46e926d3132f6b1113201460e5;hp=21210375bbfa3ae5d34cd84fe759bf8c6ecbe7ad;hpb=5f2ef377345fc47aabc63c1325df82c1cd9da9ed;p=Lucu.git diff --git a/Network/HTTP/Lucu/StatusCode/Internal.hs b/Network/HTTP/Lucu/StatusCode/Internal.hs index 2121037..e3122da 100644 --- 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 |]