Code reorganisation

diff --git a/Lucu.cabal b/Lucu.cabal
index d07f14f29f20df625c9c226d2a5b9b0f6ae29e37..ce5ac42589be5da90b99995815e67ea11de03983 100644 (file)
--- a/Lucu.cabal
+++ b/Lucu.cabal
@@ -112,9 +112,9 @@ Library
         Network.HTTP.Lucu.Request
         Network.HTTP.Lucu.Resource
         Network.HTTP.Lucu.Response
+        Network.HTTP.Lucu.Response.StatusCode
         Network.HTTP.Lucu.SocketLike
         Network.HTTP.Lucu.StaticFile
-        Network.HTTP.Lucu.StatusCode
         Network.HTTP.Lucu.Utils
 
     Other-Modules:
@@ -130,8 +130,8 @@ Library
         Network.HTTP.Lucu.Preprocess
         Network.HTTP.Lucu.RequestReader
         Network.HTTP.Lucu.Resource.Internal
+        Network.HTTP.Lucu.Response.StatusCode.Internal
         Network.HTTP.Lucu.ResponseWriter
-        Network.HTTP.Lucu.StatusCode.Internal
 
     ghc-options:
         -Wall

diff --git a/Network/HTTP/Lucu.hs b/Network/HTTP/Lucu.hs
index f82617656bb882075697cb2f66ee61bf387e613e..c81406ef648395a63c40dcf78f724b7d5b4ed8b4 100644 (file)
--- a/Network/HTTP/Lucu.hs
+++ b/Network/HTTP/Lucu.hs
@@ -50,7 +50,7 @@ module Network.HTTP.Lucu
     , Method(..)
 
       -- *** 'StatusCode'
-    , module Network.HTTP.Lucu.StatusCode
+    , module Network.HTTP.Lucu.Response.StatusCode
 
       -- *** 'Abortion'
     , module Network.HTTP.Lucu.Abortion
@@ -84,7 +84,6 @@ import Network.HTTP.Lucu.MIMEParams
 import Network.HTTP.Lucu.MIMEType
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Resource
-import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Response.StatusCode
 import Network.HTTP.Lucu.StaticFile
-import Network.HTTP.Lucu.StatusCode
 import Network.HTTP.Lucu.Utils

diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs
index db32c1d95292975a4185d6297407f87f123296fd..3dc94c2c52a281876b9e7fdff3241184107c00c9 100644 (file)
--- a/Network/HTTP/Lucu/Abortion.hs
+++ b/Network/HTTP/Lucu/Abortion.hs
@@ -19,7 +19,7 @@ import Data.Collections
 import Data.Monoid.Unicode
 import Data.Text (Text)
 import Network.HTTP.Lucu.Abortion.Internal
-import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Response.StatusCode
 import Prelude.Unicode
 
 -- |Construct an 'Abortion' with additional headers and an optional

diff --git a/Network/HTTP/Lucu/Abortion/Internal.hs b/Network/HTTP/Lucu/Abortion/Internal.hs
index a1ff54c5be0d209cf4cfcb30867d8b4d04982441..7a0539b10b89d1e4b01e6a5ad6f093c0d59e331f 100644 (file)
--- a/Network/HTTP/Lucu/Abortion/Internal.hs
+++ b/Network/HTTP/Lucu/Abortion/Internal.hs
@@ -18,6 +18,7 @@ import Network.HTTP.Lucu.DefaultPage
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Response.StatusCode
 
 -- |'Abortion' is an 'Exception' that aborts the execution of
 -- 'Network.HTTP.Lucu.Rsrc' monad with a 'StatusCode', additional

diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs
index a5ad43c30cce861b997c5e8ae5677728d677a78f..8f19d8968d9d50fd2c8e5f8b12c936f74de4f172 100644 (file)
--- a/Network/HTTP/Lucu/DefaultPage.hs
+++ b/Network/HTTP/Lucu/DefaultPage.hs
@@ -23,6 +23,7 @@ import Network.HTTP.Lucu.Config
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Response.StatusCode
 import Network.URI hiding (path)
 import Prelude hiding (head)
 import Prelude.Unicode

