module Data.CaseInsensitive ( CI
, mk
, original
, map
, FoldCase(foldCase)
) where
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 Text.Read ( Read(readPrec) )
import Text.Show ( Show(showsPrec), ShowS )
import qualified Data.List as L ( map )
import Data.Function.Unicode ( (∘) )
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 )
import qualified Data.Text as T ( Text, toCaseFold )
import qualified Data.Text.Lazy as TL ( Text, toCaseFold )
data CI s = CI { original ∷ !s
, lowerCased ∷ !s
}
deriving Typeable
mk ∷ FoldCase s ⇒ s → CI s
mk s = CI s (foldCase s)
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` lowerCased
instance Ord s ⇒ Ord (CI s) where
compare = compare `on` lowerCased
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
class FoldCase s where foldCase ∷ s → s
instance FoldCase Char where foldCase = toLower
instance FoldCase s ⇒ FoldCase [s] where foldCase = L.map foldCase
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