Network/HTTP/Lucu/Utils.hs

   1 {-# LANGUAGE
   2     BangPatterns
   3   , OverloadedStrings
   4   , UnicodeSyntax
   5   #-}
   6 -- |Utility functions used internally in the Lucu httpd. These
   7 -- functions may be useful too for something else.
   8 module Network.HTTP.Lucu.Utils
   9     ( splitBy
  10     , joinWith
  11     , quoteStr
  12     , parseWWWFormURLEncoded
  13     )
  14     where
  15 import Control.Monad
  16 import Data.Ascii (Ascii, AsciiBuilder)
  17 import qualified Data.Ascii as A
  18 import qualified Data.ByteString.Char8 as BS
  19 import Data.List hiding (last)
  20 import Data.Monoid.Unicode
  21 import Network.URI
  22 import Prelude hiding (last)
  23 import Prelude.Unicode
  24
  25 -- |> splitBy (== ':') "ab:c:def"
  26 --  > ==> ["ab", "c", "def"]
  27 splitBy ∷ (a → Bool) → [a] → [[a]]
  28 splitBy isSep src
  29     = case break isSep src
  30       of (last , []       ) → [last]
  31          (first, _sep:rest) → first : splitBy isSep rest
  32
  33 -- |> joinWith ":" ["ab", "c", "def"]
  34 --  > ==> "ab:c:def"
  35 joinWith ∷ Ascii → [AsciiBuilder] → AsciiBuilder
  36 {-# INLINEABLE joinWith #-}
  37 joinWith sep = flip go (∅)
  38     where
  39       go ∷ [AsciiBuilder] → AsciiBuilder → AsciiBuilder
  40       {-# INLINE go #-}
  41       go []     ab = ab
  42       go (x:[]) ab = ab ⊕ x
  43       go (x:xs) ab = go xs (ab ⊕ A.toAsciiBuilder sep ⊕ x)
  44
  45 -- |> quoteStr "abc"
  46 --  > ==> "\"abc\""
  47 --
  48 --  > quoteStr "ab\"c"
  49 --  > ==> "\"ab\\\"c\""
  50 quoteStr ∷ Ascii → AsciiBuilder
  51 quoteStr str = A.toAsciiBuilder "\"" ⊕
  52                go (A.toByteString str) (∅) ⊕
  53                A.toAsciiBuilder "\""
  54     where
  55       go ∷ BS.ByteString → AsciiBuilder → AsciiBuilder
  56       go bs ab
  57           = case BS.break (≡ '"') bs of
  58               (x, y)
  59                   | BS.null y → ab ⊕ b2ab x
  60                   | otherwise → go (BS.tail y) (ab ⊕ b2ab x
  61                                                    ⊕ A.toAsciiBuilder "\\\"")
  62
  63       b2ab ∷ BS.ByteString → AsciiBuilder
  64       b2ab = A.toAsciiBuilder ∘ A.unsafeFromByteString
  65
  66 -- |> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
  67 --  > ==> [("aaa", "bbb"), ("ccc", "ddd")]
  68 parseWWWFormURLEncoded ∷ String → [(String, String)]
  69 parseWWWFormURLEncoded src
  70     | null src  = []
  71     | otherwise = do pairStr ← splitBy (\ c → c ≡ ';' ∨ c ≡ '&') src
  72                      let (key, value) = break (≡ '=') pairStr
  73                      return ( unescape key
  74                             , unescape $ case value of
  75                                            ('=':val) → val
  76                                            val       → val
  77                             )
  78     where
  79       unescape ∷ String → String
  80       unescape = unEscapeString ∘ map plusToSpace
  81
  82       plusToSpace ∷ Char → Char
  83       plusToSpace '+' = ' '
  84       plusToSpace c   = c