+-- |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
+ , isWhiteSpace
+ , quoteStr
)
where
+import Control.Monad.Trans
import Data.Char
import Data.List
+import Foreign
+import Foreign.C
+import Network.URI
-
+-- |> splitBy (== ':') "ab:c:def"
+-- > ==> ["ab", "c", "def"]
splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy isSeparator src
= 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
+ = foldr (++) [] $ intersperse separator xs
+-- |> trim (== '_') "__ab_c__def___"
+-- > ==> "ab_c__def"
trim :: (a -> Bool) -> [a] -> [a]
trim p = trimTail . trimHead
where
trimHead = dropWhile p
trimTail = reverse . trimHead . reverse
-
+-- |@'noCaseEq' a b@ is equivalent to @(map toLower a) == (map toLower
+-- b)@
noCaseEq :: String -> String -> Bool
noCaseEq a b
= (map toLower a) == (map toLower b)
-
+-- |@'isWhiteSpace' c@ is True iff c is one of SP, HT, CR and LF.
isWhiteSpace :: Char -> Bool
isWhiteSpace = flip elem " \t\r\n"
+
+-- |> quoteStr "abc"
+-- > ==> "\"abc\""
+--
+-- > quoteStr "ab\"c"
+-- > ==> "\"ab\\\"c\""
+quoteStr :: String -> String
+quoteStr str = foldr (++) "" (["\""] ++ map quote str ++ ["\""])
+ where
+ quote :: Char -> String
+ quote '"' = "\\\""
+ quote c = [c]
\ No newline at end of file