{-# LINE 1 "Data/Text/ICU/DateFormatter.hsc" #-}
{-# LANGUAGE EmptyDataDecls, RankNTypes, BangPatterns, ForeignFunctionInterface, RecordWildCards #-}
module Data.Text.ICU.DateFormatter
(DateFormatter, FormatStyle(..), DateFormatSymbolType(..), standardDateFormatter, patternDateFormatter, dateSymbols, formatCalendar
) where
import Control.Monad (forM)
import Data.Int (Int32)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.ICU.Error.Internal (UErrorCode, handleError, handleOverflowError)
import Data.Text.ICU.Internal (LocaleName(..), UChar, withLocaleName, newICUPtr, fromUCharPtr, useAsUCharPtr)
import Data.Text.ICU.Calendar
import Foreign.C.String (CString)
import Foreign.C.Types (CInt(..))
import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
import Foreign.Ptr (FunPtr, Ptr, nullPtr)
import Prelude hiding (last)
import System.IO.Unsafe (unsafePerformIO)
data FormatStyle =
FullFormatStyle
| LongFormatStyle
| MediumFormatStyle
| ShortFormatStyle
| DefaultFormatStyle
| RelativeFormatStyle
| NoFormatStyle
deriving (FormatStyle -> FormatStyle -> Bool
(FormatStyle -> FormatStyle -> Bool)
-> (FormatStyle -> FormatStyle -> Bool) -> Eq FormatStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormatStyle -> FormatStyle -> Bool
== :: FormatStyle -> FormatStyle -> Bool
$c/= :: FormatStyle -> FormatStyle -> Bool
/= :: FormatStyle -> FormatStyle -> Bool
Eq, Int -> FormatStyle
FormatStyle -> Int
FormatStyle -> [FormatStyle]
FormatStyle -> FormatStyle
FormatStyle -> FormatStyle -> [FormatStyle]
FormatStyle -> FormatStyle -> FormatStyle -> [FormatStyle]
(FormatStyle -> FormatStyle)
-> (FormatStyle -> FormatStyle)
-> (Int -> FormatStyle)
-> (FormatStyle -> Int)
-> (FormatStyle -> [FormatStyle])
-> (FormatStyle -> FormatStyle -> [FormatStyle])
-> (FormatStyle -> FormatStyle -> [FormatStyle])
-> (FormatStyle -> FormatStyle -> FormatStyle -> [FormatStyle])
-> Enum FormatStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: FormatStyle -> FormatStyle
succ :: FormatStyle -> FormatStyle
$cpred :: FormatStyle -> FormatStyle
pred :: FormatStyle -> FormatStyle
$ctoEnum :: Int -> FormatStyle
toEnum :: Int -> FormatStyle
$cfromEnum :: FormatStyle -> Int
fromEnum :: FormatStyle -> Int
$cenumFrom :: FormatStyle -> [FormatStyle]
enumFrom :: FormatStyle -> [FormatStyle]
$cenumFromThen :: FormatStyle -> FormatStyle -> [FormatStyle]
enumFromThen :: FormatStyle -> FormatStyle -> [FormatStyle]
$cenumFromTo :: FormatStyle -> FormatStyle -> [FormatStyle]
enumFromTo :: FormatStyle -> FormatStyle -> [FormatStyle]
$cenumFromThenTo :: FormatStyle -> FormatStyle -> FormatStyle -> [FormatStyle]
enumFromThenTo :: FormatStyle -> FormatStyle -> FormatStyle -> [FormatStyle]
Enum, Int -> FormatStyle -> ShowS
[FormatStyle] -> ShowS
FormatStyle -> String
(Int -> FormatStyle -> ShowS)
-> (FormatStyle -> String)
-> ([FormatStyle] -> ShowS)
-> Show FormatStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FormatStyle -> ShowS
showsPrec :: Int -> FormatStyle -> ShowS
$cshow :: FormatStyle -> String
show :: FormatStyle -> String
$cshowList :: [FormatStyle] -> ShowS
showList :: [FormatStyle] -> ShowS
Show)
toUDateFormatStyle :: FormatStyle -> CInt
toUDateFormatStyle :: FormatStyle -> UDateFormatStyle
toUDateFormatStyle FormatStyle
FullFormatStyle = UDateFormatStyle
0
{-# LINE 59 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatStyle LongFormatStyle = 1
{-# LINE 60 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatStyle MediumFormatStyle = 2
{-# LINE 61 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatStyle ShortFormatStyle = 3
{-# LINE 62 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatStyle DefaultFormatStyle = 2
{-# LINE 63 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatStyle RelativeFormatStyle = 128
{-# LINE 64 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatStyle NoFormatStyle = -1
{-# LINE 65 "Data/Text/ICU/DateFormatter.hsc" #-}
data DateFormatSymbolType =
Eras
| Months
| ShortMonths
| Weekdays
| ShortWeekdays
| AmPms
| LocalizedChars
| EraNames
| NarrowMonths
| NarrowWeekdays
| StandaloneMonths
| StandaloneWeekdays
| StandaoneShortWeekdays
| StandaloneNarrowWeekdays
| Quarters
| ShortQuarters
| StandaloneQuarters
| ShorterWeekdays
| StandaloneShorterWeekdays
| CyclicYearsWide
| CyclicYearsAbbreviated
| CyclicYearsNarrow
| ZodiacNamesWide
| ZodiacNamesAbbreviated
| ZodiacNamesNarrow
{-# LINE 97 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType :: DateFormatSymbolType -> CInt
toUDateFormatSymbolType :: DateFormatSymbolType -> UDateFormatStyle
toUDateFormatSymbolType DateFormatSymbolType
Eras = UDateFormatStyle
0
{-# LINE 100 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType Months = 1
{-# LINE 101 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType ShortMonths = 2
{-# LINE 102 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType Weekdays = 3
{-# LINE 103 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType ShortWeekdays = 4
{-# LINE 104 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType AmPms = 5
{-# LINE 105 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType LocalizedChars = 6
{-# LINE 106 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType EraNames = 7
{-# LINE 107 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType NarrowMonths = 8
{-# LINE 108 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType NarrowWeekdays = 9
{-# LINE 109 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType StandaloneMonths = 10
{-# LINE 110 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType StandaloneWeekdays = 13
{-# LINE 111 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType StandaoneShortWeekdays = 14
{-# LINE 112 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType StandaloneNarrowWeekdays = 15
{-# LINE 113 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType Quarters = 16
{-# LINE 114 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType ShortQuarters = 17
{-# LINE 115 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType StandaloneQuarters = 18
{-# LINE 116 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType ShorterWeekdays = 20
{-# LINE 117 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType StandaloneShorterWeekdays = 21
{-# LINE 118 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType CyclicYearsWide = 22
{-# LINE 119 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType CyclicYearsAbbreviated = 23
{-# LINE 120 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType CyclicYearsNarrow = 24
{-# LINE 121 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType ZodiacNamesWide = 25
{-# LINE 122 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType ZodiacNamesAbbreviated = 26
{-# LINE 123 "Data/Text/ICU/DateFormatter.hsc" #-}
toUDateFormatSymbolType ZodiacNamesNarrow = 27
{-# LINE 124 "Data/Text/ICU/DateFormatter.hsc" #-}
{-# LINE 128 "Data/Text/ICU/DateFormatter.hsc" #-}
type UDateFormatStyle = CInt
type UFieldPosition = CInt
type UDateFormatSymbolType = CInt
data UDateFormat
newtype DateFormatter = DateFormatter (ForeignPtr UDateFormat)
standardDateFormatter :: FormatStyle -> FormatStyle -> LocaleName -> Text -> IO DateFormatter
standardDateFormatter :: FormatStyle
-> FormatStyle -> LocaleName -> Text -> IO DateFormatter
standardDateFormatter FormatStyle
timeStyle FormatStyle
dateStyle LocaleName
loc Text
timeZoneId =
LocaleName -> (CString -> IO DateFormatter) -> IO DateFormatter
forall a. LocaleName -> (CString -> IO a) -> IO a
withLocaleName LocaleName
loc ((CString -> IO DateFormatter) -> IO DateFormatter)
-> (CString -> IO DateFormatter) -> IO DateFormatter
forall a b. (a -> b) -> a -> b
$ \CString
locale ->
Text -> (Ptr UChar -> I16 -> IO DateFormatter) -> IO DateFormatter
forall a. Text -> (Ptr UChar -> I16 -> IO a) -> IO a
useAsUCharPtr Text
timeZoneId ((Ptr UChar -> I16 -> IO DateFormatter) -> IO DateFormatter)
-> (Ptr UChar -> I16 -> IO DateFormatter) -> IO DateFormatter
forall a b. (a -> b) -> a -> b
$ \Ptr UChar
tzPtr I16
tzLen ->
(ForeignPtr UDateFormat -> DateFormatter)
-> FinalizerPtr UDateFormat
-> IO (Ptr UDateFormat)
-> IO DateFormatter
forall a i.
(ForeignPtr a -> i) -> FinalizerPtr a -> IO (Ptr a) -> IO i
newICUPtr ForeignPtr UDateFormat -> DateFormatter
DateFormatter FinalizerPtr UDateFormat
udat_close (IO (Ptr UDateFormat) -> IO DateFormatter)
-> IO (Ptr UDateFormat) -> IO DateFormatter
forall a b. (a -> b) -> a -> b
$
(Ptr UDateFormatStyle -> IO (Ptr UDateFormat))
-> IO (Ptr UDateFormat)
forall a. (Ptr UDateFormatStyle -> IO a) -> IO a
handleError ((Ptr UDateFormatStyle -> IO (Ptr UDateFormat))
-> IO (Ptr UDateFormat))
-> (Ptr UDateFormatStyle -> IO (Ptr UDateFormat))
-> IO (Ptr UDateFormat)
forall a b. (a -> b) -> a -> b
$ UDateFormatStyle
-> UDateFormatStyle
-> CString
-> Ptr UChar
-> Int32
-> Ptr UChar
-> Int32
-> Ptr UDateFormatStyle
-> IO (Ptr UDateFormat)
udat_open (FormatStyle -> UDateFormatStyle
toUDateFormatStyle FormatStyle
timeStyle) (FormatStyle -> UDateFormatStyle
toUDateFormatStyle FormatStyle
dateStyle) CString
locale Ptr UChar
tzPtr (I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
tzLen) Ptr UChar
forall a. Ptr a
nullPtr (Int32
0 :: Int32)
patternDateFormatter :: Text -> LocaleName -> Text -> IO DateFormatter
patternDateFormatter :: Text -> LocaleName -> Text -> IO DateFormatter
patternDateFormatter Text
pattern LocaleName
loc Text
timeZoneId =
LocaleName -> (CString -> IO DateFormatter) -> IO DateFormatter
forall a. LocaleName -> (CString -> IO a) -> IO a
withLocaleName LocaleName
loc ((CString -> IO DateFormatter) -> IO DateFormatter)
-> (CString -> IO DateFormatter) -> IO DateFormatter
forall a b. (a -> b) -> a -> b
$ \CString
locale ->
Text -> (Ptr UChar -> I16 -> IO DateFormatter) -> IO DateFormatter
forall a. Text -> (Ptr UChar -> I16 -> IO a) -> IO a
useAsUCharPtr Text
timeZoneId ((Ptr UChar -> I16 -> IO DateFormatter) -> IO DateFormatter)
-> (Ptr UChar -> I16 -> IO DateFormatter) -> IO DateFormatter
forall a b. (a -> b) -> a -> b
$ \Ptr UChar
tzPtr I16
tzLen ->
Text -> (Ptr UChar -> I16 -> IO DateFormatter) -> IO DateFormatter
forall a. Text -> (Ptr UChar -> I16 -> IO a) -> IO a
useAsUCharPtr Text
pattern ((Ptr UChar -> I16 -> IO DateFormatter) -> IO DateFormatter)
-> (Ptr UChar -> I16 -> IO DateFormatter) -> IO DateFormatter
forall a b. (a -> b) -> a -> b
$ \Ptr UChar
patPtr I16
patLen ->
(ForeignPtr UDateFormat -> DateFormatter)
-> FinalizerPtr UDateFormat
-> IO (Ptr UDateFormat)
-> IO DateFormatter
forall a i.
(ForeignPtr a -> i) -> FinalizerPtr a -> IO (Ptr a) -> IO i
newICUPtr ForeignPtr UDateFormat -> DateFormatter
DateFormatter FinalizerPtr UDateFormat
udat_close (IO (Ptr UDateFormat) -> IO DateFormatter)
-> IO (Ptr UDateFormat) -> IO DateFormatter
forall a b. (a -> b) -> a -> b
$
(Ptr UDateFormatStyle -> IO (Ptr UDateFormat))
-> IO (Ptr UDateFormat)
forall a. (Ptr UDateFormatStyle -> IO a) -> IO a
handleError ((Ptr UDateFormatStyle -> IO (Ptr UDateFormat))
-> IO (Ptr UDateFormat))
-> (Ptr UDateFormatStyle -> IO (Ptr UDateFormat))
-> IO (Ptr UDateFormat)
forall a b. (a -> b) -> a -> b
$ UDateFormatStyle
-> UDateFormatStyle
-> CString
-> Ptr UChar
-> Int32
-> Ptr UChar
-> Int32
-> Ptr UDateFormatStyle
-> IO (Ptr UDateFormat)
udat_open (Int32 -> UDateFormatStyle
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((-Int32
2) :: Int32)) (Int32 -> UDateFormatStyle
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((-Int32
2) :: Int32)) CString
locale Ptr UChar
tzPtr (I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
tzLen) Ptr UChar
patPtr (I16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral I16
patLen)
{-# LINE 190 "Data/Text/ICU/DateFormatter.hsc" #-}
dateSymbols :: DateFormatter -> DateFormatSymbolType -> [Text]
dateSymbols :: DateFormatter -> DateFormatSymbolType -> [Text]
dateSymbols (DateFormatter ForeignPtr UDateFormat
df) DateFormatSymbolType
symType = IO [Text] -> [Text]
forall a. IO a -> a
unsafePerformIO (IO [Text] -> [Text]) -> IO [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ do
ForeignPtr UDateFormat
-> (Ptr UDateFormat -> IO [Text]) -> IO [Text]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr UDateFormat
df ((Ptr UDateFormat -> IO [Text]) -> IO [Text])
-> (Ptr UDateFormat -> IO [Text]) -> IO [Text]
forall a b. (a -> b) -> a -> b
$ \Ptr UDateFormat
dfPtr -> do
Int32
n <- Ptr UDateFormat -> UDateFormatStyle -> IO Int32
udat_countSymbols Ptr UDateFormat
dfPtr (DateFormatSymbolType -> UDateFormatStyle
toUDateFormatSymbolType DateFormatSymbolType
symType)
[Text]
syms <- [Int32] -> (Int32 -> IO Text) -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int32
0..(Int32
nInt32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
-Int32
1)] ((Int32 -> IO Text) -> IO [Text])
-> (Int32 -> IO Text) -> IO [Text]
forall a b. (a -> b) -> a -> b
$ \Int32
i -> do
Int
-> (Ptr UChar -> Int32 -> Ptr UDateFormatStyle -> IO Int32)
-> (Ptr UChar -> Int -> IO Text)
-> IO Text
forall a b.
Storable a =>
Int
-> (Ptr a -> Int32 -> Ptr UDateFormatStyle -> 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 UDateFormat
-> UDateFormatStyle
-> Int32
-> Ptr UChar
-> Int32
-> Ptr UDateFormatStyle
-> IO Int32
udat_getSymbols Ptr UDateFormat
dfPtr (DateFormatSymbolType -> UDateFormatStyle
toUDateFormatSymbolType DateFormatSymbolType
symType) (Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i) 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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text]
syms
formatCalendar :: DateFormatter -> Calendar -> Text
formatCalendar :: DateFormatter -> Calendar -> Text
formatCalendar (DateFormatter ForeignPtr UDateFormat
df) (Calendar ForeignPtr UDateFormatStyle
cal) = IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$
ForeignPtr UDateFormat -> (Ptr UDateFormat -> IO Text) -> IO Text
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr UDateFormat
df ((Ptr UDateFormat -> IO Text) -> IO Text)
-> (Ptr UDateFormat -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr UDateFormat
dfPtr -> do
ForeignPtr UDateFormatStyle
-> (Ptr UDateFormatStyle -> IO Text) -> IO Text
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr UDateFormatStyle
cal ((Ptr UDateFormatStyle -> IO Text) -> IO Text)
-> (Ptr UDateFormatStyle -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Ptr UDateFormatStyle
calPtr -> do
Int
-> (Ptr UChar -> Int32 -> Ptr UDateFormatStyle -> IO Int32)
-> (Ptr UChar -> Int -> IO Text)
-> IO Text
forall a b.
Storable a =>
Int
-> (Ptr a -> Int32 -> Ptr UDateFormatStyle -> 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 UDateFormat
-> Ptr UDateFormatStyle
-> Ptr UChar
-> Int32
-> Ptr UDateFormatStyle
-> Ptr UDateFormatStyle
-> IO Int32
udat_formatCalendar Ptr UDateFormat
dfPtr Ptr UDateFormatStyle
calPtr Ptr UChar
dptr Int32
dlen Ptr UDateFormatStyle
forall a. Ptr a
nullPtr)
(\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))
foreign import ccall unsafe "hs_text_icu.h __hs_udat_open" udat_open
:: UDateFormatStyle -> UDateFormatStyle
-> CString
-> Ptr UChar -> Int32
-> Ptr UChar -> Int32
-> Ptr UErrorCode
-> IO (Ptr UDateFormat)
foreign import ccall unsafe "hs_text_icu.h &__hs_udat_close" udat_close
:: FunPtr (Ptr UDateFormat -> IO ())
foreign import ccall unsafe "hs_text_icu.h __hs_udat_formatCalendar" udat_formatCalendar
:: Ptr UDateFormat
-> Ptr UCalendar
-> Ptr UChar -> Int32
-> Ptr UFieldPosition
-> Ptr UErrorCode
-> IO Int32
foreign import ccall unsafe "hs_text_icu.h __hs_udat_getSymbols" udat_getSymbols
:: Ptr UDateFormat -> UDateFormatSymbolType -> Int32 -> Ptr UChar -> Int32 -> Ptr UErrorCode -> IO Int32
foreign import ccall unsafe "hs_text_icu.h __hs_udat_countSymbols" udat_countSymbols
:: Ptr UDateFormat -> UDateFormatSymbolType -> IO Int32