{-# LANGUAGE DeriveDataTypeable, ForeignFunctionInterface, ScopedTypeVariables  #-}
-- |
-- Module      : Data.Text.ICU.Collate.Pure
-- Copyright   : (c) 2010 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Pure string collation functions for Unicode, implemented as
-- bindings to the International Components for Unicode (ICU)
-- libraries.
--
-- For the impure collation API (which is richer, but less easy to
-- use), see the "Data.Text.ICU.Collate" module.

module Data.Text.ICU.Collate.Pure
    (
    -- * Unicode collation API
    -- $api
      Collator
    , collator
    , collatorWith
    , collatorFromRules
    , collatorFromRulesWith
    , collate
    , collateIter
    , rules
    , sortKey
    , uca
    ) where

import qualified Control.Exception as E
import Control.Monad (forM_)
import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.Text.ICU.Error.Internal (ParseError(..))
import Data.Text.ICU.Collate.Internal (Collator(..))
import Data.Text.ICU.Internal (CharIterator, LocaleName(..))
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.Text.ICU.Collate as IO

-- $api
--

-- | Create an immutable 'Collator' for comparing strings.
--
-- If 'Root' is passed as the locale, UCA collation rules will be
-- used.
collator :: LocaleName -> Collator
collator :: LocaleName -> Collator
collator LocaleName
loc = IO Collator -> Collator
forall a. IO a -> a
unsafePerformIO (IO Collator -> Collator) -> IO Collator -> Collator
forall a b. (a -> b) -> a -> b
$ MCollator -> Collator
C (MCollator -> Collator) -> IO MCollator -> IO Collator
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` LocaleName -> IO MCollator
IO.open LocaleName
loc

-- | Create an immutable 'Collator' with the given 'Attribute's.
collatorWith :: LocaleName -> [IO.Attribute] -> Collator
collatorWith :: LocaleName -> [Attribute] -> Collator
collatorWith LocaleName
loc [Attribute]
atts = IO Collator -> Collator
forall a. IO a -> a
unsafePerformIO (IO Collator -> Collator) -> IO Collator -> Collator
forall a b. (a -> b) -> a -> b
$ do
  MCollator
mc <- LocaleName -> IO MCollator
IO.open LocaleName
loc
  [Attribute] -> (Attribute -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Attribute]
atts ((Attribute -> IO ()) -> IO ()) -> (Attribute -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ MCollator -> Attribute -> IO ()
IO.setAttribute MCollator
mc
  Collator -> IO Collator
forall (m :: * -> *) a. Monad m => a -> m a
return (MCollator -> Collator
C MCollator
mc)

-- | Create an immutable 'Collator' from the given collation rules.
collatorFromRules :: Text -> Either ParseError Collator
collatorFromRules :: Text -> Either ParseError Collator
collatorFromRules Text
rul = Text -> [Attribute] -> Either ParseError Collator
collatorFromRulesWith Text
rul []

-- | Create an immutable 'Collator' from the given collation rules with the given 'Attribute's.
collatorFromRulesWith :: Text -> [IO.Attribute] -> Either ParseError Collator
collatorFromRulesWith :: Text -> [Attribute] -> Either ParseError Collator
collatorFromRulesWith Text
rul [Attribute]
atts = IO (Either ParseError Collator) -> Either ParseError Collator
forall a. IO a -> a
unsafePerformIO (IO (Either ParseError Collator) -> Either ParseError Collator)
-> IO (Either ParseError Collator) -> Either ParseError Collator
forall a b. (a -> b) -> a -> b
$
  (Collator -> Either ParseError Collator
forall a b. b -> Either a b
Right (Collator -> Either ParseError Collator)
-> IO Collator -> IO (Either ParseError Collator)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO Collator
openAndSetAtts)
  IO (Either ParseError Collator)
-> (ParseError -> IO (Either ParseError Collator))
-> IO (Either ParseError Collator)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(ParseError
err::ParseError) -> Either ParseError Collator -> IO (Either ParseError Collator)
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseError -> Either ParseError Collator
forall a b. a -> Either a b
Left ParseError
err)
  where
    openAndSetAtts :: IO Collator
openAndSetAtts = do
      MCollator
mc <- Text -> Maybe Bool -> Maybe Strength -> IO MCollator
IO.openRules Text
rul Maybe Bool
forall a. Maybe a
Nothing Maybe Strength
forall a. Maybe a
Nothing
      [Attribute] -> (Attribute -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Attribute]
atts ((Attribute -> IO ()) -> IO ()) -> (Attribute -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ MCollator -> Attribute -> IO ()
IO.setAttribute MCollator
mc
      Collator -> IO Collator
forall (m :: * -> *) a. Monad m => a -> m a
return (MCollator -> Collator
C MCollator
mc)

-- | Get rules for the given 'Collator'.
rules :: Collator -> Text
rules :: Collator -> Text
rules (C MCollator
c) = IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ MCollator -> IO Text
IO.getRules MCollator
c

-- | Compare two strings.
collate :: Collator -> Text -> Text -> Ordering
collate :: Collator -> Text -> Text -> Ordering
collate (C MCollator
c) Text
a Text
b = IO Ordering -> Ordering
forall a. IO a -> a
unsafePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$ MCollator -> Text -> Text -> IO Ordering
IO.collate MCollator
c Text
a Text
b
{-# INLINE collate #-}

-- | Compare two 'CharIterator's.
--
-- If either iterator was constructed from a 'ByteString', it does not
-- need to be copied or converted beforehand, so this function can be
-- quite cheap.
collateIter :: Collator -> CharIterator -> CharIterator -> Ordering
collateIter :: Collator -> CharIterator -> CharIterator -> Ordering
collateIter (C MCollator
c) CharIterator
a CharIterator
b = IO Ordering -> Ordering
forall a. IO a -> a
unsafePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$ MCollator -> CharIterator -> CharIterator -> IO Ordering
IO.collateIter MCollator
c CharIterator
a CharIterator
b
{-# INLINE collateIter #-}

-- | Create a key for sorting the 'Text' using the given 'Collator'.
-- The result of comparing two 'ByteString's that have been
-- transformed with 'sortKey' will be the same as the result of
-- 'collate' on the two untransformed 'Text's.
sortKey :: Collator -> Text -> ByteString
sortKey :: Collator -> Text -> ByteString
sortKey (C MCollator
c) = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString)
-> (Text -> IO ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MCollator -> Text -> IO ByteString
IO.sortKey MCollator
c
{-# INLINE sortKey #-}

-- | A 'Collator' that uses the Unicode Collation Algorithm (UCA).
uca :: Collator
uca :: Collator
uca = LocaleName -> Collator
collator LocaleName
Root
{-# NOINLINE uca #-}