diff --git a/Data/CaseInsensitive.hs b/Data/CaseInsensitive.hs new file mode 100644 --- /dev/null +++ b/Data/CaseInsensitive.hs @@ -0,0 +1,131 @@ +{-# 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 +-- +-- 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 + , 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 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@, @Text@, @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. + , lowerCased ∷ !s + } + 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` 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 + + +-------------------------------------------------------------------------------- +-- Folding (lowering) cases +-------------------------------------------------------------------------------- + +-- | Class of string-like types that support folding cases. +-- +-- For 'Char' this means 'toLower' and for 'T.Text' this means 'T.toCaseFold'. +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 + + +-- The End --------------------------------------------------------------------- diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright (c) 2011 Bas van Dijk + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * The name of Bas van Dijk and the names of contributors may NOT + be used to endorse or promote products derived from this + software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/case-insensitive.cabal b/case-insensitive.cabal new file mode 100644 --- /dev/null +++ b/case-insensitive.cabal @@ -0,0 +1,28 @@ +name: case-insensitive +version: 0.1 +cabal-version: >=1.6 +build-type: Simple +license: BSD3 +license-file: LICENSE +copyright: 2011 Bas van Dijk +author: Bas van Dijk +maintainer: Bas van Dijk +category: Data, Text +synopsis: Case insensitive string comparison +description: The module @Data.CaseInsensitive@ provides the 'CI' type + constructor which can be parameterised by a string-like + type like: 'String', 'ByteString', 'Text', + etc.. Comparisons of values of the resulting type are + then insensitive to cases. + +source-repository head + Type: darcs + Location: http://code.haskell.org/~basvandijk/code/case-insensitive + +Library + GHC-Options: -Wall + build-depends: base >= 4 && < 4.4 + , base-unicode-symbols >= 0.1.1 && < 0.3 + , bytestring >= 0.9 && < 0.10 + , text >= 0.3 && < 0.12 + exposed-modules: Data.CaseInsensitive