diff --git a/Network/HTTP/Lucu/Dispatcher/Internal.hs b/Network/HTTP/Lucu/Dispatcher/Internal.hs
index 6e088df8061178f32ffd492187502d4206def0cf..3699f700fd82c2413bd47b54e82d7b4ee2c8a072 100644 (file)
--- a/Network/HTTP/Lucu/Dispatcher/Internal.hs
+++ b/Network/HTTP/Lucu/Dispatcher/Internal.hs
@@ -58,7 +58,7 @@ class HostMapper α where
     hostMap = HMap
 
 -- |Container type for the 'HostMapper' type class.
-data HostMap = ∀α. HostMapper α ⇒ HMap α
+data HostMap = ∀α. HostMapper α ⇒ HMap !α
 
 -- |Class of maps from resource 'Path' to 'Resource'.
 --
@@ -77,7 +77,7 @@ class ResourceMapper α where
     resourceMap = RMap
 
 -- |Container type for the 'ResourceMapper' type class.
-data ResourceMap = ∀α. ResourceMapper α ⇒ RMap α
+data ResourceMap = ∀α. ResourceMapper α ⇒ RMap !α
 
 -- |'ResourceTree' is an opaque structure which a map from resource
 -- 'Path' to 'ResourceNode'.

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index 7c43f96c5e7a12bcf3145771a7ea6b4976fed17e..ec9207032ce845a0fb68e0bd963a8b08d3953fd1 100644 (file)
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -47,6 +47,7 @@ import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.Preprocess
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Response.StatusCode
 import Network.HTTP.Lucu.Utils
 #if defined(HAVE_SSL)
 import OpenSSL.X509

diff --git a/Network/HTTP/Lucu/OrphanInstances.hs b/Network/HTTP/Lucu/OrphanInstances.hs
index 333e162cdf5075bb1230059ddc723c13d5bb927a..8fa7e68714437b8270abb7b42d13e3ab35d360dc 100644 (file)
--- a/Network/HTTP/Lucu/OrphanInstances.hs
+++ b/Network/HTTP/Lucu/OrphanInstances.hs
@@ -12,6 +12,7 @@ module Network.HTTP.Lucu.OrphanInstances
     )
     where
 import Control.Applicative hiding (empty)
+import Control.Monad
 import Data.Ascii (Ascii)
 import qualified Data.Ascii as A
 import Data.ByteString (ByteString)
@@ -31,6 +32,12 @@ import Language.Haskell.TH.Syntax
 import Prelude hiding (last, mapM, null, reverse)
 import Prelude.Unicode
 
