@@ -0,0 +1,343 @@
1+module Data.Intl.DateTimeFormat
2+ ( LocalesOption
3+ , LocaleMatcher(..)
4+ , TimeZone(..)
5+ , FormatMatcher(..)
6+ , DateTimeFormatOptions(..)
7+ , DateTimeFormatOptions'
8+ , DateTimeComponents(..)
9+ , DateTimeFormat
10+ , createDateTimeFormat
11+ , formatJSDate
12+ , module Data.Intl.DateTimeFormat.Types
13+ , supportedLocalesOf
14+ , formatToParts
15+ , resolvedOptions
16+ ) where
17+
18+import Data.Intl.DateTimeFormat.Types
19+
20+import Control.Monad.Error.Class (throwError)
21+import Data.Either (Either(..))
22+import Data.Foreign (F, Foreign, ForeignError(..), isUndefined, readString)
23+import Data.Foreign.Index ((!))
24+import Data.Function.Uncurried (Fn3, Fn4, runFn3, runFn4)
25+import Data.Intl.DateTimeFormat.Class (class FormatComponent, FormatComponentRecord(FormatComponentRecord), formatComponent)
26+import Data.JSDate (JSDate)
27+import Data.Maybe (Maybe(..), fromMaybe, maybe)
28+import Data.Newtype (class Newtype, un)
29+import Data.StrMap (union)
30+import Data.Symbol (SProxy(..))
31+import Data.Traversable (sequence)
32+import Data.Variant (Variant, case_, default, on)
33+import Prelude (class Eq, class Show, Unit, bind, id, pure, show, (#), ($), (<$>), (<<<), (>>=))
34+import Unsafe.Coerce (unsafeCoerce)
35+
36+foreign import data LocalesOption' :: Type
37+
38+foreign import dateTimeFormatImpl :: LocalesOption' -> DateTimeFormatOptions_ -> DateTimeFormat
39+
40+newtype DateTimeFormatOptions_ = DateTimeFormatOptions_
41+ { localeMatcher :: String
42+ , timeZone :: String
43+ , hour12 :: Boolean
44+ , formatMatcher :: String
45+ , weekday :: String
46+ , era :: String
47+ , year :: String
48+ , month :: String
49+ , day :: String
50+ , hour :: String
51+ , minutes :: String
52+ , second :: String
53+ , timeZoneName :: String
54+ }
55+
56+type LocalesOption = Variant (locale :: String, locales :: Array String, undefined :: Undefined)
57+
58+toLocale :: LocalesOption -> LocalesOption'
59+toLocale = unsafeCoerce $
60+ default undefined
61+ # on (SProxy :: SProxy "locale") id
62+ # on (SProxy :: SProxy "locales") id
63+
64+data LocaleMatcher
65+ = LMLookup
66+ | LMBestFit
67+
68+instance showLocaleMatcher :: Show LocaleMatcher where
69+ show LMLookup = "lookup"
70+ show LMBestFit = "best fit"
71+
72+newtype TimeZone = TimeZone String
73+
74+instance showTimeZone :: Show TimeZone where
75+ show (TimeZone tz) = tz
76+
77+derive instance newtypeTimeZone :: Newtype TimeZone _
78+
79+derive instance eqTimeZone :: Eq TimeZone
80+
81+data FormatMatcher
82+ = FMBasic
83+ | FMBestFit
84+
85+instance showFormatMatcher :: Show FormatMatcher where
86+ show FMBasic = "basic"
87+ show FMBestFit = "best fit"
88+
89+type DateTimeComponents a =
90+ Variant
91+ ( weekdayYearMonthDayHourMinuteSecond :: WeekdayYearMonthDayHourMinuteSecond
92+ , weekdayYearMonthDay :: WeekdayYearMonthDay
93+ , yearMonthDay :: YearMonthDay
94+ , yearMonth :: YearMonth
95+ , monthDay :: MonthDay
96+ , hourMinuteSecond :: HourMinuteSecond
97+ , hourMinute :: HourMinute
98+ , custom :: a
99+ )
100+
101+data DateTimeFormatOptions a = DateTimeFormatOptions
102+ { localeMatcher :: Maybe LocaleMatcher
103+ , timeZone :: Maybe TimeZone
104+ , hour12 :: Maybe Boolean
105+ , formatMatcher :: Maybe FormatMatcher
106+ }
107+ (DateTimeComponents a)
108+
109+type DateTimeFormatOptions' = DateTimeFormatOptions Unit
110+
111+formatDateTimeOptions :: forall a. (FormatComponent a) => DateTimeFormatOptions a -> DateTimeFormatOptions_
112+formatDateTimeOptions (DateTimeFormatOptions opts comps) = merge opts' (compsCoerce comps')
113+ where
114+
115+ undefinedString :: String
116+ undefinedString = unsafeCoerce undefined
117+
118+ opts' = { localeMatcher: maybe undefinedString show opts.localeMatcher
119+ , timeZone: maybe undefinedString show opts.timeZone
120+ , hour12: fromMaybe (unsafeCoerce undefined) opts.hour12
121+ , formatMatcher: maybe undefinedString show opts.formatMatcher
122+ }
123+ comps' = un FormatComponentRecord $ case_
124+ # on (SProxy :: SProxy "weekdayYearMonthDayHourMinuteSecond") formatComponent
125+ # on (SProxy :: SProxy "weekdayYearMonthDay") formatComponent
126+ # on (SProxy :: SProxy "yearMonthDay") formatComponent
127+ # on (SProxy :: SProxy "yearMonth") formatComponent
128+ # on (SProxy :: SProxy "monthDay") formatComponent
129+ # on (SProxy :: SProxy "hourMinuteSecond") formatComponent
130+ # on (SProxy :: SProxy "hourMinute") formatComponent
131+ # on (SProxy :: SProxy "custom") formatComponent
132+ $ comps
133+
134+ toUndefined :: Maybe String -> String
135+ toUndefined m = fromMaybe (unsafeCoerce undefined) m
136+
137+ compsCoerce
138+ :: { weekday :: Maybe String
139+ , era :: Maybe String
140+ , year :: Maybe String
141+ , month :: Maybe String
142+ , day :: Maybe String
143+ , hour :: Maybe String
144+ , minute :: Maybe String
145+ , second :: Maybe String
146+ , timeZoneName :: Maybe String
147+ }
148+ -> { weekday :: String
149+ , era :: String
150+ , year :: String
151+ , month :: String
152+ , day :: String
153+ , hour :: String
154+ , minute :: String
155+ , second :: String
156+ , timeZoneName :: String
157+ }
158+ compsCoerce { weekday, era, year, month, day, hour, minute, second, timeZoneName }
159+ = { weekday: toUndefined weekday
160+ , era: toUndefined era
161+ , year: toUndefined year
162+ , month: toUndefined month
163+ , day: toUndefined day
164+ , hour: toUndefined hour
165+ , minute: toUndefined minute
166+ , second: toUndefined second
167+ , timeZoneName: toUndefined timeZoneName
168+ }
169+
170+ merge
171+ :: { localeMatcher :: String
172+ , timeZone :: String
173+ , hour12 :: Boolean
174+ , formatMatcher :: String
175+ }
176+ -> { weekday :: String
177+ , era :: String
178+ , year :: String
179+ , month :: String
180+ , day :: String
181+ , hour :: String
182+ , minute :: String
183+ , second :: String
184+ , timeZoneName :: String
185+ }
186+ -> DateTimeFormatOptions_
187+ merge a b = unsafeCoerce $ union (unsafeCoerce a) (unsafeCoerce b)
188+
189+foreign import data DateTimeFormat :: Type
190+
191+foreign import createDateTimeFormatImpl
192+ :: Fn4
193+ (forall a. String -> F a)
194+ (forall a. a -> F a)
195+ LocalesOption'
196+ DateTimeFormatOptions_
197+ (F DateTimeFormat)
198+
199+-- | Examples
200+-- | ``` purescript
201+-- | import Data.Variant (inj)
202+-- |
203+-- | fmtHourMinute = F DateTimeFormat
204+-- | fmtHourMinute = createDateTimeFormat locale opts
205+-- | where
206+-- | locale = inj (SProxy :: SProxy "locale") "en-GB"
207+-- | opts = (DateTimeFormatOptions
208+-- | { localeMatcher: Nothing
209+-- | , timeZone: (Just (TimeZone "Europe/London"))
210+-- | , hour12: Just false
211+-- | , formatMatcher: Nothing
212+-- | }
213+-- | (inj (SProxy :: SProxy "hourMinute")
214+-- | (HourMinute {hour: TwoDigit, minute: TwoDigit}))
215+-- |
216+-- |
217+-- | fmtDate :: F DateTimeFormat
218+-- | fmtDate = createDateTimeFormat locale opts
219+-- | wher
220+-- | locale = inj (SProxy :: SProxy "locale") "en-GB"
221+-- | opts :: DateTimeFormatOptions'
222+-- | opts =
223+-- | (DateTimeFormatOptions
224+-- | { localeMatcher: Nothing
225+-- | , timeZone: (Just (TimeZone "Europe/London"))
226+-- | , hour12: Just true
227+-- | , formatMatcher: Nothing
228+-- | }
229+-- | (inj
230+-- | (SProxy :: SProxy "weekdayYearMonthDayHourMinuteSecond")
231+-- | (WeekdayYearMonthDayHourMinuteSecond
232+-- | { weekday: Short
233+-- | , year: Numeric
234+-- | , month: MonthLong
235+-- | , day: Numeric
236+-- | , hour: Numeric
237+-- | , minute: Numeric
238+-- | , second: Numeric
239+-- | }
240+-- | )
241+-- | )
242+-- | )
243+-- | ```
244+-- | You have predifined types: `WeekdayYearMonthDayHourMinuteSecond`,
245+-- | `WeekdayYearMonthDay`, `YearMonthDay`, `YearMonth`, `MonthDay`,
246+-- | `HourMinuteSecond`, `HourMinute`. But you can also provide your own by
247+-- | implementing `FormatComponent` class (or by deriving it), e.g.
248+-- | ``` purescript
249+-- | newtype EraYear = EraYear
250+-- | { era :: StringRep
251+-- | , year :: NumericRep
252+-- | }
253+-- |
254+-- | derive instance genericEraYear :: Generic EraYear _
255+-- |
256+-- | instance formatComponentEraYear :: FormatComponent EraYear where
257+-- | formatComponent = genericFormatComponent
258+-- |
259+-- | fmtEraYear :: F DateTimeFormat
260+-- | fmtEraYear = createDateTimeFormat locales opts
261+-- | where
262+-- | locale = inj (SProxy :: SProxy "locale") "en-GB"
263+-- | opts :: DateTimeFormatOptions EraYear
264+-- | opts =
265+-- | (DateTimeFormatOptions
266+-- | { localeMatcher: Nothing
267+-- | , timeZone: (Just (TimeZone "Europe/London"))
268+-- | , hour12: Just true
269+-- | , formatMatcher: Nothing
270+-- | }
271+-- | (inj
272+-- | (SProxy :: SProxy "custom")
273+-- | (EraYear
274+-- | { era: Long
275+-- | , year: Numeric
276+-- | }
277+-- | )
278+-- | )
279+-- | )
280+-- | ```
281+createDateTimeFormat
282+ :: forall a
283+ .(FormatComponent a)
284+ => LocalesOption
285+ -> DateTimeFormatOptions a
286+ -> F DateTimeFormat
287+createDateTimeFormat ls opts =
288+ runFn4 createDateTimeFormatImpl
289+ (throwError <<< pure <<< ForeignError)
290+ pure
291+ (toLocale ls)
292+ (formatDateTimeOptions opts)
293+
294+-- | Examples
295+-- | ``` purescript
296+-- | formatJSDate (either (const "") id $ runExcept fmtHourMinute) date -- "12:00"
297+-- | formatJSDate (either (const "") id $ fmtDate) date -- "Tue, January 2, 2018, 12:00:00 PM"
298+-- | formatJSDate (either (const "") id $ fmtEraYear) date -- "2018 Anno Domini"
299+-- | ```
300+foreign import formatJSDate :: DateTimeFormat -> JSDate -> String
301+
302+foreign import supportedLocalesOfImpl
303+ :: Fn3
304+ (String -> Either String (Array String))
305+ (Array String -> Either String (Array String))
306+ (Array String)
307+ (Either String (Array String))
308+
309+foreign import formatToPartsImpl :: DateTimeFormat -> JSDate -> Array Foreign
310+
311+formatToParts :: DateTimeFormat -> JSDate -> F (Array FormatParts)
312+formatToParts formatter date = sequence $ readFormatParts <$> formatToPartsImpl formatter date
313+
314+supportedLocalesOf :: Array String -> Either String (Array String)
315+supportedLocalesOf locales = runFn3 supportedLocalesOfImpl Left Right locales
316+
317+foreign import resolvedOptionsImpl :: DateTimeFormat -> Foreign
318+
319+resolvedOptions :: DateTimeFormat -> F ResolvedOptions
320+resolvedOptions fmt = do
321+ locale <- obj ! "locale" >>= readString
322+ calendar <- obj ! "calendar" >>= readString
323+ numberingSystem <- obj ! "numberingSystem" >>= readString
324+ timeZone <- obj ! "timeZone" >>= readString
325+ era <- obj ! "era" >>= readMaybeString
326+ weekday <- obj ! "weekday" >>= readMaybeString
327+ year <- obj ! "year" >>= readMaybeString
328+ day <- obj ! "day" >>= readMaybeString
329+ hour <- obj ! "hour" >>= readMaybeString
330+ minute <- obj ! "minute" >>= readMaybeString
331+ second <- obj ! "second" >>= readMaybeString
332+ timeZoneName <- obj ! "timeZoneName" >>= readMaybeString
333+
334+ pure $ ResolvedOptions { locale, calendar, numberingSystem, timeZone, era, weekday, year, day, hour, minute, second, timeZoneName }
335+
336+ where
337+ obj = resolvedOptionsImpl fmt
338+
339+ readMaybeString :: Foreign -> F (Maybe String)
340+ readMaybeString f =
341+ if isUndefined f
342+ then pure Nothing
343+ else Just <$> readString f