{-# LANGUAGE NoImplicitPrelude
, UnicodeSyntax
, TypeSynonymInstances
, DeriveDataTypeable
#-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.CaseInsensitive
-- Copyright : (c) 2011 Bas van Dijk
-- License : BSD-style (see the file LICENSE)
-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>
--
-- This module is intended to be imported qualified. May I suggest:
--
-- @
-- import Data.CaseInsensitive ( CI )
-- import qualifed Data.CaseInsensitivee as CI
-- @
--
-----------------------------------------------------------------------------
module Data.CaseInsensitive ( CI
, mk
, original
, foldedCase
, map
, FoldCase(foldCase)
) where
--------------------------------------------------------------------------------
-- Imports
--------------------------------------------------------------------------------
-- from base:
import Data.Char ( toLower )
import Data.Eq ( Eq((==)) )
import Data.Ord ( Ord(compare) )
import Data.Function ( on )
import Data.Functor ( fmap )
import Data.Monoid ( Monoid(mempty, mappend) )
import Data.String ( IsString(fromString) )
import Data.Typeable ( Typeable )
import Data.Char ( Char )
import Prelude ( String )
import Text.Read ( Read(readPrec) )
import Text.Show ( Show(showsPrec), ShowS )
import qualified Data.List as L ( map )
-- from base-unicode-symbols:
import Data.Function.Unicode ( (∘) )
-- from bytestring:
import qualified Data.ByteString as B ( ByteString )
import qualified Data.ByteString.Lazy as BL ( ByteString )
import qualified Data.ByteString.Char8 as C8 ( map )
import qualified Data.ByteString.Lazy.Char8 as BLC8 ( map )
-- from text:
import qualified Data.Text as T ( Text, toCaseFold )
import qualified Data.Text.Lazy as TL ( Text, toCaseFold )
--------------------------------------------------------------------------------
-- 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', 'ShowS', 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
--------------------------------------------------------------------------------
-- Folding (lowering) cases
--------------------------------------------------------------------------------
-- | Class of string-like types that support folding cases.
--
-- Note that the instances for 'Char', 'String', 'ShowS' and the 'B.ByteString'
-- types do /not/ perform fully correct Unicode-aware case folding, they simply
-- 'toLower' their characters! This is of course more than suitable for ASCII
-- encoded strings.
--
-- The instances for the 'T.Text' types use 'T.toCaseFold' which performs a
-- better Unicode-aware case fold which is more suitable for case insensitive
-- string comparisons.
class FoldCase s where foldCase ∷ s → s
instance FoldCase Char where foldCase = toLower
instance FoldCase String where foldCase = L.map toLower
instance FoldCase B.ByteString where foldCase = C8.map toLower
instance FoldCase BL.ByteString where foldCase = BLC8.map toLower
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
-- The End ---------------------------------------------------------------------