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 → [Ascii] → AsciiBuilder
  36 {-# INLINEABLE joinWith #-}
  37 joinWith sep = flip go (∅)
  38     where
  39       go ∷ [Ascii] → A.AsciiBuilder → A.AsciiBuilder
  40       {-# INLINE go #-}
  41       go []     ab = ab
  42       go (x:[]) ab = ab ⊕ A.toAsciiBuilder x
  43       go (x:xs) ab = go xs ( ab ⊕
  44                              A.toAsciiBuilder sep ⊕
  45                              A.toAsciiBuilder x )
  46
  47 -- |> quoteStr "abc"
  48 --  > ==> "\"abc\""
  49 --
  50 --  > quoteStr "ab\"c"
  51 --  > ==> "\"ab\\\"c\""
  52 quoteStr ∷ Ascii → AsciiBuilder
  53 quoteStr str = A.toAsciiBuilder "\"" ⊕
  54                go (A.toByteString str) (∅) ⊕
  55                A.toAsciiBuilder "\""
  56     where
  57       go ∷ BS.ByteString → AsciiBuilder → AsciiBuilder
  58       go bs ab
  59           = case BS.break (≡ '"') bs of
  60               (x, y)
  61                   | BS.null y → ab ⊕ b2ab x
  62                   | otherwise → go (BS.tail y) (ab ⊕ b2ab x
  63                                                    ⊕ A.toAsciiBuilder "\\\"")
  64
  65       b2ab ∷ BS.ByteString → AsciiBuilder
  66       b2ab = A.toAsciiBuilder ∘ A.unsafeFromByteString
  67
  68 -- |> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
  69 --  > ==> [("aaa", "bbb"), ("ccc", "ddd")]
  70 parseWWWFormURLEncoded ∷ String → [(String, String)]
  71 parseWWWFormURLEncoded src
  72     | src == "" = []
  73     | otherwise = do pairStr <- splitBy (\ c → c == ';' || c == '&') src
  74                      let (key, value) = break (== '=') pairStr
  75                      return ( unEscapeString key
  76                             , unEscapeString $ case value of
  77                                                  ('=':val) → val
  78                                                  val       → val
  79                             )