{-# 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 <v.dijk.bas@gmail.com> -- -- 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.Data ( Data ) 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 (Data, 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: -- <http://hackage.haskell.org/package/text-icu> 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