diff --git a/Data/CaseInsensitive.hs b/Data/CaseInsensitive.hs --- a/Data/CaseInsensitive.hs +++ b/Data/CaseInsensitive.hs @@ -1,10 +1,4 @@ -{-# LANGUAGE CPP - , NoImplicitPrelude - , UnicodeSyntax - , TypeSynonymInstances - , DeriveDataTypeable - , FlexibleInstances - #-} +{-# LANGUAGE CPP, NoImplicitPrelude, DeriveDataTypeable #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} @@ -13,7 +7,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.CaseInsensitive --- Copyright : (c) 2011-2012 Bas van Dijk +-- Copyright : (c) 2011-2013 Bas van Dijk -- License : BSD-style (see the file LICENSE) -- Maintainer : Bas van Dijk -- @@ -24,6 +18,9 @@ -- import qualified Data.CaseInsensitive as CI -- @ -- +-- /Note that the FoldCase instance for ByteStrings is only/ +-- /guaranteed to be correct for ISO-8859-1 encoded strings!/ +-- ----------------------------------------------------------------------------- module Data.CaseInsensitive ( CI @@ -40,25 +37,31 @@ -- from base: import Data.Bool ( (||) ) +import Data.Char ( Char, toLower ) import Data.Eq ( Eq, (==) ) -import Data.Ord ( Ord, compare ) import Data.Function ( on ) import Data.Monoid ( Monoid, mempty, mappend ) +import Data.Ord ( Ord, compare ) import Data.String ( IsString, fromString ) import Data.Typeable ( Typeable ) import Data.Word ( Word8 ) import Prelude ( String, (.), fmap, (&&), (+), (<=), (>=), otherwise ) import Text.Read ( Read, readPrec ) -import Text.Show ( Show, showsPrec, ShowS ) +import Text.Show ( Show, showsPrec ) +import qualified Data.List as L ( map ) + -- from bytestring: -import qualified Data.ByteString as B ( ByteString, map ) -import qualified Data.ByteString.Lazy as BL ( ByteString, map ) +import qualified Data.ByteString as B ( ByteString, map ) +import qualified Data.ByteString.Lazy as BL ( ByteString, map ) -- from text: import qualified Data.Text as T ( Text, toCaseFold ) import qualified Data.Text.Lazy as TL ( Text, toCaseFold, pack, unpack ) +-- from deepseq: +import Control.DeepSeq ( NFData, rnf, deepseq ) + -- from hashable: import Data.Hashable ( Hashable, hashWithSalt ) @@ -67,7 +70,7 @@ -------------------------------------------------------------------------------- {-| A @CI s@ provides /C/ase /I/nsensitive comparison for the string-like type -@s@ (for example: 'String', 'T.Text', 'B.ByteString', 'ShowS', etc.). +@s@ (for example: 'String', 'T.Text', 'B.ByteString', etc.). Note that @CI s@ has an instance for 'IsString' which together with the @OverloadedStrings@ language extension allows you to write case insensitive @@ -79,42 +82,44 @@ @ -} -data CI s = CI { original ∷ !s -- ^ Retrieve the original string-like value. - , foldedCase ∷ !s -- ^ Retrieve the case folded string-like value. - -- (Also see 'foldCase'). +data CI s = CI { original :: !s -- ^ Retrieve the original string-like value. + , foldedCase :: !s -- ^ Retrieve the case folded string-like value. + -- (Also see 'foldCase'). } deriving Typeable -- | Make the given string-like value case insensitive. -mk ∷ FoldCase s ⇒ s → CI s +mk :: FoldCase s => s -> CI s mk s = CI s (foldCase s) -- | Transform the original string-like value but keep it case insensitive. -map ∷ FoldCase s2 ⇒ (s1 → s2) → (CI s1 → CI s2) +map :: FoldCase s2 => (s1 -> s2) -> (CI s1 -> CI s2) map f = mk . f . original -instance (IsString s, FoldCase s) ⇒ IsString (CI s) where +instance (IsString s, FoldCase s) => IsString (CI s) where fromString = mk . fromString -instance Monoid s ⇒ Monoid (CI s) where +instance Monoid s => Monoid (CI s) where mempty = CI mempty mempty CI o1 l1 `mappend` CI o2 l2 = CI (o1 `mappend` o2) (l1 `mappend` l2) -instance Eq s ⇒ Eq (CI s) where +instance Eq s => Eq (CI s) where (==) = (==) `on` foldedCase -instance Ord s ⇒ Ord (CI s) where +instance Ord s => Ord (CI s) where compare = compare `on` foldedCase -instance (Read s, FoldCase s) ⇒ Read (CI s) where +instance (Read s, FoldCase s) => Read (CI s) where readPrec = fmap mk readPrec -instance Show s ⇒ Show (CI s) where +instance Show s => Show (CI s) where showsPrec prec = showsPrec prec . original instance Hashable s => Hashable (CI s) where - hashWithSalt salt = hashWithSalt salt . foldedCase + hashWithSalt salt = hashWithSalt salt . foldedCase +instance NFData s => NFData (CI s) where + rnf (CI o f) = o `deepseq` f `deepseq` () -------------------------------------------------------------------------------- -- Folding (lowering) cases @@ -127,23 +132,50 @@ -- Programs that require locale sensitivity should use appropriate versions of -- the case mapping functions from the @text-icu@ package: -- -class FoldCase s where foldCase ∷ s → s +class FoldCase s where + foldCase :: s -> s --- | Note that @foldCase = 'B.map' toLower@ which is only guaranteed to be correct for ASCII encoded strings! -instance FoldCase B.ByteString where foldCase = B.map toLower + foldCaseList :: [s] -> [s] + foldCaseList = L.map foldCase --- | Note that @foldCase = 'BL.map' toLower@ which is only guaranteed to be correct for ASCII encoded strings! -instance FoldCase BL.ByteString where foldCase = BL.map toLower +instance FoldCase a => FoldCase [a] where + foldCase = foldCaseList -instance FoldCase String where foldCase = TL.unpack . TL.toCaseFold . TL.pack +-- | Note that @foldCase@ on @'B.ByteString's@ is only guaranteed to be correct for ISO-8859-1 encoded strings! +instance FoldCase B.ByteString where foldCase = B.map toLower8 + +-- | Note that @foldCase@ on @'BL.ByteString's@ is only guaranteed to be correct for ISO-8859-1 encoded strings! +instance FoldCase BL.ByteString where foldCase = BL.map toLower8 + +instance FoldCase Char where + foldCase = toLower + foldCaseList = TL.unpack . TL.toCaseFold . TL.pack + instance FoldCase T.Text where foldCase = T.toCaseFold instance FoldCase TL.Text where foldCase = TL.toCaseFold -instance FoldCase ShowS where foldCase = (foldCase .) instance FoldCase (CI s) where foldCase (CI _ l) = CI l l -toLower :: Word8 -> Word8 -toLower w +toLower8 :: Word8 -> Word8 +toLower8 w | 65 <= w && w <= 90 || 192 <= w && w <= 214 || 216 <= w && w <= 222 = w + 32 | otherwise = w + +-------------------------------------------------------------------------------- +-- Rewrite RULES +-------------------------------------------------------------------------------- + +{-# RULES + "mk/ByteString" forall (bs :: B.ByteString). mk bs = CI bs (foldCaseBS bs) + #-} + +foldCaseBS :: B.ByteString -> B.ByteString +foldCaseBS bs = B.map toLower8' bs + where + toLower8' :: Word8 -> Word8 + toLower8' w + | 65 <= w && w <= 90 || + 192 <= w && w <= 214 || + 216 <= w && w <= 222 = w + 32 + | otherwise = w diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2011-2012 Bas van Dijk +Copyright (c) 2011-2013 Bas van Dijk All rights reserved. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/bench/bench.hs b/bench/bench.hs new file mode 100644 --- /dev/null +++ b/bench/bench.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Main ( main) where + +import Criterion.Main ( defaultMain, bcompare, bench, nf ) +import qualified Data.ByteString as B ( readFile ) +import qualified Data.CaseInsensitive as CI ( mk ) +import qualified NoClass as NC ( mk ) + +#if !MIN_VERSION_bytestring(0,10,0) +import Control.DeepSeq ( NFData ) +instance NFData ByteString +#endif + +main :: IO () +main = do + bs <- B.readFile "data/pg2189.txt" + defaultMain + [ bcompare + [ bench "no-class" $ nf (\s -> NC.mk s) bs + , bench "case-insensitive" $ nf (\s -> CI.mk s) bs + ] + ] diff --git a/case-insensitive.cabal b/case-insensitive.cabal --- a/case-insensitive.cabal +++ b/case-insensitive.cabal @@ -1,6 +1,6 @@ name: case-insensitive -version: 0.4.0.4 -cabal-version: >=1.6 +version: 1.0 +cabal-version: >=1.8 build-type: Simple license: BSD3 license-file: LICENSE @@ -24,9 +24,38 @@ Location: git://github.com/basvandijk/case-insensitive.git Library - GHC-Options: -Wall + ghc-options: -Wall build-depends: base >= 3 && < 4.7 , bytestring >= 0.9 && < 0.11 , text >= 0.3 && < 0.12 + , deepseq >= 1.1 && < 1.4 , hashable >= 1.0 && < 1.3 exposed-modules: Data.CaseInsensitive + +test-suite test-case-insensitive + type: exitcode-stdio-1.0 + main-is: test.hs + hs-source-dirs: test + + build-depends: case-insensitive + , base >= 3 && < 4.7 + , bytestring >= 0.9 && < 0.11 + , text >= 0.3 && < 0.12 + , HUnit >= 1.2.2 && < 1.3 + , test-framework >= 0.2.4 && < 0.9 + , test-framework-hunit >= 0.2.4 && < 0.4 + + ghc-options: -Wall + +benchmark bench-case-insensitive + type: exitcode-stdio-1.0 + main-is: bench.hs + hs-source-dirs: bench + + ghc-options: -Wall -O2 + + build-depends: case-insensitive + , base >= 3 && < 4.7 + , bytestring >= 0.9 && < 0.11 + , criterion >= 0.6.1 && < 0.7 + , deepseq >= 1.1 && < 1.4 diff --git a/test/test.hs b/test/test.hs new file mode 100644 --- /dev/null +++ b/test/test.hs @@ -0,0 +1,82 @@ +module Main ( main ) where + +import Data.ByteString ( ByteString ) +import qualified Data.ByteString.Char8 as BC8 ( pack, map ) +import qualified Data.ByteString.Lazy as Lazy ( ByteString ) +import qualified Data.ByteString.Lazy.Char8 as BLC8 ( pack, map ) +import qualified Data.CaseInsensitive as CI ( mk ) +import Data.Char ( toUpper, chr ) +import Data.Text ( Text ) +import qualified Data.Text as T ( pack, toUpper ) +import qualified Data.Text.Lazy as Lazy ( Text ) +import qualified Data.Text.Lazy as TL ( pack, toUpper ) +import Test.Framework ( defaultMain, testGroup ) +import Test.Framework.Providers.HUnit ( testCase ) +import Test.HUnit ( assertEqual ) + +main :: IO () +main = defaultMain + [ testGroup "ASCII" + [ testCase "String" $ assertEqual "" (CI.mk asciiStr) + (CI.mk ( map toUpper asciiStr)) + , testCase "ByteString" $ assertEqual "" (CI.mk asciiBs) + (CI.mk ( BC8.map toUpper asciiBs)) + , testCase "Lazy.ByteString" $ assertEqual "" (CI.mk asciiLBs) + (CI.mk (BLC8.map toUpper asciiLBs)) + , testCase "Text" $ assertEqual "" (CI.mk asciiTxt) + (CI.mk ( T.toUpper asciiTxt)) + , testCase "Lazy.Text" $ assertEqual "" (CI.mk asciiLTxt) + (CI.mk ( TL.toUpper asciiLTxt)) + ] + , testGroup "ISO-8859-1" + [ testCase "String" $ assertEqual "" (CI.mk iso_8859_1Str) + (CI.mk ( map toUpper iso_8859_1Str)) + , testCase "ByteString" $ assertEqual "" (CI.mk iso_8859_1Bs) + (CI.mk ( BC8.map toUpper' iso_8859_1Bs)) + , testCase "Lazy.ByteString" $ assertEqual "" (CI.mk iso_8859_1LBs) + (CI.mk (BLC8.map toUpper' iso_8859_1LBs)) + , testCase "Text" $ assertEqual "" (CI.mk iso_8859_1Txt) + (CI.mk ( T.toUpper iso_8859_1Txt)) + , testCase "Lazy.Text" $ assertEqual "" (CI.mk iso_8859_1LTxt) + (CI.mk ( TL.toUpper iso_8859_1LTxt)) + ] + ] + + +asciiLTxt :: Lazy.Text +asciiLTxt = TL.pack asciiStr + +asciiTxt :: Text +asciiTxt = T.pack asciiStr + +asciiLBs :: Lazy.ByteString +asciiLBs = BLC8.pack asciiStr + +asciiBs :: ByteString +asciiBs = BC8.pack asciiStr + +asciiStr :: String +asciiStr = map chr [0..127] + + +iso_8859_1LTxt :: Lazy.Text +iso_8859_1LTxt = TL.pack iso_8859_1Str + +iso_8859_1Txt :: Text +iso_8859_1Txt = T.pack iso_8859_1Str + +iso_8859_1LBs :: Lazy.ByteString +iso_8859_1LBs = BLC8.pack iso_8859_1Str + +iso_8859_1Bs :: ByteString +iso_8859_1Bs = BC8.pack iso_8859_1Str + +iso_8859_1Str :: String +iso_8859_1Str = asciiStr ++ map chr [128..255] + + +-- | Upper-casing some characters in ISO 8859-1 move them outside the 0-255 range. +toUpper' :: Char -> Char +toUpper' 'µ' = 'µ' -- toUpper 'µ' (code point: 181) == 'Μ' (code point: 924) +toUpper' 'ÿ' = 'ÿ' -- toUpper 'ÿ' (code point: 255) == 'Ÿ' (code point: 376) +toUpper' c = toUpper c