X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FUtils.hs;h=c85c9a72b6a023241857ba1c613eb1e4d5a2485e;hb=70bf5bd248aa426ca4e410b3fb9a0529354aedaf;hp=b22780b5f121aab681722b8ac17333f41ba3a66e;hpb=858129cb755aa09da2b7bd758efb8519f2c89103;p=Lucu.git diff --git a/Network/HTTP/Lucu/Utils.hs b/Network/HTTP/Lucu/Utils.hs index b22780b..c85c9a7 100644 --- a/Network/HTTP/Lucu/Utils.hs +++ b/Network/HTTP/Lucu/Utils.hs @@ -1,64 +1,47 @@ +{-# LANGUAGE + BangPatterns + , UnicodeSyntax + #-} -- |Utility functions used internally in the Lucu httpd. These -- functions may be useful too for something else. module Network.HTTP.Lucu.Utils ( splitBy , joinWith , trim - , noCaseEq - , noCaseEq' , isWhiteSpace , quoteStr , parseWWWFormURLEncoded ) where -import Control.Monad.Trans -import Data.Char -import Data.List -import Foreign -import Foreign.C +import Control.Monad +import Data.List hiding (last) import Network.URI +import Prelude hiding (last) -- |> splitBy (== ':') "ab:c:def" -- > ==> ["ab", "c", "def"] splitBy :: (a -> Bool) -> [a] -> [[a]] -splitBy isSeparator src - = isSeparator `seq` - case break isSeparator src - of (last , [] ) -> last : [] - (first, sep:rest) -> first : splitBy isSeparator rest +splitBy isSep src + = case break isSep src + of (last , [] ) -> [last] + (first, _sep:rest) -> first : splitBy isSep rest --- |> joinWith ':' ["ab", "c", "def"] +-- |> joinWith ":" ["ab", "c", "def"] -- > ==> "ab:c:def" joinWith :: [a] -> [[a]] -> [a] -joinWith separator xs - = separator `seq` xs `seq` - foldr (++) [] $! intersperse separator xs +joinWith = (join .) . intersperse -- |> trim (== '_') "__ab_c__def___" -- > ==> "ab_c__def" trim :: (a -> Bool) -> [a] -> [a] -trim p = p `seq` trimTail . trimHead +trim !p = 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' c@ is 'Prelude.True' iff c is one of SP, HT, CR +-- and LF. isWhiteSpace :: Char -> Bool isWhiteSpace ' ' = True isWhiteSpace '\t' = True @@ -73,8 +56,7 @@ isWhiteSpace _ = False -- > quoteStr "ab\"c" -- > ==> "\"ab\\\"c\"" quoteStr :: String -> String -quoteStr str = str `seq` - foldr (++) "" (["\""] ++ map quote str ++ ["\""]) +quoteStr !str = concat (["\""] ++ map quote str ++ ["\""]) where quote :: Char -> String quote '"' = "\\\"" @@ -91,5 +73,5 @@ parseWWWFormURLEncoded src return ( unEscapeString key , unEscapeString $ case value of ('=':val) -> val - "" -> "" + val -> val )