{-# LANGUAGE CPP, DeriveDataTypeable #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Unsafe #-}
#endif
module Data.CaseInsensitive.Internal ( CI
, mk
, unsafeMk
, original
, foldedCase
, map
, traverse
, FoldCase(foldCase)
) where
import Control.Applicative (Applicative)
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 ( (.), fmap, (&&), (+), (<=), otherwise )
import Text.Read ( Read, readPrec )
import Text.Show ( Show, showsPrec )
import Data.Semigroup ( Semigroup, (<>) )
import qualified Data.List as L ( map )
#if __GLASGOW_HASKELL__ < 700
import Control.Monad ( (>>) )
import Prelude ( fromInteger )
#endif
import qualified Data.ByteString as B ( ByteString, map )
import qualified Data.ByteString.Lazy as BL ( ByteString, map )
import qualified Data.Text as T ( Text, toCaseFold )
import qualified Data.Text.Lazy as TL ( Text, toCaseFold, pack, unpack )
import Control.DeepSeq ( NFData, rnf, deepseq )
import Data.Hashable ( Hashable, hashWithSalt )
data CI s = CI { original :: !s
, foldedCase :: !s
}
deriving (Data, Typeable)
mk :: FoldCase s => s -> CI s
mk s = CI s (foldCase s)
unsafeMk :: FoldCase s => s -> CI s
unsafeMk s = CI s s
map :: FoldCase s2 => (s1 -> s2) -> (CI s1 -> CI s2)
map f = mk . f . original
traverse :: (FoldCase s2, Applicative f) => (s1 -> f s2) -> CI s1 -> f (CI s2)
traverse f = fmap mk . f . original
instance (IsString s, FoldCase s) => IsString (CI s) where
fromString = mk . fromString
instance Semigroup s => Semigroup (CI s) where
CI o1 l1 <> CI o2 l2 = CI (o1 <> o2) (l1 <> l2)
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` ()
class FoldCase s where
foldCase :: s -> s
foldCaseList :: [s] -> [s]
foldCaseList = L.map foldCase
instance FoldCase a => FoldCase [a] where
foldCase = foldCaseList
instance FoldCase B.ByteString where foldCase = B.map toLower8
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
{-# INLINE toLower8 #-}
toLower8 :: Word8 -> Word8
toLower8 w
| 65 <= w && w <= 90 ||
192 <= w && w <= 214 ||
216 <= w && w <= 222 = w + 32
| otherwise = w
{-# RULES "foldCase/ByteString" foldCase = foldCaseBS #-}
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