Rakka.Utils

Ditz-issue: 1c6bfe78f0f9ebd241b8650eb62939dc932cd6f0

diff --git a/Rakka.cabal b/Rakka.cabal
index fffa6f8678ebebf501532ddbafaddfdb44fedb3b..cda8dc97e6ae241b0ccb03bdf97b4ed8d69aac34 100644 (file)
--- a/Rakka.cabal
+++ b/Rakka.cabal
@@ -72,6 +72,7 @@ Executable rakka
         base-unicode-symbols == 0.2.*,
         bytestring           == 0.9.*,
         containers           == 0.4.*,
+        dataenc              == 0.14.*,
         directory            == 1.1.*,
         filemanip            == 0.3.*,
         filepath             == 1.2.*,

diff --git a/Rakka/Utils.hs b/Rakka/Utils.hs
index 051685cbf8a93cfedb07258fe44a04e0ac9169d3..e89fee08c381e21c66bdd498556442915a64e047 100644 (file)
--- a/Rakka/Utils.hs
+++ b/Rakka/Utils.hs
@@ -10,25 +10,24 @@ module Rakka.Utils
     , deleteIfEmpty
     , chomp
     , guessMIMEType
-    , isSafeChar
     , mkQueryString
     )
     where
-import qualified Blaze.ByteString.Builder as BBB
 import Control.Arrow
 import Control.Arrow.ArrowList
 import Data.Ascii (Ascii)
 import qualified Data.Ascii as A
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as C8
 import qualified Data.ByteString.Unsafe as BS
 import qualified Data.ByteString.Lazy as LS
-import Data.Monoid.Unicode
+import Data.Char
 import qualified Data.Text as T
-import qualified Data.Text.Lazy as LT
 import Data.Text.Encoding
 import Magic
 import Network.HTTP.Lucu
 import Network.URI
+import Numeric
 import Prelude.Unicode
 import System.IO.Unsafe
 
@@ -79,31 +78,56 @@ guessMIMEType = read
                    magicLoadDefault m
                    return m
 
+{-
 isSafeChar ∷ Char → Bool
 {-# INLINEABLE isSafeChar #-}
 isSafeChar c
-    | c ≡ '/'        = True
-    | isReserved c   = False
-    | isUnreserved c = True
-    | otherwise      = False
+    | c ≡ '/'           = True
+    | isReserved c      = False
+    | c > ' ' ∧ c ≤ '~' = True
+    | otherwise         = False
+-}
 
 mkQueryString ∷ [(T.Text, T.Text)] → Ascii
-{-# INLINE mkQueryString #-}
+{-# INLINEABLE mkQueryString #-}
 mkQueryString = A.unsafeFromByteString
-                ∘ BBB.toByteString
-                ∘ flip mkBBB (∅)
+                ∘ BS.intercalate (C8.singleton ';')
+                ∘ map encodePair
     where
-      mkBBB ∷ [(T.Text, T.Text)] → BBB.Builder → BBB.Builder
-      {-# INLINEABLE mkBBB #-}
-      mkBBB []      acc = acc
-      mkBBB (kv:[]) acc = acc ⊕ pair kv
-      mkBBB (kv:xs) acc = mkBBB xs (acc ⊕ pair kv ⊕ semicolon)
+      encodePair ∷ (T.Text, T.Text) → BS.ByteString
+      {-# INLINE encodePair #-}
+      encodePair (k, v)
+          = BS.intercalate (C8.singleton '=') [encodeText k, encodeText v]
 
-      pair ∷ (T.Text, T.Text) → BBB.Builder
-      {-# INLINE pair #-}
-      pair (k, v)
-          = encodeText k ⊕ equal ⊕ encodeText v
-
-      encodeText ∷ T.Text → BBB.Builder
+      encodeText ∷ T.Text → BS.ByteString
       {-# INLINE encodeText #-}
-      encodeText = BBB.fromByteString ∘ URI.encode ∘ encodeUtf8
+      encodeText = toURLEncoded ∘ encodeUtf8
+
+toURLEncoded ∷ BS.ByteString → BS.ByteString
+{-# INLINEABLE toURLEncoded #-}
+toURLEncoded = C8.concatMap go
+    where
+      go ∷ Char → BS.ByteString
+      {-# INLINE go #-}
+      go c | c ≡ ' '        = C8.singleton '+'
+           | isReserved   c = urlEncode c
+           | isUnreserved c = C8.singleton c
+           | otherwise      = urlEncode c
+
+      urlEncode ∷ Char → BS.ByteString
+      {-# INLINE urlEncode #-}
+      urlEncode c = C8.pack ('%':toHex (ord c))
+
+      toHex ∷ Int → String
+      {-# INLINE toHex #-}
+      toHex n
+          = case showIntAtBase 16 toChrHex n "" of
+              []  → "00"
+              [c] → ['0', c]
+              cs  → cs
+
+      toChrHex ∷ Int → Char
+      {-# INLINE toChrHex #-}
+      toChrHex d
+          | d < 10    = chr (ord '0' + fromIntegral  d    )
+          | otherwise = chr (ord 'A' + fromIntegral (d-10))