+instance Applicative Q where
+    {-# INLINE pure #-}
+    pure = return
+    {-# INLINE (<*>) #-}
+    (<*>) = ap
+
 instance Lift ByteString where
     lift bs = [| Strict.pack $(litE ∘ stringL $ Strict.unpack bs) |]
 

diff --git a/Network/HTTP/Lucu/Postprocess.hs b/Network/HTTP/Lucu/Postprocess.hs
index b31c0ee5ef6bd819498584ed89bc7d036a34b90c..ddda849169e4a428e8469412c530675b102b7289 100644 (file)
--- a/Network/HTTP/Lucu/Postprocess.hs
+++ b/Network/HTTP/Lucu/Postprocess.hs
@@ -24,6 +24,7 @@ import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.Interaction
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Response.StatusCode
 import Prelude.Unicode
 
 postprocess ∷ NormalInteraction → STM ()

diff --git a/Network/HTTP/Lucu/Preprocess.hs b/Network/HTTP/Lucu/Preprocess.hs
index 0848f15124e590205a9b4d5d44c89a8b071e3c2a..e01160dafe6ef46acd1888731abdd0b477943fd9 100644 (file)
--- a/Network/HTTP/Lucu/Preprocess.hs
+++ b/Network/HTTP/Lucu/Preprocess.hs
@@ -26,7 +26,7 @@ import qualified Data.Text.Encoding as T
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.HttpVersion
 import Network.HTTP.Lucu.Request
-import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Response.StatusCode
 import Network.Socket
 import Network.URI
 import Prelude.Unicode

diff --git a/Network/HTTP/Lucu/Request.hs b/Network/HTTP/Lucu/Request.hs
index 13ccf9c9420b8265fa244934ed2d98cebc1a497f..ea855ba30cffc108ac7764766196b63a03ff8ce0 100644 (file)
--- a/Network/HTTP/Lucu/Request.hs
+++ b/Network/HTTP/Lucu/Request.hs
@@ -6,9 +6,7 @@
   , UnicodeSyntax
   , ViewPatterns
   #-}
--- |Definition of things related on HTTP request.
---
--- In general you don't have to use this module directly.
+-- |Definition of HTTP requests.
 module Network.HTTP.Lucu.Request
     ( Method(..)
     , Request(..)
@@ -27,8 +25,7 @@ import Network.HTTP.Lucu.Parser.Http
 import Network.URI
 import Prelude.Unicode
 
--- |This is the definition of HTTP request methods, which shouldn't
--- require any descriptions.
+-- |Definition of HTTP request methods.
 data Method = OPTIONS
             | GET
             | HEAD
@@ -40,7 +37,7 @@ data Method = OPTIONS
             | ExtensionMethod !Ascii
               deriving (Eq, Show)
 
--- |This is the definition of an HTTP reqest.
+-- |Definition of HTTP requests.
 data Request
     = Request {
         reqMethod  ∷ !Method
@@ -64,6 +61,20 @@ reqHasBody (reqMethod → m)
     | m ≡ PUT   = True
     | otherwise = False
 
+instance Default (Parser Method) where
+    {-# INLINEABLE def #-}
+    def = choice
+          [ string "OPTIONS" ≫ return OPTIONS
+          , string "GET"     ≫ return GET
+          , string "HEAD"    ≫ return HEAD
+          , string "POST"    ≫ return POST
+          , string "PUT"     ≫ return PUT
+          , string "DELETE"  ≫ return DELETE
+          , string "TRACE"   ≫ return TRACE
+          , string "CONNECT" ≫ return CONNECT
+          , ExtensionMethod <$> token
+          ]
+
 instance Default (Parser Request) where
     {-# INLINEABLE def #-}
     def = do skipMany crlf
@@ -78,7 +89,7 @@ instance Default (Parser Request) where
 
 requestLine ∷ Parser (Method, URI, HttpVersion)
 {-# INLINEABLE requestLine #-}
-requestLine = do meth ← method
+requestLine = do meth ← def
                  sp
                  u ← uri
                  sp
@@ -86,20 +97,6 @@ requestLine = do meth ← method
                  crlf
                  return (meth, u, ver)
 
-method ∷ Parser Method
-{-# INLINEABLE method #-}
-method = choice
-         [ string "OPTIONS" ≫ return OPTIONS
-         , string "GET"     ≫ return GET
-         , string "HEAD"    ≫ return HEAD
-         , string "POST"    ≫ return POST
-         , string "PUT"     ≫ return PUT
-         , string "DELETE"  ≫ return DELETE
-         , string "TRACE"   ≫ return TRACE
-         , string "CONNECT" ≫ return CONNECT
-         , ExtensionMethod <$> token
-         ]
-
 uri ∷ Parser URI
 {-# INLINEABLE uri #-}
 uri = do bs ← takeWhile1 (\c → (¬) (isCtl c ∨ c ≡ '\x20'))

diff --git a/Network/HTTP/Lucu/RequestReader.hs b/Network/HTTP/Lucu/RequestReader.hs
index 543c82e52e182524460a13d95efb09295fdd4578..edd3fa2fedf899243d22840769aa2ccbd653a828 100644 (file)
--- a/Network/HTTP/Lucu/RequestReader.hs
+++ b/Network/HTTP/Lucu/RequestReader.hs
@@ -34,6 +34,7 @@ import Network.HTTP.Lucu.Interaction
 import Network.HTTP.Lucu.Preprocess
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Response.StatusCode
 import Network.HTTP.Lucu.Resource.Internal
 import Network.HTTP.Lucu.Utils
 import Network.Socket

diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index ce6c98a32c63e99af1d17effeb19eb02b7775b90..acc62057549f0527e40daac13e6024ff7395bda6 100644 (file)
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -182,6 +182,7 @@ import Network.HTTP.Lucu.Parser
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Resource.Internal
 import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Response.StatusCode
 import Network.HTTP.Lucu.MIMEType
 import Network.HTTP.Lucu.Utils
 import Network.Socket hiding (accept)

diff --git a/Network/HTTP/Lucu/Resource/Internal.hs b/Network/HTTP/Lucu/Resource/Internal.hs
index b13d3a9f14062e76b3090086cf992f98aae03f4c..d0d18b79afe6bcd5de2dbe4810fbac0e51d65120 100644 (file)
--- a/Network/HTTP/Lucu/Resource/Internal.hs
+++ b/Network/HTTP/Lucu/Resource/Internal.hs
@@ -61,6 +61,7 @@ import Network.HTTP.Lucu.Interaction
 import Network.HTTP.Lucu.Postprocess
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Response.StatusCode
 import Network.HTTP.Lucu.Utils
 import Network.Socket
 #if defined(HAVE_SSL)

diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs
index 920449db36e469b431babe522792ca954a6aac07..93291a779430c2f98e6e8ab6f6a4caa9fdcb6ff8 100644 (file)
--- a/Network/HTTP/Lucu/Response.hs
+++ b/Network/HTTP/Lucu/Response.hs
@@ -7,16 +7,10 @@
   , UnicodeSyntax
   , ViewPatterns
   #-}
--- |Definition of things related on HTTP response.
+-- |Definition of HTTP responses.
 module Network.HTTP.Lucu.Response
-    ( -- * Class and Types
-      StatusCode(..)
-    , SomeStatusCode
-    , Response(..)
-    , statusCodes
-    , module Network.HTTP.Lucu.StatusCode
-
-      -- * Functions
+    ( Response(..)
+
     , emptyResponse
     , setStatusCode
     , resCanHaveBody
@@ -36,8 +30,7 @@ import Data.Convertible.Utils
 import Data.Monoid.Unicode
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.HttpVersion
-import Network.HTTP.Lucu.StatusCode
-import Network.HTTP.Lucu.StatusCode.Internal
+import Network.HTTP.Lucu.Response.StatusCode
 import Prelude.Unicode
 
 -- |This is the definition of an HTTP response.

diff --git a/Network/HTTP/Lucu/StatusCode.hs b/Network/HTTP/Lucu/Response/StatusCode.hs
similarity index 84%
rename from Network/HTTP/Lucu/StatusCode.hs
rename to Network/HTTP/Lucu/Response/StatusCode.hs
index 8f3e22579ddc8d4d8d32963e84ae7bc936a01eda..f09c6ddda9bb65dfff6713d82c799281b33b4790 100644 (file)
--- a/Network/HTTP/Lucu/StatusCode.hs
+++ b/Network/HTTP/Lucu/Response/StatusCode.hs
@@ -1,18 +1,20 @@
 {-# LANGUAGE
-    OverloadedStrings
-  , QuasiQuotes
+    QuasiQuotes
   #-}
--- |Definition of HTTP status code.
--- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named status
--- codes so you don't have to memorize that, say, \"Gateway Timeout\"
--- is 504.
-module Network.HTTP.Lucu.StatusCode
-    ( -- * Informational
-      Continue(..)
+-- |Definition of HTTP status codes.
+module Network.HTTP.Lucu.Response.StatusCode
+    ( -- * Type class
+      StatusCode(..)
+    , SomeStatusCode
+    , statusCodes
+
+      -- * Status codes
+      -- ** Informational
+    , Continue(..)
     , SwitchingProtocols(..)
     , Processing(..)
 
-      -- * Successful
+      -- ** Successful
     , OK(..)
     , Created(..)
     , Accepted(..)
@@ -24,7 +26,7 @@ module Network.HTTP.Lucu.StatusCode
     , AlreadyReported(..)
     , IMUsed(..)
 
-      -- * Redirection
+      -- ** Redirection
     , MultipleChoices(..)
     , MovedPermanently(..)
     , Found(..)
@@ -33,7 +35,7 @@ module Network.HTTP.Lucu.StatusCode
     , UseProxy(..)
     , TemporaryRedirect(..)
 
-      -- * Client Error
+      -- ** Client Error
     , BadRequest(..)
     , Unauthorized(..)
     , PaymentRequired(..)
@@ -57,7 +59,7 @@ module Network.HTTP.Lucu.StatusCode
     , FailedDependency(..)
     , UpgradeRequired(..)
 
-      -- * Server Error
+      -- ** Server Error
     , InternalServerError(..)
     , NotImplemented(..)
     , BadGateway(..)
@@ -70,7 +72,7 @@ module Network.HTTP.Lucu.StatusCode
     , NotExtended(..)
     )
     where
-import Network.HTTP.Lucu.StatusCode.Internal
+import Network.HTTP.Lucu.Response.StatusCode.Internal
 
 [statusCodes|
 100 Continue

diff --git a/Network/HTTP/Lucu/StatusCode/Internal.hs b/Network/HTTP/Lucu/Response/StatusCode/Internal.hs
similarity index 79%
rename from Network/HTTP/Lucu/StatusCode/Internal.hs
rename to Network/HTTP/Lucu/Response/StatusCode/Internal.hs
index 026b1a88b16bfdcb7094b8ae2d0dfe66f6f6508d..7d0da98d263b9c3b87d908fc8e5daab194791559 100644 (file)
--- a/Network/HTTP/Lucu/StatusCode/Internal.hs
+++ b/Network/HTTP/Lucu/Response/StatusCode/Internal.hs
@@ -3,20 +3,22 @@
   , FlexibleInstances
   , MultiParamTypeClasses
   , OverlappingInstances
+  , OverloadedStrings
   , TemplateHaskell
-  , TypeFamilies
   , UndecidableInstances
   , UnicodeSyntax
   , ViewPatterns
   #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-module Network.HTTP.Lucu.StatusCode.Internal
+module Network.HTTP.Lucu.Response.StatusCode.Internal
     ( StatusCode(..)
     , SomeStatusCode
     , statusCodes
     )
     where
 import Control.Applicative
+import Control.Applicative.Unicode
+import Control.Monad.Unicode
 import Data.Ascii (Ascii, AsciiBuilder)
 import qualified Data.Ascii as A
 import Data.Attoparsec.Char8
@@ -26,9 +28,11 @@ import Data.Convertible.Base
 import Data.Convertible.Instances.Ascii ()
 import Data.Convertible.Utils
 import Data.List
+import Data.Monoid
 import Language.Haskell.TH.Lib
 import Language.Haskell.TH.Syntax
 import Language.Haskell.TH.Quote
+import Network.HTTP.Lucu.OrphanInstances ()
 import Network.HTTP.Lucu.Parser
 import Prelude.Unicode
 
@@ -46,6 +50,7 @@ class (Eq sc, Show sc) ⇒ StatusCode sc where
     textualStatus ∷ sc → AsciiBuilder
     -- |Wrap the status code into 'SomeStatusCode'.
     fromStatusCode ∷ sc → SomeStatusCode
+    {-# INLINE CONLIKE fromStatusCode #-}
     fromStatusCode = SomeStatusCode
 
 instance StatusCode sc ⇒ ConvertSuccess sc SomeStatusCode where
@@ -74,7 +79,7 @@ instance StatusCode sc ⇒ ConvertAttempt sc AsciiBuilder where
 
 -- |Container type for the 'StatusCode' type class.
 data SomeStatusCode
-    = ∀sc. StatusCode sc ⇒ SomeStatusCode sc
+    = ∀sc. StatusCode sc ⇒ SomeStatusCode !sc
 
 -- |Equivalence of 'StatusCode's. Two 'StatusCode's @α@ and
 -- @β@ are said to be equivalent iff @'numericCode' α '=='
@@ -87,8 +92,11 @@ instance Show SomeStatusCode where
     show (SomeStatusCode sc) = show sc
 
 instance StatusCode SomeStatusCode where
-    numericCode   (SomeStatusCode sc) = numericCode   sc
+    {-# INLINE numericCode #-}
+    numericCode (SomeStatusCode sc) = numericCode sc
+    {-# INLINE textualStatus #-}
     textualStatus (SomeStatusCode sc) = textualStatus sc
+    {-# INLINE CONLIKE fromStatusCode #-}
     fromStatusCode = id
 
 -- |'QuasiQuoter' for 'StatusCode' declarations.
@@ -107,17 +115,17 @@ instance StatusCode SomeStatusCode where
 --
 -- @
 --   data OK = OK deriving ('Eq', 'Show')
---   instance OK where
+--   instance 'StatusCode' OK where
 --     'numericCode'   _ = 200
 --     'textualStatus' _ = 'cs' (\"200 OK\" ∷ Ascii)
 --
 --   data BadRequest = BadRequest deriving ('Eq', 'Show')
---   instance BadRequest where
+--   instance 'StatusCode' BadRequest where
 --     'numericCode'   _ = 400
 --     'textualStatus' _ = 'cs' (\"400 Bad Request\" ∷ Ascii)
 --
 --   data MethodNotAllowed = MethodNotAllowed deriving ('Eq', 'Show')
---   instance MethodNotAllowed where
+--   instance 'StatusCode' MethodNotAllowed where
 --     'numericCode'   _ = 405
 --     'textualStatus' _ = 'cs' (\"405 Method Not Allowed\" ∷ Ascii)
 -- @
@@ -126,22 +134,25 @@ statusCodes = QuasiQuoter {
                 quoteExp  = const unsupported
               , quotePat  = const unsupported
               , quoteType = const unsupported
-              , quoteDec  = (concat <$>) ∘ mapM statusDecl ∘ parseStatusCodes ∘ Lazy.pack
+              , quoteDec  = (concat <$>)
+                            ∘ (mapM statusDecl =≪)
+                            ∘ parseStatusCodes
+                            ∘ Lazy.pack
               }
     where
       unsupported ∷ Monad m ⇒ m α
       unsupported = fail "Unsupported usage of statusCodes quasi-quoter."
 
-parseStatusCodes ∷ Lazy.ByteString → [(Int, [Ascii])]
+parseStatusCodes ∷ Monad m ⇒ Lazy.ByteString → m [(Int, [Ascii])]
 parseStatusCodes src
     = case LP.parse pairs src of
         LP.Fail _ eCtx e
-            → error $ "Unparsable status codes: "
-                    ⧺ intercalate ", " eCtx
-                    ⧺ ": "
-                    ⧺ e
+            → fail $ "Unparsable status codes: "
+                   ⧺ intercalate ", " eCtx
+                   ⧺ ": "
+                   ⧺ e
         LP.Done _ xs
-            → xs
+            → return xs
     where
       pairs ∷ Parser [(Int, [Ascii])]
       pairs = do skipMany endOfLine
@@ -165,35 +176,29 @@ parseStatusCodes src
       word = A.unsafeFromByteString <$> takeWhile1 isAlpha_ascii
 
 statusDecl ∷ (Int, [Ascii]) → Q [Dec]
-statusDecl (num, phrase)
-    = do a  ← dataDecl
-         bs ← instanceDecl
-         return (a:bs)
+statusDecl (num, phrase) = (:) <$> dataDecl ⊛ instanceDecl
     where
+      dataDecl ∷ Q Dec
+      dataDecl = dataD (cxt []) name [] [con] [''Eq, ''Show]
+
       name ∷ Name
       name = mkName $ concatMap cs phrase
 
-      dataDecl ∷ Q Dec
-      dataDecl = dataD (cxt []) name [] [con] [''Eq, ''Show]
+      con ∷ Q Con
+      con = normalC name []
 
       instanceDecl ∷ Q [Dec]
       instanceDecl
           = [d| instance StatusCode $typ where
                   {-# INLINE CONLIKE numericCode #-}
                   numericCode _ = $(lift num)
-                  {-# INLINE CONLIKE textualStatus #-}
-                  textualStatus _ = $txt
+                  {-# INLINE textualStatus #-}
+                  textualStatus _ = cs $(lift txt)
               |]
 
       typ ∷ Q Type
       typ = conT name
 
-      con ∷ Q Con
-      con = return $ NormalC name []
-
-      txt ∷ Q Exp
-      txt = [| cs ($(lift txt') ∷ Ascii) |]
-
-      txt' ∷ String
-      txt' = concat $ intersperse "\x20"
-                    $ show num : map cs phrase
+      txt ∷ Ascii
+      txt = mconcat $ intersperse "\x20"
+                    $ A.unsafeFromString (show num) : phrase

diff --git a/Network/HTTP/Lucu/ResponseWriter.hs b/Network/HTTP/Lucu/ResponseWriter.hs
index 0af4a69df02f1a78604b0bc46d3b71077a545768..39e4e50f3a7831dab7ca935164b85492fd07eec3 100644 (file)
--- a/Network/HTTP/Lucu/ResponseWriter.hs
+++ b/Network/HTTP/Lucu/ResponseWriter.hs
@@ -26,6 +26,7 @@ import Network.HTTP.Lucu.HttpVersion
 import Network.HTTP.Lucu.Interaction
 import Network.HTTP.Lucu.Request
 import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Response.StatusCode
 import Prelude.Unicode
 import System.IO (hPutStrLn, stderr)
 

diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index 7d2ff79ac260a843673e40b2064208f5819d42b0..5cb8fb0efbd90a8710ff2fc5872528b2e6684400 100644 (file)
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -26,7 +26,7 @@ import Network.HTTP.Lucu.MIMEType
 import Network.HTTP.Lucu.MIMEType.Guess
 import Network.HTTP.Lucu.Resource
 import Network.HTTP.Lucu.Resource.Internal
-import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Response.StatusCode
 import Network.HTTP.Lucu.Utils
 import Prelude.Unicode
 import System.Directory

diff --git a/bugs/issue-e6ec5a54d14cad8f79c456e23e92770fbbd3577e.yaml b/bugs/issue-e6ec5a54d14cad8f79c456e23e92770fbbd3577e.yaml
index 60ac6b016628ef6e8595023498957d101c0e1579..708e82d3aa9ec0712e0ca3e5f993a1f0f29c9019 100644 (file)
--- a/bugs/issue-e6ec5a54d14cad8f79c456e23e92770fbbd3577e.yaml
+++ b/bugs/issue-e6ec5a54d14cad8f79c456e23e92770fbbd3577e.yaml
@@ -5,8 +5,8 @@ type: :task
 component: Lucu
 release: Lucu-1.0
 reporter: PHO <pho@cielonegro.org>
-status: :in_progress
-disposition: 
+status: :closed
+disposition: :wontfix
 creation_time: 2011-12-16 10:11:08.635552 Z
 references: []
 
@@ -20,4 +20,8 @@ log_events:
   - PHO <pho@cielonegro.org>
   - changed status from unstarted to in_progress
   - ""
+- - 2011-12-27 23:37:46.236041 Z
+  - PHO <pho@cielonegro.org>
+  - closed with disposition wontfix
+  - Cancelled.
 git_branch: