case-insensitive-match (empty) → 0.1.0.0
raw patch · 12 files changed
+1374/−0 lines, 12 filesdep +QuickCheckdep +basedep +bytestringsetup-changed
Dependencies added: QuickCheck, base, bytestring, case-insensitive, case-insensitive-match, criterion, mtl, random-strings, tagsoup, text
Files
- CHANGELOG +0/−0
- LICENSE +30/−0
- README.markdown +87/−0
- Setup.hs +2/−0
- case-insensitive-match.cabal +119/−0
- lib/Data/CaseInsensitive.hs +23/−0
- lib/Data/CaseInsensitive/Eq.hs +163/−0
- lib/Data/CaseInsensitive/Ord.hs +226/−0
- src/bench-others.hs +265/−0
- src/bench-tagsoup.hs +72/−0
- src/readme-example.hs +19/−0
- src/test-basics.hs +368/−0
+ CHANGELOG view
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Michael Hatfield++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Michael Hatfield nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.markdown view
@@ -0,0 +1,87 @@++### case-insensitive-match 0.1.0.0++Here is a simplified library for matching and comparing strings in a+case-insensitive manner. The only dependencies are `base`, `bytestring` and+`text`.++Usage is simple++ -- normal string comparison+ "href" /= "HREF"+ "apples" /= "oranges"+ "Smith" < "Jones++ -- case-insensitive comparison+ "href" ^== "HREF"+ "appples" ^/= "oranges"+ "jones" ^< "Smith"++ -- sorting some data structurue+ get_names p = (last_name p,first_name p)+ sortBy (caseInsensitiveComparing get_names) people++#### Benchmarks++The benchmarks are pretty comprehensive, offering comparisons with other+algorithms, including the `case-insensitive` package and simple case folding+using the `base` package. Before simply running the `bench-others` executable,+check the source code or you'll end up with a long series of 360 benchmark+tests. You'll want something like `bench-others -m glob ByteString/Short/*/*`,+which runs _only_ 36 benchmarks. The heirarchy is+`<data-type>/<string-length>/<match-type>/<algorithm>`. As usual, performance+comparisons depend heavily on use-cases, but for matching shorter strings that+are often unequal this algorithm is clearly fastest.++There is also a real-world bench test that compares different algorithms while+looking for links in an HTML file with Text.HTML.TagSoup. This bench involves+a lot of work other than string comparison, so the differences between+algorithms is slim, but usually measurable. Build an run:++ $ cabal build bench-tagsoup+ ...++ $ curl -s 'https://hackage.haskell.org/packages/names' > sample/hackage-names.html+ $ dist/build/bench-tagsoup/bench-tagsoup < sample/hackage-names.html+ ...+++#### Testing++It would be quite involved to build a perfectly comprehensive testing module,+but the `test-basics` executable is tests multiple cases against all supported+data types.+++#### Sample++Here is a sample:++ {-# LANGUAGE OverloadedStrings #-}++ module Main ( main ) where++ import Data.List+ import Data.CaseInsensitive+ import qualified Data.ByteString.Char8 as BS++ main = do+ stdin <- BS.getContents+ let sorted_names = map join_name $ sortBy caseInsensitiveCompare $ map split_name $ BS.lines stdin+ mapM_ BS.putStrLn sorted_names+++ split_name name = (last,BS.drop 2 first)+ where (last,first) = BS.span (/= ',') name++ join_name (last,first) = BS.concat [ last , ", " , first ]+++Try it with:++ $ cabal build readme-sample+ ...+ + $ dist/build/readme-sample/readme-sample < sample/declaration-signers.txt++
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ case-insensitive-match.cabal view
@@ -0,0 +1,119 @@++name: case-insensitive-match+version: 0.1.0.0++license: BSD3+license-file: LICENSE+copyright: (c) 2016 Michael Hatfield++author: Michael Hatfield+maintainer: github@michael-hatfield.com+homepage: https://github.com/mikehat/random-strings+bug-reports: https://github.com/mikehat/random-strings++synopsis: A simplified, faster way to do case-insensitive matching.+description:++ A way to do case-insensitive string matching and comparison with less+ overhead and more speed. The 'Data.CaseInsensitive.Eq' module offers+ simplified syntax and optimized instances for 'ByteString', 'String' and+ 'Text'. In particular, the 'ByteString' implementation assumes ISO-8859-1+ (8-bit) encoding and performs benchmark testing significantly faster than+ other implementations.++stability: experimental+category: Text+build-type: Simple+cabal-version: >=1.10++extra-source-files: README.markdown+ , CHANGELOG++source-repository head+ type: git+ location: git://github.com/mikehat/case-insensitive-match.git+ branch: master++source-repository this+ type: git+ location: git://github.com/mikehat/case-insensitive-match.git+ branch: master+ tag: 0.1.0.0+++library+ exposed-modules: Data.CaseInsensitive.Eq+ , Data.CaseInsensitive.Ord+ , Data.CaseInsensitive++-- Consider commenting out the previous line to avoid an impolite naming+-- conflict with the case-insensitive package. If building with cabal, a naming+-- conflict shouldn't happen unless asking for it with build-depends.++ build-depends: base ==4.*+ , bytestring+ , text++ hs-source-dirs: lib+ default-language: Haskell2010+++test-suite test-basics+ type: exitcode-stdio-1.0+ main-is: test-basics.hs++ build-depends: base ==4.*+ , case-insensitive-match+ , QuickCheck ==2.*+ , mtl ==2.*+ , bytestring ==0.*+ , text ==1.*++ hs-source-dirs: src+ default-language: Haskell2010+++benchmark bench-others+ type: exitcode-stdio-1.0+ ghc-options: -O2+ main-is: bench-others.hs++ build-depends: base ==4.*+ , bytestring ==0.*+ , text ==1.*+ , case-insensitive-match+ , case-insensitive ==1.*+ , random-strings <1.0+ , criterion++ hs-source-dirs: src+ default-language: Haskell2010+++benchmark bench-tagsoup+ type: exitcode-stdio-1.0+ ghc-options: -O2+ main-is: bench-tagsoup.hs++ build-depends: base ==4.*+ , bytestring == 0.*+ , case-insensitive ==1.*+ , case-insensitive-match+ , criterion+ , tagsoup++ hs-source-dirs: src+ default-language: Haskell2010++executable readme-example+ ghc-options: -O2+ main-is: readme-example.hs++ build-depends: base+ , case-insensitive-match+ , bytestring++ hs-source-dirs: src+ default-language: Haskell2010++
+ lib/Data/CaseInsensitive.hs view
@@ -0,0 +1,23 @@+++{- |+module: Data.CaseInsensitive+description: All the funtionality of the "Data.CaseInsensitive.Eq" and+ "Data.CaseInsensitive.Ord" modules.++This module creates an impolite naming conflict with the @case-insensitive@+package. If using @cabal@ to build, it's not a problem unless asked for in the+@build-depends@ directive. It is probably best to import only the+"Data.CaseInsensitive.Eq" module if that is the only functionality needed.++-}++module Data.CaseInsensitive+ ( module Data.CaseInsensitive.Eq+ , module Data.CaseInsensitive.Ord+ )+where++import Data.CaseInsensitive.Eq+import Data.CaseInsensitive.Ord+
+ lib/Data/CaseInsensitive/Eq.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE MultiParamTypeClasses , FlexibleInstances #-}++{- |++module: Data.CaseInsensitive.Eq+description: Simple, fast case-insensitive matching of various string types.++This, like most other case-insensitive matching algorithms, is an+over-simplification. For some complex Q&A about properties like case, see+<http://unicode.org/faq/casemap_charprop.html>. A round-trip case-conversion+does not necessarily result in the original character(s) in some scripts. Also,+string matching is not necessarily the same as character matching. The+char-at-a-time approach taken here is not technically correct, but works for+the most scripts, and definitely for ASCII and the ISO-8859-1 8-bit Latin 1+character set.++Usage is simple:++> main = putStrLn $ if "HREF" ^== "href" then "match" else "no match"+ +-}++module Data.CaseInsensitive.Eq+ ( CaseInsensitiveEq(..)+ , (^==)+ , (^/=)+ )+where++import Data.Char+import Data.Word+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL++class CaseInsensitiveEq a where+ caseInsensitiveEq :: a -> a -> Bool++ caseInsensitiveMatch :: [a] -> [a] -> Bool+ caseInsensitiveMatch = list_eq++-- | An equality operator for 'CaseInsensitiveEq'.+(^==) :: (CaseInsensitiveEq a) => a -> a -> Bool+(^==) = caseInsensitiveEq+++-- | An inequality operator for 'CaseInsensitiveEq'.+(^/=) :: (CaseInsensitiveEq a) => a -> a -> Bool+(^/=) a = not . (^==) a++------------------------------------------------------------------------------+--+-- instances++instance CaseInsensitiveEq Char where+ caseInsensitiveEq = char_eq++instance (CaseInsensitiveEq a) => CaseInsensitiveEq [a] where+ caseInsensitiveEq = caseInsensitiveMatch++instance CaseInsensitiveEq Word8 where+ caseInsensitiveEq = char8_eq++instance CaseInsensitiveEq BS.ByteString where+ caseInsensitiveEq = bs_strict_eq++instance CaseInsensitiveEq BSL.ByteString where+ caseInsensitiveEq = bs_lazy_eq++instance CaseInsensitiveEq T.Text where+ caseInsensitiveEq = t_strict_eq++instance CaseInsensitiveEq TL.Text where+ caseInsensitiveEq = t_lazy_eq++instance (CaseInsensitiveEq a, CaseInsensitiveEq b) => CaseInsensitiveEq (a,b) where+ caseInsensitiveEq (a,b) (a',b')+ | caseInsensitiveEq a a' = True+ | otherwise = caseInsensitiveEq b b'++instance (CaseInsensitiveEq a, CaseInsensitiveEq b, CaseInsensitiveEq c) => CaseInsensitiveEq (a,b,c) where+ caseInsensitiveEq (a,b,c) (a',b',c')+ | caseInsensitiveEq a a' = True+ | otherwise = caseInsensitiveEq (b,c) (b',c')++instance (CaseInsensitiveEq a, CaseInsensitiveEq b, CaseInsensitiveEq c, CaseInsensitiveEq d) => CaseInsensitiveEq (a,b,c,d) where+ caseInsensitiveEq (a,b,c,d) (a',b',c',d')+ | caseInsensitiveEq a a' = True+ | otherwise = caseInsensitiveEq (b,c,d) (b',c',d')++++-- | Unicode character matching. The real complexity of this masked by our+-- one-char-at-a-time approach. If all alphabetic characters were either+-- upper or lower case with a one-to-one mapping, both toUpper tests would+-- not be needed. However, there are some non-transitive and one-to-many+-- cases for Unicode characters. This is a pragmatic approach that is+-- better than using only 'toLower', which fails for some characters.+{-# INLINE char_eq #-}+char_eq :: Char -> Char -> Bool+char_eq a b+ | a == b = True+ | a == toLower b = True+ | b == toLower a = True+ | a == toUpper b = True+ | b == toUpper a = True+ | otherwise = False++-- | ISO-8859-1 character matching. The code here looks wonky, but this is an+-- attempt to find the answer in as few steps as necessary.+{-# INLINE char8_eq #-}+char8_eq :: Word8 -> Word8 -> Bool+char8_eq a b+ | a == b = True --+ | a < 65 || b < 65 = False -- [0..64]+ | a < 91 && b < 123 = a == b - 32 -- [65..122]+ | b < 91 && a < 123 = b == a - 32 --+ | a < 192 || b < 192 = False -- [123..192]+ | a == 215 || b == 215 = False -- not 215+ | a < 223 = a == b - 32 -- [193..214,216..254]+ | b < 223 = a - 32 == b+ | otherwise = False+++-- A two-step process for comparing ByteStrings, since length is O(1).+bs_strict_eq :: BS.ByteString -> BS.ByteString -> Bool+bs_strict_eq a b+ | BS.length a /= BS.length b = False -- length is O(1)+ | otherwise = continue_bs_strict_eq a b++-- All of the following follow the same pattern, matching a character at a time.+-- If anyone can find a faster way to do this, please send it in!++continue_bs_strict_eq a b+ | BS.null a = True -- assertion: BS.null b == True after the length check+ | char8_eq (BS.head a) (BS.head b) = continue_bs_strict_eq (BS.tail a) (BS.tail b)+ | otherwise = False++list_eq :: (CaseInsensitiveEq a) => [a] -> [a] -> Bool+list_eq a b+ | null a || null b = null a && null b+ | caseInsensitiveEq (head a) (head b) = list_eq (tail a) (tail b)+ | otherwise = False++bs_lazy_eq :: BSL.ByteString -> BSL.ByteString -> Bool+bs_lazy_eq a b+ | BSL.null a || BSL.null b = BSL.null a && BSL.null b+ | char8_eq (BSL.head a) (BSL.head b) = bs_lazy_eq (BSL.tail a) (BSL.tail b)+ | otherwise = False++t_strict_eq :: T.Text -> T.Text -> Bool+t_strict_eq a b+ | T.null a || T.null b = T.null a && T.null b+ | char_eq (T.head a) (T.head b) = t_strict_eq (T.tail a) (T.tail b)+ | otherwise = False++t_lazy_eq :: TL.Text -> TL.Text -> Bool+t_lazy_eq a b+ | TL.null a || TL.null b = TL.null a && TL.null b+ | char_eq (TL.head a) (TL.head b) = t_lazy_eq (TL.tail a) (TL.tail b)+ | otherwise = False+
+ lib/Data/CaseInsensitive/Ord.hs view
@@ -0,0 +1,226 @@++{- |+module: Data.CaseInsensitive.Ord+description: Case-insensitive comparison of strings++Case folding of Unicode characters is a bit of a mine field, and making ordinal+comparisons of characters is sketchy as well. For example, how do we compare+alphabetic and non-alphabetic characters, or a control character and a symbol?+Unicode characters don't always have a one-to-one mapping between upper- and+lower-case, so one-at-a-time character comparisons don't necessarily make+string comparisons valid. To make things worse, some applications might have a+preference for ordering \"Apple\" ahead of \"apple\" while others would prefer them+to be 'EQ' so long as \"BANANA\" compares 'GT' to either of them.++Herein is an attempt to combine both Unicode case folding and non-alphabetic+character comparisons in one module. @Be( a)?ware@ of the details and try to+think critically of your specific needs.++That /slippery disclaimer/ aside, this should exhibit most people's sense of+\'normal\' behavior when comparing and ordering strings in a case-insensitive+manner. In particular, when comparing strings with all-alphanumeric characters+or strings with matching non-alphanumeric characters in /identical/ positions+this module will yield satisfying results.++__Reasonable comparisons__:++> "James" and "Mary"++Two first names, no non-alphanumerics.++> "http://www.haskell.org/" and "HTTP://WWW.EXAMPLE.COM/"++All non-alphanumerics in matching positions until a comparison can be made.+This would be much more satisfying if the URI were parsed, even to the point of+breaking the hostname into components.++> ("Appleseed","Johnny") and ("Bunyon","Paul")++Comparing last-name-to-last-name and then first-to-first.+++__Questionable comparisons__:++> "Franklin, Benjamin" and "Hitler, Adolph"+> "Smith, Snuffy" and "Smithers, Waylon"+> "me@example.com" and "YOU@EXAMPLE.COM"++Politics and morality aside, the @last, first@ format will inevitably result in+comparisons between a comma and an alphabetic character. The result, while+intuitively correct in this case, is so because a comma is \'less than\' a+letter for arbitrary reasons (OK, the ASCII creators probably thought deeply+about this and maybe it's not simply arbitrary). Beware when someone decides to+sort your @User@ object on @last_first@ because of some local or locale-based+assumption and the results look a little backwards to normal humans.++> "Https://www.example.com" and "http://www.haskell.org/"++Do all HTTP URIs come before all HTTPS ones, or should the hostname take+precedence? Again, think carefully about why you are making case-insensitive+comparisons.++-}++module Data.CaseInsensitive.Ord+ ( CaseInsensitiveOrd(..)+ , (^>)+ , (^<)+ , (^>=)+ , (^<=)+ , caseInsensitiveComparing+ )+where++import Data.Ord+import Data.Char+import Data.Word++import Data.CaseInsensitive.Eq++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL++-- | A class for ordering strings in a case-insensitive manner.+class CaseInsensitiveOrd a where+ caseInsensitiveCompare :: a -> a -> Ordering++-- | /greater than/ for case-insensitive strings+(^>) :: (CaseInsensitiveOrd a) => a -> a -> Bool+a ^> b = caseInsensitiveCompare a b == GT++-- | /less than/ for case-insensitive strings+(^<) :: (CaseInsensitiveOrd a) => a -> a -> Bool+a ^< b = caseInsensitiveCompare a b == LT++-- | /greater than or equal to/ for case-insensitive strings+(^>=) :: (CaseInsensitiveOrd a) => a -> a -> Bool+a ^>= b = caseInsensitiveCompare a b /= LT++-- | /less than or equal to/ for case-insensitive strings+(^<=) :: (CaseInsensitiveOrd a) => a -> a -> Bool+a ^<= b = caseInsensitiveCompare a b /= GT++-- | 'comparing' for 'CaseInsensitiveOrd'+caseInsensitiveComparing :: (CaseInsensitiveOrd a) => (b -> a) -> b -> b -> Ordering+caseInsensitiveComparing f a b = caseInsensitiveCompare (f a) (f b)++++instance CaseInsensitiveOrd Char where+ caseInsensitiveCompare = compare_char++instance CaseInsensitiveOrd Word8 where+ caseInsensitiveCompare = compare_char8++instance (CaseInsensitiveOrd a) => CaseInsensitiveOrd [a] where+ caseInsensitiveCompare = compare_list++instance CaseInsensitiveOrd BS.ByteString where+ caseInsensitiveCompare = compare_bs++instance CaseInsensitiveOrd BSL.ByteString where+ caseInsensitiveCompare = compare_bsl++instance CaseInsensitiveOrd T.Text where+ caseInsensitiveCompare = compare_t++instance CaseInsensitiveOrd TL.Text where+ caseInsensitiveCompare = compare_tl++instance (CaseInsensitiveOrd a,CaseInsensitiveOrd b) => CaseInsensitiveOrd (a,b) where+ caseInsensitiveCompare (a,b) (a',b') =+ case caseInsensitiveCompare a a' of+ EQ -> caseInsensitiveCompare b b'+ ord -> ord++instance (CaseInsensitiveOrd a,CaseInsensitiveOrd b,CaseInsensitiveOrd c) => CaseInsensitiveOrd (a,b,c) where+ caseInsensitiveCompare (a,b,c) (a',b',c') =+ case caseInsensitiveCompare a a' of+ EQ -> caseInsensitiveCompare (b,c) (b',c')+ ord -> ord++instance (CaseInsensitiveOrd a,CaseInsensitiveOrd b,CaseInsensitiveOrd c,CaseInsensitiveOrd d) => CaseInsensitiveOrd (a,b,c,d) where+ caseInsensitiveCompare (a,b,c,d) (a',b',c',d') =+ case caseInsensitiveCompare a a' of+ EQ -> caseInsensitiveCompare (b,c,d) (b',c',d')+ ord -> ord+++-- | Compare Char+{-# INLINE compare_char #-}+compare_char :: Char -> Char -> Ordering+compare_char a b+ | caseInsensitiveEq a b = EQ+ | otherwise = compare (toUpper a) (toUpper b)++-- | Compare 8-bit ISO-8859-1 words.+{-# INLINE compare_char8 #-}+compare_char8 :: Word8 -> Word8 -> Ordering+compare_char8 a b+ | a == b = EQ+ | a < 65 || b < 65 = compare a b+ | a < 97 && b < 97 = compare a b+ | a < 91 && b < 123 = compare a (b - 32)+ | b < 91 && a < 123 = compare (a - 32) b+ | a < 216 && b < 216 = compare a b+ | a == 247 = GT+ | b == 247 = LT+ | a == 215 = compare a (b - 32)+ | b == 215 = compare (a - 32) b+ | a < 224 = compare a (b - 32)+ | b < 224 = compare (a - 32) b+ | otherwise = compare a b+++compare_list :: (CaseInsensitiveOrd a) => [a] -> [a] -> Ordering+compare_list a b+ | null a && null b = EQ+ | null a = LT+ | null b = GT+ | otherwise =+ case caseInsensitiveCompare (head a) (head b) of+ EQ -> compare_list (tail a) (tail b)+ ord -> ord++compare_bs :: BS.ByteString -> BS.ByteString -> Ordering+compare_bs a b+ | BS.null a && BS.null b = EQ+ | BS.null a = LT+ | BS.null b = GT+ | otherwise =+ case caseInsensitiveCompare (BS.head a) (BS.head b) of+ EQ -> compare_bs (BS.tail a) (BS.tail b)+ ord -> ord++compare_bsl :: BSL.ByteString -> BSL.ByteString -> Ordering+compare_bsl a b+ | BSL.null a && BSL.null b = EQ+ | BSL.null a = LT+ | BSL.null b = GT+ | otherwise =+ case caseInsensitiveCompare (BSL.head a) (BSL.head b) of+ EQ -> compare_bsl (BSL.tail a) (BSL.tail b)+ ord -> ord++compare_t :: T.Text -> T.Text -> Ordering+compare_t a b+ | T.null a && T.null b = EQ+ | T.null a = LT+ | T.null b = GT+ | otherwise =+ case caseInsensitiveCompare (T.head a) (T.head b) of+ EQ -> compare_t (T.tail a) (T.tail b)+ ord -> ord++compare_tl :: TL.Text -> TL.Text -> Ordering+compare_tl a b+ | TL.null a && TL.null b = EQ+ | TL.null a = LT+ | TL.null b = GT+ | otherwise =+ case caseInsensitiveCompare (TL.head a) (TL.head b) of+ EQ -> compare_tl (TL.tail a) (TL.tail b)+ ord -> ord+
+ src/bench-others.hs view
@@ -0,0 +1,265 @@+{-# LANGUAGE PackageImports , TupleSections , MultiParamTypeClasses , FlexibleInstances #-}++{- |++Run comparative benchmarks against other Haskell implementations.++The only other common implementation in Hackage is @case-insensitive@. That+algorithm and a simple one using @map toLower@ (and similar implementations)+are included in these benchmarks.++The random strings generated are limited to the printable ASCII characters.+The ratios of alphabetic and upper-case characters in the strings are part of+the randomization of the strings. The ratios chosen are shown below. The+character makeup of the test strings appears to have only slight effect on any+performance differences between the algorithms tested.++The lengths of the test strings are a little more impactful on the benches, so+two options are explored: short (random length) and long. The short strings are+likely what will be matched in the real world. The case folding routines+probably have similar performance, so the differences in string handling in+general and in allocation in particular exaggerate the difference in benchmark+performance. Even the lazily evaluated string in the @case-insensitive@ library+is noticeably slower because a second string is allocated.++The biggest difference in speed is for string comparisons that fail. When+matching short strings in a larger stream, the non-match is probably the+dominant case. The 'CaseInsensitiveEq' algorithm is by far the fastest.++Benchmarks available form a four-dimensional matrix accessible in the+tree-like, path-based style of @Criterion@'s defaultMain command line+handling.++> bench-others -m glob ByteString.Lazy/short/*/*++The axes and values are:++ - string type: data type of strings to compare++ -- @String@+ -- @ByteString@+ -- @ByteString.Lazy@+ -- @Text@+ -- @Text.Lazy@++ - string length:+ + -- @short@ - 1000 different random-length (2-12 chars) strings+ -- @long@ - 20 different 500-char strings++ - string case: comparing the original with ...++ -- @id@ - identical strings+ -- @toLower@ - a lower-case version of the original+ -- @toUpper@ - an upper-case version of the original+ -- @flipCase@ - all alphabetic characters in the opposite case+ -- @similar@ - identical at the beginning, then different+ -- @different@ - different string from the first character++ - match algorithm:++ -- @FoldCase@ - compare two case-folded strings using @base@ library+ -- @CaseInsensitiveEq@ - compare using this library+ -- @CIeq@ - compare using the @case-insensitive@ package+ -- @CIeq'@ - a smarter use of @case-insensitive@, assuming one string is a literal in client code+ -- @FoldCaseOrd@ - ordering or two case-folded strings using the @base@ library+ -- @CaseInsensitiveOrd@ - ordering using this library++Note on @CIeq'@: There is some overhead to using 'CI.mk". In most cases, one of+the two strings being compared will be a string literal in the client source+code. We can assume that 'CI.mk' will be called for the literal at most once,+if not never, during execution. The @CIeq'@ comparison algorithm (sometimes the+fastest) models this case by evaluating one half of the comparison before the+benchmark begins. This might also be informative for the @FoldCase@ algorithm,+but it's not explored here.++-}++module Main ( main ) where++import Test.RandomStrings+import Test.RandomStrings.FlipCase+import Criterion.Main++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Char8 as BSL8+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL++import Data.Ratio ( (%) )+import Data.Word+import Data.Char+import Data.String ( IsString(..) )++import qualified "case-insensitive" Data.CaseInsensitive as CI+import Data.CaseInsensitive.Eq+import Data.CaseInsensitive.Ord+++++------------------------------------------------------------------------------+-- +-- | 'main' first generates some random test strings and then organizes bench+-- groups in a tree organized by+--+-- @/ types / length / case / method@+--+main = do+ strings <- mapM mk_strings+ [ StringLengthShort+ , StringLengthLong+ ]++ defaultMain + [ bgroup "String" $ map (mk_length "" ) strings+ , bgroup "ByteString" $ map (mk_length BS.empty ) strings+ , bgroup "ByteString.Lazy" $ map (mk_length BSL.empty) strings+ , bgroup "Text" $ map (mk_length T.empty ) strings+ , bgroup "Text.Lazy" $ map (mk_length TL.empty ) strings+ ]++++------------------------------------------------------------------------------+-- +-- generating random test strings+--++-- | Test strings are all printable characters in the 7-bit ASCII range. The+-- mix is 9/10 alphabetic and the alphabetic characters are 1/6 upper case.+-- If the mix of character classes made much difference in benchmark+-- results, I'd add these as command line parameters. To try a different+-- mix, modify it here.+string_generator = randomString' randomASCII (9%10) (1%6)++data StringLengthOption = StringLengthLong | StringLengthShort deriving Eq++mk_strings :: StringLengthOption -> IO (StringLengthOption,[String])+mk_strings StringLengthShort = randomStringsLen string_generator (2,12) 1000 >>= \s -> return (StringLengthShort,s)+mk_strings StringLengthLong = randomStrings (string_generator 500) 20 >>= \s -> return (StringLengthLong,s)+++------------------------------------------------------------------------------+--+-- | CaseOption describes the change made to the original string to make a+-- testable pair of strings. Most create a pair that should be equivalent+-- in case-insensitive comparisons.+data CaseOption = CaseId | CaseToLower | CaseToUpper | CaseFlipCase | CaseSimilar | CaseDifferent++-- | Creating the pairs used by the comparison algorithms. The extra 'Bool' is+-- what the result of a case-insensitive comparison should be.+mk_pair :: CaseOption -> String -> ((String,String),Bool)+mk_pair CaseId a = ((a,a),True)+mk_pair CaseToLower a = ((a,map toLower a),True)+mk_pair CaseToUpper a = ((a,map toUpper a),True)+mk_pair CaseFlipCase a = ((a,map flipCase a),True)+mk_pair CaseSimilar a = ((a, mk_similar a), False)+mk_pair CaseDifferent a = ((a,mk_different a),False)+++-- | Make a different String after a 'random' number of chars.+-- Guaranteed to be different from the original.+mk_similar [] = []+mk_similar as@(a:_) = (take n as') ++ (map succ as'')+ where+ n = (fromEnum a) `mod` (length as)+ (as',as'') = splitAt n as++-- | Make a completely different string than the original.+mk_different = map succ+++pack_pair :: (IsString a) => a -> ((String,String),b) -> ((a,a),b)+pack_pair _ ((a,b),c) = ((fromString a,fromString b),c)++ci_mk_pair :: (CI.FoldCase a) => ((a,a),b) -> ((CI.CI a,a),b)+ci_mk_pair ((a,b),c) = ((CI.mk a,b),c)++-- | make a bench group for a StringLengthOption+mk_length :: (BenchType a) => a -> (StringLengthOption,[String]) -> Benchmark+mk_length s (len_opt,strings) = bgroup (bench_name len_opt) $+ map (mk_case s strings)+ [ CaseId -- the original string+ , CaseToLower -- a lower-case version of the original+ , CaseToUpper -- an upper-case version of the original+ , CaseFlipCase -- a version with inverted case for alphabetic chars+ , CaseSimilar -- a version that is initially equivalent, but not fully so+ , CaseDifferent -- a completely different string from the first character+ ]++------------------------------------------------------------------------------+--+-- The leaf nodes evaluate different comparison algorithms on the pairs of+-- randomly generated string. These are the actual benchmark tests, and the+-- pairs of strings being generated are fully constructed before the tests+-- because they are the final parameter of 'nf'.+++-- | make a bench group for a CaseOption+mk_case :: (BenchType a) => a -> [String] -> CaseOption -> Benchmark+mk_case s strings case_opt = bgroup (bench_name case_opt)+ [ bench "FoldCase" $ nf (map $ \((a,b),tf) -> (((fold_case_bench a) == (fold_case_bench b)) == tf || assert_fail)) $ (map (pack_pair s) pairs)+ , bench "CaseInsensitiveEq" $ nf (map $ \((a,b),tf) -> ((caseInsensitiveEq a b ) == tf || assert_fail)) $ (map (pack_pair s) pairs)+ , bench "CIeq" $ nf (map $ \((a,b),tf) -> (((CI.mk a) == (CI.mk b) ) == tf || assert_fail)) $ (map (pack_pair s) pairs)+ , bench "CIeq'" $ nf (map $ \((a,b),tf) -> ((a == (CI.mk b) ) == tf || assert_fail)) $ (map ci_mk_pair $ map (pack_pair s) pairs)+ , bench "FoldCaseOrd" $ nf (map $ \((a,b),tf) -> ((compare (fold_case_bench a) (fold_case_bench b) == EQ) == tf || assert_fail)) $ (map (pack_pair s) pairs)+ , bench "CaseInsensitiveOrd" $ nf (map $ \((a,b),tf) -> ((caseInsensitiveCompare a b == EQ) == tf || assert_fail)) $ (map (pack_pair s) pairs)+ ]+ where+ pairs = map (mk_pair case_opt) strings+ assert_fail = error "internal: assertion failed"+++------------------------------------------------------------------------------+--+-- classes+++-- | A class for string types to be benchmarked. Both 'CaseInsensitiveEq' and+-- 'CI.FoldCase' are ready to be tested as-is, but the case-folding algorithm+-- that only relies on the @base@ package requires an implementation of+-- case-folding for each string type.+class (CI.FoldCase a, CaseInsensitiveEq a, Eq a, CaseInsensitiveOrd a, Ord a, IsString a) => BenchType a where+ fold_case_bench :: a -> a++instance BenchType String where+ fold_case_bench = map toLower++instance BenchType BS.ByteString where+ fold_case_bench = BS8.map toLower++instance BenchType BSL.ByteString where+ fold_case_bench = BSL8.map toLower++instance BenchType T.Text where+ fold_case_bench = T.map toLower++instance BenchType TL.Text where+ fold_case_bench = TL.map toLower++++-- | A helper class for naming branches of the bench tree.+class NamedBench a where bench_name :: a -> String++instance NamedBench String where bench_name = const "String"+instance NamedBench BS.ByteString where bench_name = const "ByteString"+instance NamedBench BSL.ByteString where bench_name = const "ByteString.Lazy"+instance NamedBench T.Text where bench_name = const "Text"+instance NamedBench TL.Text where bench_name = const "Text.Lazy"++instance NamedBench StringLengthOption where+ bench_name StringLengthLong = "Long"+ bench_name StringLengthShort = "Short"++instance NamedBench CaseOption where+ bench_name CaseId = "id"+ bench_name CaseToLower = "toLower"+ bench_name CaseToUpper = "toUpper"+ bench_name CaseFlipCase = "flipCase"+ bench_name CaseSimilar = "similar"+ bench_name CaseDifferent = "different"+
+ src/bench-tagsoup.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings , PackageImports #-}+++{- | Benchmarking TagSoup to extract a/@href from a web page. The results are+ not at all shocking, but do show differences between packages. The easier+ syntax and slight speed improvement of the @case-insensitive-match@+ package. The time differences seem consistent, showing that when parsing+ an html page there is significant time doing case-insensitive string+ comparison.++ Note: I'm not sure why Criterion shows a faster run the first time tags+ are parsed. I added an @init@ bench to make the others look normal. The+ same thing usually happens no matter the matching algorithm. You can try+ running only one bench at a time and comparing the higher-speed results.++-}+module Main ( main ) where++import Criterion.Main+import Data.String++import Text.HTML.TagSoup+import Text.HTML.TagSoup.Match+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import Data.ByteString ( ByteString )++import qualified "case-insensitive" Data.CaseInsensitive as CI+import Data.CaseInsensitive.Eq++main = do+ html <- BS.getContents+ let tags = parseTags html+ if True -- set to False to actually see the list of HREFs+ then+ defaultMain+ [ bgroup "match-only"+ [ bench "init" $ nf (findLinks (^==) ) tags+ , bench "==" $ nf (findLinks (==) ) tags+ , bench "CaseInsensitiveEq" $ nf (findLinks (^==) ) tags+ , bench "CIeq" $ nf (findLinks ciEq ) tags+ , bench "CIeq'" $ nf (findLinks ciEq' ) tags+ ]+ , bgroup "parse-and-match"+ [ bench "init" $ nf (findLinks (^==) . parseTags ) html+ , bench "==" $ nf (findLinks (==) . parseTags ) html+ , bench "CaseInsensitiveEq" $ nf (findLinks (^==) . parseTags ) html+ , bench "CIeq" $ nf (findLinks ciEq . parseTags ) html+ , bench "CIeq'" $ nf (findLinks ciEq' . parseTags ) html+ ]+ ]+ else+ mapM_ BS8.putStrLn $ findLinks (^==) tags++-- see bench-others for the reasoning behind these two algorithms+ciEq a b = (CI.mk a) == (CI.mk b)+ciEq' a b = a == (CI.mk b)++findLinks :: (IsString a) => (a -> ByteString -> Bool) -> [Tag ByteString] -> [ByteString]+findLinks eq [] = []+findLinks eq (tag:tags)+ | tagOpen (eq "a") (const True) tag = get_tag_href eq tag : findLinks eq tags+ | otherwise = findLinks eq tags++get_tag_href eq (TagOpen _ attrs) = get_href eq attrs+get_tag_href _ _ = error "internal: tagOpen failed!"++get_href _ [] = BS.empty+get_href eq ((n,v):attrs)+ | eq "href" n = v+ | otherwise = get_href eq attrs+
+ src/readme-example.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}++module Main ( main ) where++import Data.List+import Data.CaseInsensitive+import qualified Data.ByteString.Char8 as BS++main = do+ stdin <- BS.getContents+ let sorted_names = map join_name $ sortBy caseInsensitiveCompare $ map split_name $ BS.lines stdin+ mapM_ BS.putStrLn sorted_names+++split_name name = (last,BS.drop 2 first)+ where (last,first) = BS.span (/= ',') name++join_name (last,first) = BS.concat [ last , ", " , first ]+
+ src/test-basics.hs view
@@ -0,0 +1,368 @@++{-++-}++module Main ( main ) where+++import Data.Char+import Data.Word+import Data.Maybe ( catMaybes )+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL++import Control.Monad.State+import System.Exit++import Data.CaseInsensitive+++main = do+ success <- flip execStateT True $ do+ doTest "all Char Eq" test_AllCharEqChar+ doTest "all Word8 Eq" test_AllCharEqWord8+ doTest "all Char Eq String" test_AllCharEqString+ doTest "all Char using caseInsensitiveMatch" test_AllCharMatchChar+ doTest "all Word8 Eq Strict ByteString" test_AllCharEqBS+ doTest "all Word8 Eq Lazy ByteString" test_AllCharEqBSL+ doTest "unequal String cases" test_NotEqualString+ doTest "unequal ByteString cases" test_NotEqualBS+ doTest "unequal Lazy ByteString cases" test_NotEqualBSL+ doTest "unequal Text cases" test_NotEqualT+ doTest "unequal Lazy Text cases" test_NotEqualTL+ doTest "equal String cases" test_EqualString+ doTest "equal ByteString cases" test_EqualBS+ doTest "equal Lazy ByteString cases" test_EqualBSL+ doTest "equal Text cases" test_EqualT+ doTest "equal Lazy Text cases" test_EqualTL+ doTest "equal ByteStrirg tuple" test_EqualTupleBS+ doTest "compare all Char EQ" test_CompareAllCharEQChar+ doTest "compare all Char8 EQ" test_CompareAllCharEQWord8+ doTest "compare all String EQ" test_CompareAllCharEQString+ doTest "compare all ByteString EQ" test_CompareAllByteStringEQ+ doTest "compare unequal String cases" test_OrderString+ doTest "compare unequal ByteString cases" test_OrderByteString+ doTest "compare unequal Text cases" test_OrderText+ doTest "compare equal String cases" test_CompareEQString+ doTest "compare equal ByteString cases" test_CompareEQByteString+ doTest "compare equal Text cases" test_CompareEQText+ doTest "compare equal ByteString tuple" test_CompareEQTupleBS+ doTest "compare unequal ByteString tuple" test_CompareGTTupleBS++ if success then exitSuccess else exitFailure++-- | All tests are of the simple pass/fail variety. This is meant+-- at a certain level to emulate QuickCheck.+doTest :: String -> Bool -> StateT Bool IO ()+doTest name test = do+ liftIO $ putStr $ take 40 $ concat [ name , ":" , repeat ' ' ]+ if test+ then do+ liftIO $ putStrLn "+++ OK, passed"+ else do+ liftIO $ putStrLn "--- Failed!"+ put False+++------------------------------------------------------------------------------+-- +-- Testing all character values for each instance. +--+--++-- Test the case-folding behavior of one-at-a-time character matching. A+-- highly technical implementation would not match Unicode Char and String+-- using the same algorithm. The instance for Char is pragmatic enough to pass,+-- but this is a test that the case-insensitive package fails.++test_AllCharEqChar :: Bool+test_AllCharEqChar =+ all id+ [ all (uncurry caseInsensitiveEq) $ zip all_chars all_chars+ , all (uncurry caseInsensitiveEq) $ zip all_chars all_uppers+ , all (uncurry caseInsensitiveEq) $ zip all_chars all_lowers+ , not $ all_chars == all_uppers -- validating toUpper, actually+ , not $ all_chars == all_lowers+ ]+ where+ all_chars = [minBound..maxBound] :: [Char]+ all_uppers = map toUpper all_chars+ all_lowers = map toLower all_chars++test_AllCharEqWord8 :: Bool+test_AllCharEqWord8 =+ all id+ [ all (uncurry caseInsensitiveEq) $ zip all_chars all_chars+ , all (uncurry caseInsensitiveEq) $ zip all_chars all_uppers+ , all (uncurry caseInsensitiveEq) $ zip all_chars all_lowers+ , not $ all_chars == all_uppers -- validating fold_8 toUpper, actually+ , not $ all_chars == all_lowers+ ]+ where+ all_chars = [minBound..maxBound] :: [Word8]+ all_uppers = map (fold_8 toUpper) all_chars+ all_lowers = map (fold_8 toLower) all_chars++test_AllCharMatchChar :: Bool+test_AllCharMatchChar =+ all id+ [ all_chars `caseInsensitiveMatch` all_chars+ , all_chars `caseInsensitiveMatch` all_uppers+ , all_chars `caseInsensitiveMatch` all_lowers+ , not $ all_chars == all_uppers -- validating map toUpper, actually+ , not $ all_chars == all_lowers+ ]+ where+ all_chars = [minBound..maxBound] :: [Char]+ all_uppers = map toUpper all_chars+ all_lowers = map toUpper all_chars++test_AllCharEqString :: Bool+test_AllCharEqString =+ all id+ [ all_chars `caseInsensitiveEq` all_chars+ , all_chars `caseInsensitiveEq` all_uppers+ , all_chars `caseInsensitiveEq` all_lowers+ , not $ all_chars == all_uppers -- validating map toUpper, actually+ , not $ all_chars == all_lowers+ ]+ where+ all_chars = [minBound..maxBound] :: [Char]+ all_uppers = map toUpper all_chars+ all_lowers = map toUpper all_chars++test_AllCharEqBS :: Bool+test_AllCharEqBS =+ all id+ [ all_chars `caseInsensitiveEq` all_chars+ , all_chars `caseInsensitiveEq` all_uppers+ , all_chars `caseInsensitiveEq` all_lowers+ , not $ all_chars == all_uppers -- validating fold_8 toUpper, actually+ , not $ all_chars == all_lowers+ ]+ where+ all_chars = BS.pack $ [minBound..maxBound]+ all_uppers = BS.map (fold_8 toUpper) all_chars+ all_lowers = BS.map (fold_8 toLower) all_chars++test_AllCharEqBSL :: Bool+test_AllCharEqBSL =+ all id+ [ all_chars `caseInsensitiveEq` all_chars+ , all_chars `caseInsensitiveEq` all_uppers+ , all_chars `caseInsensitiveEq` all_lowers+ , not $ all_chars == all_uppers -- validating fold_8 toUpper, actually+ , not $ all_chars == all_lowers+ ]+ where+ all_chars = BSL.pack $ [minBound..maxBound]+ all_uppers = BSL.map (fold_8 toUpper) all_chars+ all_lowers = BSL.map (fold_8 toLower) all_chars++------------------------------------------------------------------------------+--+-- Ord+--++test_CompareAllCharEQChar :: Bool+test_CompareAllCharEQChar =+ all id+ [ all ((==EQ) . uncurry caseInsensitiveCompare) $ zip all_chars all_chars+ , all ((==EQ) . uncurry caseInsensitiveCompare) $ zip all_chars all_uppers+ , all ((==EQ) . uncurry caseInsensitiveCompare) $ zip all_chars all_lowers+ ]+ where+ all_chars = [minBound..maxBound] :: [Char]+ all_uppers = map toUpper all_chars+ all_lowers = map toLower all_chars+++test_CompareAllCharEQWord8 :: Bool+test_CompareAllCharEQWord8 =+ all id+ [ all ((==EQ) . uncurry caseInsensitiveCompare) $ zip all_chars all_chars+ , all ((==EQ) . uncurry caseInsensitiveCompare) $ zip all_chars all_uppers+ , all ((==EQ) . uncurry caseInsensitiveCompare) $ zip all_chars all_lowers+ ]+ where+ all_chars = [minBound..maxBound] :: [Word8]+ all_uppers = map (fold_8 toUpper) all_chars+ all_lowers = map (fold_8 toLower) all_chars++test_CompareAllCharEQString :: Bool+test_CompareAllCharEQString =+ all id+ [ caseInsensitiveCompare all_chars all_chars == EQ+ , caseInsensitiveCompare all_chars all_uppers == EQ+ , caseInsensitiveCompare all_chars all_lowers == EQ+ ]+ where+ all_chars = [minBound..maxBound] :: [Char]+ all_uppers = map toUpper all_chars+ all_lowers = map toLower all_chars++test_CompareAllByteStringEQ :: Bool+test_CompareAllByteStringEQ =+ all id+ [ caseInsensitiveCompare all_chars all_chars == EQ+ , caseInsensitiveCompare all_chars all_uppers == EQ+ , caseInsensitiveCompare all_chars all_lowers == EQ+ ]+ where+ all_chars = BS.pack $ [minBound..maxBound]+ all_uppers = BS.map (fold_8 toUpper) all_chars+ all_lowers = BS.map (fold_8 toLower) all_chars++++------------------------------------------------------------------------------+--+-- A few test cases with strings that should not match.+--++neq_cases =+ [ (( "apples" , "oranges" ) , LT)+ , (( "apples" , "apple" ) , GT)+ , (( "123" , "" ) , GT)+ , (( "" , "abc" ) , LT)+ , (( a_to_z , z_to_a ) , LT)+ ]+ where+ a_to_z = ['a'..'z']+ z_to_a = reverse a_to_z +++neq_pairs = map fst neq_cases++neq_cases_bs = map (\((a,b),c) -> ((BS.pack a,BS.pack b),c)) $ cases_to_word8 neq_cases+neq_pairs_bs = map (\(a,b) -> (BS.pack a ,BS.pack b )) $ pairs_to_word8 neq_pairs++neq_cases_bsl = map (\((a,b),c) -> ((BSL.pack a,BSL.pack b),c)) $ cases_to_word8 neq_cases+neq_pairs_bsl = map (\(a,b) -> (BSL.pack a,BSL.pack b)) $ pairs_to_word8 neq_pairs++neq_cases_t = map (\((a,b),c) -> ((T.pack a,T.pack b),c)) $ neq_cases+neq_pairs_t = map (\(a,b) -> (T.pack a ,T.pack b )) $ neq_pairs++neq_cases_tl = map (\((a,b),c) -> ((TL.pack a,TL.pack b),c)) $ neq_cases+neq_pairs_tl = map (\(a,b) -> (TL.pack a,TL.pack b)) $ neq_pairs++test_NotEqualString :: Bool+test_NotEqualString = all not $ map (uncurry caseInsensitiveEq) neq_pairs++test_NotEqualBS :: Bool+test_NotEqualBS = all not $ map (uncurry caseInsensitiveEq) neq_pairs_bs++test_NotEqualBSL :: Bool+test_NotEqualBSL = all not $ map (uncurry caseInsensitiveEq) neq_pairs_bsl++test_NotEqualT :: Bool+test_NotEqualT = all not $ map (uncurry caseInsensitiveEq) neq_pairs_t++test_NotEqualTL :: Bool+test_NotEqualTL = all not $ map (uncurry caseInsensitiveEq) neq_pairs_tl++test_OrderString :: Bool+test_OrderString = all id $ map (\((a,b),c) -> caseInsensitiveCompare a b == c) neq_cases++test_OrderByteString :: Bool+test_OrderByteString = all id $ map (\((a,b),c) -> caseInsensitiveCompare a b == c) neq_cases_bs++test_OrderText :: Bool+test_OrderText = all id $ map (\((a,b),c) -> caseInsensitiveCompare a b == c) neq_cases_t++------------------------------------------------------------------------------+--+-- A few test cases with strings that should match.+--++case_eq_pairs =+ [ ( "apples" , "apples" )+ , ( "example.com" , "EXAMPLE.com" )+ , ( "HTML" , "html" )+ , ( "Content-Type" , "CONTENT-TYPE" )+ , ( "C:\\Windows" , "c:\\windows" )+ ]++case_eq_pairs_bs = map (\(a,b) -> (BS.pack a ,BS.pack b )) $ pairs_to_word8 case_eq_pairs+case_eq_pairs_bsl = map (\(a,b) -> (BSL.pack a,BSL.pack b)) $ pairs_to_word8 case_eq_pairs++case_eq_pairs_t = map (\(a,b) -> (T.pack a ,T.pack b )) $ case_eq_pairs+case_eq_pairs_tl = map (\(a,b) -> (TL.pack a,TL.pack b)) $ case_eq_pairs++test_EqualString :: Bool+test_EqualString = all id $ map (uncurry caseInsensitiveEq) case_eq_pairs++test_EqualBS :: Bool+test_EqualBS = all id $ map (uncurry caseInsensitiveEq) case_eq_pairs_bs++test_EqualBSL :: Bool+test_EqualBSL = all id $ map (uncurry caseInsensitiveEq) case_eq_pairs_bsl++test_EqualT :: Bool+test_EqualT = all id $ map (uncurry caseInsensitiveEq) case_eq_pairs_t++test_EqualTL :: Bool+test_EqualTL = all id $ map (uncurry caseInsensitiveEq) case_eq_pairs_tl++test_CompareEQString :: Bool+test_CompareEQString = all id $ map ((==EQ) . uncurry caseInsensitiveCompare) case_eq_pairs++test_CompareEQByteString :: Bool+test_CompareEQByteString = all id $ map ((==EQ) . uncurry caseInsensitiveCompare) case_eq_pairs_bs++test_CompareEQText :: Bool+test_CompareEQText = all id $ map ((==EQ) . uncurry caseInsensitiveCompare) case_eq_pairs_t++------------------------------------------------------------------------------+--+-- tuple instances - testing all recursively+--++test_EqualTupleBS :: Bool+test_EqualTupleBS =+ ("apple","oranges","me@example.com","Content-Type")+ ^==+ ("APPLE","Oranges","me@EXAMPLE.COM","content-type")++test_CompareEQTupleBS :: Bool+test_CompareEQTupleBS =+ ( caseInsensitiveCompare+ ("apple","oranges","me@example.com","Content-Type")+ ("APPLE","Oranges","me@EXAMPLE.COM","content-type")+ ) == EQ+++test_CompareGTTupleBS :: Bool+test_CompareGTTupleBS =+ ( caseInsensitiveCompare+ ("apple","oranges","me@example.com",("Content-Type","text/html"))+ ("APPLE","Oranges","me@EXAMPLE.COM",("content-language","en-us"))+ ) == GT+++------------------------------------------------------------------------------+--+-- utility functions for creating Word8 strings+--++char_to_word8 :: Char -> Maybe Word8+char_to_word8 c+ | fromEnum c > 256 = Nothing+ | otherwise = Just $ fromIntegral $ fromEnum c++string_to_word8s :: String -> [Word8]+string_to_word8s = catMaybes . map char_to_word8++cases_to_word8 = map (\((a,b),c) -> ((string_to_word8s a,string_to_word8s b),c))+pairs_to_word8 = map (\(a,b) -> (string_to_word8s a , string_to_word8s b))+++-- Some of the lower-256 actually have upper-case outside that range. Here,+-- we treat those as if they didn't have any case at all.+fold_8 :: (Char -> Char) -> Word8 -> Word8+fold_8 f c+ | ( fromEnum $ f $ toEnum $ fromIntegral c) > 255 = c+ | otherwise = fromIntegral $ fromEnum $ f $ toEnum $ fromIntegral c