Network/HTTP/Lucu/Utils.hs

   1 -- |Utility functions used internally in the Lucu httpd. These
   2 -- functions may be useful too for something else.
   3 module Network.HTTP.Lucu.Utils
   4     ( splitBy
   5     , joinWith
   6     , trim
   7     , isWhiteSpace
   8     , quoteStr
   9     , parseWWWFormURLEncoded
  10     )
  11     where
  12
  13 import Data.Char
  14 import Data.List
  15 import Network.URI
  16
  17 -- |> splitBy (== ':') "ab:c:def"
  18 --  > ==> ["ab", "c", "def"]
  19 splitBy :: (a -> Bool) -> [a] -> [[a]]
  20 splitBy isSeparator src
  21     = isSeparator `seq`
  22       case break isSeparator src
  23       of (last , []      ) -> last  : []
  24          (first, sep:rest) -> first : splitBy isSeparator rest
  25
  26 -- |> joinWith ":" ["ab", "c", "def"]
  27 --  > ==> "ab:c:def"
  28 joinWith :: [a] -> [[a]] -> [a]
  29 joinWith separator xs
  30     = separator `seq` xs `seq`
  31       foldr (++) [] $! intersperse separator xs
  32
  33 -- |> trim (== '_') "__ab_c__def___"
  34 --  > ==> "ab_c__def"
  35 trim :: (a -> Bool) -> [a] -> [a]
  36 trim p = p `seq` trimTail . trimHead
  37     where
  38       trimHead = dropWhile p
  39       trimTail = reverse . trimHead . reverse
  40
  41 -- |@'isWhiteSpace' c@ is 'Prelude.True' iff c is one of SP, HT, CR
  42 -- and LF.
  43 isWhiteSpace :: Char -> Bool
  44 isWhiteSpace ' '  = True
  45 isWhiteSpace '\t' = True
  46 isWhiteSpace '\r' = True
  47 isWhiteSpace '\n' = True
  48 isWhiteSpace _    = False
  49 {-# INLINE isWhiteSpace #-}
  50
  51 -- |> quoteStr "abc"
  52 --  > ==> "\"abc\""
  53 --
  54 --  > quoteStr "ab\"c"
  55 --  > ==> "\"ab\\\"c\""
  56 quoteStr :: String -> String
  57 quoteStr str = str `seq`
  58                foldr (++) "" (["\""] ++ map quote str ++ ["\""])
  59     where
  60       quote :: Char -> String
  61       quote '"' = "\\\""
  62       quote c   = [c]
  63
  64
  65 -- |> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
  66 --  > ==> [("aaa", "bbb"), ("ccc", "ddd")]
  67 parseWWWFormURLEncoded :: String -> [(String, String)]
  68 parseWWWFormURLEncoded src
  69     | src == "" = []
  70     | otherwise = do pairStr <- splitBy (\ c -> c == ';' || c == '&') src
  71                      let (key, value) = break (== '=') pairStr
  72                      return ( unEscapeString key
  73                             , unEscapeString $ case value of
  74                                                  ('=':val) -> val
  75                                                  ""        -> ""
  76                             )