{-# LANGUAGE MultiParamTypeClasses , FlexibleInstances #-}

{- |

module:         Data.CaseInsensitive.Eq
description:    Simple, fast case-insensitive matching of various string types.

This, like most other case-insensitive matching algorithms, is an
over-simplification. For some complex Q&A about properties like case, see
<http://unicode.org/faq/casemap_charprop.html>. A round-trip case-conversion
does not necessarily result in the original character(s) in some scripts. Also,
string matching is not necessarily the same as character matching. The
char-at-a-time approach taken here is not technically correct, but works for
the most scripts, and definitely for ASCII and the ISO-8859-1 8-bit Latin 1
character set.

Usage is simple:

> main = putStrLn $ if "HREF" ^== "href" then "match" else "no match"
 
-}

module Data.CaseInsensitive.Eq
    ( CaseInsensitiveEq(..)
    , (^==)
    , (^/=)
    )
where

import           Data.Char
import           Data.Word
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

class CaseInsensitiveEq a where
    caseInsensitiveEq :: a -> a -> Bool

    caseInsensitiveMatch :: [a] -> [a] -> Bool
    caseInsensitiveMatch = list_eq

-- | An equality operator for 'CaseInsensitiveEq'.
(^==) :: (CaseInsensitiveEq a) => a -> a -> Bool
(^==) = caseInsensitiveEq


-- | An inequality operator for 'CaseInsensitiveEq'.
(^/=) :: (CaseInsensitiveEq a) => a -> a -> Bool
(^/=) a = not . (^==) a

------------------------------------------------------------------------------
--
-- instances

instance CaseInsensitiveEq Char where
    caseInsensitiveEq = char_eq

instance (CaseInsensitiveEq a) => CaseInsensitiveEq [a] where
    caseInsensitiveEq = caseInsensitiveMatch

instance CaseInsensitiveEq Word8 where
    caseInsensitiveEq = char8_eq

instance CaseInsensitiveEq BS.ByteString where
    caseInsensitiveEq = bs_strict_eq

instance CaseInsensitiveEq BSL.ByteString where
    caseInsensitiveEq = bs_lazy_eq

instance CaseInsensitiveEq T.Text where
    caseInsensitiveEq = t_strict_eq

instance CaseInsensitiveEq TL.Text where
    caseInsensitiveEq = t_lazy_eq

instance (CaseInsensitiveEq a, CaseInsensitiveEq b) => CaseInsensitiveEq (a,b) where
    caseInsensitiveEq (a,b) (a',b')
        | caseInsensitiveEq a a' = True
        | otherwise = caseInsensitiveEq b b'

instance (CaseInsensitiveEq a, CaseInsensitiveEq b, CaseInsensitiveEq c) => CaseInsensitiveEq (a,b,c) where
    caseInsensitiveEq (a,b,c) (a',b',c')
        | caseInsensitiveEq a a' = True
        | otherwise = caseInsensitiveEq (b,c) (b',c')

instance (CaseInsensitiveEq a, CaseInsensitiveEq b, CaseInsensitiveEq c, CaseInsensitiveEq d) => CaseInsensitiveEq (a,b,c,d) where
    caseInsensitiveEq (a,b,c,d) (a',b',c',d')
        | caseInsensitiveEq a a' = True
        | otherwise = caseInsensitiveEq (b,c,d) (b',c',d')



-- | Unicode character matching. The real complexity of this masked by our
--   one-char-at-a-time approach. If all alphabetic characters were either
--   upper or lower case with a one-to-one mapping, both toUpper tests would
--   not be needed. However, there are some non-transitive and one-to-many
--   cases for Unicode characters. This is a pragmatic approach that is
--   better than using only 'toLower', which fails for some characters.
{-# INLINE char_eq #-}
char_eq :: Char -> Char -> Bool
char_eq a b
    | a == b = True
    | a == toLower b = True
    | b == toLower a = True
    | a == toUpper b = True
    | b == toUpper a = True
    | otherwise = False

-- | ISO-8859-1 character matching. The code here looks wonky, but this is an
--   attempt to find the answer in as few steps as necessary.
{-# INLINE char8_eq #-}
char8_eq :: Word8 -> Word8 -> Bool
char8_eq a b
    | a == b = True                     --
    | a < 65 || b < 65 = False          -- [0..64]
    | a < 91 && b < 123 = a == b - 32   -- [65..122]
    | b < 91 && a < 123 = b == a - 32   --
    | a < 192 || b < 192 = False        -- [123..192]
    | a == 215 || b == 215 = False      -- not 215
    | a < 223 = a == b - 32             -- [193..214,216..254]
    | b < 223 = a - 32 == b
    | otherwise = False


-- A two-step process for comparing ByteStrings, since length is O(1).
bs_strict_eq :: BS.ByteString -> BS.ByteString -> Bool
bs_strict_eq a b
    | BS.length a /= BS.length b = False -- length is O(1)
    | otherwise = continue_bs_strict_eq a b

-- All of the following follow the same pattern, matching a character at a time.
-- If anyone can find a faster way to do this, please send it in!

continue_bs_strict_eq a b
    | BS.null a = True -- assertion: BS.null b == True after the length check
    | char8_eq (BS.head a) (BS.head b) = continue_bs_strict_eq (BS.tail a) (BS.tail b)
    | otherwise = False

list_eq :: (CaseInsensitiveEq a) => [a] -> [a] -> Bool
list_eq a b
    | null a || null b = null a && null b
    | caseInsensitiveEq (head a) (head b) = list_eq (tail a) (tail b)
    | otherwise = False

bs_lazy_eq :: BSL.ByteString -> BSL.ByteString -> Bool
bs_lazy_eq a b
    | BSL.null a || BSL.null b = BSL.null a && BSL.null b
    | char8_eq (BSL.head a) (BSL.head b) = bs_lazy_eq (BSL.tail a) (BSL.tail b)
    | otherwise = False

t_strict_eq :: T.Text -> T.Text -> Bool
t_strict_eq a b
    | T.null a || T.null b = T.null a && T.null b
    | char_eq (T.head a) (T.head b) = t_strict_eq (T.tail a) (T.tail b)
    | otherwise = False

t_lazy_eq :: TL.Text -> TL.Text -> Bool
t_lazy_eq a b
    | TL.null a || TL.null b = TL.null a && TL.null b
    | char_eq (TL.head a) (TL.head b) = t_lazy_eq (TL.tail a) (TL.tail b)
    | otherwise = False