diff --git a/Data/CaseInsensitive.hs b/Data/CaseInsensitive.hs --- a/Data/CaseInsensitive.hs +++ b/Data/CaseInsensitive.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, NoImplicitPrelude, DeriveDataTypeable #-} +{-# LANGUAGE CPP, NoImplicitPrelude #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} @@ -30,157 +30,4 @@ , map , FoldCase(foldCase) ) where - --------------------------------------------------------------------------------- --- Imports --------------------------------------------------------------------------------- - --- from base: -import Data.Bool ( (||) ) -import Data.Char ( Char, toLower ) -import Data.Eq ( Eq, (==) ) -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 ) - -import qualified Data.List as L ( map ) - -#if __GLASGOW_HASKELL__ < 700 -import Control.Monad ( (>>) ) -import Prelude ( fromInteger ) -#endif - --- from bytestring: -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 ) - --------------------------------------------------------------------------------- --- Case Insensitive Strings --------------------------------------------------------------------------------- - -{-| A @CI s@ provides /C/ase /I/nsensitive comparison for the string-like type -@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 -string literals as in: - -@ -\> (\"Content-Type\" :: 'CI' 'T.Text') == (\"CONTENT-TYPE\" :: 'CI' 'T.Text') -True -@ - --} -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 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 f = mk . f . original - -instance (IsString s, FoldCase s) => IsString (CI s) where - fromString = mk . fromString - -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 - (==) = (==) `on` foldedCase - -instance Ord s => Ord (CI s) where - compare = compare `on` foldedCase - -instance (Read s, FoldCase s) => Read (CI s) where - readPrec = fmap mk readPrec - -instance Show s => Show (CI s) where - showsPrec prec = showsPrec prec . original - -instance Hashable s => Hashable (CI s) where - hashWithSalt salt = hashWithSalt salt . foldedCase - -instance NFData s => NFData (CI s) where - rnf (CI o f) = o `deepseq` f `deepseq` () - --------------------------------------------------------------------------------- --- Folding (lowering) cases --------------------------------------------------------------------------------- - --- | Class of string-like types that support folding cases. --- --- /Note/: In some languages, case conversion is a locale- and context-dependent --- operation. The @foldCase@ method is /not/ intended to be locale sensitive. --- 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 - - foldCaseList :: [s] -> [s] - foldCaseList = L.map foldCase - -instance FoldCase a => FoldCase [a] where - foldCase = foldCaseList - --- | 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 (CI s) where foldCase (CI _ l) = CI l l - -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 +import Data.CaseInsensitive.Internal diff --git a/Data/CaseInsensitive/Internal.hs b/Data/CaseInsensitive/Internal.hs new file mode 100644 --- /dev/null +++ b/Data/CaseInsensitive/Internal.hs @@ -0,0 +1,190 @@ +{-# LANGUAGE CPP, NoImplicitPrelude, DeriveDataTypeable #-} + +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Unsafe #-} +#endif + +----------------------------------------------------------------------------- +-- | +-- Module : Data.CaseInsensitive.Internal +-- Copyright : (c) 2011-2013 Bas van Dijk +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Bas van Dijk +-- +-- Internal module which exports the 'CI' type, constructor, +-- associated instances and the 'FoldCase' class and instances. +-- +----------------------------------------------------------------------------- + +module Data.CaseInsensitive.Internal ( CI + , mk + , unsafeMk + , original + , foldedCase + , map + , FoldCase(foldCase) + ) where + +-------------------------------------------------------------------------------- +-- Imports +-------------------------------------------------------------------------------- + +-- from base: +import Data.Bool ( (||) ) +import Data.Char ( Char, toLower ) +import Data.Eq ( Eq, (==) ) +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 ) + +import qualified Data.List as L ( map ) + +#if __GLASGOW_HASKELL__ < 700 +import Control.Monad ( (>>) ) +import Prelude ( fromInteger ) +#endif + +-- from bytestring: +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 ) + + +-------------------------------------------------------------------------------- +-- Case Insensitive Strings +-------------------------------------------------------------------------------- + +{-| A @CI s@ provides /C/ase /I/nsensitive comparison for the string-like type +@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 +string literals as in: + +@ +\> (\"Content-Type\" :: 'CI' 'T.Text') == (\"CONTENT-TYPE\" :: 'CI' 'T.Text') +True +@ + +-} +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 s = CI s (foldCase s) + +-- | Constructs a 'CI' from an already case folded string-like +-- value. The given string is used both as the 'original' as well as +-- the 'foldedCase'. +-- +-- This function is unsafe since the compiler can't guarantee that the +-- provided string is case folded. +unsafeMk :: FoldCase s => s -> CI s +unsafeMk s = CI s s + +-- | Transform the original string-like value but keep it case insensitive. +map :: FoldCase s2 => (s1 -> s2) -> (CI s1 -> CI s2) +map f = mk . f . original + +instance (IsString s, FoldCase s) => IsString (CI s) where + fromString = mk . fromString + +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 + (==) = (==) `on` foldedCase + +instance Ord s => Ord (CI s) where + compare = compare `on` foldedCase + +instance (Read s, FoldCase s) => Read (CI s) where + readPrec = fmap mk readPrec + +instance Show s => Show (CI s) where + showsPrec prec = showsPrec prec . original + +instance Hashable s => Hashable (CI s) where + hashWithSalt salt = hashWithSalt salt . foldedCase + +instance NFData s => NFData (CI s) where + rnf (CI o f) = o `deepseq` f `deepseq` () + +-------------------------------------------------------------------------------- +-- Folding (lowering) cases +-------------------------------------------------------------------------------- + +-- | Class of string-like types that support folding cases. +-- +-- /Note/: In some languages, case conversion is a locale- and context-dependent +-- operation. The @foldCase@ method is /not/ intended to be locale sensitive. +-- 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 + + foldCaseList :: [s] -> [s] + foldCaseList = L.map foldCase + +instance FoldCase a => FoldCase [a] where + foldCase = foldCaseList + +-- | 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 (CI s) where foldCase (CI _ l) = CI l l + +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/Data/CaseInsensitive/Unsafe.hs b/Data/CaseInsensitive/Unsafe.hs new file mode 100644 --- /dev/null +++ b/Data/CaseInsensitive/Unsafe.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE CPP, NoImplicitPrelude #-} + +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Unsafe #-} +#endif + +----------------------------------------------------------------------------- +-- | +-- Module : Data.CaseInsensitive.Unsafe +-- Copyright : (c) 2011-2013 Bas van Dijk +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Bas van Dijk +-- +-- Provides an unsafe way to create a case insensitive string-like value. +-- +----------------------------------------------------------------------------- + +module Data.CaseInsensitive.Unsafe ( unsafeMk ) where +import Data.CaseInsensitive.Internal ( unsafeMk ) diff --git a/case-insensitive.cabal b/case-insensitive.cabal --- a/case-insensitive.cabal +++ b/case-insensitive.cabal @@ -1,5 +1,5 @@ name: case-insensitive -version: 1.0.0.2 +version: 1.1 cabal-version: >=1.8 build-type: Simple license: BSD3 @@ -30,7 +30,8 @@ , text >= 0.3 && < 0.12 , deepseq >= 1.1 && < 1.4 , hashable >= 1.0 && < 1.3 - exposed-modules: Data.CaseInsensitive + exposed-modules: Data.CaseInsensitive, Data.CaseInsensitive.Unsafe + other-modules: Data.CaseInsensitive.Internal test-suite test-case-insensitive type: exitcode-stdio-1.0