Network/HTTP/Lucu/Utils.hs

   1 {-# LANGUAGE
   2     BangPatterns
   3   , UnicodeSyntax
   4   #-}
   5 -- |Utility functions used internally in the Lucu httpd. These
   6 -- functions may be useful too for something else.
   7 module Network.HTTP.Lucu.Utils
   8     ( splitBy
   9     , joinWith
  10     , trim
  11     , isWhiteSpace
  12     , quoteStr
  13     , parseWWWFormURLEncoded
  14     )
  15     where
  16 import Control.Monad
  17 import Data.List     hiding (last)
  18 import Network.URI
  19 import Prelude       hiding (last)
  20 import Prelude.Unicode
  21
  22 -- |> splitBy (== ':') "ab:c:def"
  23 --  > ==> ["ab", "c", "def"]
  24 splitBy :: (a -> Bool) -> [a] -> [[a]]
  25 splitBy isSep src
  26     = case break isSep src
  27       of (last , []       ) -> [last]
  28          (first, _sep:rest) -> first : splitBy isSep rest
  29
  30 -- |> joinWith ":" ["ab", "c", "def"]
  31 --  > ==> "ab:c:def"
  32 joinWith :: [a] -> [[a]] -> [a]
  33 joinWith = (join .) . intersperse
  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 -- |@'isWhiteSpace' c@ is 'Prelude.True' iff c is one of SP, HT, CR
  44 -- and LF.
  45 isWhiteSpace :: Char -> Bool
  46 isWhiteSpace ' '  = True
  47 isWhiteSpace '\t' = True
  48 isWhiteSpace '\r' = True
  49 isWhiteSpace '\n' = True
  50 isWhiteSpace _    = False
  51 {-# INLINE isWhiteSpace #-}
  52
  53 -- |> quoteStr "abc"
  54 --  > ==> "\"abc\""
  55 --
  56 --  > quoteStr "ab\"c"
  57 --  > ==> "\"ab\\\"c\""
  58 quoteStr :: String -> String
  59 quoteStr !str = concat (["\""] ++ 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     | null src  = []
  71     | otherwise = do pairStr ← splitBy (\ c → c ≡ ';' ∨ c ≡ '&') src
  72                      let (key, value) = break (≡ '=') pairStr
  73                      return ( unescape key
  74                             , unescape $ case value of
  75                                            ('=':val) → val
  76                                            val       → val
  77                             )
  78     where
  79       unescape ∷ String → String
  80       unescape = unEscapeString ∘ map plusToSpace
  81
  82       plusToSpace ∷ Char → Char
  83       plusToSpace '+' = ' '
  84       plusToSpace c   = c