+-- |Utility functions used internally in the Lucu httpd. These
+-- functions may be useful too for something else.
module Network.HTTP.Lucu.Utils
- ( splitBy -- (a -> Bool) -> [a] -> [[a]]
- , trim -- (a -> Bool) -> [a] -> [a]
- , noCaseEq -- String -> String -> Bool
- , isWhiteSpace -- Char -> Bool
+ ( splitBy
+ , joinWith
+ , trim
+ , noCaseEq
+ , noCaseEq'
+ , isWhiteSpace
+ , quoteStr
+ , parseWWWFormURLEncoded
)
where
import Data.Char
import Data.List
+import Network.URI
-
+-- |> splitBy (== ':') "ab:c:def"
+-- > ==> ["ab", "c", "def"]
splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy isSeparator src
- = case break isSeparator src
+ = isSeparator `seq`
+ case break isSeparator src
of (last , [] ) -> last : []
(first, sep:rest) -> first : splitBy isSeparator rest
+-- |> joinWith ':' ["ab", "c", "def"]
+-- > ==> "ab:c:def"
+joinWith :: [a] -> [[a]] -> [a]
+joinWith separator xs
+ = separator `seq` xs `seq`
+ foldr (++) [] $! intersperse separator xs
+-- |> trim (== '_') "__ab_c__def___"
+-- > ==> "ab_c__def"
trim :: (a -> Bool) -> [a] -> [a]
-trim p = trimTail . trimHead
+trim p = p `seq` trimTail . trimHead
where
trimHead = dropWhile p
trimTail = reverse . trimHead . reverse
-
+-- |@'noCaseEq' a b@ is equivalent to @(map toLower a) == (map toLower
+-- b)@. See 'noCaseEq''.
noCaseEq :: String -> String -> Bool
noCaseEq a b
= (map toLower a) == (map toLower b)
+{-# INLINE noCaseEq #-}
+-- |@'noCaseEq'' a b@ is a variant of 'noCaseEq' which first checks
+-- the length of two strings to avoid possibly unnecessary comparison.
+noCaseEq' :: String -> String -> Bool
+noCaseEq' a b
+ | length a /= length b = False
+ | otherwise = noCaseEq a b
+{-# INLINE noCaseEq' #-}
+-- |@'isWhiteSpace' c@ is True iff c is one of SP, HT, CR and LF.
isWhiteSpace :: Char -> Bool
-isWhiteSpace = flip elem " \t\r\n"
+isWhiteSpace ' ' = True
+isWhiteSpace '\t' = True
+isWhiteSpace '\r' = True
+isWhiteSpace '\n' = True
+isWhiteSpace _ = False
+{-# INLINE isWhiteSpace #-}
+
+-- |> quoteStr "abc"
+-- > ==> "\"abc\""
+--
+-- > quoteStr "ab\"c"
+-- > ==> "\"ab\\\"c\""
+quoteStr :: String -> String
+quoteStr str = str `seq`
+ foldr (++) "" (["\""] ++ map quote str ++ ["\""])
+ where
+ quote :: Char -> String
+ quote '"' = "\\\""
+ quote c = [c]
+
+
+-- |> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
+-- > ==> [("aaa", "bbb"), ("ccc", "ddd")]
+parseWWWFormURLEncoded :: String -> [(String, String)]
+parseWWWFormURLEncoded src
+ | src == "" = []
+ | otherwise = do pairStr <- splitBy (\ c -> c == ';' || c == '&') src
+ let (key, value) = break (== '=') pairStr
+ return ( unEscapeString key
+ , unEscapeString $ case value of
+ ('=':val) -> val
+ "" -> ""
+ )