{-# LINE 1 "Data/Text/ICU/NumberFormatter.hsc" #-}
{-# LANGUAGE EmptyDataDecls, RankNTypes, BangPatterns, ForeignFunctionInterface, RecordWildCards #-}
-- |
-- Module      : Data.Text.ICU.NumberFormatter
-- Copyright   : (c) 2021 Torsten Kemps-Benedix
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Number formatter implemented as bindings to
-- the International Components for Unicode (ICU) libraries.

module Data.Text.ICU.NumberFormatter
    (
      -- * Data
      NumberFormatter,
      -- * Formatter
      numberFormatter,
      -- $skeleton
      -- * Formatting functions
      formatIntegral, formatIntegral', formatDouble, formatDouble'
    ) where



import Data.Int (Int32, Int64)
import Data.Text (Text)
import Data.Text.ICU.Error.Internal (UErrorCode, handleError, handleOverflowError)
import Data.Text.ICU.Internal (LocaleName(..), UChar, withLocaleName, newICUPtr, fromUCharPtr, useAsUCharPtr)
import Foreign.C.String (CString)
import Foreign.C.Types (CDouble(..))
import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
import Foreign.Ptr (FunPtr, Ptr)
import Prelude hiding (last)
import System.IO.Unsafe (unsafePerformIO)

-- $skeleton
--
-- Here are some examples for number skeletons, see
-- https://unicode-org.github.io/icu/userguide/format_parse/numbers/skeletons.html#examples for more:
--
-- +----------------------------+-----------------+--------+--------------+-------------------------------------------------------------+
-- | Long Skeleton              | Concise Skeleton | Input | en-US Output | Comments                                                    |
-- +============================+==================+=======+==============+=============================================================+
-- | percent                    | %                | 25    | 25%          |                                                             |
-- | .00                        |.00               | 25    | 25.00        | Equivalent to Precision::fixedFraction(2)                   |
-- | percent .00                | % .00            | 25    | 25.00%       |                                                             |
-- | scale/100                  | scale/100        | 0.3   | 30           | Multiply by 100 before formatting                           |
-- | percent scale/100          | %x100            | 0.3   | 30%          |                                                             |
-- | measure-unit/length-meter  | unit/meter       | 5     | 5 m          | UnitWidth defaults to Short                                 |
-- | unit-width-full-name       | unit/meter       | 5     | 5 meters     |                                                             |
-- | compact-short              | K                | 5000  | 5K           |                                                             |
-- | compact-long               | KK               | 5000  | 5 thousand   |                                                             |
-- | group-min2                 | ,?               | 5000  | 5000         | Require 2 digits in group for separator                     |
-- | group-min2                 | ,?               | 15000 | 15,000       |                                                             |
-- | sign-always                | +!               | 60    | +60          | Show sign on all numbers                                    |
-- | sign-always                | +!               | 0     | +0           |                                                             |
-- | sign-except-zero           | +?               | 60    | +60          | Show sign on all numbers except 0                           |
-- | sign-except-zero           | +?               | 0     | 0            |                                                             |
-- +----------------------------+-----------------+--------+--------------+-------------------------------------------------------------+

data UNumberFormatter
data UFormattedNumber

newtype NumberFormatter = NumberFormatter (ForeignPtr UNumberFormatter)

-- | Create a new 'NumberFormatter'.
--
-- See https://unicode-org.github.io/icu/userguide/format_parse/numbers/skeletons.html for how to specify
-- the number skeletons. And use 'availableLocales' in order to find the allowed locale names. These
-- usuallly look like "en", "de", "de_AT" etc. See 'formatIntegral' and 'formatDouble' for some examples.
numberFormatter :: Text -> LocaleName -> IO NumberFormatter
numberFormatter :: Text -> LocaleName -> IO NumberFormatter
numberFormatter Text
skel LocaleName
loc =
  LocaleName -> (CString -> IO NumberFormatter) -> IO NumberFormatter
forall a. LocaleName -> (CString -> IO a) -> IO a
withLocaleName LocaleName
loc ((CString -> IO NumberFormatter) -> IO NumberFormatter)
-> (CString -> IO NumberFormatter) -> IO NumberFormatter
forall a b. (a -> b) -> a -> b
$ \CString
locale ->
    Text
-> (Ptr UChar -> I16 -> IO NumberFormatter) -> IO NumberFormatter
forall a. Text -> (Ptr UChar -> I16 -> IO a) -> IO a
useAsUCharPtr Text
skel ((Ptr UChar -> I16 -> IO NumberFormatter) -> IO NumberFormatter)
-> (Ptr UChar -> I16 -> IO NumberFormatter) -> IO NumberFormatter
forall a b. (a -> b) -> a -> b
$ \Ptr UChar
skelPtr I16
skelLen ->
      (ForeignPtr UNumberFormatter -> NumberFormatter)
-> FinalizerPtr UNumberFormatter
-> IO (Ptr UNumberFormatter)
-> IO NumberFormatter
forall a i.
(ForeignPtr a -> i) -> FinalizerPtr a -> IO (Ptr a) -> IO i
newICUPtr ForeignPtr UNumberFormatter -> NumberFormatter
NumberFormatter FinalizerPtr UNumberFormatter
unumf_close (IO (Ptr UNumberFormatter) -> IO NumberFormatter)
-> IO (Ptr UNumberFormatter) -> IO NumberFormatter
forall a b. (a -> b) -> a -> b
$
        (Ptr UErrorCode -> IO (Ptr UNumberFormatter))
-> IO (Ptr UNumberFormatter)
forall a. (Ptr UErrorCode -> IO a) -> IO a
handleError ((Ptr UErrorCode -> IO (Ptr UNumberFormatter))
 -> IO (Ptr UNumberFormatter))
-> (Ptr UErrorCode -> IO (Ptr UNumberFormatter))
-> IO (Ptr UNumberFormatter)
forall a b. (a -> b) -> a -> b
$ Ptr UChar
-> Int32 -> CString -> Ptr UErrorCode -> IO (Ptr UNumberFormatter)
unumf_openForSkeletonAndLocale Ptr UChar
skelPtr (I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
skelLen) CString
locale

-- | Format an integral number.
--
-- See https://unicode-org.github.io/icu/userguide/format_parse/numbers/skeletons.html for how to specify
-- the number skeletons.
--
-- >>> import Data.Text
-- >>> nf <- numberFormatter (pack "precision-integer") (Locale "de")
-- >>> formatIntegral nf 12345
-- "12.345"
-- >>> nf2 <- numberFormatter (pack "precision-integer") (Locale "fr")
-- >>> formatIntegral nf2 12345
-- "12\8239\&345"
formatIntegral :: Integral a => NumberFormatter -> a -> Text
formatIntegral :: forall a. Integral a => NumberFormatter -> a -> Text
formatIntegral (NumberFormatter ForeignPtr UNumberFormatter
nf) a
x = IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr UNumberFormatter
-> (Ptr UNumberFormatter -> IO Text) -> IO Text
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr UNumberFormatter
nf ((Ptr UNumberFormatter -> IO Text) -> IO Text)
-> (Ptr UNumberFormatter -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr UNumberFormatter
nfPtr -> do
    ForeignPtr UFormattedNumber
resultPtr <- IO (ForeignPtr UFormattedNumber)
newResult
    ForeignPtr UFormattedNumber
-> (Ptr UFormattedNumber -> IO Text) -> IO Text
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr UFormattedNumber
resultPtr ((Ptr UFormattedNumber -> IO Text) -> IO Text)
-> (Ptr UFormattedNumber -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr UFormattedNumber
resPtr -> do
      (Ptr UErrorCode -> IO ()) -> IO ()
forall a. (Ptr UErrorCode -> IO a) -> IO a
handleError ((Ptr UErrorCode -> IO ()) -> IO ())
-> (Ptr UErrorCode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr UNumberFormatter
-> Int64 -> Ptr UFormattedNumber -> Ptr UErrorCode -> IO ()
unumf_formatInt Ptr UNumberFormatter
nfPtr (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x) Ptr UFormattedNumber
resPtr
      Text
t <- Int
-> (Ptr UChar -> Int32 -> Ptr UErrorCode -> IO Int32)
-> (Ptr UChar -> Int -> IO Text)
-> IO Text
forall a b.
Storable a =>
Int
-> (Ptr a -> Int32 -> Ptr UErrorCode -> IO Int32)
-> (Ptr a -> Int -> IO b)
-> IO b
handleOverflowError (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
64 :: Int))
        (\Ptr UChar
dptr Int32
dlen -> Ptr UFormattedNumber
-> Ptr UChar -> Int32 -> Ptr UErrorCode -> IO Int32
unumf_resultToString Ptr UFormattedNumber
resPtr Ptr UChar
dptr Int32
dlen)
        (\Ptr UChar
dptr Int
dlen -> Ptr UChar -> I16 -> IO Text
fromUCharPtr Ptr UChar
dptr (Int -> I16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dlen))
      Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t

-- | Create a number formatter and apply it to an integral number.
formatIntegral' :: (Integral a) => Text -> LocaleName -> a -> Text
formatIntegral' :: forall a. Integral a => Text -> LocaleName -> a -> Text
formatIntegral' Text
skel LocaleName
loc a
x = IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ do
  NumberFormatter
nf <- Text -> LocaleName -> IO NumberFormatter
numberFormatter Text
skel LocaleName
loc
  Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ NumberFormatter -> a -> Text
forall a. Integral a => NumberFormatter -> a -> Text
formatIntegral NumberFormatter
nf a
x

-- | Format a Double.
--
-- See https://unicode-org.github.io/icu/userguide/format_parse/numbers/skeletons.html for how to specify
-- the number skeletons.
--
-- >>> import Data.Text
-- >>> nf3 <- numberFormatter (pack "precision-currency-cash") (Locale "it")
-- >>> formatDouble nf3 12345.6789
-- "12.345,68"
formatDouble :: NumberFormatter -> Double -> Text
formatDouble :: NumberFormatter -> Double -> Text
formatDouble (NumberFormatter ForeignPtr UNumberFormatter
nf) Double
x = IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr UNumberFormatter
-> (Ptr UNumberFormatter -> IO Text) -> IO Text
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr UNumberFormatter
nf ((Ptr UNumberFormatter -> IO Text) -> IO Text)
-> (Ptr UNumberFormatter -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr UNumberFormatter
nfPtr -> do
    ForeignPtr UFormattedNumber
resultPtr <- IO (ForeignPtr UFormattedNumber)
newResult
    ForeignPtr UFormattedNumber
-> (Ptr UFormattedNumber -> IO Text) -> IO Text
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr UFormattedNumber
resultPtr ((Ptr UFormattedNumber -> IO Text) -> IO Text)
-> (Ptr UFormattedNumber -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr UFormattedNumber
resPtr -> do
      (Ptr UErrorCode -> IO ()) -> IO ()
forall a. (Ptr UErrorCode -> IO a) -> IO a
handleError ((Ptr UErrorCode -> IO ()) -> IO ())
-> (Ptr UErrorCode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr UNumberFormatter
-> CDouble -> Ptr UFormattedNumber -> Ptr UErrorCode -> IO ()
unumf_formatDouble Ptr UNumberFormatter
nfPtr (Double -> CDouble
CDouble Double
x) Ptr UFormattedNumber
resPtr
      Text
t <- Int
-> (Ptr UChar -> Int32 -> Ptr UErrorCode -> IO Int32)
-> (Ptr UChar -> Int -> IO Text)
-> IO Text
forall a b.
Storable a =>
Int
-> (Ptr a -> Int32 -> Ptr UErrorCode -> IO Int32)
-> (Ptr a -> Int -> IO b)
-> IO b
handleOverflowError (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
64 :: Int))
        (\Ptr UChar
dptr Int32
dlen -> Ptr UFormattedNumber
-> Ptr UChar -> Int32 -> Ptr UErrorCode -> IO Int32
unumf_resultToString Ptr UFormattedNumber
resPtr Ptr UChar
dptr Int32
dlen)
        (\Ptr UChar
dptr Int
dlen -> Ptr UChar -> I16 -> IO Text
fromUCharPtr Ptr UChar
dptr (Int -> I16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dlen))
      Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t

-- | Create a number formatter and apply it to a Double.
formatDouble' :: Text -> LocaleName -> Double -> Text
formatDouble' :: Text -> LocaleName -> Double -> Text
formatDouble' Text
skel LocaleName
loc Double
x = IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ do
  NumberFormatter
nf <- Text -> LocaleName -> IO NumberFormatter
numberFormatter Text
skel LocaleName
loc
  Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ NumberFormatter -> Double -> Text
formatDouble NumberFormatter
nf Double
x

newResult :: IO (ForeignPtr UFormattedNumber)
newResult :: IO (ForeignPtr UFormattedNumber)
newResult = (ForeignPtr UFormattedNumber -> ForeignPtr UFormattedNumber)
-> FinalizerPtr UFormattedNumber
-> IO (Ptr UFormattedNumber)
-> IO (ForeignPtr UFormattedNumber)
forall a i.
(ForeignPtr a -> i) -> FinalizerPtr a -> IO (Ptr a) -> IO i
newICUPtr ForeignPtr UFormattedNumber -> ForeignPtr UFormattedNumber
forall a. a -> a
id FinalizerPtr UFormattedNumber
unumf_closeResult (IO (Ptr UFormattedNumber) -> IO (ForeignPtr UFormattedNumber))
-> IO (Ptr UFormattedNumber) -> IO (ForeignPtr UFormattedNumber)
forall a b. (a -> b) -> a -> b
$ (Ptr UErrorCode -> IO (Ptr UFormattedNumber))
-> IO (Ptr UFormattedNumber)
forall a. (Ptr UErrorCode -> IO a) -> IO a
handleError Ptr UErrorCode -> IO (Ptr UFormattedNumber)
unumf_openResult

foreign import ccall unsafe "hs_text_icu.h __hs_unumf_openForSkeletonAndLocale" unumf_openForSkeletonAndLocale
    :: Ptr UChar -> Int32 -> CString -> Ptr UErrorCode -> IO (Ptr UNumberFormatter)
foreign import ccall unsafe "hs_text_icu.h &__hs_unumf_close" unumf_close
    :: FunPtr (Ptr UNumberFormatter -> IO ())
foreign import ccall unsafe "hs_text_icu.h __hs_unumf_openResult" unumf_openResult
    :: Ptr UErrorCode -> IO (Ptr UFormattedNumber)
foreign import ccall unsafe "hs_text_icu.h &__hs_unumf_closeResult" unumf_closeResult
    :: FunPtr (Ptr UFormattedNumber -> IO ())
foreign import ccall unsafe "hs_text_icu.h __hs_unumf_formatInt" unumf_formatInt
    :: Ptr UNumberFormatter -> Int64 -> Ptr UFormattedNumber -> Ptr UErrorCode -> IO ()
foreign import ccall unsafe "hs_text_icu.h __hs_unumf_formatDouble" unumf_formatDouble
    :: Ptr UNumberFormatter -> CDouble -> Ptr UFormattedNumber -> Ptr UErrorCode -> IO ()
foreign import ccall unsafe "hs_text_icu.h __hs_unumf_resultToString" unumf_resultToString
    :: Ptr UFormattedNumber -> Ptr UChar -> Int32 -> Ptr UErrorCode -> IO Int32