Skip to content
Browse files

Use case-insensitive instead of CIByteString

  • Loading branch information...
1 parent 247f83e commit af0a9be5bdb3298a8a71ff962663c871ae7c9f3b @basvandijk basvandijk committed
View
2 snap-core.cabal
@@ -109,7 +109,6 @@ Library
build-depends: bytestring-mmap >= 0.2.1 && <0.3
exposed-modules:
- Data.CIByteString,
Snap.Types,
Snap.Iteratee,
Snap.Internal.Debug,
@@ -134,6 +133,7 @@ Library
blaze-builder >= 0.2.1.4 && <0.3,
bytestring,
bytestring-nums,
+ case-insensitive >= 0.2 && < 0.3,
containers,
deepseq >= 1.1 && <1.2,
directory,
View
79 src/Data/CIByteString.hs
@@ -1,79 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-------------------------------------------------------------------------------
--- | "Data.CIByteString" is a module containing 'CIByteString', a wrapper for
--- 'ByteString' which provides case-insensitive (ASCII-wise) 'Ord' and 'Eq'
--- instances.
---
--- 'CIByteString' also has an 'IsString' instance, so if you use the
--- \"OverloadedStrings\" LANGUAGE pragma you can write case-insensitive string
--- literals, e.g.:
---
--- @
--- \> let a = \"Foo\" in
--- putStrLn $ (show $ unCI a) ++ \"==\\\"FoO\\\" is \" ++
--- show (a == \"FoO\")
--- \"Foo\"==\"FoO\" is True
--- @
-
-module Data.CIByteString
- ( CIByteString
- , toCI
- , unCI
- , ciToLower
- ) where
-
-
-------------------------------------------------------------------------------
--- for IsString instance
-import Data.ByteString.Char8 ()
-import Data.ByteString (ByteString)
-import Data.ByteString.Internal (c2w, w2c)
-import qualified Data.ByteString as S
-import Data.Char
-import Data.String
-
-
-------------------------------------------------------------------------------
--- | A case-insensitive newtype wrapper for 'ByteString'
-data CIByteString = CIByteString { unCI :: !ByteString
- , _lowercased :: !ByteString }
-
-
-------------------------------------------------------------------------------
-toCI :: ByteString -> CIByteString
-toCI s = CIByteString s t
- where
- t = lowercase s
-
-
-------------------------------------------------------------------------------
-ciToLower :: CIByteString -> ByteString
-ciToLower = _lowercased
-
-
-------------------------------------------------------------------------------
-instance Show CIByteString where
- show (CIByteString s _) = show s
-
-
-------------------------------------------------------------------------------
-lowercase :: ByteString -> ByteString
-lowercase = S.map (c2w . toLower . w2c)
-
-
-------------------------------------------------------------------------------
-instance Eq CIByteString where
- (CIByteString _ a) == (CIByteString _ b) = a == b
- (CIByteString _ a) /= (CIByteString _ b) = a /= b
-
-
-------------------------------------------------------------------------------
-instance Ord CIByteString where
- (CIByteString _ a) <= (CIByteString _ b) = a <= b
-
-
-------------------------------------------------------------------------------
-instance IsString CIByteString where
- fromString = toCI . fromString
View
17 src/Snap/Internal/Http/Types.hs
@@ -57,7 +57,8 @@ import Foreign.C.String
#endif
------------------------------------------------------------------------------
-import Data.CIByteString
+import Data.CaseInsensitive (CI)
+import qualified Data.CaseInsensitive as CI
import Snap.Iteratee (Enumerator)
import qualified Snap.Iteratee as I
@@ -84,7 +85,7 @@ foreign import ccall unsafe "c_format_log_time"
------------------------------------------------------------------------------
-- | A type alias for a case-insensitive key-value mapping.
-type Headers = Map CIByteString [ByteString]
+type Headers = Map (CI ByteString) [ByteString]
------------------------------------------------------------------------------
@@ -102,33 +103,33 @@ class HasHeaders a where
-- | Adds a header key-value-pair to the 'HasHeaders' datatype. If a header
-- with the same name already exists, the new value is appended to the headers
-- list.
-addHeader :: (HasHeaders a) => CIByteString -> ByteString -> a -> a
+addHeader :: (HasHeaders a) => CI ByteString -> ByteString -> a -> a
addHeader k v = updateHeaders $ Map.insertWith' (++) k [v]
------------------------------------------------------------------------------
-- | Sets a header key-value-pair in a 'HasHeaders' datatype. If a header with
-- the same name already exists, it is overwritten with the new value.
-setHeader :: (HasHeaders a) => CIByteString -> ByteString -> a -> a
+setHeader :: (HasHeaders a) => CI ByteString -> ByteString -> a -> a
setHeader k v = updateHeaders $ Map.insert k [v]
------------------------------------------------------------------------------
-- | Gets all of the values for a given header.
-getHeaders :: (HasHeaders a) => CIByteString -> a -> Maybe [ByteString]
+getHeaders :: (HasHeaders a) => CI ByteString -> a -> Maybe [ByteString]
getHeaders k a = Map.lookup k $ headers a
------------------------------------------------------------------------------
-- | Gets a header value out of a 'HasHeaders' datatype. If many headers came
-- in with the same name, they will be catenated together.
-getHeader :: (HasHeaders a) => CIByteString -> a -> Maybe ByteString
+getHeader :: (HasHeaders a) => CI ByteString -> a -> Maybe ByteString
getHeader k a = liftM (S.intercalate " ") (Map.lookup k $ headers a)
------------------------------------------------------------------------------
-- | Clears a header value from a 'HasHeaders' datatype.
-deleteHeader :: (HasHeaders a) => CIByteString -> a -> a
+deleteHeader :: (HasHeaders a) => CI ByteString -> a -> a
deleteHeader k = updateHeaders $ Map.delete k
@@ -304,7 +305,7 @@ instance Show Request where
beginheaders =
"Headers:\n ========================================"
endheaders = " ========================================"
- hdrs' (a,b) = (B.unpack $ unCI a) ++ ": " ++ (show (map B.unpack b))
+ hdrs' (a,b) = (B.unpack $ CI.original a) ++ ": " ++ (show (map B.unpack b))
hdrs = " " ++ (concat $ intersperse "\n " $
map hdrs' (Map.toAscList $ rqHeaders r))
contentlength = concat [ "content-length: "
View
11 src/Snap/Internal/Parsing.hs
@@ -6,7 +6,8 @@ import Control.Arrow (first)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
-import Data.CIByteString
+import qualified Data.CaseInsensitive as CI
+import Data.CaseInsensitive (CI)
import Data.Char (isAlpha, isAscii, isControl)
import Control.Applicative
import Control.Monad
@@ -185,21 +186,21 @@ trim = snd . S.span isSpace . fst . S.spanEnd isSpace
------------------------------------------------------------------------------
-pValueWithParameters :: Parser (ByteString, [(CIByteString, ByteString)])
+pValueWithParameters :: Parser (ByteString, [(CI ByteString, ByteString)])
pValueWithParameters = do
value <- liftM trim (pSpaces *> takeWhile (/= ';'))
params <- many pParam
- return (value, map (first toCI) params)
+ return (value, map (first CI.mk) params)
where
pParam = pSpaces *> char ';' *> pSpaces *> pParameter
------------------------------------------------------------------------------
pContentTypeWithParameters ::
- Parser (ByteString, [(CIByteString, ByteString)])
+ Parser (ByteString, [(CI ByteString, ByteString)])
pContentTypeWithParameters = do
value <- liftM trim (pSpaces *> takeWhile (not . isSep))
params <- many (pSpaces *> satisfy isSep *> pSpaces *> pParameter)
- return (value, map (first toCI) params)
+ return (value, map (first CI.mk) params)
where
isSep c = c == ';' || c == ','
View
4 src/Snap/Internal/Types.hs
@@ -19,7 +19,7 @@ import Control.Monad.State
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
-import qualified Data.CIByteString as CIB
+import Data.CaseInsensitive (CI)
import Data.Int
import Data.IORef
import Data.Maybe
@@ -634,7 +634,7 @@ ipHeaderFilter = ipHeaderFilter' "x-forwarded-for"
-- address can get it in a uniform manner. It has specifically limited
-- functionality to ensure that its transformation can be trusted,
-- when used correctly.
-ipHeaderFilter' :: MonadSnap m => CIB.CIByteString -> m ()
+ipHeaderFilter' :: MonadSnap m => CI ByteString -> m ()
ipHeaderFilter' header = do
headerContents <- getHeader header <$> getRequest
View
4 src/Snap/Util/FileUploads.hs
@@ -72,10 +72,10 @@ import Control.Monad.Trans
import qualified Data.Attoparsec.Char8 as Atto
import Data.Attoparsec.Char8 hiding (many, Result(..))
import Data.Attoparsec.Enumerator
-import Data.CIByteString
import qualified Data.ByteString.Char8 as S
import Data.ByteString.Char8 (ByteString)
import Data.ByteString.Internal (c2w)
+import qualified Data.CaseInsensitive as CI
import qualified Data.DList as D
import Data.Enumerator.Binary (iterHandle)
import Data.IORef
@@ -791,7 +791,7 @@ pHeadersWithSeparator = pHeaders <* crlf
toHeaders :: [(ByteString,ByteString)] -> Headers
toHeaders kvps = foldl' f Map.empty kvps'
where
- kvps' = map (first toCI . second (:[])) kvps
+ kvps' = map (first CI.mk . second (:[])) kvps
f m (k,v) = Map.insertWith' (flip (++)) k v m
View
1 test/runTestsAndCoverage.sh
@@ -31,7 +31,6 @@ rm -Rf $DIR
mkdir -p $DIR
EXCLUDES='Main
-Data.CIByteString
Snap.Internal.Debug
Snap.Internal.Iteratee.Debug
Snap.Iteratee.Tests

0 comments on commit af0a9be

Please sign in to comment.
Something went wrong with that request. Please try again.