X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FStatusCode%2FInternal.hs;h=e3122da1f55e21af4587abf5cf7d4175e8ccdd93;hb=8de439e0d2869f46e926d3132f6b1113201460e5;hp=1d9117ceb1d3ade43416efe25ea0261a76fecb24;hpb=bb41be0c967538a1014c87103a3a5d3840ad3e15;p=Lucu.git

diff --git a/Network/HTTP/Lucu/StatusCode/Internal.hs b/Network/HTTP/Lucu/StatusCode/Internal.hs
index 1d9117c..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
@@ -19,8 +20,8 @@ module Network.HTTP.Lucu.StatusCode.Internal
 import Control.Applicative
 import Data.Ascii (Ascii, AsciiBuilder)
 import qualified Data.Ascii as A
-import Data.Attoparsec.Char8 as P
-import Data.Attoparsec.Lazy as LP
+import Data.Attoparsec.Char8
+import qualified Data.Attoparsec.Lazy as LP
 import qualified Data.ByteString.Lazy.Char8 as Lazy
 import Data.Convertible.Base
 import Data.Convertible.Instances.Ascii ()
@@ -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
@@ -43,21 +44,21 @@ class Show sc ⇒ StatusCode sc where
     numericCode ∷ sc → Int
     -- |Return the combination of 3-digit integer and reason phrase
     -- for this status e.g. @200 OK@
-    textualStatus ∷ sc → Ascii
+    textualStatus ∷ sc → AsciiBuilder
     -- |Wrap the status code into 'SomeStatusCode'.
     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@.
@@ -85,7 +86,7 @@ instance StatusCode sc ⇒ ConvertSuccess sc Ascii where
 
 instance StatusCode sc ⇒ ConvertSuccess sc AsciiBuilder where
     {-# INLINE convertSuccess #-}
-    convertSuccess = cs ∘ textualStatus
+    convertSuccess = textualStatus
 
 instance StatusCode sc ⇒ ConvertAttempt sc Ascii where
     {-# INLINE convertAttempt #-}
@@ -113,17 +114,17 @@ instance StatusCode sc ⇒ ConvertAttempt sc AsciiBuilder where
 --   data OK = OK deriving ('Show')
 --   instance OK where
 --     'numericCode'   _ = 200
---     'textualStatus' _ = 'A.unsafeFromString' \"200 OK\"
+--     'textualStatus' _ = 'cs' (\"200 OK\" ∷ Ascii)
 --
 --   data BadRequest = BadRequest deriving ('Show')
 --   instance BadRequest where
 --     'numericCode'   _ = 400
---     'textualStatus' _ = 'A.unsafeFromString' \"400 Bad Request\"
+--     'textualStatus' _ = 'cs' (\"400 Bad Request\" ∷ Ascii)
 --
 --   data MethodNotAllowed = MethodNotAllowed deriving ('Show')
 --   instance MethodNotAllowed where
 --     'numericCode'   _ = 405
---     'textualStatus' _ = 'A.unsafeFromString' \"405 Method Not Allowed\"
+--     'textualStatus' _ = 'cs' (\"405 Method Not Allowed\" ∷ Ascii)
 -- @
 statusCodes ∷ QuasiQuoter
 statusCodes = QuasiQuoter {
@@ -166,7 +167,7 @@ parseStatusCodes src
              "pair"
 
       word ∷ Parser Ascii
-      word = A.unsafeFromByteString <$> P.takeWhile1 isAlpha_ascii
+      word = A.unsafeFromByteString <$> takeWhile1 isAlpha_ascii
 
 statusDecl ∷ (Int, [Ascii]) → Q [Dec]
 statusDecl (num, phrase)
@@ -175,7 +176,7 @@ statusDecl (num, phrase)
          return (a:bs)
     where
       name ∷ Name
-      name = mkName $ concatMap A.toString phrase
+      name = mkName $ concatMap cs phrase
 
       dataDecl ∷ Q Dec
       dataDecl = dataD (cxt []) name [] [con] [''Show]
@@ -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
               |]
 
@@ -196,8 +197,8 @@ statusDecl (num, phrase)
       con = return $ NormalC name []
 
       txt ∷ Q Exp
-      txt = [| A.unsafeFromString $(lift txt') |]
+      txt = [| cs ($(lift txt') ∷ Ascii) |]
 
       txt' ∷ String
       txt' = concat $ intersperse "\x20"
-                    $ show num : map A.toString phrase
+                    $ show num : map cs phrase