From: PHO <pho@cielonegro.org>
Date: Sun, 4 Sep 2011 12:19:53 +0000 (+0900)
Subject: Merge branch 'master' into attoparsec
X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=commitdiff_plain;h=e34910f85f459f049b9e6e6b79db9ef95dfccc13;hp=-c

Merge branch 'master' into attoparsec

Conflicts:
	Network/HTTP/Lucu/Utils.hs
---

e34910f85f459f049b9e6e6b79db9ef95dfccc13
diff --combined Lucu.cabal
index e1650f8,f9c03c7..0200e77
--- a/Lucu.cabal
+++ b/Lucu.cabal
@@@ -8,7 -8,7 +8,7 @@@ Description
          without messing around FastCGI. It is also intended to be run
          behind a reverse-proxy so it doesn't have some facilities like
          logging, client filtering or such like.
- Version: 0.7.0.2
+ Version: 0.7.0.3
  License: PublicDomain
  License-File: COPYING
  Author: PHO <pho at cielonegro dot org>
@@@ -24,7 -24,6 +24,7 @@@ Extra-Source-Files
      ImplantFile.hs
      NEWS
      data/CompileMimeTypes.hs
 +    data/Makefile
      data/mime.types
      examples/HelloWorld.hs
      examples/Implanted.hs
@@@ -45,29 -44,23 +45,29 @@@ Flag build-lucu-implant-fil
  
  Library
      Build-Depends:
 -        HsOpenSSL            == 0.10.*,
 -        base                 == 4.3.*,
 -        base-unicode-symbols == 0.2.*,
 -        base64-bytestring    == 0.1.*,
 -        bytestring           == 0.9.*,
 -        containers           == 0.4.*,
 -        filepath             == 1.2.*,
 -        directory            == 1.1.*,
 -        haskell-src          == 1.0.*,
 -        hxt                  == 9.1.*,
 -        mtl                  == 2.0.*,
 -        network              == 2.3.*,
 -        stm                  == 2.2.*,
 -        time                 == 1.2.*,
 -        time-http            == 0.1.*,
 -        unix                 == 2.4.*,
 -        zlib                 == 0.5.*
 +        HsOpenSSL                  == 0.10.*,
 +        ascii                      == 0.0.*,
 +        attoparsec                 == 0.9.*,
 +        base                       == 4.3.*,
 +        base-unicode-symbols       == 0.2.*,
 +        base64-bytestring          == 0.1.*,
 +        blaze-builder              == 0.3.*,
 +        bytestring                 == 0.9.*,
 +        containers                 == 0.4.*,
 +        containers-unicode-symbols == 0.3.*,
 +        filepath                   == 1.2.*,
 +        directory                  == 1.1.*,
 +        haskell-src                == 1.0.*,
 +        hxt                        == 9.1.*,
 +        mtl                        == 2.0.*,
 +        network                    == 2.3.*,
 +        stm                        == 2.2.*,
 +        text                       == 0.11.*,
 +        text-icu                   == 0.6.*,
 +        time                       == 1.2.*,
 +        time-http                  == 0.1.*,
 +        unix                       == 2.4.*,
 +        zlib                       == 0.5.*
  
      Exposed-Modules:
          Network.HTTP.Lucu
@@@ -80,8 -73,8 +80,8 @@@
          Network.HTTP.Lucu.MIMEType
          Network.HTTP.Lucu.MIMEType.DefaultExtensionMap
          Network.HTTP.Lucu.MIMEType.Guess
 -        Network.HTTP.Lucu.Parser
          Network.HTTP.Lucu.Parser.Http
 +        Network.HTTP.Lucu.RFC2231
          Network.HTTP.Lucu.Request
          Network.HTTP.Lucu.Resource
          Network.HTTP.Lucu.Resource.Tree
