{-# LANGUAGE ForeignFunctionInterface #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module      : Data.Text.ICU.Iterator
-- Copyright   : (c) 2010 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Iteration functions for Unicode, implemented as bindings to the
-- International Components for Unicode (ICU) libraries.
--
-- Unlike the C and C++ @UCharIterator@ type, the Haskell
-- 'CharIterator' type is immutable, and can safely be used in pure
-- code.
--
-- Functions using these iterators may be more efficient than their
-- counterparts.  For instance, the 'CharIterator' type allows a UTF-8
-- 'ByteString' to be compared against a 'Text', without first
-- converting the 'ByteString':
--
-- > fromUtf8 bs == fromText t
module Data.Text.ICU.Iterator
    (
    -- * Types and constructors
      CharIterator
    , fromString
    , fromText
    , fromUtf8
    ) where

import Data.ByteString (ByteString)
import Data.Int (Int32)
import Data.Text (Text, pack)
import Data.Text.ICU.Internal (CharIterator(..), UCharIterator, asOrdering,
                               withCharIterator)
import Foreign.Ptr (Ptr)
import System.IO.Unsafe (unsafePerformIO)

instance Eq CharIterator where
    CharIterator
a == :: CharIterator -> CharIterator -> Bool
== CharIterator
b = CharIterator -> CharIterator -> Ordering
compareIter CharIterator
a CharIterator
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Ord CharIterator where
    compare :: CharIterator -> CharIterator -> Ordering
compare = CharIterator -> CharIterator -> Ordering
compareIter

-- | Compare two 'CharIterator's.
compareIter :: CharIterator -> CharIterator -> Ordering
compareIter :: CharIterator -> CharIterator -> Ordering
compareIter CharIterator
a CharIterator
b = IO Ordering -> Ordering
forall a. IO a -> a
unsafePerformIO (IO Ordering -> Ordering)
-> ((Ptr UCharIterator -> IO Int32) -> IO Ordering)
-> (Ptr UCharIterator -> IO Int32)
-> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Ordering) -> IO Int32 -> IO Ordering
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Ordering
forall a. Integral a => a -> Ordering
asOrdering (IO Int32 -> IO Ordering)
-> ((Ptr UCharIterator -> IO Int32) -> IO Int32)
-> (Ptr UCharIterator -> IO Int32)
-> IO Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  CharIterator -> (Ptr UCharIterator -> IO Int32) -> IO Int32
forall a. CharIterator -> (Ptr UCharIterator -> IO a) -> IO a
withCharIterator CharIterator
a ((Ptr UCharIterator -> IO Int32) -> Ordering)
-> (Ptr UCharIterator -> IO Int32) -> Ordering
forall a b. (a -> b) -> a -> b
$ CharIterator -> (Ptr UCharIterator -> IO Int32) -> IO Int32
forall a. CharIterator -> (Ptr UCharIterator -> IO a) -> IO a
withCharIterator CharIterator
b ((Ptr UCharIterator -> IO Int32) -> IO Int32)
-> (Ptr UCharIterator -> Ptr UCharIterator -> IO Int32)
-> Ptr UCharIterator
-> IO Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr UCharIterator -> Ptr UCharIterator -> IO Int32
u_strCompareIter

-- | Construct a 'CharIterator' from a Unicode string.
fromString :: String -> CharIterator
fromString :: String -> CharIterator
fromString = Text -> CharIterator
CIText (Text -> CharIterator)
-> (String -> Text) -> String -> CharIterator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
{-# INLINE fromString #-}

-- | Construct a 'CharIterator' from a Unicode string.
fromText :: Text -> CharIterator
fromText :: Text -> CharIterator
fromText = Text -> CharIterator
CIText
{-# INLINE fromText #-}

-- | Construct a 'CharIterator' from a Unicode string encoded as a
-- UTF-8 'ByteString'. The validity of the encoded string is *not*
-- checked.
fromUtf8 :: ByteString -> CharIterator
fromUtf8 :: ByteString -> CharIterator
fromUtf8 = ByteString -> CharIterator
CIUTF8
{-# INLINE fromUtf8 #-}

foreign import ccall unsafe "hs_text_icu.h __hs_u_strCompareIter" u_strCompareIter
    :: Ptr UCharIterator -> Ptr UCharIterator -> IO Int32