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     , noCaseEq
   8     , isWhiteSpace
   9     , quoteStr
  10     )
  11     where
  12
  13 import Control.Monad.Trans
  14 import Data.Char
  15 import Data.List
  16 import Foreign
  17 import Foreign.C
  18 import Network.URI
  19
  20 -- |> splitBy (== ':') "ab:c:def"
  21 --  > ==> ["ab", "c", "def"]
  22 splitBy :: (a -> Bool) -> [a] -> [[a]]
  23 splitBy isSeparator src
  24     = case break isSeparator src
  25       of (last , []      ) -> last  : []
  26          (first, sep:rest) -> first : splitBy isSeparator rest
  27
  28 -- |> joinWith ':' ["ab", "c", "def"]
  29 --  > ==> "ab:c:def"
  30 joinWith :: [a] -> [[a]] -> [a]
  31 joinWith separator xs
  32     = foldr (++) [] $ intersperse separator xs
  33
  34 -- |> trim (== '_') "__ab_c__def___"
  35 --  > ==> "ab_c__def"
  36 trim :: (a -> Bool) -> [a] -> [a]
  37 trim p = trimTail . trimHead
  38     where
  39       trimHead = dropWhile p
  40       trimTail = reverse . trimHead . reverse
  41
  42 -- |@'noCaseEq' a b@ is equivalent to @(map toLower a) == (map toLower
  43 -- b)@
  44 noCaseEq :: String -> String -> Bool
  45 noCaseEq a b
  46     = (map toLower a) == (map toLower b)
  47
  48 -- |@'isWhiteSpace' c@ is True iff c is one of SP, HT, CR and LF.
  49 isWhiteSpace :: Char -> Bool
  50 isWhiteSpace = flip elem " \t\r\n"
  51
  52 -- |> quoteStr "abc"
  53 --  > ==> "\"abc\""
  54 --
  55 --  > quoteStr "ab\"c"
  56 --  > ==> "\"ab\\\"c\""
  57 quoteStr :: String -> String
  58 quoteStr str = foldr (++) "" (["\""] ++ map quote str ++ ["\""])
  59     where
  60       quote :: Char -> String
  61       quote '"' = "\\\""
  62       quote c   = [c]