diff --combined Network/HTTP/Lucu/Utils.hs
index abd4556,dbc65ac..d254169
--- a/Network/HTTP/Lucu/Utils.hs
+++ b/Network/HTTP/Lucu/Utils.hs
@@@ -1,6 -1,5 +1,6 @@@
  {-# LANGUAGE
      BangPatterns
 +  , OverloadedStrings
    , UnicodeSyntax
    #-}
  -- |Utility functions used internally in the Lucu httpd. These
@@@ -8,70 -7,78 +8,77 @@@
  module Network.HTTP.Lucu.Utils
      ( splitBy
      , joinWith
 -    , trim
 -    , isWhiteSpace
      , quoteStr
      , parseWWWFormURLEncoded
      )
      where
  import Control.Monad
 -import Data.List     hiding (last)
 +import Data.Ascii (Ascii, AsciiBuilder)
 +import qualified Data.Ascii as A
 +import qualified Data.ByteString.Char8 as BS
 +import Data.List hiding (last)
 +import Data.Monoid.Unicode
  import Network.URI
 -import Prelude       hiding (last)
 +import Prelude hiding (last)
  import Prelude.Unicode
  
  -- |> splitBy (== ':') "ab:c:def"
  --  > ==> ["ab", "c", "def"]
 -splitBy :: (a -> Bool) -> [a] -> [[a]]
 +splitBy ∷ (a → Bool) → [a] → [[a]]
  splitBy isSep src
      = case break isSep src
 -      of (last , []       ) -> [last]
 -         (first, _sep:rest) -> first : splitBy isSep rest
 +      of (last , []       ) → [last]
 +         (first, _sep:rest) → first : splitBy isSep rest
  
  -- |> joinWith ":" ["ab", "c", "def"]
  --  > ==> "ab:c:def"
 -joinWith :: [a] -> [[a]] -> [a]
 -joinWith = (join .) . intersperse
 -
 --- |> trim (== '_') "__ab_c__def___"
 ---  > ==> "ab_c__def"
 -trim :: (a -> Bool) -> [a] -> [a]
 -trim !p = trimTail . trimHead
 +joinWith ∷ Ascii → [AsciiBuilder] → AsciiBuilder
 +{-# INLINEABLE joinWith #-}
 +joinWith sep = flip go (∅)
      where
 -      trimHead = dropWhile p
 -      trimTail = reverse . trimHead . reverse
 -
 --- |@'isWhiteSpace' c@ is 'Prelude.True' iff c is one of SP, HT, CR
 --- and LF.
 -isWhiteSpace :: Char -> Bool
 -isWhiteSpace ' '  = True
 -isWhiteSpace '\t' = True
 -isWhiteSpace '\r' = True
 -isWhiteSpace '\n' = True
 -isWhiteSpace _    = False
 -{-# INLINE isWhiteSpace #-}
 +      go ∷ [AsciiBuilder] → AsciiBuilder → AsciiBuilder
 +      {-# INLINE go #-}
 +      go []     ab = ab
 +      go (x:[]) ab = ab ⊕ x
 +      go (x:xs) ab = go xs (ab ⊕ A.toAsciiBuilder sep ⊕ x)
  
  -- |> quoteStr "abc"
  --  > ==> "\"abc\""
  --
  --  > quoteStr "ab\"c"
  --  > ==> "\"ab\\\"c\""
 -quoteStr :: String -> String
 -quoteStr !str = concat (["\""] ++ map quote str ++ ["\""])
 +quoteStr ∷ Ascii → AsciiBuilder
 +quoteStr str = A.toAsciiBuilder "\"" ⊕
 +               go (A.toByteString str) (∅) ⊕
 +               A.toAsciiBuilder "\""
      where
 -      quote :: Char -> String
 -      quote '"' = "\\\""
 -      quote c   = [c]
 +      go ∷ BS.ByteString → AsciiBuilder → AsciiBuilder
 +      go bs ab
 +          = case BS.break (≡ '"') bs of
 +              (x, y)
 +                  | BS.null y → ab ⊕ b2ab x
 +                  | otherwise → go (BS.tail y) (ab ⊕ b2ab x
 +                                                   ⊕ A.toAsciiBuilder "\\\"")
  
 +      b2ab ∷ BS.ByteString → AsciiBuilder
 +      b2ab = A.toAsciiBuilder ∘ A.unsafeFromByteString
  
  -- |> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
  --  > ==> [("aaa", "bbb"), ("ccc", "ddd")]
  parseWWWFormURLEncoded ∷ String → [(String, String)]
  parseWWWFormURLEncoded src
-     | src == "" = []
-     | otherwise = do pairStr <- splitBy (\ c → c == ';' || c == '&') src
-                      let (key, value) = break (== '=') pairStr
-                      return ( unEscapeString key
-                             , unEscapeString $ case value of
-                                                  ('=':val) → val
-                                                  val       → val
+     | null src  = []
+     | otherwise = do pairStr ← splitBy (\ c → c ≡ ';' ∨ c ≡ '&') src
+                      let (key, value) = break (≡ '=') pairStr
+                      return ( unescape key
+                             , unescape $ case value of
+                                            ('=':val) → val
+                                            val       → val
                              )
+     where
+       unescape ∷ String → String
+       unescape = unEscapeString ∘ map plusToSpace
+ 
+       plusToSpace ∷ Char → Char
+       plusToSpace '+' = ' '
+       plusToSpace c   = c