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