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     , noCaseEq
   8     , isWhiteSpace
   9     , quoteStr
  10     , parseWWWFormURLEncoded
  11     )
  12     where
  13
  14 import Control.Monad.Trans
  15 import Data.Char
  16 import Data.List
  17 import Foreign
  18 import Foreign.C
  19 import Network.URI
  20
  21 -- |> splitBy (== ':') "ab:c:def"
  22 --  > ==> ["ab", "c", "def"]
  23 splitBy :: (a -> Bool) -> [a] -> [[a]]
  24 splitBy isSeparator src
  25     = case break isSeparator src
  26       of (last , []      ) -> last  : []
  27          (first, sep:rest) -> first : splitBy isSeparator rest
  28
  29 -- |> joinWith ':' ["ab", "c", "def"]
  30 --  > ==> "ab:c:def"
  31 joinWith :: [a] -> [[a]] -> [a]
  32 joinWith separator xs
  33     = foldr (++) [] $ intersperse separator xs
  34
  35 -- |> trim (== '_') "__ab_c__def___"
  36 --  > ==> "ab_c__def"
  37 trim :: (a -> Bool) -> [a] -> [a]
  38 trim p = trimTail . trimHead
  39     where
  40       trimHead = dropWhile p
  41       trimTail = reverse . trimHead . reverse
  42
  43 -- |@'noCaseEq' a b@ is equivalent to @(map toLower a) == (map toLower
  44 -- b)@
  45 noCaseEq :: String -> String -> Bool
  46 noCaseEq a b
  47     = (map toLower a) == (map toLower b)
  48
  49 -- |@'isWhiteSpace' c@ is True iff c is one of SP, HT, CR and LF.
  50 isWhiteSpace :: Char -> Bool
  51 isWhiteSpace = flip elem " \t\r\n"
  52
  53 -- |> quoteStr "abc"
  54 --  > ==> "\"abc\""
  55 --
  56 --  > quoteStr "ab\"c"
  57 --  > ==> "\"ab\\\"c\""
  58 quoteStr :: String -> String
  59 quoteStr str = foldr (++) "" (["\""] ++ map quote str ++ ["\""])
  60     where
  61       quote :: Char -> String
  62       quote '"' = "\\\""
  63       quote c   = [c]
  64
  65
  66 -- |> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
  67 --  > ==> [("aaa", "bbb"), ("ccc", "ddd")]
  68 parseWWWFormURLEncoded :: String -> [(String, String)]
  69 parseWWWFormURLEncoded src
  70     | src == "" = []
  71     | otherwise = do pairStr <- splitBy (\ c -> c == ';' || c == '&') src
  72                      let (key, value) = break (== '=') pairStr
  73                      return ( unEscapeString key
  74                             , unEscapeString $ case value of
  75                                                  ('=':val) -> val
  76                                                  ""        -> ""
  77                             )