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